/PDP-8/E CASSETTE BASIC
/
/		DEC-8E-OBASA-A
/
/		COPYRIGHT	 1973
/		DIGITAL EQUIPMENT CORPORATION
/		MAYNARD, MASS. (01754)
/
/		BILL CLOGHER

/		THIS IS A MODIFIED VERSION OF
/		8K BASIC WHICH IN TURN WAS A MODIFIED
/		VERSION OF EDUSYSTEM 10 BASIC
	FIELD	0
/
/PROGRAM IS VERY SENSITIVE TO PAGE BOUNDARIES--FOREWARNED
/IS FOREARMED!!!!
/



BUFST=6000
BUFEND=BUFST+200

/00000	+----------+
/	!  BASIC   !
/07400	+----------+
/	!  MONITOR !
/	! ROUTINES !
/10000	+----------+
/	!  BASIC   !
/11200	+----------+
/	! OPTIONAL !
/	! FILE I/O !
/	! ELSE     !
/	! ARRAY    !
/	! SPACE    !
/11600  +----------!
/	!  ARRAY   !
/	!  SPACE   !
/	!    !     !
/	!   \!/    !
/    	!    '     !
/	+----------+
/	!  FREE    !
/	+----------+
/	!    .     !
/	!   /!\    !
/	!    !     !
/	! CODIFIED !
/	!  BASIC   !
/	+----------+
/	!  SYMBOL  !
/	!  TABLE   !
/	+----------+
/	!  LINEBUF !
/	+----------+
/	!  STACK   !
/	+----------+
/	!  FORLIST !
/	+----------+
/	!  GOLIST  !
/16000	+----------+
/	! CASSETTE !
/	!  BUFFER  !
/16200	+----------+
/	! CASSETTE !
/	!  MONITOR !
/17777	+----------+


/FOR CASSETTE HANDLER
TLSOUT=7402	/TTY OUTPUT ROUTINE
LLSOUT=7400	/LPT OUTPUT ROUTINE
KBDINP=7626	/KEYBOARD INPUT ROUTINE
WAIT=6200
HNDLR=6600
ENTER=6404
INCHN=7403	/REALLY THE SINCH
LOOKUP=7002
CLOSE=6400
CTRLCJ=7604

CNTLO=7407
MBREAK=7603
/
/8/E INSTRUCTIONS
/
BSW=7002
MQL=7421
MQA=7501
CAM=7621
SWP=7521



