/OS8 BASIC EDITOR, V5A
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1972, 1973, 1974, 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/DEC-S8-LBASA-B-LA
/
/COPYRIGHT  C 1972, 1973, 1974
/
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD,MASSACHUSETTS 01754
/
/AUGUST 19, 1972
/
/HANK MAURER, 1972
/LEN ELEKMAN, 1972
/SHAWN SPILMAN, 1973
/
/
/ASSEMBLE AND LOAD AS FOLLOWS:
/
/	.R PAL8
/	*BASIC,BASIC<BASIC.03
/	.R ABSLDR
/	*BASIC$
/	.SA SYS BASIC;3211
/
/NOTE DIFFERENCES FROM VERSION 1 AS FOLLOWS:
/
/	.R SRCCOM
/	*LPT:<BASIC.01,BASIC.03
/	*
/
	VERSON=	5	/VERSION LOCATED IN CORE AT TAG "VERLOC"
			/LEFT 6BIT HALF = VERSION NUMBER+21
			/RIGHT 6BIT HALF = PATCH LEVEL+41 (A=01)

/
/FIXES FOR V4		J.K.	1975
/
/.LINE TOO LONG ERROR MESSAGE
/.CLEAR CD OPTION TABLE AT START UP
/.LIST FROM ACROSS FLD BOUNDRIES
/.MEMORY OVERFLOW
/.INPUT FROM TTY

/JR	5-APR-77	ADDED EXTENDED DATE PRINTOUT
/JR	13-APR-77	ADDED SCROLLING, SCOPE SUPPORT AND .BASIC COMMAND INTERFACE
/JR	30-APR-77	FIX JSW FIELD BUG

//	14-DEC-2018  LHN - INSTALLED DSN PATCH 31.12.1 M

	BCSIZE=	3700	/ SIZE OF BCOMP.SV
	BCBEGN=	7001	/ START OF BCOMP
	INFO=	7604	/ INFORMATION AREA (FIELD 1)
	JSW=	7746	/JOB STATUS WORD IN FIELD 0
	OS8RES=	3400	/ SWAP AREA FOR OS8
	DSKBUF=	4200	/ FILE BUFFER
	HANDLR=	4600	/ INPUT OUTPUT HANDLER ADDRESS
	TXTAREA=5200	/ START OF TEXT AREA
	MDATE=	7666	/ADDR OF OS8 DATE IN FIELD 1
	BIPCCL=	7777	/ADDR OF DATE EXTENSION IN FIELD 0
	*3
SWAPT1,	0
SWAPT2,	0
SWAPT3,	0
SWAPT4,	0
	0
X10,	INFO-1
X11,	NAMLST-1
X12,	0
X13,	0
X14,	0
X15,	0
X16,	0
X17,	0
	*20
RDTMP,	0		/USED BY INPUT ROUTINE
RDPTR,	0
SIZE,	0		/USED BY LINE EDITOR STUFF
TEMP,	0
TEMP2,	0
TOWARD,	0
PTR,	0
NDIGS,	0
NCHARS,	0
COFLAG,	0		/=0 IF CTRL/O
CHNFLAG,0		/=1 IF BACK FROM RUN, 0 IF OLD
RUNFLAG,0		/=1 IF RUN, 0 IF SAVE
OLDFLAG,0		/=1 IF INPUT COMING FROM FILE
EOFADR,	TXTAREA
CORTMP,	0
CORSIZ,	1
LINENO,	0;0		/HOLDS MOST RECENT LINE NUM
EOFLIN,	0;0		/LAST LINE NUMBER
NAME,	0;0;0;0		/NAME BUFFER
FNAME,	FILENAME NONAME.BA /CURRENT FILE NAME
DEVHAN,	0		/ADDRESS OF DEVICE HANDLER
DEVNUM,	0		/CURRENT DEVICE NUMBER
SWPNUM,	0		/SWAPPER FLAG (FOR ^C)
O7700,	7700
O200,	200
O201,	201
O7761,	7761
O177,	177
O232,	232
O7201,	7201
O7706,	7706
O32,	32
O7200,	7200
O7600,	7600
O17,	17
O260,	260
O237,	237
O13,	13
O215,	215
O212,	212
O37,	37
O7741,	7741
O7405,	7405
O7701,	7701
O7772,	7772
O6171,	6171
O6211,	6211
O7770,	7770
O6201,	6201
O10,	10
O7774,	7774
O7766,	7766
O7634,	7634
O137,	137
O7746,	7746
O36,	36
O77,	77
O7745,	7745
O12,	12
O7771,	7771
O7400,	7400
O7760,	7760
/
O14,	14
CSFLG,	0
	PAGE