/
/CODES FOR LANGUAGE ELEMENTS
/
/4200	+
/4201	-
/4302	*
/4303	/
/4404	^
/4105	=
/4106	<
/4107	>
/4110	<=
/4110	=<
/4111	>=
/4111	=>
/4112	<>
/4113	(UMINUS)
/4014	(DONE)
/4015	,
/4016	;
/4017	)
/4021	TO
/4022	STEP
/4023	(
/4024	FN
/4025	COS
/4026	TAN
/4027	ATN
/4030	LOG
/4031	EXP
/4032	SQR
/4033	ABS
/4034	SGN
/4035	INT
/4036	RND
/4037	SIN
/4040	PUT
/4041	GET
/4042	TAB
/4043	UUF
/4044	LIST
/4044	LIS
/4045	RUN
/4046	SCR(ATCH)
/4047	SAVE
/4047	SAV
/4050	OLD
/4051	NEW
/4052	NAME
/4052	NAM


/6000	(CRLF)
/6000	\
/6001	PRINT#
/6002	PRINT
/6003	LET
/6004	GOTO
/6004	THEN
/6005	IF
/6006	FOR
/6007	NEXT
/6010	GOSUB
/6011	INPUT
/6012	RETURN
/6013	STOP
/6014	DIM
/6015	RESTORE
/6016	REM
/6017	DEF
/6020	READ
/6021	DATA
/6022	(EXIT)
/6023	(EOF)
/6024	END
/6025	TTY OUT
/6026	LPT
/6027	END#
/6030	INPUT#
/6031	NO COMMAS
/6032	COMMAS
/6033	OPEN
/6034	CLOSE
/6035	OUTPUT
/6036	CHAIN
/6037	RUBOUTS
/6040	NO RUBOUTS



FEXIT=0000
FSNE=0040
FSEQ=0050
FSGE=0100
FSLT=0110
FSGT=0140
FSLE=0150
FJMP=1000
FJMPI=1400
FST=2000
FSTI=2400
FLD=3000
FLDI=3400
FAD=4000
FADI=4400
FSB=5000
FSBI=5400
FMP=6000
FMPI=6400
FDV=7000
FDVI=7400
FWD=200
BKWD=600

*3
ARRLOC,	0
CODELOC,0

/COME HERE IF CTRL/C TYPED
CTRLC,	CDF CIF 10	/CLOSE OUTPUT FILE IF ONE OPEN
	JMS I	PCLOS
	JMP I	KM200	/TO 7600 AND MONITOR
*10
XRLOC,	0
XRPUT,	0	/XREGS USED IN MOVING LINES AROUND
O260,	260
OV,	0
INDEX1,	0
INDEX2,	0
AC3,	0
AC2,	0
AC1,	0
OP3,	0
OP2,	0
OP1,	0
ACS,	0
ACE,	0
OPS,	0
O177,	177	
OPE,	0
TMP,	0
PGETCH,	GETCH
PPUTCH,	PUTCH
DIMFLAG,0
FENTER=JMS I .;FPT
PDL,	0
PLINBUF,LINBUF
MLINBUF,-LINBUF
MENDLIN,-ENDLIN
PRTEMP,	0
DECEXP,	0
PNUMBUF,NUMBUF
LOCCTR,	0
READLOC,0
PARGERR,ARGERR
WORD,	0
O240,	240
PSYMTAB,0
NSYMTAB,0
LINENO,	0
GOTEMP,	0
O7740,	7740
O7770,	7770


EPTR,	0
FPTR,	0
GPTR,	0
HPTR,	0
O2,	2

FORCT,	0
SNUMFLG,0
O12,	12
OLDOP,	0
ADDRESS,0
KM200,-200
O377,	377
O7,	7
OPERAND,0;0;0
PTEXT,	XXTEXT
PERROR,	ERROR
PSXERR,	SXERR
PEVAL,	EVAL
PGETADD,GETADDR
PEXECUT,EXECUTE
PPUSH,	PUSH
PPOP,	POP
PFIX,	FIX
PGOTOPR,GOTOPR
PPASSCR,PASSCR
CTRZCK,	CKCTRZ	/PATCH FOR ^Z IN RUNTIME INPUT FILES
PSTOVAR,STOVAR
PGETVAR,GETVAR
PPRINTX,PRINTXT
PGETBLK,GETBLK
PSLOOP,	SLOOP
POUTNUM,OUTNUM
PEDIT,	EDIT
PSTICKI,STICKIT
PNONBLN,NONBLNK
PPRINUM,PRINUM
PGETLIN,GETLIN
PPDLIST,PDLIST
COLUMN,	0
INDEV,	0
OUTD2,	0
OUTDEV,	0
CNTLOZ,	ZCNTLO
RBSWCH,	0	/1-RUBOUTS OK,0-NO RUBOUTS
PRESET,	RESET1


PCOWT,	COWT
	*140	/SEE LOC O140B
O77,	77	/DON'T MOVE
CNCLR,	CKBRAK	/SEE IF HE HIT 'BREAK' TO STOP A RUN
SPLEFT,	RMLEFT
PCLOS,	CLOS	/CLOSE ROUTINE IS IN FIELD 1
PANORM,	ANORM
PAR1,	AR1
PAL1,	AL1
ONE,	2014
ZERO,	0;0;0
PTEN=ZERO	/CONSTANT TEN IS AT LOC. 0 IN FIELD 1!!!
O200,	200
FPFLAG,	0
POADD,	OADD
O4,	4
PLINFIX,LINFIX
O7745,	7745
PCHKFIT,CHKFIT
PGOLIST,GOLIST
GSBPTR,	0
GET=1
ISIT=JMS I .;XISIT;XGISIT
MUSTBE=JMS I .;XMUST;XGMUST
PLBEGIN,LBEGIN
MLBEGIN,-LBEGIN-1
MLEND,	-ENDPDL
PISITLI,ISITLIT
O215,	215
O212,	212
CMSWCH,	-2		/=-2 IF COMMAS ON RT/OUTPUT;=0 IF NO COMMAS
	PAGE

	*.-1


GETWD,	0
	TAD I	LOCCTR
	DCA	WORD
	ISZ	LOCCTR
	JMP I	GETWD
PLETDO,	LETDO
LETDO,	MUSTBE		/'='
	3673
	JMS I	PEVAL
	MUSTBE		/(CR) OR '\'
	2000
	JMS	STOVAR
EXECUTE,JMS	GETWD
	TAD	PLETDO
	DCA	GETVAR
	TAD I	WORD
	SPA
	JMP	KEYWD
	SZA CLA		/IS IT A LINENO
	JMP	NOTKWD	/NO
	TAD	WORD
	DCA	LINENO
	JMS	GETWD
	TAD I	WORD
	SMA CLA
	JMP	NOTKWD
KEYWD,	CLA CLL CML RTR
	TAD I	WORD
	SNL		/IS IT A STATEMENT WORD
	JMP I	PSXERR	/NO
	TAD	SJUMP
	DCA	.+2
	JMS	CKBRAK	/SEE IF HE TYPED 'BREAK'
	0
SJUMP,	JMP I	.+1
	EXECUTE
PRN,	PRINTN	/PRINT# STATEMENT
	PRINT
	LET
	GOTO
	IF
	FOR
	NEXT

	GOSUB
	INPUT
	RETURN
	STOP
	DIM
	RESTORE
	SKIPIT
	DEF
	READ
	SKIPIT
	EXIT
	EDIT
	END
	TTYOUT
	LPTOUT
PENDN,	SXERR	/END# STMT. VALID ONLY AFTER IF STMT.
INPTN,	INPUTN
PCOMMA,	NOCOM
	COMMAS
	OPEN
	CLOSEO
	SXERR	/OUTPUT
	CHAIN
	RUBO
	NORUBO



GETVAR,	0
LET,	JMS	GETWD
NOTKWD,	MUSTBE		/A VARIABLE
	7000
	TAD	WORD
	DCA	VAR
	DCA	SSONE
	DCA	SSTWO
	GET+ISIT		/'('
	3755
	JMP I	GETVAR	/NO
	JMS I	PEVAL
	JMS I	PFIX
	DCA	SSONE
	ISIT		/','
	3763
	JMP	NOCOMMA	/NO
	JMS I	PEVAL
	JMS I	PFIX
	DCA	SSTWO
NOCOMMA,MUSTBE		/')'
	3761
	JMS	GETWD
	JMP I	GETVAR
STOVAR,	0
	JMS I	PGETADDR
VAR,	0
SSONE,	0
SSTWO,	0
	FENTER
	FSTI	ADDRESS
	FEXIT
	JMP I	STOVAR
/
/CHECK TO SEE IF HE TYPED 'BREAK' TO STOP A RUNNING
/BASIC PROG.
/
CKBRAK,	0
	CDF	0
	TAD I	PMBREAK	/DID HE TYPE 'BREAK' TO STOP RUN?
	CDF	10
	SZA	CLA
	JMP I	CKBRAK	/NOPE-JUST RETN.
	CDF	0	
	ISZ I	PMBREAK	/RESET THE FLAG
	CDF CIF 10	/DO A CLOSE IF A RT FILE OPEN
	JMS I	PCLOS
	JMS I	PCOWT	/YUP-WAIT FOR I/O
	JMS I	PRESET	/RESET I/O DEVICES
	JMS I	PPRINTXT	/PRINT MESSAGE
	BREAK
	JMP I	PHLP	/GO GET HELP AND SAVE A WORD
PHLP,	HLP

PMBREAK,	MBREAK

PENDNM,	ENDNM
	*367
FILALT,	JMS I	PPRINTXT /HE TYPED ALTMODE WHILE INPUTTING A FILE NAME
	DELETED		/GIVE MESSAGE AND GO TO EDIT MODE
	JMP I	PEDIT


IF,	GET+ISIT	/MUST DO SPECIAL CHECK  FOR 'END#'
	1751
	SKP		/NOT IT
	JMP I	PENDNM	/ITS 'IF END#'--HANDLE IT
	CLA	IAC	/MUST DO SPECIAL CALL TO EVAL-HAVE WD
	JMS I	PEVAL
	FENTER
	FST	OPERAND
	FEXIT
IF1,	MUSTBE		/'THEN'--COME BACK HERE FROM END# ROUTINE
	1774
	TAD	OPERAND
	SPA SNA CLA
	JMP	SKIPIT
	GET+ISIT	/A LINE#
	0000
	JMP I	XEXECU
	JMP	GOTO+1
XEXECU,	EXECUTE+1
FOR,	GET+MUSTBE	/A VARIABLE
	7000
	JMS	FINDIT
	JMP	NOTHERE
	CLA IAC
	TAD	INDEX1
	DCA	INDEX2
	CLA CMA
	TAD	INDEX1
	DCA	INDEX1
	JMP	INLUPF
LUPF,	TAD I	INDEX2
	DCA I	INDEX1
	TAD I	INDEX2
	DCA I	INDEX1
INLUPF,	ISZ	GOTEMP
	JMP	LUPF
	ISZ	FORCT
NOTHERE,TAD	FORCT
	TAD	O11
	SPA SNA CLA		/CAN'T FIT 9 IN FORLIST
	JMP	FORERR
	TAD	WORD
	CIA
	DCA I	INDEX1
	TAD	WORD
	DCA	FORVAR
	GET+MUSTBE	/'='
	3673
	JMS I	PEVAL
	JMS I	PGETADDR
FORVAR,	0
	0
	0
	FENTER
	FSTI	ADDRESS
	FEXIT
	MUSTBE		/'TO'
	3757
	TAD	LOCCTR
	DCA I	INDEX1
	CLA CMA
	TAD	FORCT
	DCA	FORCT

SKIPIT,	JMS I	PIGNORE		/LOOK FOR "\" OR C.R.
	JMP I	PEXECUTE	/AND EXECUTEPTHE NEXT STATEMENT.

PIGNORE,IGNORE


PASSCR,	0			/THIS LOOKS FOR A REAL C.R.
	JMS I	PIGNORE		/LOOK FOR "\" OR C.R.
	ISZ	WORD
	ISIT
	4100			/A REAL C.R. ?
	JMP	.-4		/NOPE. A SLASH.
	JMP I	PASSCR		/AND RETURN TO CALLER.





FORERR,	JMS I	PERROR
	TEXT 'FOR'
O11,	11
GOSUB,	JMS GETWD
	JMS	GOBOTH
	TAD	GSBPTR
	TAD	MGSBEND
	SNA CLA
	JMP	DEEPERR
	TAD	LOCCTR
	DCA I	GSBPTR
	ISZ	GSBPTR
	JMP	GOTO+2
GOTO,	JMS GETWD
	JMS	GOBOTH
	ISZ	GOTEMP
	TAD I	GOTEMP
	DCA	LOCCTR
	JMP I	PEXECUTE
MGSBEND,-GSBEND
DEEPERR,JMS I	PERROR
	TEXT 'GOSUB'
GOBOTH,	0
	MUSTBE		/A LINENO
	0000
	TAD	WORD
	DCA	GOTEMP
	ISZ	WORD
	ISIT		/DEFINED
	0000
	JMP	ISITDF
	JMS I	PERROR
	TEXT 'LINE#'
ISITDF,	GET+MUSTBE	/(CR) OR '\'
	2000
	JMP I	GOBOTH
VARTEMP,0;0;0
PXFORLI,FORLIST-1
FINDIT,	0
	TAD	FORCT
	DCA	GOTEMP
	TAD	PXFORLIST
	DCA	INDEX1
	JMP	INLOOP
FINDLUP,TAD I	INDEX1
	TAD	WORD
	SNA CLA
	JMP	FOUND
	ISZ	INDEX1
INLOOP,	ISZ	GOTEMP
	JMP	FINDLUP
	JMP I	FINDIT
FOUND,	ISZ	FINDIT
	JMP I	FINDIT

	PAGE

NEXT,	GET+MUSTBE	/A VARIABLE
	7000
	JMS I	PFINDIT
	JMP	NEXTERR
	TAD	WORD
	DCA	NEXTVAR
	GET+MUSTBE	/(CR) OR '\'
	2000
	TAD	LOCCTR
	DCA	LOCTEMP
	TAD I	INDEX1
	DCA	LOCCTR
	JMS I	PEVAL
	FENTER
	FST+FWD+FORLIM-.
	FEXIT
	ISIT		/(CR) OR '\'
	2000
	JMP	TRYSTEP	/NO
	FENTER
	FLD	ONE
	FJMP+FWD+GOTSTEP-.
TRYSTEP,MUSTBE		/'STEP'
	3756
	JMS I	PEVAL
	MUSTBE		/(CR) OR '\'
	2000
	FENTER
GOTSTEP,FST+FWD+FORSTEP-.
	FEXIT
	JMS I	PGETADDR
NEXTVAR,0
	0
	0
	FENTER
	FLDI	ADDRESS
	FAD+FWD+FORSTEP-.
	FST+BKWD+.-VARTEMP
	FSB+FWD+FORLIM-.
	FEXIT
	TAD	ACS
	TAD	FORSTEP
	SMA CLA
	TAD	AC1
	SZA CLA
	JMP	FORDONE
	FENTER
	FLD+BKWD+.-VARTEMP
	FSTI	ADDRESS
	FEXIT
	JMP I	PEXECUTE
FORDONE,TAD	LOCTEMP
	DCA	LOCCTR
	ISZ	FORCT
	ISZ	GOTEMP
	JMP	.-2
	JMP I	PEXECUTE
LOCTEMP,0
PFINDIT,FINDIT
NEXTERR,JMS I	PERROR
	TEXT 'NEXT'
RETURN,	GET+MUSTBE	/(CR) OR '\'
	2000
	TAD	GSBPTR
	TAD	MGOLIST
	SNA CLA
	JMP	RETNERR
	CLA CMA
	TAD	GSBPTR
	DCA	GSBPTR
	TAD I	GSBPTR
	DCA	LOCCTR
	JMP I	PEXECUTE
RETNERR,JMS I	PERROR
	TEXT 'RETURN'
MGOLIST,-GOLIST
FORLIM,	0;0;0
FORSTEP,0;0
SGN,	0
	FENTER
	FSGE
	FLD+FWD+MNSONE-.
	FSLE
	FLD	ONE
	FEXIT
	JMP I	SGN
MNSONE,	6014;0;0
PUTCH,	0
	DCA	SGN
	TAD	SGN
PCCUNT,	AND	O177
	TAD	O7763A
	SNA CLA			/IS IT A C.R.
	DCA	COLUMN	/YES
	TAD	SGN		/RECALL THE CHARACTER.
	AND	O140A
	SZA
	TAD	O7640A
O7640A,	SZA CLA
	ISZ	COLUMN
	TAD	SGN
	JMS I	JPUTCH
	JMP I	PUTCH


O7763A,	7763
O140A,	140
JPUTCH,	PUTER
/
/PART OF GETLIN ROUTINE
/
BARROW,	TAD	EPTR
	TAD	MLBEGIN
	SNA	CLA
	JMP I	(NEWCHAR
	CLA	CMA
	TAD	EPTR
	DCA	EPTR
	TAD	O3737B
	JMS	PUTCH
	JMP I	(NEWCHAR
O3737B,	3737



	PAGE


EVAL,	0
	SNA	CLA	/FOR CALL FROM PRINT AND IF ROUTINES
	JMS	GETWD
	TAD	EVAL
EVALGO,	JMS I	PPUSH
	TAD	O4014
	JMS I	PPUSH
	JMP	GETOPR+1
ISUMIN,	TAD	O4213
	JMS I	PPUSH
GETOPR,	JMS	GETWD
	ISIT		/'-'
	3577
	SKP
	JMP	ISUMIN
	ISIT		/'+'
	3600
	SKP
	JMP	GETOPR
	ISIT		/'('
	3755
	JMP	NOPAREN	/NO
	JMS	EVAL
	MUSTBE		/')'
	3761
	JMP I	PGOTOPR
NOPAREN,ISIT		/A VARIABLE
	7000
	JMP	NOTVAR	/NO
	DCA	ONESS
	DCA	TWOSS
	TAD	WORD
	DCA	WDTEMP
	GET+ISIT	/'('
	3755
	JMP	GOTSS	/NO
	TAD	WDTEMP
	JMS I	PPUSH
	JMS	EVAL
	ISIT		/','
	3763
	JMP	ONEDIM
	JMS I	PFIX
	JMS I	PPUSH
	JMS	EVAL
	JMS I	PFIX
	DCA	TWOSS
	JMS I	PPOP
	JMP	.+3
ONEDIM,	DCA	TWOSS
	JMS I	PFIX
	DCA	ONESS
	MUSTBE		/')'
	3761
	JMS I	PPOP
	DCA	WDTEMP
	JMS	GETWD
GOTSS,	JMS I	PGETADDR
WDTEMP,	0
ONESS,	0
TWOSS,	0
	FENTER
	FLDI	ADDRESS
	FEXIT
	JMP I	.+1
	OPDONE
NOTVAR,	JMS I	PISITLIT /ISIT A LITERAL
	JMP	ISITFUN	/NO
	JMP I	PGOTOPR	/IT IS IN THE AC NOW
ISITFUN,TAD I	WORD
	TAD	O3734		/-4044, WHICH IS BEGINNING OF FUNCTIONS.
	SMA
	JMP I	PSXERR	/BAD!!
	TAD	O20	/IS IT PAST END OF LEGAL FUNCTS??
	SPA			/IS IT A LEGAL FUNCTION?
	JMP I	PSXERR		/NO. EXIT WITH MESSAGE.
	SNA			/WAS IT 'FN'
	JMS	GETWD		/YES,SKIP OVER LETTER
	JMS I	PPUSH
	GET+MUSTBE		/'('
	3755
	JMS	EVAL
	JMS I	PPOP
	TAD	FJUMP
	DCA	.+1
	HLT
	JMP I	.+1
	FNEXIT
FJUMP,	JMS I	FUNTAB
FUNTAB,	FN
	COS
	TAN
	ATN
	LOG
	EXP
	SQR
	ABS
	SGN
	INT
	RND
	SIN
	PUTJ			/POINTER TO PUT CHAR ROUTINE.
	GETJ			/GET A CHAR FROM THE TTY.
	TAB			/TAB FUNCTION IS IMPLEMENTED.
	SXERR			/UNIMPLEMENTED USER FUNCTION.



O20,	20
O3734,	3734
O4014,	4014
O4213,	4213



IMMED,	TAD	PLINBUF
	DCA	LOCCTR
	TAD	PPXXEOF
	DCA	LINENO
	JMP I	PEXECUTE

PPXXEOF,	XXEOF

SPACERR,JMS I	PERROR
	TEXT 'TOO-BIG'
CLOSEO,	CDF CIF 10	/CLOSE HANDLER IS IN FLD.1
	JMS I	PCLOS
	JMP I	PEXECUTE
TUBIG,	JMS I	PRESET
	JMS I	PPRINTXT
	TOOLONG
	JMP I	PNEWLIN
PNEWLIN,	NEWLIN


	PAGE

FNEXIT,	MUSTBE		/')'
	3761
GOTOPR,	JMS	GETWD
OPDONE,	JMS I	PPOP
	DCA	OLDOP
	TAD I	WORD
	AND	O700
	SNA CLA
	JMP	ITSOP
	TAD I	WORD
	AND	O7077
	TAD	O3755
	CLL
	TAD	O23
	SNL CLA
	JMP I	PSXERR
ITSOP,	TAD	OLDOP
	AND	O700
	DCA	OTEMP
	TAD I	WORD
	AND	O700
	CIA
	TAD	OTEMP
	SMA CLA
	JMP	DOITNOW
	TAD	OLDOP
	JMS I	PPUSH
	FENTER
	FST	OPERAND
	FEXIT
	TAD	OPERAND
	JMS I	PPUSH
	TAD	OPERAND+1
	JMS I	PPUSH
	TAD	OPERAND+2
	JMS I	PPUSH
	TAD I	WORD
	JMS I	PPUSH
	JMP I	PGETOPR
DOITNOW,TAD	OLDOP
	AND	O77
	TAD	O7764A
	SNA
	JMP	UDOPER
	IAC
	SNA CLA
	JMP	UMOPER
	TAD	OLDOP
	AND	O77
	TAD	OJUMP
	DCA	OTEMP
	JMS I	PPOP
	DCA	OPERAND+2
	JMS I	PPOP
	DCA	OPERAND+1
	JMS I	PPOP
	DCA	OPERAND
OTEMP,	HLT
O700,	700
O3755,	3755
O7764A,	7764
O7077,	7077
OJUMP,	JMP I	.+1
	PLUS
	MINUS
	STAR
	SLASH
	UPARRX	/OR 'UPARROW' IF NO EXTENDED FNS
	RELATE
	RELATE
	RELATE
	RELATE
	RELATE
	RELATE
PLUS,	FENTER
	FAD	OPERAND
FADEXT,	FEXIT
	JMP	OPDONE
MINUS,	FENTER
	FSB	OPERAND
	FEXIT
UMOPER,	TAD	AC1
	SZA CLA
	CLA CLL CML RAR
	TAD	ACS
	DCA	ACS	/DIRECT REF TO FLOATING AC
	JMP	OPDONE
STAR,	FENTER
	FMP	OPERAND
	FJMP+BKWD+.-FADEXT
SLASH,	FENTER
	FST+FWD+SLSHTMP-.
	FLD	OPERAND
	FDV+FWD+SLSHTMP-.
	FJMP+BKWD+.-FADEXT
SLSHTMP,0;0;0
RELATE,	TAD	OLDOP
	TAD	CONST
	DCA	THESKIP
	CDF	0		/''''''''' 8 K INSERT.
	TAD I	THESKIP
	CDF	10		/''''''''' 8 K INSERT.
	DCA	THESKIP
	FENTER
	FSB	OPERAND
THESKIP,HLT
	FJMP+FWD+4
	FLD	ONE
	FEXIT
	JMP	OPDONE
	FLD	ZERO
	FEXIT
	JMP	OPDONE
UDOPER,	JMS I	PPOP
	DCA	OLDOP
	JMP I	OLDOP
O23,	23
CONST,	.-4104
	FSEQ		/  =
	FSGT		/  <
	FSLT		/  >
	FSGE		/  <=
	FSLE		/  >=
	FSNE		/  <>

PGETOPR,	GETOPR
	PAGE


GETADDR,0
	CDF	0		/''''''''''' 8 K INSERT.
	TAD I	GETADDR
	DCA	INDEX2
	TAD	GETADDR	/USE AN XREG TO SAVE A FEW WDS.
	DCA	XRLOC
	TAD I	XRLOC
	DCA	GSS1
	TAD I	XRLOC

	DCA	GSS2
	CDF	10		/''''''''''' 8 K INSERT.
	TAD I	INDEX2
	DCA	ADDRESS
	ISZ	ADDRESS
	TAD	GSS1
	SNA CLA
	JMP I	XRLOC	/DONE RETURN
	TAD I	INDEX2
	SNA
	JMP	ALLOC
	CLL CMA
	TAD	GSS1
	SZL CLA
	JMP	SSERR
	TAD I	INDEX2
	DCA	GDIM2
	TAD	GSS2
	SNA
	JMP	NOSS2
	CLL CIA
	TAD	GDIM2
	SNL CLA
	JMP	SSERR
	TAD	GSS1
	CIA
	DCA	GSS1
	SKP
	TAD	GDIM2
	ISZ	GSS1
	JMP	.-2
	TAD	GSS2
	DCA	GSS1
NOSS2,	TAD	GSS1
	CLL RAL
	TAD	GSS1
	TAD	ADDRESS
	DCA	ADDRESS
NOSS1,	JMP I	XRLOC
ALLOC,	ISZ	DIMFLAG
	SKP
	JMP	ISDIM
	DCA	DIMFLAG
	TAD	GSS2
	SZA CLA
	TAD	O13
	DCA	GSS2
	TAD	O13
	DCA	GSS1
ISDIM,	TAD	GSS2
	SNA
	CLA IAC
	CIA
	DCA	GDIM2
	CLA CLL IAC
	TAD	GSS1
	SZL
	JMP I	PSPACERR
	ISZ	GDIM2
	JMP	.-4
	DCA	GDIM2
	TAD	GDIM2
	CLL CML RAL
	SNL
	TAD	GDIM2
	DCA	GDIM2
	TAD	GDIM2
	SZL
	JMP I	PSPACERR
	JMS I	SPLEFT
	SKP
	JMP I	PSPACERR
	CLA CLL CMA RAL
	TAD	INDEX2
	DCA	INDEX2
	TAD	ARRLOC
	DCA I	INDEX2
	TAD	GSS1
	DCA I	INDEX2
	TAD	GSS2
	DCA I	INDEX2
	CLA CMA
	TAD	ADDRESS
	DCA	ADDRESS
	TAD	O7774
	DCA	GSS2
	TAD I	ADDRESS
	ISZ	ADDRESS
	JMS I	PSTICKIT
	ISZ	GSS2
	JMP	.-4
	TAD	GDIM2
	CIA
	TAD	O4
	DCA	GDIM2
	JMS I	PSTICKIT
	ISZ	GDIM2
	JMP	.-2
	JMS I	CNCLR		/CHECK FOR CONTROL C.
	JMP	GETADDR+1
GSS1,	0
GSS2,	0
GDIM2,	0
PSPACER,SPACERR
O7774,	7774
O13,	13		/(12) IF 1 ORG INDEXING
SSERR,	JMS I	PERROR
	TEXT 'SUBSCRIPT'
QERROR,	TEXT ' ERROR'

*1575
DEF,	TAD	LINENO
	DCA	INDEX1
	TAD I	INDEX1
	DCA	USERFN
	GET+MUSTBE	/'FN'
	3754
	GET+MUSTBE	/A VARIABLE
	7000
	GET+MUSTBE	/'('
	3755
	GET+MUSTBE	/A VARIABLE
	7000
	GET+MUSTBE	/')'
	3761
	GET+MUSTBE	/'='
	3673
	JMP I	PSKIPIT
PSKIPIT,SKIPIT
USERFN,	0
MORERD,	MUSTBE		/','
	3763
READ,	JMS I	PGETVAR
	CLA CMA
	TAD	LOCCTR
	DCA	LOCTMP
	TAD	READLOC
	DCA	LOCCTR
	GET+ISIT	/(CR) OR '\'
	2000
	SKP
	JMP	SEARCH
	ISIT		/A LINENO
	0000
	SKP
	JMP	SEARCH
	ISIT		/','
	3763
	JMP	DATAERR
ISSOME,	JMS I	PEVAL
	CLA CMA
	TAD	LOCCTR
	DCA	READLOC
	TAD	LOCTMP
	DCA	LOCCTR
	JMS I	PSTOVAR
	GET+ISIT	/(CR) OR '\'
	2000
	JMP	MORERD
	JMP I	PEXECUTE
SCHMOR,	JMS	GETWD
SEARCH,	ISIT		/'TEXT'-MUST IGNORE TEXT IN PRINT OR REM
	5000
	SKP		/NOPE
	JMS I	KIGNORE	/YUP-SKIP TO CR. OR \
	ISIT		/'DATA'
	1757
	SKP
	JMP	ISSOME
	ISIT		/(EOF)
	1755
	JMP	SCHMOR
DATAERR,JMS I	PERROR
	TEXT 'DATA'
KIGNORE,	IGNORE
LOCTMP,	0
GETBLK,	0
	JMS I	PCHKFIT
	CMA
	TAD	CODELOC
	DCA	XRLOC
	TAD	PSYMTAB	/CALCULATE HOW MANY WORDS TO MOVE
	CMA	IAC
	TAD	CODELOC
	DCA	LOCTMP	/STORE AS A COUNTER
	TAD	CODELOC
	TAD	ABCDEF
	DCA	CODELOC
	CMA
	TAD	CODELOC
	DCA	XRPUT	/USE INDEX REGS. FOR MOVE.
	TAD	PSYMTAB		/UPDATE SYMBOL TABLE NOW.
	TAD	ABCDEF		/BY ADDING IN CORRECTION FACTOR.
	DCA	PSYMTAB

GTBKLP,	TAD I	XRLOC		/MOVE TEXT NOW.
	DCA I	XRPUT
	ISZ	LOCTMP		/NOW CHECK FOR END.
	JMP	GTBKLP

	CLA CMA
	TAD	NSYMTAB
	DCA	NSYMTAB
	TAD	GSBPTR
	CMA
	TAD	PGOLIST
	DCA	LOCTMP
	TAD	PGOLIST
	DCA	WORD
	TAD	ABCDEF
	TAD I	WORD
	DCA I	WORD
	ISZ	WORD
	ISZ	LOCTMP
	JMP	.-5
	TAD	FORCT
	DCA	LOCTMP
	TAD	PPFORLIS
	DCA	WORD
	JMP	.+6
	TAD	ABCDEF
	TAD I	WORD
	DCA I	WORD
	ISZ	WORD
	ISZ	WORD
	ISZ	LOCTMP
	JMP	.-6
	TAD	PSYMTAB
	JMP I	GETBLK
ABCDEF,	-4
PPFORLI,FORLIST+1


GETJ,	0			/GETS A CHARACTER FROM THE TTY.
	JMS I	PBEGFIX		/CLEAN UP THE FAC
	JMS I	PGETCH		/FECTH A CHAR.
	DCA	AC3		/SAVE IT, BABY!
	JMS I	PANORM		/AND NORMALIZE AC.
	JMP I	GETJ		/AND RETURN NOW.

PBEGFIX,BEGFIX

	*1776


NOTNOW,	ISZ	WORD
	TAD I	WORD
	SNA
	JMP	INSERT
	DCA	LOWLOC
	DCA I	WORD
	TAD	LOWLOC
	DCA	LOCCTR
	JMS I	PPASSCR
MOVE,	TAD	LOWLOC
	CIA
	TAD	CODELOC
	SNA CLA
	JMP	INSRT5
	CLA CLL CMA
	TAD	LOWLOC
	DCA	LOWLOC
	CLA CLL CMA
	TAD	LOCCTR
	DCA	LOCCTR
	TAD I	LOWLOC
	DCA I	LOCCTR
	JMP	MOVE
INSRT5,	TAD	LOCCTR
	DCA	CODELOC
INSERT,	TAD	FPTR
	TAD	MLINBUF
	CMA
	DCA	FPTR
	CLA CLL CML RTL
	TAD	FPTR
	SNA
	JMP	FIXLIN
	CMA
	JMS I	PCHKFIT
	CLA	CMA
	TAD	PSYMTAB	/AN R.L OPTIMIZATION FOR CASSETTE INPUT
	DCA	LOCCTR	/DON'T LOOK THRU ALL THE LINES
	TAD	INDEV	/IF INPUT FROM CASSETTE-KNOW THEY'RE IN ORDER
	CLL	RAR
	SZA	CLA
	JMP	OLDKLG	/DO THE KLUDGE FOR CASSETTE INPUT
	TAD	CODELOC
	DCA	LOCCTR
	TAD I	PLINBUF
	IAC
	DCA	INDEX1
	TAD I	INDEX1
	DCA	OPERAND
	TAD I	INDEX1
	DCA	OPERAND+1
	SKP
	JMS I	PPASSCR	/SKIP DOWN TO NEXT LINE
OLDKLG,	GET+ISIT	/A LINENO?
	0
	JMP	IAMLESS
	TAD	WORD
	IAC
	DCA	INDEX1
	TAD I	INDEX1
	CLL CMA IAC
	TAD	OPERAND
	SZA	CLA
	JMP	FRSTNE
	TAD I	INDEX1
	CLL CMA IAC
	TAD	OPERAND+1
FRSTNE,	SZL	CLA
	JMP	OLDKLG-1
IAMLESS,	CLA CMA
	TAD	CODELOC
	DCA	XRLOC	/STORE IN INDEX REG.
	TAD	FPTR
	TAD	CODELOC
	DCA	CODELOC
	CLA	CMA
	TAD	CODELOC
	DCA	XRPUT
	TAD	LOCCTR
	CMA	IAC
	TAD	XRLOC
	IAC		/ADJUST BY 1
	DCA	LOWLOC	/STORE IN TEM
	JMP	.+3	/SKIP OVER FIRST TIME
MOVLUP,	TAD I	XRLOC	/GET A WORD
	DCA I	XRPUT	/STORE IN NEW PLACE
	ISZ	LOWLOC	/DONE ALL?
	JMP	.-3	/NOPE
TRANSF,	CLA	CMA
	TAD	PLINBUF
	DCA	XRLOC
TRALUP,	TAD I	XRLOC
	DCA I	XRPUT
	ISZ	FPTR
	JMP	TRALUP
FIXLIN,	JMS I	PLINFIX
	JMP I	PEDIT

IGNORE,	0			/THIS ROUTINE LOOKS FOR A "\" OR A C.R.

	JMS	GETWD
	TAD I	WORD
	TAD	K5000
	SZA		/IS IT TEXT?
	JMP	NOTBAD	/NOPE
	TAD I	LOCCTR	/YUP
	ISZ	LOCCTR	/GET NEXT WORD OF IT
	AND	O77
	SZA CLA			/END OF TEXT?
	JMP	.-4		/NOPE.
	JMP	IGNORE+1	/YEP. GET NEXT ITEM.
NOTBAD,	TAD	K5000	/IS IT CAR.RETN.?
	SNA
	JMP I	IGNORE	/YES-RETN.
	TAD	KM4004	/NO-LOOK FOR LITERAL
	CLL
	TAD	O4
	SNL
	CLA		/NOT A LITERAL
	TAD	LOCCTR	/LITERAL-ADD # OF WDS TO LOCCTR
	DCA	LOCCTR
	JMP	IGNORE+1
LOWLOC,	0
K5000,	5000
KM4004,	3774
O10,	10
*2172
PRINT,	TAD	OUTDEV	/SAVE OUTPUT DEV.
	DCA	OUTD2
PRINT2,	CLA CLL CMA RAL	/ENTER HERE FOR PRINT# W/OUTDEV=CASSETTE
	TAD	OUTDEV
	SMA SZA CLA
	TAD	O10
	TAD	O110	/NOW ADD IN 72. THUS TTY,CASSETTE=72,LPT=80.
	DCA	TWIDTH		/AND SAVE FOR FUTURE USE.
	GET+ISIT			/CHECK FOR FIRST COMMA. ONCE ONLY CHECK.
	3763
	JMP	PRINTC		/NO. CONTINUE CHECKING.
	JMP	PRINBLK		/YEP. GIVE BLANK, THEN TAB OVER.
PRINTG,	JMS	GETWD		/GET NEXT ELEMENT AFTER A TEXT ELEMENT.
PRINTC,	DCA	TABFLG		/RESET TAB INDICATER.
	ISIT			/CHECK TO SEE IF CARRIAGE RETURN.
	2000
	JMP	NOPCR		/NOT A CARRIAGE RETURN. CONTINUE CHECKING.
	JMS I	PPRINTXT
	CRLF
PRINEX,	TAD	OUTD2
	DCA	OUTDEV	/RESTORE OUTPUT DEVICE
	JMP I	PEXECUTE


NOPCR,	ISIT			/IS IT A COMMA (",")
	3763
	JMP	PRENT		/NO. FINISH CHECKING BELOW.
	JMP	PRINCOM		/IT IS. PROCESS THE COMMA NOW.

PRINTHS,ISIT			/TEXT
	5000
	JMP	NOTTXT
PRINQUO,JMS	GETWD
	TAD	WORD
	BSW
	JMS	PRINHAF
	TAD	WORD
	JMS	PRINHAF
	JMP	PRINQUO
NOTTXT,	CLA	IAC	/SPECIAL CALL TO EVAL!!
	JMS I	PEVAL
	TAD	TABFLG		/WAS THERE A TAB PRESENT?
	SZA CLA
	JMP I	TABTHR		/YEP. EXECUTE TAB CORRECTER.
	TAD	O14		/SEE IF ROOM FOR 13 PLACES(1+12).
	JMS	CHECKW
	TAD	ACS
	SMA	CLA
	TAD	O240
	JMS I	POUTNUM	/OUTNUM CALLS PUTCH IF AC NOT=0
	TAD	CMSWCH	/CHECK SWITCH FOR PRINTING COMMAS
	TAD	OUTDEV	/DURING RUNTIME OUTPUT TO CASSETTE
	SNA	CLA
	TAD	O14	/DO IT -CHANGE SPACE TO COMMA!!
	TAD	O240
	JMS I	PPUTCH
	JMP	PRINTC		/GO BACK AND GET NEXT.
PRINHAF,0
	AND	O77
	SNA
	JMP	PRINTG		/GO SKIP PAST TEXT ELEMENT AND CHECK NEXT.
	TAD	OO7736
	SNA
	JMP I	PRINHAF
	TAD	O2
	AND	O77
	TAD	O240
	DCA	ACS		/SAVE CHARACTER FOR A SECOND.
	JMS	CHECKW		/CHECK TO SEE IF IT'LL FIT ON THE LINE.
	TAD	ACS		/RESTORE THE CHARACTER.
	JMS I	PPUTCH
	JMP I	PRINHAF


COMCK,	ISIT		/','
	3763
	JMP	PRINTHS
PRINBLK,CLA			/MAKE SURE AC IS ZERO.
	TAD	O240
	JMS I	PPUTCH
	JMS	CHECKW		/CHECK TO SEE IF ROOM FOR ONE MORE.
PRINCOM,TAD	COLUMN		/SEE IF COLUMN ON COMMA BOUNDRY.
	SNA
	JMP	PRINSEM		/YEP.
	TAD	O7762		/SUBTRACT A LITTLE AN CHECK AGAIN.
	SMA			/TOO FAR?
	JMP	.-4		/NOPE.
	JMP	PRINBLK		/YEP. GIVE BLANK AND LOOP AGAIN.

PRENT,	ISIT		/';'
	3762
	JMP	COMCK
PRINSEM,GET+ISIT	/(CR) OR '\'
	2000
	JMP PRENT
	JMP	PRINEX
OO7736,	7736
O7762,	7762
LINFIX,	0
	TAD	CODELOC
	DCA	LOCCTR
LFXLUP,	JMS	GETWD
	TAD I	WORD
	SZA CLA		/IS IT A LINENO
	JMP I	LINFIX	/NO
	ISZ	WORD
	CLA CMA
	TAD	LOCCTR
	DCA I	WORD
	JMS I	PPASSCR
	JMP	LFXLUP


TABFLG,	0			/TAB FOUND FLAG.

CHECKW,	0			/THIS ROUTINE CHECKS FOR LINE TOO LONG.
	TAD	COLUMN		/GET WHERE AT NOW.
	CMA			/-WHEREAT-#OF PLACES IN OUT CHAR.
	TAD	TWIDTH		/ADD IN WIDTH OF DEVICE.
	SMA CLA			/TOO BIG.
	JMP I	CHECKW		/NAH. RETURN TO SENDER.
	JMS I	PPRINTXT	/YEP.GIVE C.R.L.F.
	CRLF
	JMP I	CHECKW		/AND RETURN TO SENDER.

TWIDTH,	0			/0 IS OK SINCE IT'LL BE SET UP CORRECTLY.
O14,	14			/MAGIC CONSTANT.
O110,	110			/WDTH OF TTY PAPER.

TABTHR,	TABDO			/ROUTINE WHICH PROCESS TAB CHARACTER.

MENDPDL,-ENDPDL-1

PUSH,	0
	DCA I	PDL
	ISZ	PDL
	TAD	PDL
	TAD	MENDPDL
	SZA CLA
	JMP I	PUSH
	JMS I	PERROR
	TEXT 'EXPRESSION'
PAGE




END,	JMS	CLEARV	
STOP,	CDF CIF 10	/GO CLOSE RUNTIME OUTPUT FILE IF ONE OPEN
	JMS I	PCLOS	/ROUTINE IS IN FIELD 1
	JMS I	PCOWT	/WAIT FOR I/O TO FINISH UP
	JMS I	PRESET	/RESET DEVICES
	JMS I	PPRINTXT	/GIVE THE STOP MESSAGE
	READY
EXIT,	JMS I	PCOWT		/WAIT FOR BUFFER TO EMPTY AND THEN CONTINUE.
	TAD	O215
	JMS I	PPUTCH
EDIT,	TAD	O212
	JMS I	PPUTCH
	TAD	OUTD2		/RESET DEVICE
	DCA	OUTDEV
	JMS I	CNCLR		/CHECK TO SEE IF ^C WAS TYPED.
	TAD	PXXTHEN
	JMS I	PGETLIN
	TAD I	PLINBUF
	DCA	WORD
	TAD I	WORD
	SNA CLA
	JMP I	PNOTNOW
	TAD	O212
	JMS I	PPUTCH
	TAD	OUTD2		/RESET I/O DEVICE.
	DCA	OUTDEV
	ISIT		/'RUN'
	3733
	SKP
	JMP	RUN
	ISIT		/'LIS'
	3734
	SKP
	JMP I	PLIST
	ISIT		/'SCR'
	3732
	JMP	SAVE1
SCRATCH,TAD	PPERMSYM
	DCA	CODELOC
	TAD	PXXEOF
	DCA I	PPERMSYM
	TAD	PPERMSYM
	IAC
	DCA	PSYMTAB
	CLA CMA
	DCA	NSYMTAB
RUNC,	JMS I	PRESET		/RESET DEVICES AFTER SCRATCH.
			/PROGRAM CHAINED TO STARTS HERE(RUNC) AFTER
			/ALL IS READ AND COMPILED
RUN,	JMS	CLEARV
	JMP I	PEXECUTE

SAVE1,	CDF CIF 10	/SAVE ROUTINE IS IN FIELD 1
	JMP I	PSAVE
PSAVE,	SAVE


CLEARV,	0
	TAD	PSYMTAB
	DCA	EPTR
	TAD	NSYMTAB
	DCA	FPTR
	JMP	RUNIN
RUNLUP,	TAD I	EPTR
	TAD	O7000A
	SZA CLA		/IS IT A VARIABLE
	JMP	RUNNOT	/NO
	ISZ	EPTR
	TAD I	EPTR
	DCA	GPTR
	TAD I	GPTR
	DCA I	EPTR
	SKP
RUNNOT,	ISZ	EPTR
	ISZ	EPTR
	ISZ	EPTR
	ISZ	EPTR
RUNIN,	ISZ	FPTR
	JMP	RUNLUP
	TAD	PLIMIT
	DCA	ARRLOC
	TAD	PSYMTAB
	DCA	EPTR
	TAD	NSYMTAB
	DCA	FPTR
	JMP	RUN2IN
RUN2LUP,TAD I	EPTR
	TAD	O7000A
	SZA CLA		/IS IT A VARIABLE
	JMP	RUN2NOT	/NO
	ISZ	EPTR
	TAD I	EPTR
	DCA	TMP
	TAD	ARRLOC
	DCA I	EPTR
	TAD	TMP
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	ISZ	EPTR
	DCA I	EPTR
	ISZ	EPTR
	DCA I	EPTR
	JMP	.+4
RUN2NOT,ISZ	EPTR
	ISZ	EPTR
	ISZ	EPTR
	ISZ	EPTR
RUN2IN,	ISZ	FPTR
	JMP	RUN2LUP
	TAD	CODELOC
	DCA	LOCCTR
	TAD	PPDLIST
	DCA	PDL
	TAD	CODELOC
	DCA	READLOC
	CLA CMA
	DCA	FORCT
	TAD	PGOLIST
	DCA	GSBPTR
	JMP I	CLEARV
O7000A,	7000
PLIMIT,	LIMIT		/FIRST WORD OF USER AREA
PXXTHEN,XXTHEN
PLIST,	LIST
PXXEOF,	XXEOF
PPERMSY,PERMSYM
PNOTNOW,NOTNOW
OCASERR,	JMS I	PERROR
	TEXT 'OUT'	/OUTPUT ERROR ON CASSETTE


	*2577

GETLRET,JMS I	PLINFIX
	JMS I	CNCLR		/CHECK TO SEE IF ^C WAS TYPED WHILE HERE.
	JMP I	GETLIN
GETLIN,	0
	DCA	SNUMFLG
	TAD	OUTDEV		/GET THE OUTPUT DEVICE.
	DCA	OUTD2		/SAVE FOR A SECOND.
NEWLIN,	CLA CLL CMA RAL		/CHECK THE INPUT DEVICE NOW.
	TAD	INDEV		/GET IT, BABY.
O7700,	SMA CLA			/IS IT THE TTY?
	JMP	.+3		/NOPE.
	JMS I	CNTLOZ		/IT IS. RESET CONTROL O.
	CLA IAC			/AND TEMPORARILY SET THE OUTPUT TO THE TTY.
	DCA	OUTDEV		/(TURN OFF OUT DEV.)
	TAD	PLBEGIN
	DCA	EPTR
	TAD	O40
	DCA I	EPTR
	ISZ	EPTR
NEWCHAR,JMS I	PGETCH
	DCA I	EPTR
	TAD I	EPTR
	TAD	O7603
	SNA		/IS IT ALT-MODE (175)
	JMP	ALTMODE	/YES
	TAD	O36
	SNA		/IS IT '_'
	JMP I	PBARROW	/YES
	TAD	O122
	SNA		/IS IT (CAR. RET.)
	JMP	CARRET	/YES
	TAD	O7715
	SNA		/IS IT '@'
	JMP	NEWCHAR	/YES
	AND	O140B
	SZA
	TAD	O7640B
	SZA CLA		/IS IT A PRINTABLE CHARACTER
	JMP I	CTRZCK	/NO-MAKE SPECIAL ^Z CHECK
	TAD	OUTDEV	/DON'T CALL OUTPUT ROUTINE IF INPUT
	SNA	CLA	/IS FROM CASSETTE (OUTDEV=0)
	JMP	.+3
	TAD I	EPTR
	JMS I	PPUTCH
	TAD	EPTR
	TAD	MLEND
	SZA CLA
	JMP	NEWCHAR-1
	JMP I	.+1
	TUBIG
ALTMODE,	JMS I	PPRINTXT
	DELETED
	JMP	NEWLIN
CARRET,	TAD	OUTDEV	/DON'T PRINT IF OUTDEV=0
	SNA	CLA	/COLUMN POINTER WILL BE SCREWED
	JMP	.+3	/UP
	TAD	O215
	JMS I	PPUTCH
	TAD	PLBEGIN	/EPTR=BEGINNING OF STRING
	DCA	EPTR	/FPTR=WHERE TRANSLATED SYMBOL GOES
	TAD	PLINBUF	/GPRE=CHAR IN STRING(.GE. EPTR)
	DCA	FPTR	/HPTR=POSITION IN TABLE
SLOOP,	TAD	PTABLE
	DCA	HPTR
HLOOP,	TAD I	EPTR	/AN RL'ISM TO SPEED UP THE SEARCH
	TAD	O7740
	SZA
	JMP	.+3
	ISZ	EPTR
	JMP	HLOOP
	CLL BSW
	AND	O7700
	CMA	IAC
	DCA	TMP
GLOOP,	TAD	EPTR
	DCA	GPTR
	TAD I	HPTR
	SNA CLA
	JMP	O40	/GO FALL THROUGH PAGE TO OTHER!!!!!!!!!
	TAD	HPTR
	DCA	WORD
	ISZ	HPTR
	CLA CLL CML RAR
	TAD I	HPTR
	AND	O7700
	SZA
	TAD	TMP
	SZA	CLA
	JMP	SKPSYM
	DCA	ACS
HLOP1,	TAD I	GPTR	/IGNORE BLANKS
	TAD	O7740
	SNA	CLA
	JMP	NEXTG
BSKIP,	CLA CLL CML RAR
	TAD	ACS
	DCA	ACS
	TAD I	HPTR
	SZL
	ISZ	HPTR
	SNL
	BSW
O140B,	AND	O77
	SNA
	JMP I	JMATCH
	TAD	O7740
	SNA
	JMP	BSKIP
	AND	O77
	TAD	O40
	CIA
	TAD I	GPTR
NEXTG,	ISZ	GPTR
	SNA CLA
	JMP	HLOP1
SKPSYM,	TAD I	HPTR
	AND	O77
	ISZ	HPTR
O7640B,	SZA CLA
	JMP	.-4
	JMP	GLOOP
JMATCH,	AMATCH
O36,	36
O122,	122
PBARROW, BARROW
O7603,	7603
O7715,	7715
PTABLE,	XXPLUS
	*2777	/MUST BE LAST LOC OF PAGE-JUMP HERE AND
		/FALL THROUGH TO OTHER!!!!!!!!
O40,	40




/"OTHER" MUST BE FIRST LOC. OF PAGE---FALL THROUGH PAGE BOUNDARY
/TO HERE!!!!!!!!!!!!!
*3000
OTHER,	JMS	NONBLNK	/MUST BE FIRST LOC OF PAGE
	TAD	O7763B
	SZA
	JMP	NOTCR
	TAD	PXXCRLF
	DCA I	FPTR
	TAD	FPTR
	DCA	INDEX1
	TAD	PXXEXIT
	DCA I	INDEX1
	TAD	INDEX1
	TAD	MENDLIN
	SNA
	JMP I	PGETLRET
	SPA CLA
	JMP	.-7
	JMP I	PTUBIG
PTUBIG,	TUBIG
PGETLRE,GETLRET
NOTCR,	TAD	O7737
	SNA
	JMP	DIGIT
	TAD	O7764B
	CLL
	TAD	O12
	SZL
	JMP	DIGIT
	TAD	O7725A
	CLL
	TAD	O32
	SZL
	JMP I	PLETTER
	CLA CLL CML RAR
	TAD I	EPTR
	DCA I	EPTR
REMPACK,TAD	PTEXT
	DCA I	FPTR
	ISZ	FPTR
TXTPAK,	MQL		/FLIP TO MQ
	TAD I	EPTR
	TAD	O7763B
	SNA
	JMP	CRINTXT
	TAD	O7753
	SNA CLA
	JMP	DQINTXT
	TAD I	EPTR
	AND	O77
	SWP
	SNA
	JMP	LHALF
	MQA
	DCA I	FPTR
	ISZ	FPTR
	JMP	RHALF
LHALF,	MQA
	CLL BSW
RHALF,	ISZ	EPTR
	JMP	TXTPAK
CRINTXT,	MQA
	JMP	MTXXIT
O7725A,	7725
O7763B,	7763
O7764B,	7764
PLETTER,LETTER
O7753,	7753
O4200,	4200
O42,	42
NONBLNK,0
	TAD I	EPTR
	TAD	O7740
	SZA CLA
	JMP	.+3
	ISZ	EPTR
	JMP	NONBLNK+1
	TAD I	EPTR
	JMP I	NONBLNK
O32,	32
O7737,	7737
PXXCRLF,XXCRLF
PXXEXIT,XXEXIT
POPERA,	OPERAND-1
PXXLIT0,XXLIT0
LITRAL,	FENTER
	FST	OPERAND
	FEXIT
	TAD	OPERAND+2
	SZA CLA
	JMP	ALL3
	TAD	OPERAND+1
	SZA CLA
	JMP	JUST2
	TAD	OPERAND
	SNA CLA
	JMP	JUST0
JUST1,	CLA CLL CMA RAL
ALL3,	IAC
JUST2,	TAD	O2
JUST0,	CMA
	DCA	TMP

	TAD	POPERA
	DCA	INDEX1
	TAD	TMP
	CMA
	TAD	PXXLIT0
	JMP	JUST0P
JUST0F,	CDF	0		/'''''''''''' 8 K INSERT.
	TAD I	INDEX1
	CDF	10		/'''''''''''' 8  K INSERT.
JUST0P,	DCA I	FPTR
	ISZ	FPTR
	ISZ	TMP
	JMP	JUST0F
	JMP I	PSLOOP


DQINTXT,MQA
	ISZ	EPTR
	SZA
	JMP	.+3
	TAD	O4200
	JMP	MTXXIT
	TAD	O42
	DCA I	FPTR
	ISZ	FPTR
MTXXIT,	DCA I	FPTR
	ISZ	FPTR
	JMP I	PSLOOP


*3176

DIGIT,	CLA
	TAD I	SNUMFLG
	TAD	O1770
	SZA		/IS IT 'GOTO' OR 'THEN'
	TAD	O4
	SZA		/OR 'GOSUB'
	TAD	O1740
	SNA CLA		/OR 'LIST'
	CLA CMA		/YES
	DCA	SNUMFLG
	FENTER
	FLD	ZERO
	FEXIT
	CLA	CMA
	DCA	DPFLAG
	DCA	DECFRAC
	JMP	DIGIN1
ITSDP,	ISZ	DPFLAG
	JMP	ENDNUM
DIGIN,	ISZ	EPTR
DIGIN1,	JMS I	PNONBLNK
	TAD	O7673
	SNA
	JMP	ITSE
	TAD	O27
	SNA
	JMP	ITSDP
	TAD	O7764C
	CLL
	TAD	O12
	SNL
	JMP	ENDNUM
	CLL RAR
	TAD	O2040A
	DCA	FDIGIT
	RAR
	DCA	FDIGIT+1
	FENTER
	FMPI	PTEN
	FAD+FWD+FDIGIT-.
	FEXIT
	TAD	DPFLAG
	SMA CLA
	ISZ	DECFRAC
	JMP	DIGIN
ITSE,	DCA	FDIGIT
	TAD	SNUMFLG
	SZA CLA
	JMP	ENDNUM
	ISZ	EPTR
	JMS I	PNONBLNK
	TAD	O7725B
	SNA
	JMP	ITSP
	TAD	O7776
	SZA CLA
	JMP	NOTSGN
	ISZ	FDIGIT
ITSP,	ISZ	EPTR
NOTSGN,	JMS I	JISDIG
	JMP	ENDNUM
	ISZ	EPTR
	DCA	FDIGIT+1
	JMS I	JISDIG
	JMP	ONLY1
	CLA
	TAD	FDIGIT+1
	CLL RTL
	TAD	FDIGIT+1
	CLL RAL
	DCA	FDIGIT+1
	JMS I	JISDIG
O7673,	7673
	TAD	FDIGIT+1
	DCA	FDIGIT+1
	ISZ	EPTR
ONLY1,	TAD	FDIGIT
	CLL RAR
	TAD	FDIGIT+1
	SNL
	CIA
	TAD	DECFRAC
	DCA	DECFRAC
ENDNUM,	CLA
	TAD	DECFRAC
	SMA CLA
	TAD	DIVXTEN
	TAD	MULXTEN
	DCA	MULEXP
	TAD	DECFRAC
	SPA
	CIA
	CMA
	DCA	DECFRAC
	JMP	MULX1
FDIGIT,	0;0;0
MULXTEN,FMPI	PTEN
DIVXTEN,FDV-FMP
DPFLAG,	0
DECFRAC,0
JISDIG,	ISDIG
O27,	27
O7725B,	7725
O7776,	7776
O2040A,	2040
O7764C,	7764
O1740,	1740
O1770,	1770
PLITRAL,	LITRAL
LERR,	JMS I	PERROR
	TEXT 'LOOKUP'
CHNERR,	JMS I	PERROR
CHNMS,	TEXT 'CHAIN'


	*3366
	FENTER
MULEXP,	HLT
	FEXIT
MULX1,	ISZ	DECFRAC
	JMP	.-4
	ISZ	SNUMFLG
	JMP I	PLITRAL
	JMS I	PFIX
	CLA		/FALL THRU TO COMMON!!!!!

	*3377

COMMON,	TAD	PSYMTAB
	DCA	GPTR
	TAD	NSYMTAB
	DCA	HPTR
	JMP	IN
LUP,	TAD I	GPTR
	ISZ	GPTR
	ISZ	GPTR
	SZA CLA		/IS IT A LINENO
	JMP	NOT	/NO
	TAD I	GPTR
	ISZ	GPTR
	CIA
	TAD	AC2
	SZA CLA
	JMP	NOT+1
	TAD I	GPTR
	CIA
	TAD	AC3
	SZA CLA
	JMP	NOT+1
	CLA CLL CMA RTL
	JMP	ISDEF2
NOT,	ISZ	GPTR
	ISZ	GPTR
IN,	ISZ	HPTR
	JMP	LUP
	JMS I	PGETBLK
	DCA	SNUMFLG
	DCA I	SNUMFLG
	TAD	SNUMFLG
	DCA	INDEX1
	DCA I	INDEX1
	TAD	AC2
	DCA I	INDEX1
	TAD	AC3
	DCA I	INDEX1
	JMP	ITSDEF
LETTER,	IAC
	CLL RTL
	RTL
	RTL
	DCA	TMP
	ISZ	EPTR
	JMS I	PNONBLNK
	TAD	O7706C
	CLL
	TAD	O12
	SNL CLA
	JMP	SIMPLV
	TAD I	EPTR
	TAD	TMP
	DCA	TMP
	ISZ	EPTR
SIMPLV,	TAD	PSYMTAB
	DCA	GPTR
	TAD	NSYMTAB
	DCA	HPTR
	JMP	VSCHIN
O7706C,	7706
O7000B,	7000
VSCHLUP,TAD I	GPTR
	TAD	O7000B
	SZA CLA
	JMP	VSCHNOT
	ISZ	GPTR
	TAD I	GPTR
	DCA	SNUMFLG
	TAD I	SNUMFLG
	CIA
	TAD	TMP
	SZA CLA
	JMP	VSCHNOT+1
	CLA CMA
ISDEF2,	TAD	GPTR
	DCA	SNUMFLG
ITSDEF,	TAD	SNUMFLG
	DCA I	FPTR
	ISZ	FPTR
	JMP I	PSLOOP
VSCHNOT,ISZ	GPTR
	ISZ	GPTR
	ISZ	GPTR
	ISZ	GPTR
VSCHIN,	ISZ	HPTR
	JMP	VSCHLUP
	JMS I	PGETBLK
	DCA	SNUMFLG
	CLA CMA
	TAD	SNUMFLG
	DCA	INDEX1
	TAD	O1000
	DCA I	INDEX1
	TAD	ARRLOC
	DCA I	INDEX1
	DCA I	INDEX1
	DCA I	INDEX1
	JMS I	PCHKFIT
	TAD	TMP
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	JMS I	PSTICKIT
	JMP	ITSDEF
O1000,	1000
PUTJ,	0
	JMS I	PFIX
	CLA
	TAD	AC3
	JMS I	PPUTCH
	JMS I	PANORM
	JMP I	PUTJ
TWOLF,	TEXT '__'
UGH1,	TEXT '_TOO BIG. LINE IGNORED_'
OPEN,	CDF CIF 10	/OPEN PROCESSOR IS IN FLD 1
	JMP I	.+1
	OPEN1


	PAGE


LIST,	TAD I	PXLINBUF
	DCA	WORD
	ISIT		/LINENO
	0000
	JMP	LISTALL
	ISZ	WORD
	TAD I	WORD
	SNA
LISTALL,TAD	CODELOC
LISTSOM,DCA	LOCCTR
LISTLUP, GET+ISIT		/(EOF)
	1755
	JMP	LNOEND		/NOT DUNE YET
	TAD	OUTDEV	/OUTPUT A CHAR. DEPENDING ON DEVICE
	TAD	(TAD TABL-1	/TTY:NULL,CASSETTE:CTRL/Z,LPT:FORMFEED
	DCA	.+1
	0
	JMS I	PPUTCH
	JMS I	PCOWT		/WAIT FOR I/O TO FINISH AND CLEAN UP.
	JMS	PRINTXT
	TWOLF
	JMP I	PSTOP
LNOEND,	ISIT		/A LINENO
	0000
	JMP	LIST2	/NO
	TAD	WORD
	JMS I	PPRINUM
	TAD	O240
	JMS I	PPUTCH
	JMP	LISTLUP
LIST2,	ISIT		/A VARIABLE
	7000
	JMP	LIST3
	ISZ	WORD
	TAD I	WORD
	DCA	WORD
	TAD I	WORD
	DCA	PRINVAR
	JMS	PRINTXT
	PRINVAR
	JMP	LISTLUP
PRINVAR,0
TABL,	0	/NULL FOR TTY:-(ZERO MUST FOLLOW PRINVAR!!!)
	232		/CTRL/Z FOR END OF FILE ON CASSETTE
	214		/FORM FEED FOR LPT
LIST3,	JMS I	PISITLIT /ISIT A LITERAL
	JMP	LIST4	/NO
	JMS I	POUTNUM	/PRINT IT
	JMP	LISTLUP
LIST4,	ISIT		/(TEXT)
	5000
	JMP	LIST5
L4LUP,	JMS	GETWD
	TAD	WORD
	DCA	PRINVAR
	JMS	PRINTXT
	PRINVAR
	TAD	WORD
	AND	O77
	SZA CLA
	JMP	L4LUP
	JMP	LISTLUP
LIST5,	TAD	WORD	/ITS A SYSTEM SYMBOL
	IAC
	JMS	PRINTXT

	JMP	LISTLUP
PRINTXT,0
	SZA
	JMP	JBPENT+1	/'''''''''''' 8 K INSERT.
	CDF	0		/'''''''''''' 8 K INSERT.
	TAD I	PRINTXT
JBPENT,	ISZ	PRINTXT
	DCA	PRTEMP
PRLOOP,	TAD I	PRTEMP
	BSW
	JMS	PRSUBR
	TAD I	PRTEMP
	JMS	PRSUBR
	ISZ	PRTEMP
	JMP	PRLOOP
PRTXRET,CDF	10		/'''''''' 8 K INSERT.
	JMP I	PRINTXT
PRSUBR,	0
	AND	O77
	SNA
	JMP	PRTXRET
	TAD	O7741
	SNA
	JMP	CRLFPR
	TAD	O77
	AND	O77
	TAD	O240
	JMS I	PPUTCH
	JMP I	PRSUBR
CRLFPR,	TAD	O215
	JMS I	PPUTCH
	TAD	O212
	JMS I	PPUTCH
	JMP I	PRSUBR
O7741,	7741
PXLINBU,LINBUF+1
PRINUM,	0
	IAC
	DCA	INDEX1
	JMS	BEGFIX		/SET UP FAC TO RECEIVE INTEGER DATA.
	TAD I	INDEX1
	DCA	AC2
	TAD I	INDEX1
	DCA	AC3
	JMS I	PANORM
	JMS I	POUTNUM
	JMP I	PRINUM




BEGFIX,	0			/SETS UP FOR INTEGER TO AC MODE.
	DCA	AC2		/CLEAR THEM ALL, EXCEPT FOR LOW WORD.
	DCA	AC1
	DCA	OV
	DCA	ACS
	TAD	O233
	DCA	ACE
	JMP I	BEGFIX

O233,	233


RESTORE,GET+MUSTBE	/(CR) OR '\'
	2000
	TAD	CODELOC
	DCA	READLOC
	JMP I	PEXECUTE



PSTOP,	STOP

PAGE



MOREIN,	ISIT		/(CR) OR '\'
	2000
	JMP	INPLUP
	TAD	O212
	JMS I	PPUTCH
	TAD	OUTD2		/GET THE OLD OUTPUT DEVICE.
	DCA	OUTDEV		/AND RESET IT.
INPUT,	CLA CMA			/CHECK THE INPUT DEVICE NOW.
	TAD	INDEV		/ARE WE INPUT FROM THE TELETYPE.
	SZA CLA
	JMP	IPNOPE		/NOPE.
	TAD	OUTDEV		/GET THE OUTPUT DEVICE.
	JMS I	PPUSH		/SAVE IT FOR A SECOND.
	CLA IAC			/SET OUTPUT DEVICE TO TTY FOR "?"
	DCA	OUTDEV
	JMS I	PCOWT		/WAIT FOR OUTPUT TO FINISH, THEN CONTINUE.
	TAD	O77
	JMS I	PPUTCH
	JMS I	PPOP		/RESET OUTPUT DEVICE NOW.
	DCA	OUTDEV
IPNOPE,	TAD	LOCCTR
	DCA I	GSBPTR
	TAD	PTEXT
	JMS I	PGETLIN
	TAD I	GSBPTR
	DCA	LOCCTR
	TAD	PLINBUF
	DCA	INPPTR
INPLUP,	JMS I	PGETVAR
	TAD	WORD
	DCA	INWDTMP
	TAD	LOCCTR
	DCA	INLCTMP
	TAD	INPPTR
	DCA	LOCCTR
	JMS I	PEVAL
	CLA	CMA
	TAD	INDEV
	SNA	CLA
	JMP	NOCR
	ISIT
	3763
	JMP	NOCR
	GET+ISIT
	2000
	CLA	CMA
NOCR,	TAD	LOCCTR
	DCA	INPPTR
	TAD	INLCTMP
	DCA	LOCCTR
	JMS I	PSTOVAR
	CLA CLL CML RTR
	TAD I	INWDTMP
	SZA CLA
	JMP	MOREIN
	TAD	O212
	JMS I	PPUTCH
	TAD	OUTD2		/RESET THE DEV, BABY
	DCA	OUTDEV
	CLA	IAC	/RESET INPUT TO TTY
	DCA	INDEV 
	JMP I	PEXECUTE
INPPTR,	0
INLCTMP,0


ISITLIT,0
	TAD I	WORD
	CLL CMA RTL
	CML RTR
	DCA	ACS
	TAD	ACS
	TAD	O4
	SNL CLA
	JMP I	ISITLIT
	ISZ	ISITLIT
	DCA	AC1
	DCA	AC2
	DCA	AC3
	JMS	ISLIT
	DCA	AC3
	JMS	ISLIT
	DCA	AC2
	JMS	ISLIT
	DCA	AC1
LOADED,	FENTER
	FLD	AC3
	FEXIT
	JMP I	ISITLIT
ISLIT,	0
	ISZ	ACS
	SKP
	JMP	LOADED
	JMS	GETWD
	TAD	WORD
	JMP I	ISLIT
ERROR,	0
INWDTMP=ERROR
	CDF CIF 10	/CLOSE RUNTIME OUTPUT FILE IF ONE WAS OPEN
	JMS I	PCLOS
	JMS I	PRESET		/RESET ALL I/O DEVICES.
	JMS I	PPRINTXT
	CRLF
	TAD	ERROR
	DCA	.+2
	JMS I	PPRINTXT
	HLT
	JMS I	PPRINTXT
	QERROR
	TAD I	LINENO
	SPA CLA
	JMP	.+5
	JMS I	PPRINTXT
	ATLINE
	TAD	LINENO
	JMS I	PPRINUM
	JMS I	PPRINTXT
	CRLF
HLP,	TAD	PPDLIST
	DCA	PDL
	JMP I	PEDIT

POP,	0
	CLA CMA
	TAD	PDL
	DCA	PDL
	TAD I	PDL
	JMP I	POP

CKCTRZ,	TAD	EPTR	/SPECIAL ^Z CHECK FOR RUNTIME INPUT
	CDF CIF 10	/GO TO FIELD 1
	JMP I	.+1
	CTRZHP

	PAGE




	/	JMS	FPT	/ENTER FLOATING POINT PACK
	/	0000		/FEXIT
	/	0040		/FSNE
	/	0050		/FSEQ
	/	0100		/FSGE
	/	0110		/FSLT
	/	0140		/FSGT
	/	0150		/FSLE
	/		IF BIT 4 OFF THEN SAME AS PDP-8
	/		IF BIT 4 ON THEN IF BIT 3 OFF THEN RELATIVE PLUS
	/				 IF BIT 3 ON THEN RELATIVE MINUS
	/	1XXX		/FJMP
	/	2XXX		/FST
	/	3XXX		/FLD
	/	4XXX		/FAD
	/	5XXX		/FSB
	/	6XXX		/FMP
	/	7XXX		/FDV
FPT,	0
	JMP	.+3
FPLOOP,	JMS I	PANORM
	ISZ	FPT
	CDF	0		/'''''''' 8 K INSERT.
	TAD I	FPT
	RTL
	RTL
	AND	O7
	SNA
	JMP	FPOPER
	DCA	FPGOTO
	TAD I	FPT
	AND	O200
	SNA CLA
	JMP	FPPGZ
	TAD I	FPT
	AND	O177
	SZL
	CIA
	TAD	FPT
	DCA	FPADDR
	JMP	FPDOIT
FPPGZ,	TAD I	FPT
	AND	O177
	DCA	FPADDR
	SNL
	JMP	FPDOIT
	TAD I	FPADDR
	DCA	FPADDR
	CDF	10		/'''''''' 8 K INSERT.
FPDOIT,	CLA CLL CMA RTL
	TAD	FPGOTO
	SPA CLA
	JMP	FPNOADR
	CLA CLL CML RAR
	AND I	FPADDR
	DCA	OPS
	TAD I	FPADDR
	SZA CLA
	CMA
	DCA	FPFLAG
	TAD I	FPADDR
	RTR
	RAR
	AND	O377
	DCA	OPE
	TAD I	FPADDR
	AND	O7
	DCA	OP1
	ISZ	FPADDR
	TAD I	FPADDR
	DCA	OP2
	ISZ	FPADDR
	TAD I	FPADDR
	DCA	OP3
FPNOADR,TAD	FPGOTO
	TAD	FPJUMP
	DCA	.+1
FPGOTO,	HLT
FPJUMP,	JMP I	.
	FPJMP
	FPSTO
	FPLAC
	FPADD
	FPSUB
	FPMUL
	FPDIV
FPADDR,	0
FPOPER,	TAD I	FPT
	CDF	10		/''''''''''' 8 K INSERT.
	SNA
	JMP I	FPT
	TAD	O7600
	DCA	FPSKIP
	JMS	HIGHWD
FPSKIP,	HLT
	ISZ	FPT
	JMP	FPLOOP+1
FPJMP,	TAD	FPADDR
	DCA	FPT
	JMP	FPLOOP+2
FPSTO,	JMS	HIGHWD
	DCA I	FPADDR
	ISZ	FPADDR
	TAD	AC2
	DCA I	FPADDR
	ISZ	FPADDR
	TAD	AC3
	DCA I	FPADDR
	JMP	FPLOOP+1
HIGHWD,	0
	TAD	ACE
	CLL RAL
	SMA

	CLL RTL
	SPA SZL
	JMP	O7600
	TAD	ACS
	TAD	AC1
	JMP I	HIGHWD
O7600,	7600
	TAD	O377
	DCA	ACE
	JMP	HIGHWD+1
FPLAC,	TAD	OPS
	DCA	ACS
	TAD	OPE
	DCA	ACE
	TAD	OP1
	DCA	AC1
	TAD	OP2
	DCA	AC2
	TAD	OP3
	DCA	AC3
	DCA	OV
	JMP	FPLOOP
UPARR2,	CIA		/(CMA) IF 1 ORG INDEXING
	DCA	INDEX1
	FENTER
	FLD	ONE
	FEXIT
	JMP	.+4
	FENTER
	FMP	OPERAND
	FEXIT
	ISZ	INDEX1
	JMP	.-4
	JMP I	.+1
	OPDONE





AR1,	0
	TAD	AC1
	CLL RAR
	DCA	AC1
	TAD	AC2
	RAR
	DCA	AC2
	TAD	AC3
	RAR
	DCA	AC3
	RAR
	DCA	OV
	JMP I	AR1
ACN,	0
	TAD	POP3
	DCA	OADD
	CLA CLL CMA RTL
	DCA	AR1
	CML RAL
	TAD I	OADD
	CIA
	DCA I	OADD
	ISZ	OADD
	ISZ	AR1
	JMP	.-6
	JMP I	ACN
POP3,	OP3
OADD,	0
	CLL
	TAD	AC3
	TAD	OP3
	DCA	AC3
	RAL
	TAD	AC2
	TAD	OP2
	DCA	AC2
	RAL
	TAD	AC1
	TAD	OP1
	DCA	AC1
	JMP I	OADD
FPSUB,	CLA CLL CML RAR
	TAD	OPS
	DCA	OPS
FPADD,	ISZ	FPFLAG
	JMP	EOFAD
	TAD	ACE
	CLL CIA
	TAD	OPE
	SZL
	JMP	BCKWDS
	DCA	OADD
ALGNLP,	TAD	OP1
	CLL RAR
	DCA	OP1
	TAD	OP2
	RAR
	DCA	OP2
	TAD	OP3
	RAR
	DCA	OP3
	ISZ	OADD
	JMP	ALGNLP
	JMP	SETSGN
BCKWDS,	CMA
	DCA	OADD
	TAD	OPE
	DCA	ACE
	SKP
	JMS	AR1
	ISZ	OADD
	JMP	.-2
SETSGN,	TAD	ACS
	TAD	OPS
	SPA CLA
	JMS	ACN
	JMS	OADD
	TAD	AC1
	SMA CLA
	JMP	EOFAD
	CLA CLL CMA RTL
	JMS	ACN
	TAD	OPS
	DCA	ACS
EOFAD,	DCA	OV
	JMP I	PFPLOOP
FPMUL,	ISZ	FPFLAG
	JMP	MULCLR
	TAD	ACS
	TAD	OPS
	DCA	ACS
	TAD	ACE
	TAD	OPE
	TAD	O7577
	DCA	ACE
	TAD	AC1
	DCA	OPS
	TAD	AC2
	DCA	OPE
	TAD	AC3
	DCA	TMP
	DCA	AC1
	TAD	O7745
	DCA	FPTEMP
MPYLUP,	JMS	AR1
	TAD	OPS
	RAR
	DCA	OPS
	TAD	OPE
	RAR
	DCA	OPE
	TAD	TMP
	RAR
	DCA	TMP
	SZL
	JMS	OADD
	ISZ	FPTEMP
	JMP	MPYLUP
	JMP I	PFPLOOP
MULCLR,	CLA CLL CMA RTL
	DCA	ACE
	DCA	AC1
	JMP I	PFPLOOP
PFPLOOP,FPLOOP
FPTEMP,	0
O7577,	7577







	PAGE



ANORM,	0
	TAD	AC1
	SNA			/IS HIGH WORD ZERO?
	JMP	MAYZERO		/YEP. ENTIRE NUMBER MAY BE ZERO.
	TAD	O7770
	SPA CLA
	JMP	NOTBIG
	JMS I	PAR1
	ISZ	ACE
	JMP	ANORM+1

MAYZERO,TAD	AC2		/IS SECOND WORD ZERO?
	SZA CLA
	JMP	NOTBIG		/NOPE. NORMAL NORMALIZE.
	TAD	AC3		/1 & 2 ARE ZERO. IS THIRD WORD?
	SNA CLA
	JMP	UNDERF		/YEP. CLEAR AC. ALL ZERO.

NOTBIG,	TAD	OV
	SNA CLA
	JMP	NOBUMP
	ISZ	AC3
	JMP	NOBUMP
	ISZ	AC2
	JMP	NOBUMP
	ISZ	AC1
	DCA	OV
	JMP	ANORM+1
	CLA CMA
NOBUMP,	TAD	ACE
	SPA
	JMP	UNDERF
	DCA	ACE
	CLA CLL CMA RTL
	TAD	AC1
	SMA SZA CLA
	JMP I	ANORM
	JMS	AL1
	JMP	NOBUMP-1
UNDERF,	CLA
	DCA	ACS
	DCA	ACE
	DCA	AC1
	DCA	AC2
	DCA	AC3
	JMP I	ANORM
AL1,	0
	TAD	AC3
	CLL RAL
	DCA	AC3
	TAD	AC2
	RAL
	DCA	AC2
	TAD	AC1
	RAL
	DCA	AC1
	JMP I	AL1
FPDIV,	CDF	0		/''''''''''''''''''' 8 K INSERT.
	ISZ	FPFLAG
	JMP	FPZDIV
	TAD	ACS
	TAD	OPS
	DCA	ACS
	TAD	OPE
	CIA
	TAD	ACE
	TAD	O177
	DCA	ACE
	DCA	TMP
	TAD	O7743
	DCA	ANORM
DIVLP,	CLA CLL CML RAR
	AND	OP1
	TAD	AC1
	SMA CLA
	JMS I	PACN
	JMS I	POADD
	TAD	TMP
	RAL
	DCA	TMP
	TAD	OPE
	RAL
	DCA	OPE
	TAD	OPS
	RAL
	DCA	OPS
	JMS I	PAL1
	ISZ	ANORM
	JMP	DIVLP
	TAD	OPS
	DCA	AC1
	TAD	OPE
	DCA	AC2
	TAD	TMP
	DCA	AC3
	JMP I	PPFLOOP
FPZDIV,	TAD	O377
	DCA	ACE
	JMP I	PPFLOOP
PPFLOOP,FPLOOP
PACN,	ACN
O7743,	7743
FIX,	0
	TAD	AC1
	SNA CLA
	JMP	ZFIXEX
FIXLUP,	TAD	ACE
	TAD	O7545
	SMA CLA
	JMP	FIXEXIT
	JMS I	PAR1
	TAD	ACS
	AND	OV
	SZA CLA
	ISZ	AC3
	JMP	.+4
	ISZ	AC2
	JMP	.+2
	ISZ	AC1
	ISZ	ACE
	JMP	FIXLUP
ZFIXEX,	DCA	ACE
	DCA	AC1
	DCA	AC2
	DCA	AC3
FIXEXIT,DCA	OV
	TAD	AC3
SSFIX,	IAC		/(NOP) IF 1 ORG INDEXING
	JMP I	FIX
O7545,	7545







	PAGE



OUTNUM,	0
	SZA		/SPECIAL CALL FOR PRINT HANDLER
	JMS I	PPUTCH	/NON-ZERO-OUTPUT IT
	CDF	0		/'''''''''' 8 K INSERT.
	TAD	ACS
	SMA CLA
	JMP	.+3
	TAD	O255
	JMS I	PPUTCH
	TAD	AC1
	SNA	CLA
	JMP	FHER
NONZERO,JMS I	FIXUP
	TAD	O7771
	DCA	PRTEMP
	TAD	PNUMBUF
	DCA	ACE
	JMP	.+5
CVTLOOP,TAD	AC1
	AND	O177
	DCA	AC1
	JMS I	PMPY
	TAD	AC1
	RTL
	RTL
	RTL
	AND	O17
	TAD	O260
	DCA I	ACE
	ISZ	ACE
	ISZ	PRTEMP
	JMP	CVTLOOP
	CLA CLL CML RTL
	TAD	DECEXP
	SNA
	JMP	FMT1	/.0NNNNNNN
	SPA
	JMP	FMT2	/N.NNNNNNE-NN
	TAD	O7770
	SPA CLA
	JMP	FMT3	/OTHER THAN N.NNNNNNE+NN
FMT2,	CLA		/N.NNNNNNE+NN
	TAD	PNUMBUF
	DCA	ACE
	TAD	O7772
	DCA	PRTEMP
	TAD I	ACE
	JMS I	PPUTCH
	TAD	O256A
	JMS I	PPUTCH
	ISZ	ACE
	TAD I	ACE
	JMS I	PPUTCH
	ISZ	PRTEMP
	JMP	.-4
	TAD	O305
	JMS I	PPUTCH
	TAD	DECEXP
	SPA CLA
	CLA CLL CML RTL
	TAD	O253
	JMS I	PPUTCH
	DCA	ACE
	TAD	DECEXP
	SPA
	CIA
	DCA	DECEXP
	TAD	DECEXP

	TAD	O7766
	SPA
	JMP	.+4
	DCA	DECEXP
	ISZ	ACE
	JMP	.-6
	CLA
	TAD	ACE
	TAD	O260
	JMS I	PPUTCH
	TAD	DECEXP
FHER,	TAD	O260
	JMS I	PPUTCH
FMTENF,	CDF	10		/'''''''''' 8 K INSERT.
	JMP I	OUTNUM
FMT1,	JMS I	PPRINTXT
	DOTZERO
	CDF	0		/'''''''''' 8 K INSERT.
FMT3,	TAD	O7771
	DCA	PRTEMP
	TAD	PNBF6
TRYAGIN,DCA	ACE
	TAD I	ACE
	TAD	O7520
	SZA CLA
	JMP I	ZERDONE
	ISZ	PRTEMP
	CLA CMA
	TAD	ACE
	JMP	TRYAGIN
ZERDONE,	PZERDONE		/''''''' 8 K INSERT.
FIXUP,	FIXITUP
O17,	17
O253,	253
O255,	255
O305,	305
O7520,	7520
O7766,	7766
O7771,	7771
O256A,	256
O7772,	7772
PMPY,	MPY
PNBF6,	NUMBUF+6


ICASERR,	JMS I	PERROR	/CASSETTE INPUT ERROR
	TEXT 'IN'
TOOLONG,TEXT '_LINE TOO LONG_'
FNERR,	JMS I	PERROR
	TEXT 'FUNCTION'







	PAGE


FIXITUP,0
	TAD	ACE
	TAD	O7610
	DCA	ACE
	SKP
OCC,	TAD	DECEXP
	DCA	DECEXP
NORMIT,	TAD	AC1
	RTL
	SZL CLA
	JMP	NORMED
	JMS I	PAL1
	CLA CMA
	TAD	ACE
	DCA	ACE
	JMP	NORMIT
NORMED,	TAD	ACE
	SMA SZA
	JMP	NOTX10
	CLA
	JMS I	PAR1
	JMS I	PAR1
	JMS I	PAR1
	JMS I	PAR1
	JMS	MPY
	TAD	ACE
	TAD	O4
	DCA	ACE
	CLA CMA
	JMP	OCC
NOTX10,	TAD	O7773
	SPA
	JMP	EXPOK
	CLA
EXPGOOD,TAD	O7740
	DCA	MPY
	CLL
DVLOOP,	TAD	AC1
	TAD	O5400
	SMA
	DCA	AC1
	CLA CML CMA RAL
	DCA	OP1
	JMS I	PAL1
	ISZ	OP1
	ISZ	AC3
	ISZ	MPY
	JMP	DVLOOP
	TAD	AC1
	AND	O377
	DCA	AC1
	CLA IAC
	JMP	OCC
EXPOK,	DCA	PRTEMP
	SKP
	JMS I	PAR1
	ISZ	PRTEMP
	JMP	.-2
	TAD	AC1
	TAD	O5400
	SMA CLA
	JMP	EXPGOOD
	CLA CLL
	TAD	AC3
	TAD	O2062
	DCA	AC3
	SZL
	ISZ	AC2
	SKP
	ISZ	AC1
	TAD	AC1
	TAD	O5400
	SZA CLA
	JMP I	FIXITUP
	TAD	O200
	DCA	AC1
	DCA	AC2
	DCA	AC3
	ISZ	DECEXP
	NOP
	JMP I	FIXITUP
MPY,	0
	JMS I	PAL1
	TAD	AC1
	DCA	OP1
	TAD	AC2
	DCA	OP2
	TAD	AC3
	DCA	OP3
	JMS I	PAL1
	JMS I	PAL1
	JMS I	POADD
	JMP I	MPY
NUMBUF,	0;0;0;0;0;0;0
O2062,	2062
O7610,	7610
O7773,	7773
O5400,	5400






RNDJMP,	FEXIT
	JMS I	PANORM
	JMP I	RND

RND,	0
	FENTER
	FLD+FWD+FRNDX-.
	FEXIT
	TAD	OP3
	RTL
	RTL
	RTL
	DCA	AC1
	TAD	AC1
	RAR
	AND	O7740
	DCA	AC2
	DCA	AC3
	JMS I	POADD
	JMS I	POADD
	JMS I	POADD
	TAD	OPE
	DCA	ACE
	TAD	AC1
	AND	O7
	DCA	AC1
	FENTER
	FST+FWD+FRNDX-.
	FJMP+BKWD+.-RNDJMP


FRNDX,	2004;4173;1231




FSQRX,	0;0;0
SQR,	0
	FENTER
	FST	OPERAND
	FSNE
	FJMP+FWD+SQEXIT-.
	FEXIT
	TAD	ACS
	SPA CLA
	JMP I	PARGERR
	TAD	ACE
	TAD	OO7600
	CLL
	SPA
	CML
	RAR
	TAD	O200
	DCA	ACE
	TAD	O7770
	DCA	INDEX1
SQLOOP,	FENTER
	FST+BKWD+.-FSQRX
	FLD	OPERAND
	FDV+BKWD+.-FSQRX
	FAD+BKWD+.-FSQRX
	FEXIT
	CLA CMA
	TAD	ACE
	DCA	ACE
	ISZ	INDEX1
	JMP	SQLOOP
SQEXIT,	FEXIT
	JMP I	SQR
OO7600,	7600
FN,	0
	TAD	LOCCTR
	JMS I	PPUSH
	TAD	WORD
	JMS I	PPUSH
	CDF	0			/''''''' 8 K INSERT
	TAD I	PUSERFN
	CDF	10			/'''''''' 8 K INSERT.
	IAC
	DCA	LOCCTR
	GET+ISIT	/'DEF'
	1761
	JMP I	PFNERR	/NO
	JMS	GETWD	/SKIP 'FN'
	JMS	GETWD	/SKIP LETTER
	JMS	GETWD	/SKIP '('
	GET+ISIT	/A VARIABLE
	7000
	JMP I	PFNERR	/NO
	ISZ	WORD
	TAD I	WORD
	DCA	INDEX1
	TAD I	INDEX1
	JMS I	PPUSH
	TAD I	INDEX1
	JMS I	PPUSH
	TAD I	INDEX1
	JMS I	PPUSH
	TAD	INDEX1
	JMS I	PPUSH
	CLA CLL CMA RAL
	TAD	INDEX1
	DCA	INDEX1
	FENTER
	FSTI	INDEX1
	FEXIT
	JMS	GETWD	/SKIP ')'
	JMS	GETWD	/SKIP '='
	JMS I	PEVAL
	JMS I	PPOP
	DCA	WORD
	JMS I	PPOP
	DCA I	WORD
	CLA CMA
	TAD	WORD
	DCA	WORD
	JMS I	PPOP
	DCA I	WORD
	CLA CMA
	TAD	WORD
	DCA	WORD
	JMS I	PPOP
	DCA I	WORD
	JMS I	PPOP
	DCA	WORD
	JMS I	PPOP
	DCA	LOCCTR
	JMP I	FN
PUSERFN,USERFN



PFNERR,	FNERR








TAB,	0			/FUNCTION "TAB" IN PRINT STATEMENT.
	JMS I	PFIX		/FIX THE FAC NOW.
	CDF	0		/SET DATA FIELD TO FIELD ZERO.
	CLA IAC			/SET FLAG TO INDICATE WE'VE DONE THIS FUNCTION.
	DCA I	PTABFLG		/AND STORE AWAY.
	TAD	ACS		/GET SIGN OF FAC
	SNA CLA			/WAS IT A POSITIVE NUMBER?
	TAD	AC3		/YEP. PICK UP DESIRED POSITION.
	AND	O377		/MAXIMUM OF 256 COLUMNS.
	DCA I	PTABDES		/SAVE AWAY FOR ACTUAL SPACER TO USE.
	JMS I	TBEGFIX		/PREPARE TO RETURN PRESENT COLUMN NUMBER.
	CLA IAC
	TAD	COLUMN		/INCREMENT TO ACCOUNT FOR DIFFERENCES.
	DCA	AC3		/AND STORE AWAY.
	CDF	10		/RESET DATA FIELD NOW.
	JMS I	PANORM		/NORMALIZE AC NOW.
	JMP I	TAB		/AND RETURN NOW.


PTABDES,TABDES			/POINTER TO DESIRED LOCATION OF PRINT HEAD.
PTABFLG,TABFLG			/POINTER TO TAB IN PRINT FLAG.
TBEGFIX,BEGFIX			/POINTER TO MINI-FIX-SET-UP ROUTINE.








RUBO,	CLA IAC			/SET RUBOUT SWITCH.
NORUBO,	DCA	RBSWCH
	JMP I	.+1		/AND CLEAN IT UP.
	DEVCOM			/CLEAN-UP POINTER.










	PAGE





TAN,	0
	FENTER
	FST+FWD+FTANT1-.
	FEXIT
	JMS	COS
	FENTER
	FST+FWD+FTANT2-.
	FLD+FWD+FTANT1-.
	FEXIT
	JMS	SIN
	FENTER

	FDV+FWD+FTANT2-.
	FEXIT
	JMP I	TAN
COS,	0
	FENTER
	FAD+FWD+FSINC7-.
	FEXIT
	JMS	SIN
	JMP I	COS
SIN,	0
	FENTER
	FDV+FWD+FSINC1-.
	FST+FWD+FSINZ-.
	FEXIT
	DCA	ACS
	JMS I	PINT
	CLA CLL CML RAR
	AND	FSINZ
	DCA	ACS
	FENTER
	FSB+FWD+FSINZ-.
	FMP+FWD+FSINM4-.
FSIN10,	FST+FWD+FSINZ-.
	FEXIT
	DCA	ACS
	FENTER
	FSB	ONE
	FSGT
	FJMP+FWD+FSINOK-.
	FLD+FWD+FSINZ-.
	FEXIT
	JMS I	PSGN
	ISZ	ACE
	FENTER
	FSB+FWD+FSINZ-.
	FJMP+BKWD+.-FSIN10
FSINOK,	FLD+FWD+FSINZ-.
	FMP+FWD+FSINZ-.
	FST+FWD+FSINZZ-.
	FMP+FWD+FSINC3-.
	FAD+FWD+FSINC4-.
	FMP+FWD+FSINZZ-.
	FAD+FWD+FSINC5-.
	FMP+FWD+FSINZZ-.
	FAD+FWD+FSINC6-.
	FMP+FWD+FSINZZ-.
	FAD+FWD+FSINC7-.
	FMP+FWD+FSINZ-.
	FEXIT
	JMP I	SIN
PSGN,	SGN
PINT,	INT
FTANT1,	0;0;0
FTANT2,	0;0;0
FSINZ,	0;0;0
FSINZZ,	0;0;0
FSINC1,	2036;2207;7325
FSINC3,	1644;7553;6722
FSINC4,	5714;6223;1432
FSINC5,	1755;0632;1276
FSINC6,	6005;1256;7406
FSINC7,	2016;2207;7325
FSINM4,	6034;0000;0000
UPARRX,	FENTER
	FST+BKWD+.-FSINZ
	FSGE
	FJMP+FWD+EXPLONG-.
	FEXIT
	JMS I	PINT
	FENTER
	FSB+BKWD+.-FSINZ
	FSEQ
	FJMP+FWD+EXPLONG-.
	FLD+BKWD+.-FSINZ
	FSB+FWD+FUPRC1-.
	FSLE
	FJMP+FWD+EXPLONG-.
	FLD+BKWD+.-FSINZ
	FEXIT
	JMP I	.+1
	UPARROW
FUPRC1,	2077;7700
EXPLONG,FLD	OPERAND
	FEXIT
	JMS I	PLOG
	FENTER
	FMP+BKWD+.-FSINZ
	FEXIT
	JMS I	PEXP
	JMP I	.+1
	OPDONE
PLOG,	LOG
PEXP,	EXP








	PAGE


EXP,	0
	FENTER
	FDV+FWD+FEXPC1-.
	FST+FWD+FEXPU-.
	FEXIT
	JMS I	PPINT
	CLA CLL CML RAR
	TAD	ACS
	DCA	ACS
	FENTER
	FST+FWD+FEXPI-.
	FAD+FWD+FEXPU-.
	FST+FWD+FEXPF-.
	FMP+FWD+FEXPF-.
	FAD+FWD+FEXPC2-.
	FST+FWD+FEXPU-.
	FLD+FWD+FEXPI-.
	FEXIT
	JMS I	PFIX
FXXPFX,	NOP		/(IAC IF 1 ORG INDEXING)
	DCA	FEXPI
	TAD	ACS
	CMA CLL CML RAL
	TAD	FEXPI
	SNL
	CIA
	IAC
	DCA	FEXPI
	FENTER
	FLD+FWD+FEXPC3-.
	FDV+FWD+FEXPU-.
	FAD+FWD+FEXPC4-.
	FSB+FWD+FEXPF-.
	FST+FWD+FEXPU-.
	FLD+FWD+FEXPF-.
	FMP+FWD+FEXPF-.
	FMP+FWD+FEXPC5-.
	FAD+FWD+FEXPU-.
	FST+FWD+FEXPU-.
	FLD+FWD+FEXPF-.
	FDV+FWD+FEXPU-.
	FAD+FWD+FEXPC6-.
	FST+FWD+FEXPF-.
	FEXIT
	TAD	ACE
	TAD	FEXPI
	DCA	ACE
	JMP I	EXP
PPINT,	INT
FEXPI,	0;0;0
FEXPU,	0;0;0
FEXPF,	0;0;0
FEXPC1,	2005;4271;0300
FEXPC2,	2075;3552;7022
FEXPC3,	6124;6477;0715
FEXPC4,	2044;7643;0062
FEXPC5,	1744;3372;3400
FEXPC6,	2004;0000;0000
LOG,	0
	TAD	ACS
	SPA CLA
	JMP I	PARGERR
	TAD	ACE
	DCA	LOGACE
	TAD	O200
	DCA	ACE
	FENTER
	FST+BKWD+.-FEXPU
	FAD+FWD+FLOGC1-.
	FST+BKWD+.-FEXPF
	FLD+BKWD+.-FEXPU
	FSB+FWD+FLOGC1-.
	FDV+BKWD+.-FEXPF
	FST+BKWD+.-FEXPF
	FMP+BKWD+.-FEXPF
	FMP+FWD+FLOGC2-.
	FAD+FWD+FLOGC3-.
	FMP+BKWD+.-FEXPF
	FMP+BKWD+.-FEXPF
	FAD+FWD+FLOGC4-.
	FMP+BKWD+.-FEXPF
	FSB+BKWD+.-FEXPC6
	FST+BKWD+.-FEXPF
	FLD+FWD+LOGFWD-.
	FSB+FWD+LOGOKW-.
	FAD+BKWD+.-FEXPF
	FMP+BKWD+.-FEXPC1
	FEXIT
	JMP I	LOG
FLOGC2,	2004;6253;2521
FLOGC3,	2007;5421;3604
FLOGC4,	2025;6125;1007
LOGFWD,	2174
LOGACE,	0
	0
LOGOKW,	2174;0200;0
FLOGC1,	2005;5202;3632
COMMAS,	CLA CLL CMA RAL	/COMMAS ON RT OUTPUT-SET SWITCH
NOCOM,	DCA	CMSWCH	/NO COMMAS-CLEAR SWITCH
	JMP I	PEXECUTE	/DONE








	PAGE




ATN,	0
	TAD	ACS
	DCA	FATNSX
	DCA	ACS
	FENTER
	FST+FWD+FATNT-.
	FST+FWD+FATNAX-.
	FSB+FWD+FATNC1-.
	FSGT
	FJMP+FWD+ATNBIG-.
	FSB+FWD+FATNC2-.
	FSGT
	FJMP+FWD+ATNLOW-.
	FLD	ONE
	FDV+FWD+FATNT-.
	FST+FWD+FATNT-.
ATNLOW,	FLD	ZERO
	FST+FWD+FATNC-.
	FLD+FWD+FATNT-.
	FSB+FWD+FATNC3-.
	FSGE
	FJMP+FWD+ATNNOT-.
	FLD+FWD+FATNT-.
	FAD+FWD+FATNC4-.
	FST+FWD+FATNT-.
	FLD+FWD+FATNCJ-.
	FDV+FWD+FATNT-.
	FAD+FWD+FATNC4-.
	FST+FWD+FATNT-.
	FLD+FWD+FATNC5-.
	FST+FWD+FATNC-.
ATNNOT,	FLD+FWD+FATNT-.
	FMP+FWD+FATNT-.
	FST+FWD+FATNTT-.
	FLD+FWD+FATNC6-.
	FMP+FWD+FATNTT-.
	FAD+FWD+FATNC7-.
	FMP+FWD+FATNTT-.
	FAD+FWD+FATNC8-.
	FMP+FWD+FATNTT-.
	FAD+FWD+FATNC9-.
	FMP+FWD+FATNTT-.
	FAD	ONE
	FMP+FWD+FATNT-.
	FAD+FWD+FATNC-.
	FST+FWD+FATNT-.
	FLD+FWD+FATNAX-.
	FSB	ONE
	FSGT
	FJMP+FWD+ATNBIG-.
	FLD+FWD+FATNCH-.
	FSB+FWD+FATNT-.
	FST+FWD+FATNT-.
ATNBIG,	FLD+FWD+FATNT-.
	FEXIT
	TAD	FATNSX
	DCA	ACS
	JMP I	ATN
FATNSX,	0
FATNAX,	0;0;0
FATNT,	0;0;0
FATNTT,	0;0;0
FATNC1,	1634;0000;0000
FATNC2,	2007;7776;0000
FATNC3,	1774;2230;2427
FATNC4,	2016;7331;7272
FATNC5,	2004;1405;2216
FATNC6,	1756;0462;4562
FATNC7,	5764;4221;3403
FATNC8,	1766;3141;6672
FATNC9,	5775;2525;2337
FATNC,	0;0;0
FATNCH,	2016;2207;7325
FATNCJ,	6034;0000;0000




TABDO,	TAD	COLUMN		/GET WHERE WE ARE NOW.
	CMA
	TAD	TABDES	/COMPARE WITH DESIRED LOC.
	SNA		/IF WE ARE 1 AWAY THEN RETN.
	JMP I	TPRINT	/GOT IT
	SMA	CLA	/IF NEGATIVE MUST DO A C.RETN FIRST
	JMP	.+5	/ELSE SPACE OVER TO IT
	TAD	O215	/ISSUE C.RETN.
	JMS I	PPUTCH
	JMS I	PPUTCH	/FOLLOWED BY A NULL
	JMP	TABDO	/SEE IF THERE
	TAD	O240	/SPACE OVER
	JMP	.-3

NFOPEN,	JMS I	PERROR	/RUN TIME FILE NOT OPENED ERROR
	TEXT 'NO FILE OPEN'
TABDES,	0
TPRINT,	PRINTC			/NORMAL EXIT LOCATION.

	*6400


CHKFIT,	0
	TAD	O4
	JMS I	SPLEFT
	JMP I	CHKFIT
	JMS I	PLINFIX
	JMS I	PRESET		/RESET ALL I/O DEVICES.
	JMS I	PPRINTXT
	UGH1
	DCA	SNUMFLG		/RESET THIS FLAG NOW
	JMP I	.+1
	NEWLIN			/THIS MAY BE RIGHT.


RMLEFT,	0
	CLL
	TAD	ARRLOC
	SZL
	JMP	NORLFT
	CIA
	TAD	CODELOC
	SNL CLA
NORLFT,	ISZ	RMLEFT
	JMP I	RMLEFT



ABS,	0
	DCA	ACS
	JMP I	ABS

STICKIT,0
	DCA I	ARRLOC
	ISZ	ARRLOC
	JMP I	STICKIT

INT,	0
	JMS I	PFIX
	CLA
	JMS I	PANORM
	JMP I	INT



SXERR,	0			/INCASE THIS IS JMS'D TO.
	CLA
	DCA	SXERR		/AND REMAKE INTO AN "AND"
	JMS I	PERROR
	TEXT 'SYNTAX'
ATLINE,	TEXT ' AT LINE '


O7570,	7570
UPARROW,TAD	ACS
	SMA CLA
	TAD	O7570
	TAD	ACE
	SMA CLA
	JMP I	PARGERR
	JMS I	PFIX
	JMP I	.+1
	UPARR2
MOREDIM,MUSTBE		/','
	3763
DIM,	CLA CMA
	DCA	DIMFLAG
	JMS I	PEVAL
	ISIT		/(CR) OR '\'
	2000
	JMP	MOREDIM
	JMP I	PEXECUTE/YES

DELETED,TEXT ' DELETED_'


AMATCH,	TAD	WORD
	DCA	SNUMFLG
	TAD	SNUMFLG
	DCA I	FPTR
	ISZ	FPTR
	TAD	GPTR
	DCA	EPTR
	ISIT		/'REM'
	1762
	JMP I	PSLOOP
	JMP I	.+1
	REMPACK




BREAK,	3723;2417;2056
READY,	TEXT '_READY.__'
CRLF=.-1





ISDIG,	0
	JMS I	PNONBLNK
	TAD	O7706A
	CLL
	TAD	O12
	SNL
	CLA
	SZL
	ISZ	ISDIG
	JMP I	ISDIG
O7706A,	7706


PZERDON,TAD	PRTEMP
	TAD	DECEXP
	SPA CLA
	JMP	.+4
	TAD	DECEXP
	CMA
	DCA	PRTEMP
	TAD	PNUMBUF
	DCA	ACE
	CLA CLL CMA RAL
DIGLUP,	CMA
	TAD	DECEXP
	SZA
	JMP	.+3
	TAD	O256B
	JMS I	PPUTCH
	DCA	DECEXP
	TAD I	ACE
	JMS I	PPUTCH
	ISZ	ACE
	ISZ	PRTEMP
	JMP	DIGLUP
	JMP I	.+1		/'''''''' 8 K INSERT RETURN.
	FMTENF

O256B,	256
DOTZERO,	TEXT '.0'



	PAGE



WAITR,	0
	SZA		/DID HE SUPPLY NEW ERR. RETN?
	DCA	WTEM	/YES-STORE TEMPORARILY
	CDF 0
	CIF 10
	JMS I	(WAIT	/CALL WAIT ROUTINE
	JMP I	LASERR	/ERROR ON LAST CALL-HANDLE IT
	TAD	WTEM	/OK-RESET ERROR RETURN
	DCA	LASERR
	JMP I	WAITR	/RETN
LASERR,	WTEM	/IF GET ERROR BEFORE DOING ANYTHING-HALT
WTEM,	HLT


/
/CASSETTE INPUT
/
CASIN,	ISZ	CGET	/PAST EOF?
	JMP	REOFER	/YES-HE TRIED TO READ PAST EOF-IN RUNTIME FILE I/O
	ISZ	ICOUNT	/BUFFER EMPTY?
	JMP	NOTEM	/NOPE
	ISZ	RIP	/YUP-IS A READ IN PROGRESS?
	JMS	READIT	/NO-START ONE
	JMS	WAITR	/WAIT FOR IT TO FINISH
	TAD	KM200	/DONE-RESET BUFFER COUNTER
	DCA	ICOUNT
	DCA	RIP	/SET READ NOT IN PROGRESS
NOTEM,	TAD	ICOUNT	/GET NEXT CHAR. FROM BUFFER
	TAD	(BUFEND
	DCA	RCHR	/CALCULATE ADDRESS
	CDF	10
	TAD I	RCHR
	AND	O177
	TAD	(-32	/IS THE CHAR A CTRL/Z--EOF??
	SNA	CLA
	JMP	CTRLZI	/YES-HANDLE IT
	CLA	IAC
	TAD	ICOUNT	/ARE WE AT TUNED LOC.?
	SNA	CLA
	JMS	READIT	/YES-START NEXT READ
	CMA
	DCA	CGET	/SET FLAG-NOT PAST EOF
	CDF 10
	TAD I	RCHR	/NO-GET IT BACK
	JMP I	(GOTIT	/RETN. W/CHAR. IN AC
EOFRTN,	0	/POINTER TO WHERE TO GO WHEN GET EOF FROM
			/CASSETTE FILE(FOR CHAIN OR OLD)
CGET,	0	/=0 IF EOF (CTRL/Z) DETECTED ON CURRENT INPUT FILE
		/=7777 OTHERWISE

CTRLZI,	TAD	DRTI	/DOING RUN-TIME INPUT?
	SNA	CLA
	JMP I	EOFRTN	/NO-TAKE END OF FILE RETN.
	TAD	(232	/RETURN A 232 FOR CTRL/Z
	JMP I	(GOTIT1	/SPECIAL ^Z RETN TO GOTIT+1-KLUDGE
DRTI,	0		/=7777 IF DOING RUN TIME INPUT


IUNIT,	0	/INPUT CASSETTE UNIT #
RIP,	0	/=7777 IF A CASSETTE READ IS IN PROGRESS
ICOUNT,	0	/MINUS COUNT OF CHARS. IN CASSETTE BUFFER
IERR,	0	/POINTER TO WHERE TO GO ON INPUT ERRORS-SET UP
		/BY CALLING ROUTINES


READIT,	0
	TAD	IERR	/RESET ERROR MESSAGE AFTER WAIT
	JMS	WAITR	/WAIT FOR ALL CASSETTE I/O TO BE DONE
	TAD	IUNIT	/DO A READ-GET UNIT #
	CIF	10
	JMS I	(HNDLR	/CALL HANDLER
	0010		/FUNCTION WD.-READ INTO FIELD 1
	BUFST
	JMP I	IERR	/ERROR-TRAP OUT
	CLA	CMA
	DCA	RIP
	JMP I	READIT



REOFER,	JMS I	PERROR
	TEXT 'EOF'   /READ PAST EOF AT RUNTIME

/
/CASSETTE OUTPUT
/
CASOUT,	0
	DCA	RCHR	/STORE CHAR. PASSED
	ISZ	OCOUNT	/DONE FILLING A BUFFER?
	JMP	NOTFUL	/NO-GO ON
	JMS	WAITR	/YES-WAIT FOR LAST WRITE TO FINISH
	TAD	KM200	/DONE-RESET COUNTER-BUFFER EMPTY
	DCA	OCOUNT
NOTFUL,	TAD	OCOUNT	/GET ADDR TO STORE THIS CHAR AT
	TAD	KBUFEND
	DCA	READIT
	CDF	10
	TAD	RCHR	/GET THE CHAR
	DCA I	READIT	/PUT IT IN BUFFER
	TAD	RCHR	/WAS THIS CHAR A CTRL/Z?
	AND	O177
	TAD	(-32
	SNA	CLA
	JMP	DWRIT	/YES-DO A WRITE
NCTRLZ,	TAD	OCOUNT	/ARE WE AT THE 'TUNER' LOC.
	IAC
	SZA	CLA
	JMP	NOTYET	/NOPE
DWRIT,	TAD	OERR	/RESET ERROR RETN AFTER WAIT
	JMS	WAITR	/YUP-WAIT FOR ALL I/O TO CASSETTE TO FINISH
	TAD	OUNIT	/YUP-START WRITING THIS BUFFER
	CIF	10
	JMS I	(HNDLR
	4010		/WRITE FROM FIELD 1
KBUFST,	BUFST		/OR RTBUF IF RUNTIME OUTPUT
	JMP I	OERR	/ERROR-HANDLE IT
NOTYET,	TAD	RCHR	/GET THE CHAR.
	AND	O177
	TAD	(-32	/WAS IT CTRL/Z?
	SZA	CLA
	JMP I	CASOUT	/NO-DONE-RETN.
	JMS	WAITR	/GOT CTRL/Z-WAIT FOR LAST WRITE TO BE DONE
	TAD	OUNIT	/NOW CLOSE THE FILE
	CIF	10
	JMS I	(CLOSE
	JMP I	OERR	/ERR-HANDLE IT
	DCA I	(OIP	/CLEAR OUTPUT IN PROGRESS FLAG
	TAD	OUTD2
	DCA	OUTDEV	/RESET OUTPUT TO WHAT IT WAS
	JMP I	CASOUT	/RETN


OERR,	0	/POINTER TO WHERE TO GO ON OUTPUT ERR-SETUP BY CALLING ROUTINE
OUNIT,	0	/OUTPUT CASSETTE UNIT #
OCOUNT,	0	/MINUS COUNT OF CHARS. IN OUTPUT BUFFER

KBUFEND,	BUFEND	/OR RTBUFN IF RUN-TIME OUTPUT IN USE!

RCHR,	0

IANDO,	JMS I	PERROR	/ATTEMPTED TO DO RUNTIME INPUT AND OUTPUT
	TEXT 'I&O'	/TO SAME UNIT

	PAGE


PUTER,	0
	DCA	OPUTC	/STORE CHAR. TEMPORARILY
	RDF		/GET CALLING FIELD
	TAD	K6201	/SET DATA FIELD TO IT ON EXIT
	DCA	PUTCDF
K6201,	CDF	0
	TAD	OUTDEV	/MOVE OVER OUTPUT DEV.
	TAD	OPOTAB	/SO WE DO OUT
	DCA	OTEMP1	/SET UP OUTPUT ROUTINE CALL
	TAD	OPUTC	/GET THE CHAR.
OTEMP1,	0		/CALL APPROPRIATE ROUTINE
	CLA		/CLR. GARBAGE
PUTCDF,	0
	JMP I	PUTER	/RETN. W/DATA FIELD SAME AS IT WAS

OPOTAB,	JMS I	.+1
	OTEMP1		/NO OUTPUT
	TTYO		/TELETYPE
	CASOUT		/CASSETTE
	LLSOUT		/LINEPRINTER
ECHO,	0	/SET TO 400 WHEN BASIC MUST PRINT SOMETHING ON TTY

TTYO,	0
	TAD	ECHO
	JMS I	(TLSOUT	/OUTPUT PLUS ECHO/NO ECHO SWITCH
	DCA	ECHO
	JMP I	TTYO	/RETN AFTER ZEROING ECHO SWITCH


CHAIN,	GET+MUSTBE	/NEXT ELEMENT MUST BE TEXT!
	5000
	CDF	0
	CIF	10
	JMS I	(CNAMST	/SET UP UNIT AND NAME FROM CORE!
	JMP	BADCHN	/ERROR!
	DCA I	(IUNIT	/SAVE UNIT #
	CDF CIF 10	/CLOSE RT OUTPUT FILE IF ONE OPEN
	JMS I	PCLOS
	JMS I	(WAITR	/DO A WAIT BEFORE RESETTING ERR. RETN.
	TAD	(CHNERR	/OK-SET UP ERROR RETN.-CASSETTE ERROR
	DCA I	(IERR
	TAD	(RUNC	/SET UP EOF RETURN TO RUN PROG.
	DCA I	(EOFRTN
	CIF	10
	TAD I	(IUNIT	/GET UNIT #
	JMS I	(LOOK	/LOOK UP THE FILE
	IONAM
	JMP	CNTFND	/NOT FOUND
	CDF CIF 10
	TAD	(IONAM-NAMLOC	/NAME OF FILE IS IN IONAM
	DCA I	(NAMER	/SO SET NAMER IN CASE HE DOES A SAVE
	JMP I	(OLD3	/FOUND-JUMP INTO 'OLD' HANDLER

CNTFND,	JMS I	PPRINTXT
	CHNMS		/PRINT CHAIN ERR MESS.
	CDF CIF 10
	JMP I	(NTFND+2	/GO PRINT THE REST
BADCHN,	JMS I	PERROR
	TEXT 'FILE NAME'


RESET1,	0
	CLA IAC
	DCA	OUTDEV
	CLA IAC
	DCA	OUTD2
	CLA IAC
	DCA	INDEV
	DCA	RBSWCH	/NO RUBOUTS NOW
	CDF	0		/RESET DATA FIELD TO HERE.
	DCA I	(OCOUNT
	DCA I	(RIP
	DCA I	(DRTI	/CLR. RUNTIME INPUT FLAG
	CMA
	DCA I	(ICOUNT
	CLA CLL CMA RAL
	DCA	CMSWCH	/RESET COMMAS SWITCH
	DCA I	(OIP	/CLR. OUTPUT IN PROGRESS SWITCH
	JMS I	CNTLOZ	/CLEAR CNTLO SWITCH
	JMP I	RESET1









XGISIT,	0
	TAD I	LOCCTR
	DCA	WORD
	ISZ	LOCCTR
	TAD	XGISIT
	DCA	XISIT
	JMP	XISIT+1
XISIT,	0
	TAD I	WORD
	CDF	0		/''''''''''''' 8 K INSERT.
	TAD I	XISIT
	CDF	10		/''''''''''''' 8 K INSERT.
	ISZ	XISIT
	SNA CLA
	ISZ	XISIT
	JMP I	XISIT

FIOER,	JMS I	PERROR
	TEXT 'NO FILES'	/NO RUN TIME FILE I/O NOW


/
/ROUTINE TO WAIT FOR CASSETTE I/O TO STOP
/THEN CLEAR CONTROL/O SWITCH AND FORCE TTY OUTPUT
/
COWT,	0
	JMS I	(WAITR	/WAIT FOR CASSETTE I/O
	JMS I	CNTLOZ	/CLR. CONTROL /O STATE
	JMP I	COWT	/RETN

ZCNTLO,	0
	TAD	(400
	DCA	ECHO	/RESET SWITCH SO WE CLR. MONITOR'S CNTLO SWITCH
	CDF 10
	JMP I	ZCNTLO	/RETN.-TURNS INTRPT BACK ON
OPUTC=ZCNTLO







PAGE
GETCH,	0
	CLA	CMA	/WHERE IS INPUT FROM
	TAD	INDEV	
	SZA	CLA	
	JMP I	(CASIN	/CASSETTE-WHEN DONE RETN TO GOTIT	
			/(TO GOTIT1 IF GOT ^Z IN RUNTIME INPUT FILE)
	CDF 	0
	JMS I	(KBDINP	/KEYBOARD
GOTIT,	AND	O177	/MAKE 7 BIT ASCII
GOTIT1,	DCA	GTEMP	/STORE (IF GOT ^Z COME HERE W/232 IN AC-ONLY RUNTIME I/O)
	CDF	10
	TAD	RBSWCH	/ARE RUBOUTS LEGAL AS DELETE CHAR?
	SNA	CLA
	JMP	GRB	/NOPE
	TAD	GTEMP	/YUP IS THIS ONE
	TAD	(7601	
	SZA	CLA
	JMP	GRB	/NOPE-GO ON
GRDELA,	TAD	(137	/YUP-PASS IT AS BACKARROW(ALWAYS LEGAL)
	JMP I	GETCH

GRB,	TAD	GTEMP	/GET CHAR.
	TAD	(7602	/IS IT ALTMODE(376)?
	SNA
	JMP	GALT	/YUP
	TAD	(143	/NO-IS IT ALTMODE(ESCAPE)-233?
	SNA	
	JMP	GALT	/YUP
	TAD	(7673	/NO-IS IT PRINTING CHAR.?
	SPA
	JMP	GOUT	/YUP-ITS OK
	TAD	(7746
	SMA	SZA
	JMP	GOUT	/YUP ALSO-ITS OK
	TAD	(132	/NOPE-MAKE LOW CASE ASCII=UPPER CASE ASCII
	JMP I	GETCH	/RETN IT

GALT,	TAD	(175	/GOT ALTMODE -RETN IT
	JMP I	GETCH

GOUT,	CLA
	TAD	GTEMP	/LEGAL CHAR-RETN IT
	JMP I	GETCH

GTEMP=XGMUST

ARGERR,	JMS I	PERROR
	TEXT 'ARGUMENT'
/
/CALL A FLIED ZERO ROUTINE FROM FIELD 1
/
LJMS,	0
	DCA	XGMUST	/STORE AC
	TAD I	LJMS	/GET ADDR OF SUBR TO CALL
	ISZ	LJMS	/BUMP RETN.
	DCA	XMUST	/STORE THE ADDR
	TAD	XGMUST	/GET STORED AC
	JMS I	XMUST	/CALL THE ROUTINE
	SKP		/IN CASE OF SKIPPING RETN.
	ISZ	LJMS
	CDF CIF 10
	JMP I	LJMS	/RETN






XGMUST,	0
	TAD I	LOCCTR
	ISZ	LOCCTR
	DCA	WORD
	TAD	XGMUST
	DCA	XMUST
	JMP	XMUST+1
XMUST,	0
	TAD I	WORD
	CDF	0		/''''''''' 8 K INSERT.
	TAD I	XMUST
	CDF	10		/''''''''' 8 K INSERT.
	ISZ	XMUST
	SNA CLA
	JMP I	XMUST
	JMP I	PSXERR







LOOKER,	JMS I	PERROR
	TEXT 'FILE OPEN'		/HARD ERROR ON CASSETTE-FILE ALREADY OPEN









INPUTN,	JMS	DRTICK	/CHECK IF DOING RUNTIME INPUT
	CLA CLL CML RTL	/OK-SET INPUT DEV. TO CASSETTE
	DCA	INDEV
	JMP I	(INPUT	/GO DO IT



PRINTN,	TAD	OIP	/IS RUNTIME OUTPUT IN PROGRESS?
	SNA	CLA
	JMP I	(NFOPEN	/NOPE-GIVE ERROR
	TAD	OUTDEV	/YES-SAVE CURRENT OUTPUT DEV
	DCA	OUTD2
	CLA CLL CML RTL	/SET OUTPUT TO CASSETTE
	DCA	OUTDEV
	JMP I	(PRINT2	/GO DO IT

ENDNM,	JMS	DRTICK	/CHECK IF DOING RUNTIME INPUT-CGET IN AC ON RETN.
	IAC		/(CGET=0:YES;CGET=-1:NO)
	DCA	OPERAND	/OPRND=1:YES;0:NO--FOR CHECK AT IF1
	JMS	GETWD	/MUST GET NEXT WD OF INTRP.CODE
	JMP I	(IF1	/JUMP BACK INTO IF PROCESSOR

/CHECK IF DOING RUNTIME INPUT-IF NOT GIVE ERROR
/IF SO RETN W/DATA FLD=1 AND CGET IN AC FOR ENDNM
/
DRTICK,	0
	CDF	0	/DRTI FLAG IS IN FLD. 0
	TAD I	(DRTI	/RUNTIME INPUT FILE OPEN??
	SNA	CLA	
	JMP I	(NFOPEN	/NO-GIVE NO FILE OPEN ERROR
	TAD I	(CGET	/YES-GET CGET INTO AC--(INPUTN CLRS AC)
	CDF 10	/DATA FLD =1
	JMP I	DRTICK	/RETN.

LPTOUT,	CLA CLL CML RTL			/LINE PRINTER OUTPUT
TTYOUT,	IAC			/TTY OUT
	DCA	OUTDEV		/AND SET IT UP
	TAD	OUTDEV		/ALSO MOVE OVER TO SECONDARY DEVICE.
	DCA	OUTD2
DEVCOM,	GET+MUSTBE	/CR. OR \
	2000			/C.R. OR \
	JMP I	PEXECUTE

OIP,	0		/=-1 IF OUTPUT TO CAS. INPROGRESS
			/FOR SAVE OR RUNTIME OUTPUT
	PAGE


/
/INTERRUPT HANDLER GOES HERE
/

	FIELD	1
*0
/MUST REMAIN AT LOC. 0!!!SEE LOC. PTEN ON PAGE ZERO,FLD. ZERO
TEN,	2045;0000;0000		/INSERTED IN UPPER CORE BECAUSE OF FEEBILITY.
TEMP,	0
UJMS,	UUJMS
*5
/RESERVED FOR XOD--DECUS DEBUGGING PROG.
XXOD1,	0
XXOD2,	0
XXOD3,	0
*10
X10,	0
XREG2,	0
UNIT,	TEXT '_UNIT#(0-7):'
*21
*21
UTEM1,	0
ISIT1=JMS I .;XISIT1
/ROUTINE TO CALL FIELD 0 TEXT PRINTER
/	JMS	MPRINT
/	(ADDR. OF MESS.-FIELD 1)
/	(RETN. HERE)
/
MPRINT,	0
	CDF	10
	TAD I	MPRINT	/GET ADDR. OF TEXT TO AC
	ISZ	MPRINT	/BUMP RETN.
	JMS I	UJMS
	PRINTXT
	JMP I	MPRINT

NAMER,	0	/=0 IF NAME OF PROG. IN CORE IS IN NAMLOC;
		/=11 IF NAME OF PROG. IN CORE IS IN IONAM (AFTER A CHAIN)

MSTBE1=JMS I .;XMUST1;XGMST1
POIP,	OIP		/OIP=-1 IF OUTPUT TO CASSETTE IN PROGRESS



/
/ROUTINE TO CHECK IF A CASSETTE OUTPUT FILE IS OPEN
/IN CASE USER TYPES BREAK OR CTRL/C BEFORE CLOSING
/THE FILE-THIS ROUTINE INSURES FILE IS CLOSED
/
CLOS,	0	
GTPTR=CLOS
	CLA
	CDF 0		/OIP IS IN FLD 0
	ISZ I	POIP	/RUNTIME OUTPUT IN PROGRESS??
	JMP	O6203	/NOPE
	TAD	[232	/YUP-CLOSE FILE
	JMS I	UJMS
	CASOUT
O6203,	CDF CIF 0
	CDF 10
	JMP I	CLOS

/
/CHECK FOR ^Z DURING RUNTIME INPUT--EQUALS  END OF FILE
/MUST RETURN "0" AND CAR.RETN. FOR THE INPUT ROUTINE
/
CHARNEW,	NEWCHAR

CTRZHP,	DCA	MPRINT	/STORE VALUE OF EPTR PASSED
	TAD I	MPRINT	/GET LAST CHAR.
	CMA	IAC	/NEGATE
	TAD	[232	/WAS IT ^Z?
	CIF 0
	SZA	CLA
	JMP I	CHARNEW	/NOPE-RETN. GET NEXT CHHAR
	CDF 0
	CLA	CMA	/CHECK THAT INPUT IS CASSETTE IF GET ^Z
	TAD I	[INDEV
	CDF 10
	SNA	CLA
	JMP I	CHARNEW	/NOPE-JUST IGNORE^Z
	TAD	[60	/YUP-RETN. 0
	DCA I	MPRINT	/BY PUTTING IT IN BUFFER
	CDF 0
	ISZ I 	KEPTR	/NOW BUMP POINTER
	TAD	[15	/C.RETN TO END LINE
	CDF	10
	JMP I	.+1	/NOW  THE LINE IS DONE
	NEWCHAR+1
KEPTR,	EPTR
*100
NOPUNCH
MONITR,	ZBLOCK 30
ENPUNCH

*200
SETINCH,	0		/(GETUNIT STORES CAS. UNIT # IN SETINCH)
	TAD	(NAMLOC-1	/EITHER NAMLOC-1 OR IONAM-1
	DCA	X10	/STORE
	TAD	(INCHN-1	/GET POINTER TO IN CORE HEADER
	DCA	XREG2
	TAD	(-11
	DCA	GETUNIT
	TAD I	X10	/GET A CHAR. OF FILE NAME
	DCA I	XREG2	/STORE IN HEADER
	ISZ	GETUNIT	/DONE ALL?
	JMP	.-3	/NO-GO ON
	CLA IAC
	DCA I	XREG2	/TYPE=1=ASCII
	JMP I	SETINCH	/YES-RETN.

////////////NAMLOC AND IONAM BLOCKS MUST BE KEPT IN ORDER
////////////THEY ARE INITIALIZED TO "NONAME.BAS"
NAMLOC,	"N;"O;"N;"A;"M;"E
EXTLOC,	"B;"A;"S

IONAM,	"N;"O;"N;"A;"M;"E
IEXTLC,	"B;"A;"S
///////////////////////////////////////


GETUNIT,	0
	CDF	0
	CLA	IAC
	DCA I	[OUTDEV
	CLA	IAC	/MUST BE TO TTY!
	DCA I	[OUTD2
	JMS	MPRINT
	UNIT		/PRINT MESSAGE ASKING FOR UNIT #
	JMS	GETIT	/ACCEPT A 1 DIGIT OCTAL #
	TAD	[-70
	CLL		/FOLLOWED BY A C.R.
	TAD	[10
	SNL		/IS IT BETW. 0-7?
	JMP	TRYALT	/NO-WAS IT ALTMODE?
	TAD	[60
	DCA	SETINCH	/YES-STORE IT
	JMS	GETIT	/HE MUST TYPE CAR. RETN.
	TAD	[7763
	SZA	
	JMP	TRYAL	/NOPE-WAS IT ALTMODE?
	JMS	MPRINT
	CRLFD		/OK-TYPE CRLF
	TAD	SETINCH	/RETN. W/UNIT# IN AC
	JMP I	GETUNIT

TRYAL,	TAD	(-43
TRYALT,	TAD	(-115
	SNA	CLA	/DID HE TYPE ALTMODE??
	JMP I	(FALT	/YES-GO TO EDIT MODE
	JMP	GETUNIT+1	/NO-TRY AGAIN

GETIT,	0
	JMS I	UJMS	/GET A CHAR. FR. TTY
	GETCH
	DCA	TEMP	/STORE TEMPORARILY
	TAD	TEMP
	JMS I	UJMS	/PRINT IT
	PUTCH
	TAD	TEMP
	JMP I	GETIT	/RETN IT IN AC


/LOOKUP FILE ON CASSETTE-UNIT # IN AC ON ENTRY
/IF LINK=1,FILE NAME IS IN NAMLOC, IF LINK=0
/FILE NAME IS IN IONAM
/


LOOK,	0
	DCA	LUNIT	/STORE UNIT #
	TAD I	LOOK	/GET WHERE NAME IS
	DCA	NAM	/STORE IN LOOKUP CALL
	ISZ	LOOK	/BUMP RETN PAST IS
	TAD	O6203	/DETERMINE CALLING FIELD
	RDF
	DCA	LUKERR
	CDF	10
	TAD	LUNIT	/GET UNIT #
	JMS I	(LOOKUP	/LOOK UP THE FILE
	CDF	10	/NAME IS IN FLD 1
NAM,	0
	JMP	LKERR	/ERROR-HANDLE IT
	SKP	CLA	/NOT FOUND-RETN TO CALL+2
	ISZ	LOOK	/OK-RETN TO CALL+3
LUKERR,	0
	JMP I	LOOK	/IF NOT FOUND-RETN TO CALL+2
LKERR,	CDF CIF 0
	JMP I	(LOOKER	/YES-GIVE MESSAGE-FILE OPEN ALREADY

SCRAT1,	0
	TAD	(XXEOF	/DO A SCRATCH--ALMOST
	CDF 10
	DCA I	(PERMSYM
	CDF	0
	TAD	(PERMSYM
	DCA I	(CODELOC
	IAC
	TAD	(PERMSYM
	DCA I	(PSYMTAB
	CLA	CMA
	DCA I	(NSYMTAB
	JMP I	SCRAT1

LUNIT=SCRAT1

PAD,	0
	TAD	[40	/PAD NAME OR EXT. WITH SPACES
	DCA I	GTPTR
	JMS I	(PAKBUF
	ISZ I	(CCNTR
	JMP	.-2
	CLA CLL CMA RTL	/WHEN DONE-RESET CNTR FOR EXT.
	DCA I	(CCNTR
	JMP I	PAD


*400

UUJMP,	0
UUJMS,	0		/JMS TO LOC. IN FIELD 0
	DCA	UUJMP
	CDF	10
	CIF	0
	TAD I	UUJMS
	DCA	UTEM
	TAD	UUJMP
	JMS I	UUUJMS
UTEM,	0
	SKP		/IN CASE OF SKIPPING RETN.
	ISZ	UUJMS
	ISZ	UUJMS
	JMP I	UUJMS

UUUJMS,	LJMS

/
/GTJMP1 WILL CONTAIN EITHER A '0'- TO FALL THRU TO
/KBDIN AND GET A CHAR FROM KEYBOARD OR A 'JMP COREIN'  TO GET
/A CHAR. FROM A TEXT STMT STORED IN CORE
/
/THIS IS SET UP BY CALLING ROUTINE BEFORE FIRST CALL TO CHRGET
/
CHRGET,	0
GTJMP1,	0	/GET CHR. FROM CORE OR KBD-SET UP BY CALLER
KBDIN,	JMS I	(GETIT	/KBD-READ AND ECHO CHAR.
	JMP I	CHRGET	/RETN.
COREIN,	ISZ	HALF	/CORE-WHICH HALF OF WD?
	JMP	RIGHT	/RIGHT-GET IT
	JMS I	UJMS	/LEFT-NEED A NEW WD
	GETWD
	CDF	0
	TAD I	[WORD	/ROTATE IT RIGHT 6 BITS
	CLL BSW
	JMP	HAF	/GO CHECK FOR SPACE,ETC.
RIGHT,	CMA		/RIGHT HALF-SET FLAG FOR LEFT NEXT
	DCA	HALF	
	CDF	0
	TAD I	[WORD	/GET WORD
HAF,	AND	[77	/MASK RIGHT 6 BITS
	TAD	[7740	/IS IT SPACE?
	SNA
GTJMP,	JMP	COREIN	/YES-IGNORE IT-GET NEXT CHAR.
	CLL
	TAD	[40	/NO-RESTORE IT TO SEVEN BIT
	SZL
	TAD	(100
	CDF	10
	JMP I	CHRGET	/AND RETN.

HALF,	0

CNAMST,	0
	RDF		/DETERMINE CALLING FIELD
	TAD	O6203
	DCA	CLEV	/STORE FOR RETN.
	CDF	10
	TAD	GTJMP
	DCA	GTJMP1	/INPUT FROM CORE-NOT KBD
	JMS I	UJMS	/MOVE PTR TO FIRST WD OF TEXT
	GETWD
	DCA	HALF	/RIGHT HALF OF WORD FIRST
	JMS	CHRGET	/GET A CHAR.
	TAD	[7710
	CLL		/SHOULD BE UNIT NUMBER
	TAD	[10
	DCA	XISIT1	/STORE CHAIN UNIT NUMBER
	SNL
	JMP	CNERR	/NOT NUMERIC-ERROR
	JMS	CHRGET	/OK-GET ANOTHER CHAR.
	TAD	(-72	/MUST BE COLON
	SZA	CLA
	JMP	CNERR	/NOPE-ERROR
	JMS I	[FILNAM	/GET FILE NAME FROM CORE
	IONAM		/LEAVE IN IONAM
CNERR,	SKP		/ERROR-RETN TO CALL+1
	ISZ	CNAMST	/OK-RETN TO CALL+2
	TAD	XISIT1	/GET CHAIN UNIT #
	TAD	[60	/GLITCH IN MON..0 MEANS SAME UNIT AS LAST USED
CLEV,	0		/CDF CIF TO CALLING FIELD
	JMP I	CNAMST	/RETN
NFMES,	TEXT ' FILE NOT FOUND_'

XISIT1,	0
	CDF	0
	TAD I	[WORD	/GET LIST POINTER
	DCA	CLEV	/STORE FOR A WHILE
	CDF	10	/DATA IS IN FIELD 1
	TAD I	CLEV	/GET THE WORD
	TAD I	XISIT1	/GET THE COMPARAND
	ISZ	XISIT1	/BUMP RETN. PAST IT
	SNA	CLA	/SAME?
	ISZ	XISIT1	/YES-BUMP RETN AGAIN
	JMP I	XISIT1	/RETN.

XGMST1,	0
	JMS I	UJMS	/GET NEXT WORD OF PSEUDO-CODE
	GETWD
	TAD	XGMST1	/FUDGE SUBR. LINKS
	DCA	XMUST1
	SKP
XMUST1,	0
	TAD I	XMUST1	/GET WHAT PSEUDO CODE SHOULD BE
	ISZ	XMUST1	/BUMP RETN. PAST IT
	DCA	.+2	/STORE
	ISIT1		/IS THAT WHAT IT IS?
	0
	JMP	SXER	/NOPE-SYNTAX ERR
	JMP I	XMUST1	/YES-RETN.
SXER,	CDF CIF 0
	JMP I	(SXERR	/GIVE THE ERR

INPSET,	0
	DCA I	[DRTI	/AC=0:NOT RUNTIME INPUT--AC=7777:R/T INPUT
	CLA	CMA
	DCA I	(ICOUNT	/SET BUFFER EMPTY
	DCA I	(RIP	/SET NO READS IN PROGRESS
	CLA CLL CML RTL	/SET INPUT DEV. TO CASSETTE
	DCA I	[INDEV
	CLA	CMA
	DCA I	[CGET	/SET FLAG-NO EOF ON INPUT YET
	JMP I	INPSET	/RETN.



*600

FILNAM,	0
	TAD I	FILNAM	/PICK UP ADDR. AT WHICH TO STORE NAME
	ISZ	FILNAM
	DCA	PWHERE
	TAD	(-50	/MAX. OF 40 CHARS. ON LINE
	DCA	PAKBUF
FIL1,	DCA	CCNTR	/CLEAR CHAR COUNTER
GNEXT,	JMS I	[CHRGET	/GET A CHAR.
	DCA	TEMP
	TAD	TEMP
	TAD	[7603	/IS IT ALTMODE?--175
	SNA
	JMP	FALT	/YES-RETN TO EDIT MODE
	TAD	[36	/NO-IS IT BACKARROW?
	SZA
	JMP	DQUOTE	/NO-SEE IF DOUBLE QUOTE
	CMA		/YES-DELETE LAST CHAR.
	TAD	CCNTR	/BUT DON'T GO BACK PAST BUFF. STRT.
	SPA
	CLA		/CCNTR CAN'T BE LESS THAN 0
	JMP	FIL1
DQUOTE,	TAD	[75	/IS IT DOUBLE QUOTE(242)?
	SNA
	JMP	NAMCHK	/YES-TREAT AS CAR. RETN.
	TAD	(122-75	/NO-IS IS CARRETN?
	SNA
	JMP	NAMCHK	/YES-CHECK NAME VALIDITY
	TAD	[7715
	AND	(140
	SZA		/PRINTING CHAR?
	TAD	P7640
	SZA	CLA	
	JMP	GNEXT
CHAROK,	TAD	TEMP	/NO-CHAR. OK
	JMS	STOBUF	/STORE IN BUFFER
	JMP	GNEXT	/GET NEXT
FALT,	CDF CIF 0
	JMP I	(FILALT

CCNTR,	0
PWHERE,	0
DONSW,	0

NAMCHK,	TAD	[15	/FIRST STORE C. RETN. IN BUFFER TO
	JMS	STOBUF	/END NAME
	CMA		/SET PERIOD SWITCH=-1
	DCA	PERSW
	TAD	[LINBUF+1	/SET POINTER FOR PICKING UP CHARS.
	DCA	GTPTR
	TAD I	GTPTR	/GET A CHAR. (FIRST ONE)
	TAD	[-133	/CHECK TO INSURE ITS ALPHABETIC
	CLL
	TAD	[32
	SNL	CLA
	JMP	FERR	/NOPE-ERROR
	JMS	PAKBUF	/ITS OK-PACK IT OFF TO FINAL RESTING PLACE
	TAD	[-5	/SET CHAR COUNTER FOR MAX OF 5
	DCA	CCNTR	/MORE CHARS. IN NAME  (EXCLUDING EXTENSION)
	CMA		/SET SWITCH-WE'RE DECODING NAME
	DCA	DONSW	/NOT EXTENSION
GETCHR,	ISZ	GTPTR	/GET NEXT CHAR.
	TAD I	GTPTR
	TAD	[7763	/IS IT CAR. RTN.
	SNA
	JMP	PADDON	/YES-GO PAD NAME IF NECESSARY-DONE
	TAD	[15-133	/NO-IS IT ALPHABETIC
	CLL
	TAD	[32
	SNL
	JMP	NUMCHK	/NO-SEE IF NUMERIC
STORCH,	CLA		/ALPHABETIC-STORE IT
	JMS	PAKBUF
	ISZ	CCNTR	/BUMP COUNTER-DONE NAME(OR EXTEN.)?
	JMP	GETCHR	/NO-GO ON
	ISZ	DONSW	/YES-DONE NAME +EXTENSION?
	JMP	DONEN	/YES-DONE ALL
GETCR,	CLA CLL CMA RTL	/NO-SET COUNTER FOR 3 LETTER EXT.
	DCA	CCNTR
	ISZ	GTPTR	/DIDN'T GET PERIOD YET-SO IGNORE
	TAD I	GTPTR	/MORE THAN 6 CHAR. NAME
	TAD	[7763	/CAR. RETN?
	SNA
	JMP	PADDON	/YES-GO CLEAN UP
	TAD	[15-56	/NO-DID HE TYPE PERIOD?
P7640,	SZA	CLA
	JMP	GETCR	/NO-IGNORE IT
	DCA	PERSW	/YES-CLR. PERIOD SWITCH-NOW WE'RE
	JMP	GETCHR	/ACCEPTING EXTENSION

NUMCHK,	TAD	[101-72	/IS CHAR. A NUMBER?
	CLL
	TAD	[12
	SZL
	JMP	STORCH	/YES-GO STORE IT
	TAD	[2	/NO-IS IT PERIOD?
	SNA	CLA
	ISZ	PERSW	/YES-IS IT FIRST PERIOD?
	JMP	FERR	/NO-EROR-BAD CHAR.
	JMS I	(PAD	/FIRST PER.-PAD NAME IF NECESSARY
	JMP	GETCHR-1	/GET NEXT CHR.
PADDON,	JMS I	(PAD	/DONE NAME-PAD IF NECESSARY
	ISZ	DONSW	/DONE EXTENSION?
	JMP	DONEN	/YES-DONE ALL
	JMP	PADDON	/NO-PAD OUT EXT.
DONEN,	ISZ	FILNAM	/DONE-BUMP RETN TO CALL+3
FERR,	JMP I	FILNAM	/RETN( TO CALL+2 IF ERR.)


STOBUF,	0
	DCA	TEMP	/STOR CHAR IN TEMP
	ISZ	PAKBUF	/TOO MANY CHARS?
	SKP		/NOPE
	JMP	FERR	/YUP-GIVE ERROR RETN.
	ISZ	CCNTR	/BUMP CHAR COUNTER
	TAD	[LINBUF	/CALCULATE BUFFER ADDR.
	TAD	CCNTR
	DCA	UTEM1
	TAD	TEMP	/GET CHAR.
	DCA I	UTEM1	/AND STORE
	JMP I	STOBUF

PERSW=STOBUF

PAKBUF,	0
	TAD I	GTPTR	/GET CHAR. TO STORE
	TAD	[200	/MAKE IT 8 BIT ASCII
	DCA I	PWHERE	/STORE WHERE IT SHOULD GO
	ISZ	PWHERE	/BUMP POINTER
	JMP I	PAKBUF	/RETN.


QMK,	TEXT'_?_'

*1000
SAVE,	ISIT1
	3731		/SAVE?
	JMP	NEW	/NO-TRY NEW
	TAD	NAMER	/NAME IS IN NAMLOC OR IONAM
	JMS I	[SETINCH	/YES-SET UP THE IN CORE HEADER
	JMS I	(GETUNIT
	JMS I	(ENTER	/ENTER FILE ON CASSETTE
	JMP I	[LKERR	/ERROR WHILE ENTERING FILE
	TAD I	[SETINCH	/GET UNIT #
	CDF	0
	DCA I	[OUNIT	/STORE FOR CASSETTE ROUTINE
	TAD	(BUFST	/SET UP BUFFER PTR.
	DCA I	[KBUFST
	TAD	(BUFEND
	DCA I	[KBUFEND	/INSURE WE USE RIGHT BUFFER!
	CLL CML RTL
	DCA I	[OUTDEV	/SET OUTPUT TO CASSETTE
	CLA	IAC
	DCA I	[OUTD2	/OUTPUT TO TTY AFTER SAVE
	JMS	OUPSET	/SET UP FOR OUTPUT
	CIF	0
	JMP I	(LISTALL	/SAVE=LIST TO CASSETTE
OUPSET,	0
	CLA	CMA
	DCA I	(OCOUNT
	TAD	(OCASERR	/SET UP ERROR RETN.
	DCA I	(OERR
	CLA	CMA
	DCA I	POIP	/SET OUTPUT IN PROGRESS
	CDF	10
	JMP I	OUPSET	/RETN.

NAME,	ISIT1
	3726		/NAME?
	JMP	IMMEDA	/NO-MUST BE IMMEDIATE MODE
	JMS	COMON	/YES-DO IT
NM1,	JMS	MPRINT
	CRLFD
	CIF 0
	JMP I	(EDIT	/BACK TO EDIT PHASE

NEW,	ISIT1
	3727		/NEW?
	JMP	OLD	/NO-TRY OLD
NEWDO,	JMS	COMON	/YES-DO IT-
	JMS	MPRINT
	CRLFD
	CIF 0
	JMP I	(SCRATCH	/DO A SCRATCH

OLD,	ISIT1
	3730		/IS IT OLD?
	JMP	NAME	/NO-TRY NAME
OLDDO,	CLA CLL CML IAC RAL	/YES-GET OLD PROG. NAME(+3 IN AC)
	JMS	COMON
	JMS I	(GETUNIT	/GET UNIT NUMBER
	CDF	0
	DCA I	[IUNIT	/STORE AWAY
	TAD	[ICASERR
	DCA I	(IERR	/SET UP ERROR RETN.
	TAD	(STOP	/TYPE READY WHEN GET E O F
	DCA I	(EOFRTN	/SET UP END OF FILE RETN.
	TAD I	[IUNIT
	CDF	 10
	JMS I	[LOOK	/LOOK UP THE FILE
	NAMLOC		/FILE NAME IS IN NAMLOC
	JMP	NTFND	/NOT FOUND-ERROR
OLD3,	CDF
	JMS I	[INPSET	/SET UP FOR INPUT--NOT RUNTIME!!
	JMS I	(SCRAT1	/DO A SCRATCH ALMOST
	CDF	10
	CIF	0
	JMP I	(RUN	/AND GO ON



/
/THESE 2 LINES MUST BE IN THIS ORDER-SEE OLDDO
/
NEWMES,	TEXT '_NEW '
OLDMES,	TEXT '_OLD '
PROGNA,	TEXT 'PROGRAM NAME-'

COMON,	0
	MQL		/SAVE AC FOR A FLASH
	CDF 0		/MUST BE FLD ZERO DUMMY!
	CLA	IAC	/INSURE OUTPUT IS TTY
	DCA I	[OUTDEV
	CLA 	IAC
	DCA I	[OUTD2
	MQA		/GET AC BACK
	JMS	MPRINT	/PRINT MESSAGE
	NEWMES
ASKAGN,	JMS	MPRINT
	PROGNA
	DCA I	(GTJMP1	/GET CHARS FROM KBD.
	JMS I	[FILNAM	/GET FILE NAME-STORE IN NAMLOC
	NAMLOC
	JMP	TYQUES	/ERROR-ASK AGAIN
	DCA	NAMER	/0=NAME OF PROG IS IN NAMLOC
	JMP I	COMON	/DONE-RETN.

TYQUES,	JMS	MPRINT
	QMK
	JMP	ASKAGN	/MUST HAVE A PROGRAM NAME!

NTFND,	JMS	MPRINT
	OLDMES
	JMS	MPRINT
	NFMES
	JMP	NM1

IMMEDA,	CIF 0
	JMP I	(IMMED


*1200
NULIM=OPEN1		/LIMIT OF USER CODE IF NO RUNTIME I/O

OPEN1,	GET+MSTBE1	/NEXT ELEMENT MUST BE TEXT
	5000
	TAD	NAMER
	SNA	CLA	/WAS THIS PROG. SEGMENT CHAINED TO?
	JMP	NTCHAN	/NOPE
	TAD	(-11	/YES-THEN ITS NAME IS IN IONAM-MOVE
	DCA	CNTO	/IT TO NAMLOC IN CASE HE SHOULD DO A
	TAD	(NAMLOC-1	/ 'SAVE' WITHOUT FIRST DOING
	DCA	X10	/A 'NAME'-SAVE IT WITH SAME NAME AS IT HAD
	TAD	(IONAM-1
	DCA	XREG2
	TAD I	XREG2
	DCA I	X10
	ISZ	CNTO
	JMP	.-3
	DCA	NAMER	/CLR. NAMER LOC.
NTCHAN,	JMS I	(CNAMST	/DONE-GET UNIT # AND FILE NAME FROM CORE
	JMP	FILNR	/ERROR-BAD UNIT OR NAME
	DCA	IOUNIT	/STORE UNIT #
	JMS I	UJMS	/GET NEXT ELEMENT OF PSEUDO-CODE
	GETWD
	CDF 0		/IS IT LAST WORD OF TEXT STMT?
	TAD I	[WORD
	CDF 10
	SZA	CLA
	JMP	.+3	/NOPE
	JMS I	UJMS	/YUP
	GETWD		/SKIP IT
	MSTBE1		/MUST BE 'FOR'
	1772
	JMS I	UJMS
	GETWD
	ISIT1		/IS IT 'INPUT'
	1767
	JMP	FROUT	/NO-MUST BE 'FOR OUTPUT'
FRINP,	TAD	[ICASERR	/RESET ERROR AFTER WAIT
	JMS I	UJMS	/WAIT FOR ALL POSSIBLE READS
	WAITR
	CDF	0
	TAD I	POIP	/IS A RUNTIME OUTPUT FILE OPEN?
	SMA	CLA
	JMP	FRINP1	/NOPE
	TAD	IOUNIT	/YUP -SAME UNIT AS HE WANTS NOW??
	CMA	IAC	
	TAD I	[OUNIT	/(UNIT # IS IN FLD 0)
	SZA	CLA
	JMP	FRINP1	/NOPE-OK
IAO,	CDF CIF 0	/YES-GIVE ERROR-CLOSE OUTPUT FILE
	JMP I	(IANDO
FRINP1,	TAD	[ICASERR	/SET UP RETN. FOR READ ERR.
	DCA I	(IERR
	CMA		/FLAG-DOING RUNTIME INPUT
	JMS I	[INPSET	/GO SET UP FOR INPUT
	CLA 	IAC	/SET INPUT TO TTY
	DCA I	[INDEV
	TAD	IOUNIT
	DCA I	[IUNIT	/STORE # OF RUN-TIME INPUT UNIT
	CDF 10
	TAD	IOUNIT	/GET THE UNIT #
	JMS I	[LOOK	/LOOK UP THE FILE
	IONAM		/NAME IS IN IONAM
	JMP	OPNERR	/NOT FOUND-GIVE ERROR
	CIF 0
	CDF 10
	JMP I	(EXECUTE	/FOUND-GO ON

IOUNIT,	0
CNTO=IOUNIT


FROUT,	MSTBE1		/MUST BE 'OUTPUT'
	1743
	CDF 0
	CLA	IAC	/IS A RUNTIME OUTPUT FILE OPEN?
	TAD I	POIP
	CDF 10
	SZA	CLA
	JMP	NOPE
LKER,	CDF CIF 0
	JMP I	(LOOKER	/GIVE ERROR AND CLOSE IT
NOPE,	TAD	(IONAM-NAMLOC
	JMS I	[SETINCH	/SET UP INCH FROM IONAM
	CDF 0
	TAD I	[IUNIT	/IS A RUN-TIME INPUT FILE OPEN-SAME UNIT?
	CMA	IAC
	TAD	IOUNIT
	SZA	CLA
	JMP	OUTOK	/NOPE
	TAD I	[DRTI	/YES-IS HE REALLY DOING RT INPUT
	SNA	CLA
	JMP	OUTOK	/NO
	TAD I	[CGET	/YES-IS HE AT EOF
	SZA	CLA
	JMP	IAO	/NO-GIVE AN 'I&O' ERROR
OUTOK,	TAD	(OCASERR	/YES-RESET ERROR RETN AFTER WAIT
	JMS I	UJMS
	WAITR		/WAIT FOR ALL I/O BEFORE ENTER
	CDF  10
	TAD 	IOUNIT	/ENTER FILE ON CASSETTE
	JMS I	(ENTER
	JMP	LKER	/ERROR
	TAD	IOUNIT	/OK-STORE IOUNIT IN OUTPUT CAS. ROUTINE
	CDF 	0
	DCA I	[OUNIT
	JMS I	(OUPSET	/SET UP FOR OUTPUT

	CDF	CIF 0
	TAD	(RTBUF
	DCA I	[KBUFST
	TAD	(RTBFND
	DCA I	[KBUFEND	/CHANGE THE BUFFER TO BE USED
	CDF 10
	JMP I	(EXECUTE	/GO ON

OPNERR,	CDF CIF 0
	JMP I	(LERR
FILNR,	CDF CIF 0
	JMP I	(BADCHN


PAGE
/RUNTIME I/O BUFFER (OUTPUT) ONLY USED
/IF HE SAYS HE IS USING RUNTIME FILE I/O
RTBUF,	0
RTBFND=RTBUF+200
*RTBFND
LIMIT,	0	/LIMIT OF USER CODE IF RUNTIME I/O IS USED


//ONCE ONLY CODE FOR START UP
/
*3000
STARTB,	TAD	(CTRLC	/SET UP WHERE TO GO ON CTRL/C
	CDF 0
	DCA I	(CTRLCJ
	JMS I	UJMS		/RESET SOME STUFF
	RESET1
ST,	JMS	MPRINT
	RTIOMES
	JMS I	(GETIT	/GET AND PRINT HIS REPLY
	DCA	TEMPS	/STORE IT
	JMS I	(GETIT	/MUST TYPE C.R. NOW
	TAD	[7763
	SZA	CLA
	JMP	ST	/NOPE-ASK AGAIN
	JMS	MPRINT	/TYPE CR/LF
	CRLFD
	TAD	TEMPS
	TAD	(-"Y!200
	SNA	CLA
	JMP	NOCHNG	/YES-NO CHANGES TO BASICK
CHNG,	TAD	(NULIM	/NO-RESET LIMIT OF USER PROG.
	CDF	0
	DCA I	(PLIMIT
	TAD	(FIOER	/SET FILE I/0 COMMANDS TO GIVE ERROR
	DCA I	(PRN
	TAD	[-5
	DCA	TEMP
	TAD	(PENDN
	DCA	X10
	TAD	(FIOER
	DCA I	X10
	ISZ	TEMP
	JMP	.-3
NOCHNG,	JMS	MPRINT
	NWOLMS		/PRINT 'NEW OR OLD--'
DOSCRT,	JMS I	(SCRAT1	/SCRATCH!
	JMS I	UJMS
	RESET1
	JMS I	UJMS	/IN CASE HE TYPES A REAL LINE OF BASIC
	CLEARV		/CODE IN  GETLIN ROUTINE
	TAD	(XXTHEN
	JMS I	UJMS
	GETLIN		/GET A LINE OF INPUT
	TAD I	[LINBUF
	DCA	UTEM1
	TAD	UTEM1
	CDF	0
	DCA I	[WORD
	CDF	10
	TAD I	UTEM1
	SNA	CLA
	JMP	NOCHNG	/BAD REPLY-ASK AGAIN
	JMS	MPRINT	/PRINT CR/LF
	CRLFD
	CDF	0
	TAD I	[OUTD2
	DCA I	[OUTDEV
	CDF	10
	TAD I	UTEM1
	TAD	(3727	/DID HE SAY NEW?
	SNA	CLA
	JMP I	(NEWDO
TRYOLD,	TAD I	UTEM1
	TAD	(3730
	SZA	CLA	/IS IT OLD?
	JMP	NOCHNG	/NO-ASK AGAIN
	JMP I	(OLDDO	/YES-DO IT

TEMPS,	0
RTIOMES,	TEXT '_USING RUN-TIME FILE I/O?(Y OR N)'
NWOLMS,	TEXT '_NEW OR OLD-'






	*5111

PERMSYM,0
XXPLUS,	4200;TEXT '+'
XXMINUS,4201;TEXT '-'
XXSTAR,	4302;TEXT '*'
XXSLASH,4303;TEXT '/'
XXUPARR,4404;TEXT '^'
XXLE,	4110;TEXT '<='
XXGE,	4111;TEXT '>='
XXNE,	4112;TEXT '<>'
XXEG,	4111;TEXT '=>'
XXEL,	4110;TEXT '=<'
XXEQ,	4105;TEXT '='
XXLT,	4106;TEXT '<'
XXGT,	4107;TEXT '>'
XXCOMMA,4015;TEXT ','
XXSEMI,	4016;TEXT ';'
XXCLOSE,4017;TEXT ')'
XXRBRAK,4017;TEXT ']'
XXOPEN,	4023;TEXT '('
XXLBRAK,4023;TEXT '['
XXTO,	4021;TEXT ' TO '
XXSTEP,	4022;TEXT ' STEP '
XXFN,	4024;TEXT 'FN'
XXCOS,	4025;TEXT 'COS'
XXTAN,	4026;TEXT 'TAN'
XXATN,	4027;TEXT 'ATN'
XXLOG,	4030;TEXT 'LOG'
XXEXP,	4031;TEXT 'EXP'
XXSQR,	4032;TEXT 'SQR'
XXABS,	4033;TEXT 'ABS'
XXSGN,	4034;TEXT 'SGN'
XXINT,	4035;TEXT 'INT'
XXRND,	4036;TEXT 'RND'
XXSIN,	4037;TEXT 'SIN'
XXPUT,	4040;TEXT 'PUT'
XXGET,	4041;TEXT 'GET'
XXTAB,	4042;TEXT 'TAB'
XXUUF,	4043;TEXT 'UUF'
XXCRLF,	6000;TEXT '_'
XXBSLSH,6000;TEXT '\'
XXPRNTN, 6001; TEXT 'PRINT# '
XXPRINT, 6002; TEXT 'PRINT '
XXLET,	6003; TEXT 'LET '
XXGOTO,	6004;TEXT 'GO TO '
XXTHEN,	6004;TEXT ' THEN '
XXIF,	6005;TEXT 'IF '
XXFOR,	6006; TEXT 'FOR '
XXGOSUB, 6010; TEXT 'GOSUB '
XXNEXT,	6007;TEXT 'NEXT '
XXINPTN, 6030;TEXT 'INPUT# '
XXINPUT, 6011; TEXT 'INPUT '
XXRETRN,6012;TEXT 'RETURN'
XXSTOP,	6013;TEXT 'STOP'
XXDIM,	6014;TEXT 'DIM '
XXRSTOR,6015;TEXT 'RESTORE'
XXREM,	6016;TEXT 'REM '
XXDEF,	6017;TEXT 'DEF '
XXREAD,	6020;TEXT 'READ '
XXDATA,	6021;TEXT 'DATA '

XXENDN, 6027; TEXT 'END#'

/
CRLFD=XXCRLF+1
/
XXOPN,	6033;TEXT 'OPEN '
XXCLSE,	6034;TEXT 'CLOSE'
XXOUTPUT, 6035; TEXT 'OUTPUT'
XXCHAN, 6036; TEXT 'CHAIN '
XXEND, 6024;TEXT 'END'	
XXTTYO,	6025;TEXT 'TTY OUT'
XXLPT,	6026;TEXT 'LPT'
XXNCOM,	6031;TEXT 'NO COMMAS'
XXCOMAS, 6032;TEXT 'COMMAS'
XXRUB,	6037; TEXT 'RUBOUTS'
XXNRUB,	6040; TEXT 'NO RUBOUTS'
XXLIST,	4044;TEXT 'LIST'
XXLIS,	4044;TEXT 'LIS'
XXRUN,	4045;TEXT 'RUN'
XXSCR,	4046;TEXT 'SCR'
XXSAVE,	4047;TEXT 'SAVE'
XXSAV,	4047;TEXT 'SAV'
XXOLD,	4050;TEXT 'OLD'
XXNEW,	4051;TEXT 'NEW'
XXNAME,	4052;TEXT 'NAME'
XXNAM,	4052;TEXT 'NAM'


	0


XXTEXT,	3000
XXEOF,	6023
XXUNARY,4113
XXFINI,	4014
XXEXIT,	6022
XXLIT0,	2000;2001;2002;2003
NOPUNCH
LINBUF,	ZBLOCK	51
LBEGIN,	ZBLOCK	60
ENDLIN,	0
PDLIST,	ZBLOCK	40
ENDPDL,	0
FORLIST,ZBLOCK	20
GOLIST,	ZBLOCK	13
GSBEND,	0
	ENPUNCH


/
/PAGE ZERO LITERALS FOR FIELD 1
/

FIELD 1
*3000	/FOR SELF-STARTING BIN LOAD


$