GETLIN,	0		/GET A LINE FROM TTY.
	TAD I	(HEIGHT	/RESET SCREEN HEIGHT ON USER INPUT
	DCA I	(LINCNT
	DCA	NDIGS	/CLEAR LINE NUMBER.
	DCA	CSFLG	/ZERO OUT ^S FLAG WHENEVER WE GET INPUT
	DCA	NCHARS	/CLEAR TEXT COUNT.
IGNORE,	CLA
	JMS I	[GETCH
	DCA	TEMP2	/SAVE CHAR
	CLL CMA RTL	/CHECK FOR CONTROL C
	TAD	TEMP2
	SNA
	JMP I	(BYEBYE	/ITS ^C  EXIT TO OS8
	TAD	O7766	/CHECK FOR CARRIAGE RETURN
	SNA
	JMP	CARRET	/JUMP IF 015 - CARRET.
	TAD	O7770	/CHECK FOR ^U
	SNA
	JMP	ALT	/TREAT ^U AS ALTMODE
	TAD	O7772	/CHECK FOR ALTMODE
	SNA
	JMP	ALT	/JUMP IF 033 - ALTMODE.
	TAD	O7634	/CHECK FOR RUBOUT
	SNA
	JMP	ARROW	/TREAT LIKE BACK ARROW
	IAC		/CHECK FOR ALTMODE
	SNA
	JMP	ALT	/JUMP IF 176 - ALTMODE.
	IAC
	SZA
	JMP	.+4	/PRINT IF 175 - ALTMODE.
ALT,	JMS I	[TYPE
	MSGALT
	JMP	GETLIN+1
	TAD	O36	/CHECK FOR BACK ARROW
	SNA
	JMP	ARROW	/JUMP IF 137 - BACKARROW.
	CLL
	TAD	O77
	SNL
	JMP	IGNORE	/JUMP IF NOT PRINTABLE.
	IAC
	DCA	TEMP	/SAVE IT(SP=01,^=77,NO 00).
	TAD	OLDFLAG	/INPUT FROM FILE ?
	SZA CLA
	JMP	.+3	/YES, DON'T ECHO
	TAD	TEMP2
	JMS I	[TTYOUT	/PRINT ON TTY
	TAD	NCHARS
	SZA CLA
	JMP	ISTEXT	/NOT LINE NUMBER.
	TAD	TEMP
	TAD	O7745	/SEE IF ITS A DIGIT
	JMS I	[LNDIG	/PUT DIGIT INTO LINE NUM
	JMP	IGNORE	/GET NEXT CHAR
ISTEXT,	TAD	NCHARS	/PUT CHAR IN THE LINE.
	TAD	O7405
	SPA CLA
	JMP	.+5
	JMS I	[CRLF
	JMS I	[TYPE	/250 CHARS IS OK TO FIT 1 MORE.
	MSGTOO
	JMP	GETLIN+1/IF AN EVEN NUMBER
	TAD	NCHARS	/OF CHARS SO FAR
	CLL RAR
	TAD	[LINE+2
	DCA	PTR
	SZL
	JMP	RIGHTY
	TAD	TEMP	/THEN STORE AS THE LEFT
	CLL RTL		/HALF OF THE WORD.
	RTL
	RTL
	JMP	.+4
RIGHTY,	TAD I	PTR	/ELSE AS THE RIGHT.
	AND	O7700
	TAD	TEMP
	DCA I	PTR
	ISZ	NCHARS
	JMP	IGNORE
ARROW,	TAD	OLDFLAG	/INPUT FROM FILE ?
	SNA CLA
	JMS I	(PRTBSP	/NO, GO PRINT BACKSPACE OR BACKARROW
	CLA CMA
	TAD	NCHARS	/IF THERE IS A TEXT CHAR TO ERASE
	SPA
	JMP	.+3
	DCA	NCHARS	/THEN ERASE IT.
	JMP	IGNORE
	TAD	NDIGS	/OTHERWISE, IF THERE IS A LINENO
	SMA		/CHARACTER TO ERASE THEN ERASE
	DCA	NDIGS	/THAT.
	JMP	IGNORE	/OTHERWISE, NEVER MIND.
CARRET,	TAD	OLDFLAG	/INPUT FROM FILE ?
	SNA CLA
	JMS I	[CRLF	/NO, PRINT CR-LF
	TAD	NCHARS
	SZA
	JMP	.+4	/NOT AN EMPTY LINE
	TAD	NDIGS	/ANY CHARS AT ALL ?
	SNA CLA
	JMP	IGNORE	/NO, IGNORE EMPTY LINES
	CLL RAR
	TAD  	[LINE+2
	DCA	PTR
	SZL
	TAD I	PTR	/STORE 00 (CAR. RET.) LIKE ALL
	AND	O7700	/THE OTHER CHARACTERS.
	DCA I	PTR
	JMS I	[NORM	/NORMALIZE LINE NUMBER
	JMP I	GETLIN
/CRLF,	0		/PRINT CR-LF
/	TAD	O215
/	JMS I	[TTYOUT
/	TAD	O212
/	JMS I	[TTYOUT
/	JMP I	CRLF
DUMMY,	0
	CLA
	ISZ	DUMMY
	JMP I 	DUMMY
PATCH4,	TAD	[NAME+3
	DCA	TEMP2
	CMA
	DCA SIZE
	JMP I	(NAMLUP

	PAGE
LNDIG,	0		/GET DIGIT INTO LINE NUM
	CLL
	TAD	O12
	SZL
	JMP	.+4
	CLA		/NOT A DIGIT
	ISZ	LNDIG	/RETURN +1
	JMP I	LNDIG
	DCA	TEMP	/SAVE DIGIT
	ISZ	NDIGS
	TAD	NDIGS
	TAD	O7771
	SMA
	JMP I	LNDIG	/IGNORE MORE THAN 6 DIGITS.
	TAD	.+3
	DCA	.+1	/PUT IN THE NTH DIGIT IN THE
	HLT		/4 BIT BCD LINE NUMBER:
	JMP	.+7
	JMP	DIG1
	JMP	DIG2
	JMP	DIG3
	JMP	DIG4
	JMP	DIG5
DIG6,	TAD	LINENO+1/WHERE N=6
	AND	O7760
	JMP	DIG56
DIG5,	TAD	TEMP	/WHERE N=5
	CLL RTL
	RTL
	DCA	TEMP
	TAD	LINENO+1
	AND	O7400
DIG56,	TAD	TEMP
	JMP	DIG456
DIG4,	TAD	TEMP	/WHERE N=4
	CLL RAR
	RTR
	RTR
DIG456,	DCA	LINENO+1
	JMP I	LNDIG
DIG3,	TAD	LINENO	/WHERE N=3
	AND	O7760
	JMP	DIG23
DIG2,	TAD	TEMP	/WHERE N=2
	CLL RTL
	RTL
	DCA	TEMP
	TAD	LINENO
	AND	O7400
DIG23,	TAD	TEMP
	JMP	DIG123
DIG1,	TAD	TEMP	/WHERE N=1
	CLL RAR
	RTR
	RTR
DIG123,	DCA	LINENO
	JMP I	LNDIG
TYPE,	0		/TYPE A MESSAGE
	DCA	CRSWIT	/SAVE CARRIAGE RETURN SWITCH
	TAD I	TYPE	/GET ADDR OF MESSAGE
	ISZ	TYPE
	DCA	PASS
TLOOP,	JMS I	[CTRLO	/CHECK FOR CTRL/O
	JMP	TCRLF	/YES, STOP PRINTING
	TAD I	PASS	/GET HIGH CHAR
	CLL RTR		/SHIFT RIGHT
	RTR
	RTR
	AND	O77	/SIX BITS
	SNA
	JMP	TCRLF	/END OF MESSAGE
	TAD	O237	/CONVERT TO ASCII
	JMS I	[TTYOUT	/PRINT CHAR
	TAD I	PASS	/GET LOWER CHAR
	ISZ	PASS
	AND	O77
	SNA
	JMP	TCRLF	/END OF LINE
	TAD	O237	/CONVERT TO ASCII
	JMS I	[TTYOUT	/PRINT
	JMP	TLOOP
TCRLF,	TAD	CRSWIT	/RETURN THE CARRIAGE ?
	SNA CLA
	JMS I	[CRLF	/YES
	JMP I	TYPE	/DONE
/TTYOUT,	0		/PRINT ONE CHAR
/	TSF		/WAIT
/	JMP	.-1
/	TLS		/PRINT
/	CLA
/	JMP I	TTYOUT
PASS,	0		/SKIP OVER LINE
	ISZ	TEMP
	SKP
	JMS	FINCR
	TAD I	TEMP
	AND	O77
	SZA CLA
	JMP	PASS+1
	ISZ	TEMP
	JMP I	PASS
	JMS	FINCR
	JMP I	PASS
CRSWIT,
FDECR,	0		/DECR. POINTER AND FIELD
	TAD	TEMP
	SZA CLA
	JMP	.+5
	RDF
	TAD	O6171
	DCA	.+1
	HLT
	CLA CMA
	TAD	TEMP
	DCA	TEMP
	JMP I	FDECR
FINCR,	0		/INCR. CURRENT DATA FIELD
	RDF
	SZA
	JMP	HERE
	TAD	CORSIZ
	DCA	CORTMP
HERE,	TAD	O6211
	DCA	.+1
	HLT
	ISZ	CORTMP
	JMP I	FINCR
	CDF 0
	JMP I	[COREOV	/FILE TOO BIG
	PAGE
CMDDONE,CDF
	JMS I	[CRLF	/TYPE READY MESSAGE
	JMS I	[TYPE
	MSGRDY
MAINLUP,CDF
	JMS I	[GETLIN	/GET AN EDITED LINE.
	SNA CLA
	JMP	NOCOMD	/NOT A COMMAND
	TAD	OLDFLAG	/IN OLD MODE ?
	SNA CLA
	JMP I	[COMMAND/NO, MUST BE A COMMAND
	JMP	MAINLUP	/OTHERWISE IGNORE
NOCOMD,	TAD	PTR	/OR A LINE WITH A LINE
	CMA		/NUMBER ON IT.
	TAD  	[LINE
	DCA	SIZE	/SET UP SIZE OF LINE.
	TAD I	[LINE+2	/IS LINE EMPTY ??
	SNA CLA
	DCA	SIZE	/POSSIBLY ZERO.
	TAD	LINENO	/IS IT > LAST LINE ?
	CIA CLL
	TAD	EOFLIN
	SZA CLA
	JMP	.+4	/HI PART NOT =, FORGET LOW
	TAD	LINENO+1
	CIA CLL
	TAD	EOFLIN+1	/COMPARE LOW PARTS
	SZL CLA
	JMP	NOTLAST	/NOT > LAST
	JMS I	[GETEOF	/GET EOF
	TAD	TEMP	/MAKE IT LOOK LIKE
	DCA	PTR	/A CALL TO FINDLN
	TAD	LINENO	/SAVE NEW LAST LINE
	DCA	EOFLIN
	TAD	LINENO+1
	DCA	EOFLIN+1
	SKP
NOTLAST,JMS I	[FINDLN	/GENERAL CASE - SEARCH
INSERT,	TAD	TEMP	/THERE ARE (TEMP-PTR) WORDS IN
	CLL CMA		/THE OLD LINE WHICH ARE TO BE
	TAD	PTR	/REPLACED BY (-SIZE) WORDS IN
	CLA		/NEW LINE.
	RDF
	SZL
	TAD	O7770
	TAD	O6201
	DCA	PTRFLD	/GET FIELD OF START OF OLD LINE
	TAD	PTR
	CLL CIA
	TAD	TEMP
	TAD	SIZE	/WHICH WAY ?
	SNA
	JMP	MOVE	/SAME SIZE, MOVE IN NEW LINE
	SPA
	JMP I	(EXPAND	/MAKE MORE ROOM FOR NEW LINE
	CIA
	TAD	TEMP	/SHRINK THE FILE
	DCA	TOWARD	/MOVE FILE DOWN TO HERE
	RDF
	TAD	O6201
	DCA	TMPFLD	/GET FIELD OF READ POINTER
	TAD	TOWARD
	CLL CMA
	TAD	TEMP
	SNL CLA
	TAD	O7770
	TAD	TMPFLD
	DCA	TWDFLD	/GET FIELD OF WRITE POINTER
TMPFLD,	HLT
	TAD I	TEMP
TWDFLD,	HLT
	DCA I	TOWARD	/MOVE DOWN
	TAD I	TOWARD
	TAD	O7701	/END OF FILE ???
	SNA CLA
	JMP	LWREOF	/YES, PUT NEW LINE IN AT END
	ISZ	TEMP	/INCREMENT POINTERS
	JMP	.+4
	TAD	TMPFLD	/AND FIELDS IF NECESSARY
	TAD	O10
	DCA	TMPFLD
	ISZ	TOWARD
	JMP	TMPFLD
	TAD	TWDFLD
	TAD	O10
	DCA	TWDFLD
	JMP	TMPFLD	/KEEP SHRINKING
LWREOF,	TAD	TOWARD	/SET NEW EOF
	JMS I	[SETEOF
MOVE,	TAD	SIZE
	SNA CLA
	JMP	MAINLUP	/IT WAS A DELETE
	CDF 00
	TAD	LINENO	/PUT IN LINE NUMBER
	DCA I	[LINE
	TAD	LINENO+1
	DCA I	[LINE+1
MOVENTR,TAD  	[LINE
	DCA	TEMP
MOVLUP,	CDF		/MOVE IN NEW LINE
	TAD I	TEMP
	ISZ	TEMP
PTRFLD,	HLT
	DCA I	PTR
	ISZ	PTR	/INCREMENT POINTERS
	JMP	.+4
	TAD	PTRFLD	/WHATCH OUT FOR FIELDS
	TAD	O10	/(W.C. OR E.M. ?)
	DCA	PTRFLD
	ISZ	SIZE
	JMP	MOVLUP
	JMP	MAINLUP
SRCHBK,	0
	DCA	TEM
	TAD I	SRCHBK
	ISZ	SRCHBK
	CIA
	TAD	TEM
	CLL CMA
	TAD I	SRCHBK
	SNL CLA
	ISZ	SRCHBK
	ISZ	SRCHBK
	TAD	TEM
	JMP I	SRCHBK
TEM,	0

	PAGE
EXPAND,	CIA		/EXTRA ROOM NEEDED
	DCA	TOWARD
	TAD I	TEMP	/SAVE THIS PLACE
	DCA	TEMP2
	TAD	O37	/NOW MARK THIS PLACE
	DCA I	TEMP
	JMS I	[GETEOF	/GET EOF
	RDF
	TAD	O6201
	DCA	TMP2FLD	/GET FIELD OF END OF FILE
	CLL
	TAD	TEMP	/MOVE FILE UP
	TAD	TOWARD	/TO
	DCA	TOWARD	/HERE
	SZL
	JMS I	[FINCR	/MIGHT BE ACROSS A FIELD
	RDF
	TAD	O6201
	DCA	TWD2FLD	/SAVE NEW EOF FIELD
	TAD	TOWARD	/SAVE NEW EOF
	JMS I	[SETEOF
TMP2FLD,HLT
	TAD I	TEMP
TWD2FLD,HLT
	DCA I	TOWARD	/MOVE UP ONE WORD
	TAD I	TOWARD
	TAD	O7741	/IS THE MARK ?
	SNA CLA
	JMP	LASTWD	/YES, PUT IN LAST WORD
	CLA CLL CMA
	TAD	TOWARD	/BACK UP POINTERS
	DCA	TOWARD
	SZL
	JMP	.+4
	TAD	TWD2FLD	/AND FIELDS (MAYBE)
	TAD	O7770
	DCA	TWD2FLD
	CLA CLL CMA
	TAD	TEMP
	DCA	TEMP
	SZL
	JMP	TMP2FLD
	TAD	TMP2FLD
	TAD	O7770
	DCA	TMP2FLD
	JMP	TMP2FLD
LASTWD,	TAD	TEMP2	/PUT IN SAVED WORD
	DCA I	TOWARD
	JMP I	[MOVE	/GO MOVE IN NEW LINE
COREOV,	JMS I	[TYPE	/FILE TOO BIG
	MSGBIG
BYEBYE,	CLA IAC
	AND	SWPNUM	/IS OS8 RES IN PLACE ?
	SZA CLA		/YES IF EVEN NUMBER OF SWAPS
BYE,	JMS I	[SWAP	/PUT BACK OS8
	TSF		/WAIT FOR TTY SO OS8 DOESN'T
	JMP	.-1	/TRAMPLE ON MY LINE FEED
	JMP I	(7605	/EXIT TO OS8
MSGBIG,	5646;5660;6372;160;6746;6347;5560;7000
MSGALT,	0145;4655;4665;4645;0
MSGWHAT,7051;4265;4000
MSGTOO,	5552;5746;0165;6060;0155;6057;5000
SCRATCH,TAD	[TXTAREA/SCRATCH FILE
	JMS I	[SETEOF
	DCA	EOFLIN	/ZERO LAST LINE NUM
	DCA	EOFLIN+1
	JMP I	[CMDDONE
NORM,	0		/LINE NUMBER NORMALIZER
	TAD	NDIGS
	SZA
	JMP	.+3	/IF THERE ARE NO DIGITS IN THE
	CLA CMA		/LINE NUMBER THEN
	JMP I	NORM	/RETURN -1.
	TAD	O7772
	SMA CLA
	JMP I	NORM	/IF THE LINENO HAS BEEN FILLED
	TAD	O7774	/OUT TO 6 DIGITS(LEADING 0'S)
	DCA	TEMP	/THEN RETURN.
	TAD	LINENO	/OTHERWISE, SHIFT RIGHT 1 DIGIT
	CLL RAR
	DCA	LINENO	/AND CHECK AGAIN.
	TAD	LINENO+1
	RAR
	DCA	LINENO+1
	ISZ	TEMP
	JMP	.-7
	ISZ	NDIGS
	JMP	NORM+1
SETEOF,	0	/SET NEW EOF
	DCA	EOFADR	/SAVE ADDR
	RDF		/GET FLD
	TAD	O6201
	DCA	EOFFLD	/SAVE IT
	TAD	O77	/STORE EOF
	DCA I	EOFADR
	JMP I	SETEOF
/
GETEOF,	0
	TAD	EOFADR	/RETRIEVE EOF INFO
	DCA	TEMP	/FIRST ADDR
EOFFLD,	CDF
	JMP I	GETEOF

	PAGE
COMMAND,TAD	COMTBL	/COMMAND LIST POINTER
	DCA	TEMP
COMLUP,	ISZ	TEMP	/GET 2 CHAR COMMAND
	TAD I	TEMP
	ISZ	TEMP
	SNA
	JMP	WHAT	/END OF LIST
	TAD I	[LINE+2	/IS THIS IT ?
	SZA CLA
	JMP	COMLUP	/NO, LOOK AGAIN
	TAD I	TEMP	/GET COMMAND ADDR
	DCA	TEMP	/AND GO TO IT
	JMP I	TEMP
WHAT,	JMS I	[TYPE	/TYPE WHAT?
	MSGWHAT
	JMP I	[MAINLUP
COMTBL,	.
	-5552
	LIST
	-6055
	OLD
	-6442
	SAVE
	-6366
	RUN
	-6444
	SCRATCH
	-4372
	BYE
	-5746
	NEW
	-5742
	RENAME
	0
WSSAVE,	0145;6454;3343;4264;5244;1770;6400
HEADING,0		/PRINT HEADING
	JMS I	[CRLF	/LATER
	TAD	[FNAME	/SET UP FOR CONVERSION
	DCA	TEMP	/POINTER TO FILE NAME
	TAD	XTITLE	/WHERE IT GOES
	DCA	PTR
	JMS	CONV	/OUTPUT FIRST TWO CHARS
	JMS	CONV	/NEXT TWO
	JMS	CONV	/THIRD TWO
	ISZ	PTR	/SKIP FOR EXT
	JMS	CONV	/OUTPUT EXTENSION
	JMS I	[TYPE	/TYPE HEADING
XTITLE,	TITLE
	JMS I	[CRLF	/FOLLOWED BY A CRLF
	JMP I	HEADING
CONV,	0		/CONVERT TO SIX BIT ASCII
	TAD I	TEMP	/GET NEXT WORD
	AND	O77	/CHECK FOR 0
	SNA		/SUBSTITUTE BLANKS
	TAD	(40
	TAD	O7741	/SUBTRACT 37
	AND	O77	/SIX BITS
	DCA I	PTR
	TAD I	TEMP	/DO UPPER CHAR
	AND	O7700
	SNA
	CLL CML RAR
	TAD	(-3700	/SAME WAY
	TAD I	PTR	/COMBINE THEM
	DCA I	PTR
	ISZ	TEMP
	ISZ	PTR
	JMP I	CONV

TITLE,	0;0;0;0101;0	/FOR THE PROG NAME
	0101;0101	/SOME BLANKS
VERLOC,	VERSON^100+2143	/VERSION NUMBER
	0101;0101	/MORE BLANKS
DATE,	0;0;0		/DATE TEMPLATE
DASH6,	1627		/"-6" FOR BUILDING DATE
EODAT,	0		/END OF DATE TEMPLATE

GETNC,	0		/GET A CHAR FOR A FILE NAME
	TAD	NCHARS	/GET CHAR POINTER
	ISZ	NCHARS	/BUMP IT
	CLL RAR		/DIVIDE BY 2
	TAD	[LINE+2	/ADD BASE
	DCA	TEMP	/GIVES ADDR OF WORD
	TAD I	TEMP	/GET 2 CHARS
	SZL		/ODD EVEN BIT IS IN LINK
	JMP	TESTCH	/GO CHECK THE CHAR
	RTR
	RTR
	RTR
TESTCH,	AND	O77	/ONLY 6 BITS
	SNA
	JMP I	GETNC	/END OF NAME
	TAD	O37
	ISZ	GETNC
	JMP I	GETNC
PATCH3,	0
	JMS I	[GETNC
	JMP I	PATCH3
	AND	O77
	JMS I	(SRCHBK
	72
	1
	JMP	EXB
	ISZ	PATCH3
	JMS I	(SRCHBK
	60
	12
EXA,	JMP I	PATCH3
	JMP I	(PATCH2
EXB,	CLA IAC
	JMP I	PATCH3

	PAGE
LIST,	TAD I	[LINE+3	/LISTNH ?
	TAD I	[LINE+4
	TAD	[-4436	/PSEUDO TEST
	SNA CLA
	JMP	LISTNH	/NO HEADING
	JMS I	[HEADING/GIVE HEADING
	TAD	COFLAG	/WAS CTRL/O TYPED ?
	SNA CLA
	JMP I	[CMDDONE/YES, ABORT LISTING
LISTNH,	DCA	NCHARS	/SET POINTER
	DCA	NDIGS	/AND DIGIT COUNTER
	JMS I	[GETNC	/SKIP UNTIL BLANK
	JMP	NUMDUN	/DONE
	TAD	(-40
	SZA CLA
	JMP	.-4	/NO BLANK YET
	JMS I	[GETNC	/GET A CHAR
	JMP	NUMDUN	/END OF NUMBER
	TAD	O7706	/SUBTRACT 72
	JMS I	[LNDIG	/GO SEE IF ITS A DIGIT
	JMP	.-4	/IT WAS, CONTINUE
NUMDUN,	TAD	[TXTAREA
	DCA	PTR	/SET UP POINTER
	JMS I	[NORM	/NORMALIZE THE NUM
	SPA CLA		/ANY NUMBER ?

//		DSN PATCH 31.12.1 M
//
//	JMP	.+3	/NO

	JMP PAT10	//

	JMS I	[FINDLN	/YES, LOCATE IT
	TAD	PTR

//	IAC
//	DCA	TEMP
//	JMS I	[FDECR
	CLL CIA		//
	TAD	TEMP	//
	JMP	MSGRDY+2 //

	RDF		/GET THE FIELD
PAT10,	TAD	O6201
	DCA	PTR2FLD	/SAVE IT
	DCA	TEMP
LSTLUP,	JMS I	[CTRLO	/CHECK FOR CTRL/O
	JMP I	[CMDDONE/YES, EXIT
	JMS CTRLS	/CHECK FOR XOFF
	JMS	GETFIL	/GET CHARACTER TO LIST
	JMP I	[CMDDONE
	JMS I	[TTYOUT	/PRINT IT
	JMP	LSTLUP	/LOOP
GETFIL,	0		/GET CHARACTER FROM FILE
	TAD	TEMP
	ISZ	TEMP
	TAD	.+3
	DCA	.+1
	HLT
	JMP I	.+1	/SEQUENCE OF OPERATIONS
	PTR2FLD		/GET FIRST WORD
	FRSTDIG		/FIRST DIGIT OF LINE NUMBER
	DIGIT		/SECOND DIGIT
	DIGIT		/THIRD DIGIT
	PTR2FLD		/GET NEXT WORD OF LINE NUMBER
	DIGIT		/FOURTH DIGIT
	DIGIT		/FIFTH DIGIT
	LASTDIG		/SIXTH AND LAST DIGIT
	PTR2FLD		/GET WORD OF TEXT
	LEFTTXT		/LEFT CHARACTER
	RITETXT		/RIGHT CHARACTER
	LINFTXT		/LINE FEED CHARACTER
PTR2FLD,HLT		/CHECK FOR EOF
	TAD I	PTR
	CDF
	TAD	O7701
	SNA
	JMP I	GETFIL	/YES, RETURN UNSKIPPED
	TAD	O77
	DCA	TEMP2	/NO, SAVE WORD
	ISZ	PTR	/BUMP POINTER
	JMP	GETFIL+1
	TAD	PTR2FLD
	TAD	O10
	DCA	PTR2FLD
	JMP	GETFIL+1
LASTDIG,CLA IAC		/FORCE LAST DIGIT (EVEN IF 0)
FRSTDIG,DCA	NDIGS	/ZERO DIGIT COUNT
DIGIT,	TAD	TEMP2
	RTL
	RTL
	DCA	TEMP2	/SHIFT LEFT ONE DIGIT
	TAD	TEMP2
	RAL
	AND	O17	/GET DIGIT
	SZA
	JMP	NZDIGIT	/ITS NOT ZERO
	TAD	NDIGS	/IS IT A LEADING ZERO ?
	SNA CLA
	JMP	GETFIL+1/YES, DON'T PRINT IT
NZDIGIT,ISZ	NDIGS	/NON ZERO OR NON LEADING ZERO
	TAD	O260	/SO PRINT IT
	JMP	GFRET
LEFTTXT,TAD	TEMP2	/GET LEFT CHAR
	RTR
	RTR
	RTR
	JMP	.+4
RITETXT,TAD	O10	/SETUP FOR LEFT CHAR NEXT
	DCA	TEMP
	TAD	TEMP2
	AND	O77	/SIXBITIZE AC
	SNA
	JMP	ZEROTXT	/0 IS END OF THE LINE
	TAD	O237	/MAKE IT ASCII
GFRET,	ISZ	GETFIL
	JMP I	GETFIL
ZEROTXT,TAD	O13	/SETUP FOR LF NEXT
	DCA	TEMP
	TAD	O215	/RETURN CR
	JMP	GFRET
LINFTXT,DCA	TEMP	/CLEAR SEQUENCER AND RETURN LF
	TAD	O212
	JMP	GFRET
/
CTRLS,	0
	TAD	CSFLG	/XON?
	SNA	CLA
	JMP I	CTRLS	/NO
	JMP LSTLUP	/YES
/
MSGRDY,	6346;4245;7200

//		DSN 31.12.1 M
//
	RDF		//
	SNL		//
	TAD 	O7770   //
	JMP	PAT10	//

	PAGE
GETFN,	0		/GET A FILE NAME (ALSO FETCH ITS HANDLER)
	DCA	SAVFLAG	/=1 FOR SAVE, 0 FOR OLD OR NEW
	TAD	CHNFLAG	/RETURNING FROM RUN ?
	SZA CLA
	JMP	NOFUSR	/YES, DON'T FETCH USR
	JMS I	[SWAP	/GET OS8 RESIDENT
	TAD	SAVFLAG	/IS IT OLD OR NEW ??
	SNA CLA
	IAC		/YES, DON'T SWAP 10000-11777
	DCA I	(7746	/DO IF SAVE, SO ALTER JSW
	CIF	10	/GET THE USR
	JMS I	O7700
	10
NOFUSR,	DCA	NCHARS	/RESET CHAR POINTER
BSKIP,	JMS I	[GETNC	/GET A CHAR
	JMP	ASKNAM	/ASK FOR FILE NAME
	TAD	M40	/BLANK ?
	SZA CLA
	JMP	BSKIP	/NO, LOOP
NOSKIP,	JMS	GETNAM	/GET A NAME
	SNA CLA
	JMP	USEDSK	/NO DEVICE SPECIFIED, USE DSK:
	TAD	NAME	/PUT IN THE DEVICE NAME
	DCA	DEV	/AS SPECIFIED
	TAD	NAME+1
	DCA	DEV+1
	JMS	GETNAM	/FETCH THE FILE NAME
	SZA CLA
	JMP I	(IOERR	/BAD SYNTAX IN FILE DESCRIPTOR
	JMP	GETHAN	/GO FETCH THE HANDLER
USEDSK,	TAD	(0423	/SET DEVICE NAME TO DSK:
	DCA	DEV
	TAD	(1300
	DCA	DEV+1
GETHAN,	TAD	[HANDLR+1
	DCA	DEV+2	/ALSO THE HANDLER ORIGIN
	CIF	10
	JMS I	O200	/CALL THE USR
	1		/FETCH HANDLER BY NAME
DEV,	0;0;0
	JMP I	(IOERR	/BAD DEVICE
	TAD	DEV+1	/SAVE THE DEVICE NUMBER
	DCA	DEVNUM
	TAD	DEV+2	/AND THE HANDLER ENTRY POINT
	DCA	DEVHAN
MOVEFN,	TAD	SAVFLAG	/WAS IT A SAVE ?
M40,	SMA SZA CLA
	JMP I	GETFN	/YES, JUST RETURN
	TAD	NAME	/NEW OR OLD, ANY NAME GIVEN ?
	SNA
	JMP I	GETFN	/NO, PROBABLY JUST A DEVICE
	DCA	FNAME	/YES, SAVE IT
	TAD	NAME+1
	DCA	FNAME+1
	TAD	NAME+2
	DCA	FNAME+2
	TAD	NAME+3
	DCA	FNAME+3
	JMP I	GETFN
ASKNAM,	TAD	SAVFLAG	/WAS THIS A SAVE ?
	SPA SNA CLA
	JMP	ASKNM	/NO, GO ASK FOR A NAME
	TAD	FNAME	/IT WAS A SAVE, ANY OLD NAME TO USE ?
	SNA
	JMP	ASKNM	/NO, GO ASK FOR ONE
	DCA	NAME	/YES, MOVE INTO NAME
	TAD	FNAME+1
	DCA	NAME+1
	TAD	FNAME+2
	DCA	NAME+2
	TAD	FNAME+3
	DCA	NAME+3
	JMP I	GETFN
ASKNM,	CLA IAC		/ASK FOR FILE NAME
	JMS I	[TYPE
	ASKFN
	TAD	(DUMMY
	DCA	[LNDIG
	JMS I	[GETLIN
	JMP I	(PATCH1
SAVFLAG,0
GETNAM,	0		/GET A FILE OR DEVICE NAME
	DCA	NAME	/ZERO THE NAME BUFFER
	DCA	NAME+1
	DCA	NAME+2
	TAD	O201	/USE DEFAULT EXT .BA
	DCA	NAME+3
	TAD	[NAME	/SETUP POINTER
	DCA	TEMP2
	TAD	O7774	/SETUP SIZE (MAX 4 WORDS)
	DCA	SIZE
NAMLUP,	JMS I	(PATCH3
	JMP I	GETNAM
	CLL RTL
	RTL
	RTL
	DCA I	TEMP2	/SAVE IT
	JMS I	(PATCH3
	JMP I	GETNAM
	TAD I	TEMP2	/COMBINE THE 2
	DCA I	TEMP2
	ISZ	TEMP2
	ISZ	SIZE	/ANY MORE ?
	JMP	NAMLUP
	JMP I	GETNAM
RENAME,	CLL CML RAR	/SAVE USR AREA
	JMS	GETFN	/GET FILE NAME
	CIF	10
	JMS I	O200	/REMOVE USR
	11		/AND RESTORE 10000-11777
	JMS I	[SWAP	/SWAP OS8 RESIDENT
	JMP I	[CMDDONE
NEW,	TAD	[TXTAREA	/SCRATCH
	JMS I	[SETEOF
	DCA	EOFLIN	/ZERO LAST LINE NUM
	DCA	EOFLIN+1
	JMS	GETFN	/GET THE FILE NAME
	JMS I	[SWAP	/REMOVE OS8
	JMP I	[CMDDONE

	PAGE
PUTFIL,	0		/WRITE THE FILE
	TAD	[TXTAREA
	DCA	PTR	/GET POINTER TO TEXT
	TAD	O6201	/GET FIELD OF TEXT
	DCA I	[PTR2FLD
	DCA	TEMP	/ZERO LINE SEQUENCER
	TAD	[DSKBUF	/GET ADDR OF DISK BUFFER
	DCA	SWAPT1	/BUFFER POINTER
	TAD	O7600
	DCA	SWAPT2	/DOUBLE WORD COUNTER
	TAD	JMPINS	/SET 3 WAY SWITCH
	DCA	PUTJMP
PFLOOP,	JMS I	[GETFIL	/GET A CHAR FROM TEXT AREA
	JMP	PFCTLZ	/END OF FILE
	JMS	PUTCH	/OUTPUT IT
	JMP	PFLOOP	/DO NEXT CHAR
PFCTLZ,	TAD	O232	/PUT CTRL-Z
	JMS	PUTCH
	TAD	O7201	/BUFFER DUMP COUNT
	DCA	PFTEMP
	JMS	PUTCH	/FILL WITH ZEROES
	ISZ	PFTEMP
	JMP	.-2
	JMP I	PUTFIL	/DONE
PFTEMP,	0
PUTCH,	0		/PUT A CHAR ONTO THE OS8 FILE
	DCA	SWAPT4	/SAVE THE CHAR
PUTJMP,	HLT		/JUMP TO CORRECT PLACE
	JMP	PH1	/FIRST CHAR
	JMP	PH2	/SECOND CHAR
PH3,	TAD	JMPINS	/RESTORE SWITCH
	DCA	PUTJMP
	TAD	SWAPT4	/GET THE CHAR
	AND	O17	/LOW FOUR BITS
	CLL RAR
	RTR		/INTO THE HIGH PART OF WORD TWO
	RTR
	TAD I	SWAPT1	/COMBINE WITH CHAR 2
	DCA I	SWAPT1
	TAD	SWAPT4	/GET THE HIGH FOUR BITS
	RTL
	RTL		/INTO THE HIGH PART OF WORD ONE
	AND	O7400
	TAD I	SWAPT3	/COMBINE WITH WORD ONE
	DCA I	SWAPT3
	ISZ	SWAPT1	/BUMP POINTER
	ISZ	SWAPT2	/BUMP DOUBLE WORD COUNT
	JMP I	PUTCH	/RETURN
	JMS I	[SWAP	/SWAP IN OS8
	JMS I	DEVHAN	/WRITE THIS BUFFER
	4200
	DSKBUF
WRBLOK,	0
	JMP I	(OUERR
	ISZ	OUSIZE	/ANY ROOM LEFT ?
	SKP
	JMP I	(OUERR	/NO, ERROR
	ISZ	WRBLOK	/BUMP BLOCK NUMBER
	ISZ I	(OULEN	/BUMP ACTUAL SIZE
	JMS I	[SWAP	/SWAP BACK
	TAD	[DSKBUF	/SET UP BUFFER POINTER
	DCA	SWAPT1
	TAD	O7600
	DCA	SWAPT2	/SET UP COUNT
	JMP I	PUTCH
PH2,	TAD	SWAPT1	/SAVE POINTER TO FIRST
	DCA	SWAPT3
	ISZ	SWAPT1	/BUMP POINTER
PH1,	TAD	SWAPT4	/GET CHAR
	DCA I	SWAPT1	/INTO BUFFER
	ISZ	PUTJMP	/BUMP SWITCH
	JMP I	PUTCH
JMPINS,	JMP	PUTJMP+1
OUSIZE,	0
SWAP,	0		/SWAP OS8 RESIDENT
	ISZ	SWPNUM	/FLIP BYEBYE SWITCH
	NOP
	JMS	SWAP2	/WITH OS8RES THROUGH OS8RES+577
	OS8RES
	CDF
	JMS	SWAP2
	OS8RES+200
	CDF 10
PATCH5,	JMS	SWAP2	/OVERLAID IF <12K
	OS8RES+400
	CDF 20
	JMP I	SWAP
SWAP2,	0
	TAD	O7600
	DCA	SWAPT3
	TAD I	SWAP2
	ISZ	SWAP2
	DCA	SWAPT4
	TAD I	SWAP2
	ISZ	SWAP2
	DCA	SWPFLD
	JMP	.+5
SWPLUP,	CDF 00
	TAD	SWAPT1
	DCA I	SWAPT4
	ISZ	SWAPT4
	TAD I	SWAPT4
	DCA	SWAPT2
SWPFLD,	HLT
	TAD I	SWAPT3
	DCA	SWAPT1
	TAD	SWAPT2
	DCA I	SWAPT3
	ISZ	SWAPT3
	JMP	SWPLUP
	CDF 00
	TAD	SWAPT1
	DCA I	SWAPT4
	JMP I	SWAP2
BADFIL,	4342;4501;4752;5546;0
ASKFN,	4752;5546;0157;4256;4616;1600

	PAGE
RUN,	TAD I	[LINE+3	/RUNNH ?
	TAD I	[LINE+4
	TAD	(-3057
	SZA CLA
	JMS I	[HEADING/GIVE A HEADING
	TAD	[LINE+2	/SET UP FAKE LINE
	DCA	TEMP
	TAD	[WSSAVE
	DCA	PTR
	TAD	O7771
	DCA	TEMP2
	TAD I	PTR	/MOVE FAKE LINE INTO "LINE"
	ISZ	PTR
	DCA I	TEMP
	ISZ	TEMP
	ISZ	TEMP2
	JMP	.-5
	ISZ	RUNFLAG	/SET RUN FLAG
	JMP	GFN
SAVE,	DCA	RUNFLAG	/CLEAR THE RUN FLAG
	TAD	DEVNUM	/SAVE CURRENT DEVICE NUM
	DCA	OLDDEV	/INCASE WE CHANGE
GFN,	CLA IAC		/SET SAVFLAG
	JMS I	[GETFN	/GET THE DEV:NAME.EX
	TAD	XNAME	/SET UP ENTER
	DCA	SAVBLK	/POINTER TO FILE NAME
	TAD	DEVNUM	/GET DEVICE NUMBER
	CIF	10
	JMS I	O200	/ENTER FILE
	3
SAVBLK,	0		/STARTING BLOCK GOES HERE
	0		/SIZE GOES HERE
	JMP I	(IOERR
	TAD	SAVBLK	/PUT BLOCK NUMBER
	DCA I	(WRBLOK	/INTO WRITE
	TAD	SAVBLK+1/PUT SIZE
	DCA I	(OUSIZE	/SOMEWHERE TOO
	DCA	OULEN	/ZERO BLOCK COUNT
	CIF	10
	JMS I	O200	/DUMP USR
	11
	JMS I	[SWAP	/AND NOW OS8
	JMS I	(PUTFIL	/DO THE SAVE
	JMS I	[SWAP	/GET OS8
	TAD	RUNFLAG	/SET NO SWAP BIT IF RUN
	DCA I	(7746
	CIF	10	/GET THE USR
	JMS I	O7700
	10
	TAD	DEVNUM	/GET DEVICE NUMBER
	CIF	10
	JMS I	O200	/CLOSE THE FILE
	4
XNAME,	NAME
OULEN,	0		/SIZE
	JMP I	(IOERR
	TAD	RUNFLAG	/WAS IT A RUN ?
	SZA CLA
	JMP I	(DORUN	/YES
	TAD	OLDDEV	/IS OLD DEVICE
	CIA		/THE SAME AS
	TAD	DEVNUM	/THE NEW ONE ??
	SNA CLA
	JMP	HNDLOK	/YES, THE HANDLER IS OK
	TAD	OLDDEV	/RESTORE DEVICE NUMBER
	DCA	DEVNUM
	TAD	[HANDLR+1
	DCA	DEVN	/SET UP HANDLER LOAD ADDR
	TAD	DEVNUM
	CIF	10
	JMS I	O200
	1
DEVN,	0
	JMP I	(IOERR
	TAD	DEVN	/RESET THE HANDLER ADDRESS
	DCA	DEVHAN
HNDLOK,	CIF	10	/GET RID OF THE USR
	JMS I	O200
	11
	JMS I	[SWAP	/REMOVE OS8 AGAIN
	JMP I	[CMDDONE
OLDDEV,	0
FINDLN,	0		/FIND A LINE
	TAD  	[TXTAREA
	DCA	TEMP
SEARCH,	TAD	TEMP	/COMPARE THE NUMBER OF
	DCA	PTR	/THIS LINE WITH THE SPOT
	TAD I	TEMP	/IN THE TEXT AREA.
	TAD	O7701
	SNA
	JMP I	FINDLN	/NEW LINE GOES AT EOF
	TAD	O77
	CLL CIA
	TAD	LINENO
	SNA
	JMP	SAME1ST
	SNL CLA
	JMP I	FINDLN	/INSERT NEW LINE
	ISZ	TEMP
	SKP
	JMS I	[FINCR
CONTIN,	JMS I	[PASS	/IF ITS GREATER KEEP SEARCHING.
	JMP	SEARCH
SAME1ST,ISZ	TEMP	/FIRST HALF OF LINE NUM SAME
	SKP
	JMS I	[FINCR
	TAD I	TEMP
	CLL CIA		/CHECK SECOND HALF
	TAD	LINENO+1
	SNA
	JMP	SAME2ND	/REPLACE OLD WITH NEW
	SZL CLA
	JMP	CONTIN
	JMS I	[FDECR
	TAD	TEMP
	DCA	PTR
	JMP I	FINDLN	/INSERT NEW LINE
SAME2ND,JMS I	[PASS
	JMP I	FINDLN

	PAGE
DORUN,	TAD	(INFO+11/SET UP SOME OF INFO BLOCK
	DCA	X10
	CDF	10
	TAD	DEVHAN	/SAVE DEVICE HANDLER ADDRESS (DSK:)
	DCA I	X10
	CLL CML RTL	/SAVE DEVICE NUMBER
	DCA I	X10
	CDF
	TAD I	(SAVBLK	/SAVE STARTING BLOCK
	CDF	10
	DCA I	X10
	TAD	FNAME	/SAVE FILE NAME
	DCA I	X10
	TAD	FNAME+1
	DCA I	X10
	TAD	FNAME+2
	DCA I	X10
	TAD	FNAME+3
	DCA I	X10
	CDF
	JMS	XMOVE	/MOVE THIS PAGE INTO FIELD 1
	CDF
	DORUN
	CDF	10
	-200
	CDF CIF 10	/GO TO THE FIELD ONE COPY
RUNDO,	JMS	XMOVE	/MOVE THE HANDLER INTO FIELD 1
	CDF
	HANDLR
	CDF	10
	-400
	TAD I	(INFO+1	/GET START OF BCOMP.SV
	DCA	BCBLOK
	CIF
	JMS I	(7607	/READ IN THE COMPILER
	BCSIZE
	0
BCBLOK,	0
	JMP	WHUPS
	JMS	XMOVE	/MOVE BACK THE HANDLER
	CDF	10
	HANDLR
	CDF
	-400
	CLA IAC		/OPEN THE TEMP FILE
	JMS I	(200
	3
TMPBLK,	TMPFIL
	0
	JMP	WHUPS
	JMS I	(200	/RESET SYSTEM TABLES
	13		/AND REMOVE TENTATIVE FILES
	TAD	TMPBLK	/SAVE ITS START
	DCA I	(INFO+10
	TAD	TMPBLK+1
	DCA I	(INFO+11	/AND ITS MAX LENGTH
	DCA I	(7644	/KILL R SWITCH
	CIF CDF
	JMP I	(BCBEGN	/GO START THE COMPILER
WHUPS,	TAD	(123	/PRINT SY ERROR
	JMS	TTYO
	TAD	(131
	JMS	TTYO
	TAD	(15
	JMS	TTYO
	TAD	(12
	JMS	TTYO
	TSF		/WAIT FOR FLAG
	JMP	.-1
	CDF CIF
	JMP I	(7605	/RETURN TO OS8
TTYO,	0
	TSF
	JMP	.-1
	TLS
	CLA
	JMP I	TTYO
XMOVE,	0
	RDF		/GET CALLING FIELD
	TAD	(6203	/PLUS CIF CDF 0
	DCA	MOVRTN	/FOR RETURN
	JMS	GMOVE	/GET FROM FIELD
	DCA	MFFLD
	JMS	GMOVE	/GET ADDRESS
	DCA	MFPTR
	JMS	GMOVE	/GET TO FIELD
	DCA	MTFLD
	JMS	GMOVE	/GET COUNT
	DCA	MCNT
MFFLD,	HLT
	TAD I	MFPTR	/MOVE IT
MTFLD,	HLT
	DCA I	MFPTR
	ISZ	MFPTR
	ISZ	MCNT
	JMP	MFFLD
MOVRTN,	HLT
	JMP I	XMOVE
MFPTR,	0
MCNT,
GMOVE,	0
	TAD I	XMOVE	/GET ARG FOR MOVE
	ISZ	XMOVE
	JMP I	GMOVE
TMPFIL,	FILENAME BASIC.TM
PATCH1,	CLA
	TAD	(400
	DCA	[LNDIG
	DCA	NCHARS
	JMP I	(NOSKIP

	PAGE
GETCH,	0		/GET A CHARACTER FROM THE TTY
	TAD	OLDFLAG	/INPUT FROM A FILE ?
	SZA CLA
	JMP	FILEIN	/YES
	KSF
	JMP	.-1
	KRB
	AND	O177
	JMP I	GETCH
FILEIN,	ISZ	COUNT	/ANYTHING IN BUFFER ?
	JMP	NOREAD	/YES, NO READ
	TAD	O7200	/SET BUFFER COUNT
	DCA	COUNT
	TAD	[DSKBUF	/SET BUFFER POINTER
	DCA	RDPTR
	TAD	RDJMP	/RESET JUMP
	DCA	NOREAD
	JMS I	[SWAP	/GET OS8
	TAD	RDSIZE	/ANY ROOM LEFT ?
	SNA
	JMP	INERR	/BAD END OF IFILE
	IAC
	DCA	RDSIZE
	JMS I	DEVHAN	/READ NEXT BLOCK
	200
	DSKBUF
RDBLOK,	0
	JMP	CHKSOF	/CHECK FOR SOFT ERROR
SOFTOK,	ISZ	RDBLOK	/BUMP BLOCK NUMBER
	JMS I	[SWAP	/AWAY WITH OS8
NOREAD,	HLT		/3W UNPACK JUMP
	JMP	INCHR1
	JMP	INCHR2
INCHR3,	TAD	RDJMP	/RESET SWITCH
	DCA	NOREAD
	TAD I	RDPTR	/GET LOW 4 BITS
	ISZ	RDPTR	/BUMP POINTER
	AND	O7400	/MASK IT
	CLL RTR		/SHIFT RIGHT 4
	RTR
	DCA	TEMP	/SAVE
	TAD I	RDTMP	/GET HIGH 4 BITS
	AND	O7400
	TAD	TEMP	/COMBINE THEM
	CLL RTR		/SHIFT RIGHT 4
	RTR
	JMP	AND177	/GO FINISH
INCHR2,	TAD	RDPTR	/SAVE ADDR OF FIRST WORD
	DCA	RDTMP
	ISZ	RDPTR	/BUMP POINTER
INCHR1,	TAD I	RDPTR	/GET NEXT CHAR
	ISZ	NOREAD	/BUMP SWITCH
AND177,	AND	O177	/MASK 7 BITS
	TAD	O7746	/CHECK FOR ^Z
	SNA
	JMP	ENDOLD	/EOF
	TAD	O32	/RESTORE CHAR
	JMP I	GETCH
ENDOLD,	DCA	OLDFLAG	/KILL OLD FLAG
	TAD	CHNFLAG	/WAS IT A RETURN FROM RUN ?
	SNA CLA
	JMP I	[CMDDONE/NO, JUST AN OLD COMMAND
	DCA	CHNFLAG	/KILL FLAG
	TAD	(INFO-3764
	DCA	X10	/PICK UP NAME FROM INFO BLOCK
	TAD I	X10	/(WHICH IS SWAPPED OUT)
	DCA	FNAME
	TAD I	X10
	DCA	FNAME+1
	TAD I	X10
	DCA	FNAME+2
	TAD I	X10
	DCA	FNAME+3
	JMP I	[CMDDONE/DONE WITH RETURN
OLDBAD,	DCA	FNAME+3	/TRY WITHOUT EXT
	ISZ	TEMP	/OR HAVE WE ALREADY ?
	JMP	OLDTRY	/NO, NOT YET
IOERR,
INERRX,	CIF	10
	JMS I	O200	/DISMISS USR
	11
OUERR,
INERR,	DCA	OLDFLAG	/KILL OLD STATUS
	JMS I	[SWAP	/OUT WITH OS8
	JMS I	[TYPE	/PRINT MESSAGE
	BADFIL
	JMP I	[MAINLUP
OLD,	TAD	[TXTAREA/SCRATCH FILE
	JMS I	[SETEOF
	DCA	EOFLIN	/ZERO LAST LINE NUM
	DCA	EOFLIN+1
	JMS I	[GETFN	/GET FILE NAME
	CLL CMA RAL	/SET RETRY COUNT
	DCA	TEMP
OLDTRY,	TAD	[FNAME	/POINTER TO FILE NAME
	DCA	SB	/INTO LOOKUP CALL
	TAD	DEVNUM	/GET DEVICE NUMBER
	CIF	10
	JMS I	O200	/LOOKUP FILE
	2
SB,	0		/START GOES HERE
RDSIZE,	0		/SIZE GOES HERE
	JMP	OLDBAD	/BAD FILE
	TAD	SB	/MOVE BLOCK
	SNA
	ISZ	RDSIZE	/SET COUNT TO 4095 IF NOT D.A.
	DCA	RDBLOK
	CLA IAC		/SET SWITCH
	DCA	OLDFLAG	/INPUT COMING FROM FILE
	CLA CMA		/SET COUNT TO INITIALIZE READ
	DCA	COUNT
	JMS I	[SWAP	/MOVE OS8
	JMP I	[MAINLUP/DO OLD
RDJMP,	JMP	NOREAD+1
COUNT,	0
PATCH2,	JMS I	[SRCHBK
	01
	32
	JMP I	(EXA
	TAD	(-56
	SZA CLA
	JMP	INERRX
	JMP I	(PATCH4
/
CHKSOF,	SMA CLA
	JMP	SOFTOK	/SOFT ERROR
	JMP	INERR

	PAGE
HEIGHT,	-30		/SET TO SCREEN HEIGHT BY SET COMMAND
SDELAY,	-200		/SET TO HOLD SCREEN DELAY BY SET COMMAND
	IFNZRO HEIGHT-3000 <__FIX SET COMMAND__>
LINCNT,	0		/THIS WORD IS ZERO TO FLAG THE NEW BASIC EDITOR TO "SET"
CURPOS,	0

STIMER,	0
SCOPFG,	0		/SET NONZERO IF TERMINAL IS A SCOPE

	/SKIP IF ^O NOT TYPED AND CLEAR 'COFLG'
	/RETURN TO CALL+1 IF ^O WAS TYPED AND SET 'COFLG'
	/SET OR CLEAR 'CLFLG' IF ^S OR ^Q TYPED OTHERWISE

ZERO,
CTRLO,	0
	KSF
	JMP CTRLOX
	KRB
	AND	A177
	TAD	MCC
	SNA
	JMP I	(BYEBYE
	TAD	MCO
	SNA
	JMP 	CTRLOX+2
	TAD	MCQ
	SNA
	JMP	SETFLG+1
	TAD	MCS
	SNA
	JMP SETFLG
CTRLOX,	ISZ	CTRLO
	CLA IAC
	DCA	COFLAG
	JMP I	CTRLO

SETFLG,	IAC
	DCA	CSFLG
	JMP	CTRLOX


CRLF,	0
	TAD	O215
	JMS I	[TTYOUT
	TAD	O212
	JMS I	[TTYOUT
	JMP I	CRLF

	/PRINT A CHAR ON TERMINAL
	/PAUSE IF LF WAS PRINTED AND DELAY REQUESTED
	/SCREENSIZE ALSO SET BY "SET TTY" COMMAND

TTYOUT,	0
	TSF		/FIRST WAIT
	JMP	.-1
	TLS		/NOW PRINT THE CHAR
	AND	A177
	TAD	(-15	/TEST IF LF WILL FOLLOW
	SZA CLA
	JMP I	TTYOUT	/RETURN IF NO
	ISZ	LINCNT	/TEST LINE COUNTER FOR SCREENFULL
	JMP I	TTYOUT
	TAD	HEIGHT
	DCA	LINCNT	/NOW RESET SCREEN COUNTER
	TAD	SDELAY
	SNA		/SKIP IF DELAY REQUESTED
	JMP I	TTYOUT	/OTHERWISE JUST RETURN AT ONCE
	DCA	STIMER	/SET HOLD SCREEN TIMER
DLOOP,	KSF		/FIRST TEST IF KEY STRUCK
	JMP	NOKST	/JMP IF NO
	KRS		/ELSE READ CHAR
	AND	A177	/MASK TO 7BIT
	TAD	MCC
	SNA
	JMP I	[BYEBYE	/JMP IF ^C SEEN
	TAD	MCO
	SZA
	TAD	MCQ
	SZA
	TAD	MCS
	SNA CLA
	JMP I	TTYOUT	/RETURN WITH CHAR STILL IN BUFFER IF ANY OF ABOVE SEEN
NOKST,	ISZ	ZERO
	JMP	.-1	/LOOP 4096 TIMES (USUALLY)
	ISZ	STIMER	/TEST DELAY COUNTER
	JMP	DLOOP	/REITERATE IF NOT DONE
	JMP I	TTYOUT	/ELSE RETURN FOR MORE

MCC,	-3
MCO,	-17+3
MCQ,	-21+17
MCS,	-23+21
A177,	177

	/PRINT A BACKSPACE
	/IF TERMINAL IS A SCOPE, ECHO BS,SP,BS TO RUBOUT AND REPOSITION
	/CURSOR.  OTHERWWISE ECHO BACKARROW

PRTBSP,	0
	TAD	SCOPFG	/TEST SCOPE BIT
	SNA CLA
	JMP	BKARRW	/NOT - ECHO BACKARROW
	TAD	NCHARS	/SEE IF AT LEFT MARGIN
	TAD	NDIGS
	SNA CLA
	JMP I	PRTBSP	/DO NOTHING IF YES
	TAD	O10	/ELSE ECHO BS
	JMS I	[TTYOUT
	TAD	(40
	JMS I	[TTYOUT	/SP
	TAD	O10
	SKP		/BS
JUSTSP,	TAD	(40	/SPACE
	JMS I	[TTYOUT
	JMP I	PRTBSP	/DONE
BKARRW,	TAD	("_
	JMS I	[TTYOUT
	JMP I	PRTBSP

	PAGE
LINE,			/THE TELETYPE LINE BUFFER.
WSNAME,	0;0;0145;6454;3343;4264;5244;1770;6400
START,	JMP	RBASIC	/IT WAS RAN
	CDF	10	/IF CHAINED TO CHECK IF CCL PASSED
	TAD I	(7644	/Q SWITCH IN RESPONSE TO .BASIC COMMAND (OS78)
	CDF
	AND	O200	/ISOLATE THE BIT
	SZA CLA
	JMP	RBASIC	/TREAT AS .R BASIC IF YES
	JMS I	(CORE
	CLA IAC
	DCA I	(JSW	/NO SWAP 
	CIF 10
	JMS I	(7700	/FETCH USR
	10
	CIF	10
	JMS I	(200	/RESET SYSTEM TABLES
	13
	TLS		/SET TTY FLAG
	JMS	GETDAT	/SET UP TITLE
	ISZ	CHNFLAG	/TELL ABOUT RETURN FROM RUN
	JMP I	(OLD	/READ IN OLD WORK SPACE
RBASIC,	CDF 10
	DCA I	(7643
	DCA I	(7644
	CDF 0
	TLS
	JMS I	(CORE
	TAD	O77
	DCA I	[TXTAREA
	JMS	GETDAT	/SET UP TITLE
FINDSV,	TAD I	X11	/LOOK UP SOME SAVE FILES
	SNA
	JMP	LUBUF	/GO FIND BASIC.UF
	DCA	XXXXSV	/SAVE POINTER TO NAME
	CLA IAC
	CIF	10
	JMS I	(200
	2
XXXXSV,	0
	0
	JMP	NG
	IAC
	CDF	10
	TAD	XXXXSV
	DCA I	X10	/SAVE BLOCK PLUS 1
	CDF		/IN INFO AREA
	JMP	FINDSV
LUBUF,	CLA IAC		/FIND BASIC.UF
	CIF	10
	JMS I	(200
	2
	BUFN
	0
	JMP	.+3	/OK IF MISSING
	TAD	.-3
	IAC		/SAVE BLOCK +1
	CDF	10
	DCA I	X10
	CDF
	CLA IAC		/TYPE WITH NO CARRIAGE RETURN
	JMS I	[TYPE	/"OLD OR NEW -- "
	OLDNEW
	JMS I	[SWAP
	JMP I	(MAINLUP
NG,	JMS I	[TYPE	/PART OF SYSTEM MISSING
	MISING
	JMP I	(7605

	/THE FOLLOWING ROUTINE ASSUMES THAT THE YEAR IS ALREADY
	/SET UP BY A CALL TO "CORE" - JR

GETDAT,	0		/PUT OS8 DATE INTO THE TITLE
	CDF	10
	TAD I	(MDATE	/GET DATE WORD
	CDF
	DCA	TEMP2	/SAVE IT
	TAD	TEMP2
	SNA
	JMP I	GETDAT	/NO DATE
	AND	O7400	/GET MONTH
	CLL RTL		/SHIFT SOME
	RTL
	RTL
	TAD	(MONTHS-3
	DCA	X12
	TAD	(DATE-1	/SET UP POINTER TO DATE
	DCA	X13
	TAD	TEMP2	/GET DAY
	RTR
	RAR
	AND	O37
	JMP	DAYGO	/CONVER TO TEXT
DAYLP,	TAD	(100-12	/REDUCE AND TALLY QUOTIENT
	TAD	TEMP
DAYGO,	DCA	TEMP
	TAD	TEMP	/SEE IF OVERFLOW
	AND	O77
	TAD	O7766
	SMA CLA
	JMP	DAYLP	/REDUCE MOD 10 IF NOT
	TAD	TEMP
	TAD	(2121	/UNPACK TO HANK'S ASCII
	DCA I	X13	/INTO DATE
	TAD I	X12	/GET MONTH CHARS
	DCA I	X13
	TAD I	X12
	DCA I	X13
/	TAD	TEMP2	/GET YEAR
/	AND	(7
/	TAD	(21
/	CLL RTL
/	RTL
/	RTL
/	ISZ	X13	/THE WORD WITH -7 IS THERE
/	DCA I	X13	/STORE LAST DIGIT OF YEAR

	/ABOVE JOB DONE BY "CORE" DURING INIT TIME

	JMP I	GETDAT

	PAGE
MONTHS,	1653;4257	/-JAN
	1647;4643	/-FEB
	1656;4263	/-MAR
	1642;6163	/-APR
	1656;4272	/-MAY
	1653;6657	/-JUN
	1653;6655	/-JUL
	1642;6650	/-AUG
	1664;4661	/-SEP
	1660;4465	/-OCT
	1657;6067	/-NOV
	1645;4644	/-DEC
NAMLST,	BASICN
	BCOMPN
	BLOADN
	BRTSN
	BAFN
	BSFN
	BFFN
	0
BASICN,	FILENAME BASIC.SV
BCOMPN,	FILENAME BCOMP.SV
BLOADN,	FILENAME BLOAD.SV
BRTSN,	FILENAME BRTS.SV
BAFN,	FILENAME BASIC.AF
BSFN,	FILENAME BASIC.SF
BFFN,	FILENAME BASIC.FF
BUFN,	FILENAME BASIC.UF
MISING,	5257;4460;5661;5546;6546;0164;7264;6546;5600
OLDNEW,	5746;7001;6063;0160;5545;1616;0

	PAGE
	/THIS PAGE GETS WIPED OUT SOON

	/ROUTINE TO GET CORESIZE, SETUP DATE IN HEADING
	/AND SET SCOPE / TTY FLAG FOR RUBOUT TREATMENT


CORE,	0		/CORE SIZE SUBROUTINE
	CDF	10	/GET INTO DATE FIELD
	TAD I	(MDATE
	CDF		/RESET FIELD
	AND	(7	/LOOK AT LOW YEAR BITS
	DCA	TEMP	/HOLD
	TAD I	(BIPCCL	/NOW GET THE EXTENDED BITS
	AND	(600	/FROM THE 600 BITS
	CLL RTR
	CLL RTR		/SHIFT INTO PLACE
	TAD	TEMP	/ADD TO LOW BITS
	ISZ I	(DASH6	/BUMP THE YEAR TENS DIGIT
	TAD	(-12
	SMA		/SKP IF .LT. 10 OFF OF 1970
	JMP	.-3	/ELSE DECR AGAIN
	TAD	(12+21	/CONVERT TO "HANKS ASCII"
	CLL RTL
	RTL
	RTL		/SWAP TO LEFT HALF BYTE
	DCA I	(EODAT	/NOW STORE IN DATE TEMPLATE
	CDF	10
	TAD I	(7726	/LOOK AT HLT/CLA HLT SCOPE KLUDGE
	CDF
	AND	O200	/GET SCOPE BIT
	DCA I	(SCOPFG	/AND STORE IT

	/STANDARD OS/8 CORESIZE ROUTINE

	TAD I	(7777
	AND COR70
	CLL RAR
	RTR
	SNA
	JMP COR0
	IAC
	DCA CORSIZ
	JMP COREX
COR0,	CDF
	TAD	CORSIZ
	RTL
	RAL
	AND	COR70
	TAD	COREX
	DCA	.+1
COR1,	CDF
	TAD I	CORLOC
COR2,	NOP
	DCA	COR1
	TAD	COR2
	DCA I	CORLOC
COR70,	70
	TAD I	CORLOC
CORX,	7400
	TAD	CORX
	TAD	CORV
	SZA CLA
	JMP	COREX
	TAD	COR1
	DCA I	CORLOC
	ISZ	CORSIZ
	JMP	COR0
COREX,	CDF
	TAD	CORSIZ
	CIA
	DCA	CORSIZ
	CLL CML CLA RTL	/2
	TAD	CORSIZ
	SZA CLA
	JMP I	CORE
	TAD	(SWAP&177+5600
	DCA I	(PATCH5
	JMP I	CORE
CORLOC,	CORX
CORV,	1400

	$$
