<div id='wikitext'>
<pre><b> File: BLOAD.PA of Tape: OS8/OS8-V3D/al-4760c-sa-os8-ext-2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/OS8 BASIC LOADER, V5
/
/
/
/
/
/
//
/
/
/
/
/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
/SHAWN SPILMAN, 1973
/
/
/
/
/ASSEMBLE AND LOAD AS FOLLOWS:
/
/	.R PAL8
/	*BLOAD,BLOAD&lt;BLOAD.03
/	.R ABSLDR
/	*BLOAD$
/	.SA SYS BLOAD;7605
/
/NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
/THE SOURCE AFTER TAG &quot;IMAGE&quot; AND THEN:
/
/	.R SRCCOM
/	*LPT:&lt;BLOAD.01,BLOAD.03
/	*
/
/ALL CODE FOLLOWING TAG &quot;IMAGE&quot; IS NEW FOR VERSION 3
/
	VERSON=	5	/VERSION WORD LOCATED AT TAG &quot;VERLOC&quot;
			/LEFT HALF CONTAINS 60+VERSON
			/RIGHT HALF CONTAINS PATCH LEVEL (A=01)

/
/CORRECTIONS MADE FOR V4		J.K 1975
/ .MADE SWAP ROUTINE A REAL SWAP
/ ./V FOR VERSION NUMBER
/ ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES
/ .ADJUST JSW FOR /K
/ .CORRECTED CCB FOR /K
/ .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8
/ .TEST FOR BATCH RUNNIG
/ .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE
/	CAN BE DONE FROM A .SV FILE WITH A 
/	FILE STATEMENT
/

/JR	30-APR-77	UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT 
/			RUNNING
	/OS8 BASIC COMPILER POST PROCESSOR

	/AUTO INDEX REGISTERS

	X10=10
	X11=11
	X13=13
	STACK=15

	/DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS

	NOPUNCH

	/BRTS COMMUNICATIONS REGION

	*20
STCDF,	0
NSTADR,	0
NASTAD,	0
SSTADR,	0
SASTAD,	0
CODCDF,	0
CODBGN,	0
DATTOP,	0
DATPTR,	0
SWPINF,	0

	/BCOMP COMMON REGION

	*40
VARCNT,	0
SVCNT,	0
ACNT,	0
SACNT,	0
LOCTRH,	0
LOCTRL,	0
BLOCK,	0
HIFLD,	0
BRTS,	0
DLSIZE,	0
ABORTX,	0

	/PAGE 0 LOCATIONS USED BY LOADER

FREEHI,	0
FREELO,	0
TEMP,	0
TEMP2,	0
TEMP3,	0
WORD1,	0
WORD2,	0
WORD3,	0
NCHARS,	0
SUBHI,	0
SUBLO,	0
CODSZ1,	0
CODSZ2,	0
LOCHI,	0
LOCLO,	0
CODB,	0
CODF,	0
ICOUNT,	0
OCOUNT,	0
AC1,	0
AC2,	0
AC3,	0
SC,	0
LINEH,	0
LINEL,	0
XLABEL,	0
CLRFLD,	0
CLREND,	0
RESADR,	0

	/MORE COMPILER DEFINITIONS

	SVARST=	1036
	ARAYST=	2132
	SARYST=	2332
	STEMPS=	2560
	LITRL=	STEMPS+2
	SLITRL=	LITRL+2
	DATLST=	SLITRL+2

	/MISC DEFINES

	STACKA=	7120	/MAIN STACK OF COMPILER
	EDTBGN=	3212	/START OF EDITOR
	EDTSIZ=	2100	/SIZE OF EDITOR
	BRTBGN=	200	/START OF BRTS
	BRTSIZ=	3400	/SIZE OF BRTS
	DCB=	7760
	JSW=	7746	/OS/8 JOB STATUS WORD
	BIPCCL=	7777	/OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD
	FSTOP1=	7	/ADDR OF BRTS EXIT ROUTINE

	ENPUNCH		/END OF DUMMY SECTIONS
	/LOADER PROPER

	*400
LOADER,	JMS I	(IMAGE	/CORE IMAGE FILE PATCH
	TAD	(7577	/EXECUTION RESUMES HERE
	DCA	FREELO
	CIA IAC
	DCA	SWPINF	/SET SWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1
	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	TAD	STACK	/ANY UNCLOSED FOR&#039;S ?
	CIA
	TAD	(STACKA-1
	SNA CLA
	JMP	.+3	/NO
	JMS I	(ERMSG	/YES
	2506
	CLA CMA
	TAD	HIFLD	/NO CDF&#039;S IF ONLY 8K
	SZA CLA
	JMP	NOPATCH	/NO PATCHES
	TAD	(PATLST-1
	DCA	X10
PATLUP,	TAD I	X10
	SNA
	JMP I	(STSTUF
	DCA	TEMP
	TAD	(SKP	/ALWAYS TWO WORDS
	DCA I	TEMP
	JMP	PATLUP
NOPATCH,CDF	10
	TAD I	(DCB	/CHECK FOR TD8E SYSTEM
	AND	(770	/ED FRIEDMAN GAVE ME THIS CODE
	TAD	(-210	/AND I&#039;M TAKING IT ON FAITH
	CDF
	SNA CLA
	TAD I	(7612	/IS IT A ROM SYSTEM ?
	TAD	(-3
	SZA CLA
GOTTD,	JMP	NOTD8E	/NO TD/8E OR ROM TD/8E
			/PREV INSTR NOP&#039;D OUT TO FORCE TD8E (IMAGE)
	TAD	(7377	/TD8E SYS WASTES 400 WORDS
	DCA	FREELO
	STL RAR		/SET SWAP INFO (17600 OUT NOW)
NOTD8E,	DCA	SWPINF
	JMS I	(FREEF	/GET CDF TO HIGHEST FIELD
	DCA	SWPF1	/INTO 2 PLACES
	TAD	SWPF1
	DCA	SWPF2
	JMS	SWAP	/MOVE OS8 OUT
	TAD	(TAD L6221
	DCA	TDLIE+1
	TAD	(TAD L6221
	DCA	TDLIE+3
	JMP I	(STSTUF	/DO SYMBOL TABLE STUFF
SWAP,	0		/SWAP OS8 RESIDENT
	CLL CML RAR	/4000
	AND	SWPINF	/IS IT A TD8E SYS ?
	SZA CLA
	JMP	TD8ESYS	/YES
	JMS	SWPSUB	/SWAP 17600 TO/FROM N7600
	CDF	10
	7600
	JMP I	SWAP
TD8ESYS,JMS	SWPSUB	/SWAP 17600 TO/FROM N7400
	CDF	10
	7400
	JMS	SWPSUB	/SWAP 27600 TO/FROM N7600
L6221,	CDF	20
L7600,	7600
TDLIE,	CLL CML RTL	/FIX UP 07600 STUFF TO MATCH
	TAD	SWPF1	/CIF CDF N0
	DCA I	(7642
	TAD	SWPF1
	IAC		/CIF N0
	DCA I	(7721
	TAD I	(7721
	DCA I	(7727
	JMP I	SWAP
SWPRET,	CLA
	CDF		/RETURN IF 8K
	JMP I	SWAP
SWPFLAG,0

SWPSUB,	0		/SWAPPER
	TAD I	SWPSUB	/GET FIELD
	DCA	SWP1	/TWICE
	TAD	SWP1
	DCA	SWP2	/ONCE FOR EACH DIRECTION
	ISZ	SWPSUB
	TAD I	SWPSUB	/GET HI FIELD ADDR
	DCA	TEMP
	ISZ	SWPSUB
	TAD	L7600	/GET COUNT/POITER
	DCA	TEMP2
SWP1,	HLT
	TAD I	TEMP2	/GET PART OF RESIDENT
	DCA	TEMP3
SWPF1,	JMP	SWPRET	/RETURN IF 8K ONLY
	TAD I	TEMP
SWP2,	HLT
	DCA I	TEMP2
	TAD	TEMP3
SWPF2,	HLT
	DCA I	TEMP	/INTO HI FIELD
	ISZ	TEMP	/BUMP POINTER
	NOP		/JR PROTECT AGAINST WRAP AROUND
	ISZ	TEMP2	/AND PTR/CTR
	JMP	SWP1	/LOOP
	CDF
	JMP I	SWPSUB

	PAGE
NODATA,	CDF
	JMS I	(FREEF	/SAVE FIELD
	CIA
	DCA	CLRFLD	/FOR ARRAY CLEARING
	TAD	FREELO	/SAVE THIS ADDR
	CIA
	DCA	CLREND	/FOR END OF ARRAY CLEAR
	ISZ	FREELO	/MAKE IT NEXT FREE + 1
	TAD	(SVARST-1
	DCA	X10	/ALLOCATE STRING VARS
	TAD	(-436
	DCA	TEMP
ASVLUP,	CDF	10
	TAD I	X10	/LOOK FOR DEFINED STRING VAR
	DCA	TEMP2	/SAVE SYMBOL NUMBER
	TAD I	X10	/GET SIZE
	SPA
	TAD	(4010	/IF UNDEF USE 16 CHARS
	DCA	TEMP3
	TAD	TEMP2	/IS IT DEFINED ?
	CDF
	SMA CLA
	JMS	SVSTOR	/YES, CREATE ENTRY
	ISZ	TEMP	/BUMP COUNT
	JMP	ASVLUP	/LOOP
	CDF	10	/ALLOCATE STRING TEMPS
P6,	TAD I	(STEMPS+1
	DCA	STEMPF	/INIT FIELD
	TAD I	(STEMPS	/AND POINTER
	SKP
STMLUP,	TAD	TEMP	/LOOK AT NEXT ENTRY
	SNA
	JMP I	(ALLOCA	/DONE GO ALLOCATE ARRAYS
	TAD	(-1
	DCA	X10	/GET POINTER
STEMPF,	CDF	10
	TAD I	X10	/GET ADDR OF NEXT ENTRY
	DCA	TEMP	/SAVE IT
P7,	TAD I	X10	/AND ITS FIELD
	DCA	STEMPF
	ISZ	X10	/SKIP TEMP NUMBER
	TAD I	X10	/GET SYM NUMBER
	DCA	TEMP2
	CDF
	TAD	(110	/GIVE IT MAX SIZE
	DCA	TEMP3
	JMS	SVSTOR	/ALOOCATE IT
	JMP	STMLUP	/LOOP
SVSTOR,	0		/MAKE ST ENTRY FOR STRING VAR
	TAD	TEMP2	/FIND ST ADDR
	CLL RAL
	TAD	TEMP2
	TAD	SSTADR
	DCA	X11
	TAD	TEMP3	/NUMBER OF CHARS
	TAD	(3
	CLL RAR
	DCA	SUBLO	/NUMBER OF WORDS
	DCA	SUBHI
	JMS	SUB	/FREEHI,LO=FREEHI,LO-SUBHI,LO
	TAD	FREELO	/SAVE ADDR
	DCA I	X11
	JMS I	(FREEF	/AND FIELD
	DCA I	X11
	TAD	TEMP3	/PUT IN MAX LENGTH
	CIA		/(NEGATIVE)
	DCA I	X11
	JMP I	SVSTOR
PSN,	0		/PRINT 3 DIGITS DECIMAL
	DCA	WORD2
	CLL CMA RTL	/-3
	DCA	XLABEL
PRNTSN,	TAD	WORD2	/GET NEXT DIGIT
	CLL RTL		/INTO THE LOW ORDER
	RTL		/THREE BITS AND THE LINK
	DCA	WORD2	/SAVE SHIFTED NUMBER
	TAD	WORD2	/NOW DO LAST SHIFT
	RAL
	AND	(17	/ONLY FOUR BITS
SPACE,	SZA
	JMP	NOZERO	/NOT A ZERO
	TAD I	(TTY	/ANY DIGITS YET ?
	SNA CLA
	JMP	LEAD0	/NO, ITS A LEADING ZERO
NOZERO,	TAD	(60	/MAKE IT ASCII
	JMS I	(TTY	/PRINT DIGIT
LEAD0,	ISZ	XLABEL	/BUMP COUNT
	JMP	PRNTSN	/MORE DIGIT(S)
	JMP I	PSN
SUB,	0		/DOUBLE SUBTRACT
	TAD	SUBLO	/SUBTRACT LOWER
	CLL CML CIA
	TAD	FREELO
	DCA	FREELO
	RAL		/GET BORROW
	TAD	SUBHI
	CIA
	TAD	FREEHI	/SUBTRACT UPPER
	DCA	FREEHI	/SAVE NEW UPPER
	TAD	FREEHI	/DID IT FIT ?
	SMA SZA CLA
	JMP I	SUB	/YUP
TOOBIG,	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	JMS I	(ERMSG	/WRITE MESSAGE
	2402		/TOO BIG
	JMP I	(ABORTL	/ABORT RUN

TTX,	0		/PRINT CHAR ON TTY
	TSF		/WAIT FOR PREVIOUS CHAR
	JMP	.-1
	TLS		/PRINT THIS ONE
	CLA
	JMP I	TTX

	PAGE
/    CAUTION !!!
/    THIS PAGE AND THE NEXT ONE ARE
/    OVERLAYED BY THE INPUT BUFFER
/    AS SOON AS THE ROUTINE &quot;INWORD&quot;
/    IS CALLED. THIS FIRST HAPPENS
/    AFTER THE TAG &quot;RELCIT&quot; .

STSTUF,	TAD	FREELO	/SAVE START OF RESIDENT -1
	CIA		/NEGATED
	DCA	RESADR	/USED TO COMPUTE AMOUNT OF MOVE
	TAD	VARCNT	/GET NUMBER OF
	TAD	(401	/VARIABLES
	CIA
	DCA	VARCNT
	TAD	SVCNT	/STRING VARIABLES
	TAD	(401
	CIA
	DCA	SVCNT
	TAD	ACNT	/ARRAYS
	TAD	(41
	CIA
	DCA	ACNT
	TAD	SACNT	/AND STRING ARRAYS
	TAD	(41
	CIA
	DCA	SACNT
	JMS I	(FREEF	/SAVE HIGH FIELD
	DCA	STCDF
	TAD	VARCNT	/SUBTRACT SPACE FOR
	CLL RAL		/SCALAR TABLE (3 WORDS A PIECE)
	TAD	VARCNT
	TAD	FREELO	/DON&#039;T BOTHER WITH A
	DCA	FREELO	/DOUBLE PREC. SUBTRACTION
	TAD	FREELO	/SAVE START OF SCALAR TABLE
	IAC		/FOR INTERPRETER
	DCA	NSTADR
	TAD	FREELO	/CLEAR ALL VARIABLES
	DCA	X10	/IN THE
	DCA I	X10	/SCALAR TABLE
	DCA I	X10
	DCA I	X10
	ISZ	VARCNT
	JMP	.-4	/JUST TO BE NICE
	CDF	10	/PREPARE TO MOVE
P1,	TAD I	(LITRL+1/THE NUMERIC LITERALS
	DCA	LFLD	/INTO THE SCALAR TABLE
	TAD I	(LITRL
	CDF
	SKP
NLLOOP,	TAD	TEMP	/ADDR OF NEXT LITERAL
	SNA
	JMP	NONL	/NO MORE NUMERIC LITERALS
	TAD	(-1
	DCA	X10
LFLD,	CDF	10
	TAD I	X10	/GET ADDR OF NEXT LITERAL
	DCA	TEMP
P2,	TAD I	X10	/ALSO ITS FIELD
	DCA	LFLD
	TAD I	X10	/NOW ITS VALUE
	DCA	WORD1
	TAD I	X10
	DCA	WORD2
	TAD I	X10
	DCA	WORD3
	TAD I	X10	/NOW THE SYMBOL NUMBER
	DCA	TEMP2
	TAD	TEMP2	/TIMES THREE
	CLL RAL
	TAD	TEMP2
	TAD	FREELO	/PLUS START
	DCA	X11	/GIVES STORE ADDR
	CDF
	TAD	WORD1	/NOW PUT LITERAL INTO TABLE
	DCA I	X11
	TAD	WORD2
	DCA I	X11
	TAD	WORD3
	DCA I	X11
	JMP	NLLOOP	/DO NEXT LITERAL
NONL,	TAD	ACNT	/ALLOCATE ARRAY TABLE
	CLL RAL
	CLL RAL		/FOUR WORDS PER
	TAD	FREELO	/SUBTRACT FROM LOWER END
	DCA	FREELO
	TAD	FREELO	/SAVE THIS
	DCA	NASTAD	/START OF ARRAY TABLE
	TAD	SVCNT	/ALLOCATE
	CLL RAL		/STRING VAR TABLE
	TAD	SVCNT
	TAD	FREELO	/3 WORDS EACH
	DCA	FREELO
	TAD	FREELO	/AND SAVE IT FOR THE INT
	DCA	SSTADR
	TAD	SACNT	/NOW SPACE FOR STRING
	CLL RAL		/ARRAY
	CLL RAL
	TAD	FREELO	/TABLE
	DCA	FREELO
	TAD	FREELO	/SAVE FOR INT
	DCA	SASTAD
	CDF	10	/PREPARE TO MOVE
P3,	TAD I	(SLITRL+1
	DCA	SLFLD	/STRING LITERALS
	TAD I	(SLITRL
	CDF
	SKP
SLLOOP,	TAD	TEMP	/IS NEXT LIT THERE ?
	SNA
	JMP I	(NOSL	/NO, END OF THE LINE
	TAD	(-1
	DCA	X10
	JMS	SFLD	/SET THE FIELD
	TAD I	X10	/GET ADDR OF NEXT
	DCA	TEMP
P4,	TAD I	X10	/ALSO FIELD
	DCA	TEMP2
	TAD I	X10	/THEN CHAR COUNT
	DCA	NCHARS
	JMP I	(SLIT2	/DO REST OF STRING LIT
SFLD,	0
SLFLD,	CDF	10
	JMP I	SFLD

	PAGE
SLIT2,	TAD	NCHARS	/COMPUTE WORD COUNT
	TAD	(3
	CLL RAR
	TAD	X10	/TO GET ADDR OF SYMBOL NUMBER
	DCA	TEMP3
	TAD I	TEMP3
	CLL RAL		/SYM NUMBER TIMES 3
	TAD I	TEMP3
	TAD	SSTADR	/PLUS BASE
	DCA	X11	/GIVES ST ADDR
	TAD	NCHARS	/ALLOCATE SPACE FOR IT
	IAC
	CLL CML CMA RAR
	DCA	TEMP3	/(SAVE NUMBER OF WORDS)
	TAD	TEMP3
	CLL
	TAD	FREELO
	DCA	FREELO	/BELOW THE SYMBOL TABLES
	SNL
	JMP	TMSLIT	/TOO MUCH STRING LITERALS
	TAD	FREELO
	TAD	(-END-10
	SZL CLA
	JMP	TMSLIT	/DITTO
	TAD	FREELO	/STICK THE ADDR
	IAC
	CDF
	DCA I	X11	/INTO THE ST ENTRY
	JMS I	(FREEF	/ALSO THE FIELD
	DCA I	X11
	TAD	NCHARS	/ALSO THE SIZE
	CIA
	DCA I	X11
	TAD	FREELO	/THIS IS WHERE IT GOES
	DCA	X11
	TAD	NCHARS	/PUT IN THE LENGTH TOO
	CIA		/(NEGATIVE)
	JMP	.+4
MOVSL,	JMS I	(SFLD
	TAD I	X10
	CDF
	DCA I	X11	/MOVE THE LITERAL TEXT
	ISZ	TEMP3
	JMP	MOVSL
P5,	TAD	TEMP2	/PUT THE FIELD OF THE NEXT
	DCA I	(SLFLD	/ENTRY WHERE IT DOES THE MOST GOOD
	JMP I	(SLLOOP	/DO THE NEXT LITERAL
NOSL,	TAD	FREELO	/SAVE TOP OF DATA LIST
	DCA	DATTOP
	TAD	DATTOP	/IF EMPTY MAKE TOP=BOTTOM
	DCA	DATPTR
	TAD	DLSIZE
	SNA		/IS ANY DATA ?
	JMP I	(NODATA	/NO
	CLL
	TAD	FREELO	/GET START OF DATA
	DCA	FREELO
	SNL
	JMP	TMDATA	/TOO MUCH DATA
	TAD	FREELO
	TAD	(-END-10
	SZL CLA
	JMP	TMDATA	/DITTO
	TAD	FREELO	/SAVE IT
	DCA	DATPTR
	TAD	FREELO	/USE X13 TO FILL LIST
	DCA	X13
	TAD	(DATLST-1
	DCA	X10
	CDF	10
DATLUP,	TAD I	X10	/ANY MORE DATA ELEMENTS ?
	SNA
	JMP I	(NODATA
	DCA	TEMP	/SAVE ADDR
P8,	TAD I	X10	/GET NEW FIELD
	DCA	DATAF1
P9,	TAD	DATAF1	/TWICE
	DCA	DATAF2
	TAD	TEMP	/START WITH NEW ELEMENT
	DCA	X10
DATAF1,	CDF	10
	TAD I	TEMP	/GET COUNT
	DCA	TEMP
DATMOV,	TAD I	X10	/GET NEXT WORD
	CDF
	DCA I	X13	/MOVE INTO DATA AREA
DATAF2,	CDF	10
	ISZ	TEMP
	JMP	DATMOV
	JMP	DATLUP	/DO NEXT ELEMENT
TMDATA,	DCA	LINEL	/ZERO LINE NUMBER
	DCA	LINEH
	JMS I	(ERMSG	/PRINT ERROR MESSAGE
	2404
	JMP I	(ABORTL
TMSLIT,	DCA	LINEH	/CLEAR THE LINE NUMBER
	DCA	LINEL
	JMS I	(ERMSG	/PRINT MESSAGE
	2423
	JMP I	(ABORTL

PATLST,	P1;P2;P3;P4;P5;P6;P7;P8;P9;0

	PAGE
ALLOCA,	TAD	ACNT	/ANY ARRAYS ?
	SNA CLA
	JMP	ALLOCS	/NO
	TAD	(ARAYST	/ALLOCATE ARRAYS
	DCA	X10
	TAD	NASTAD
	DCA	X11
DOARAY,	CDF	10
	TAD I	X10	/GET NEXT ARRAY
	DCA	TEMP
	TAD I	X10	/GET FIRST DIM
	SNA
	TAD	(12	/USE 10 IF NONE
	IAC		/ALLOCATE 0TH ELEMENT
	DCA	TEMP2
	TAD I	X10	/GET SECOND DIM
	SNA
	TAD	(12
	IAC
	DCA	TEMP3
	TAD	TEMP3	/GET READY TO SUBTRACT
	DCA	SUBLO
	DCA	SUBHI
	CDF
	CLL CML RTR
	AND	TEMP	/HOW MANY DIMS ?
	SNA CLA
	JMP	ONLY1	/ONE
	TAD	TEMP2	/PRODUCT OF DIMS
	JMS I	(MUL12
	JMP	TIMES3	/MULT BY 3
ONLY1,	DCA	TEMP3	/ZERO SECOND DIMENSION
	TAD	TEMP2
	DCA	SUBLO
TIMES3,	TAD	(3	/MULT SIZE BY 3
	JMS I	(MUL12
	JMS I	(SUB	/SUBTRACT FROM FREE
	TAD	FREELO
	DCA I	X11	/SAVE ADDR IN S.T.
	JMS I	(FREEF
	DCA I	X11
	TAD	TEMP2	/ALSO DIMS
	DCA I	X11
	TAD	TEMP3
	DCA I	X11
	ISZ	X10	/SKIP SYMBOL NUMBER
	ISZ	ACNT
	JMP	DOARAY
ALLOCS,	TAD	SACNT	/ANY STRING ARRAYS
	SNA CLA
	JMP I	(RELCIT	/NO
	TAD	(SARYST+1
	DCA	X10	/ALLOCATE STRING ARRAYS
	TAD	SASTAD
	DCA	X11
DOSARY,	CDF	10
	TAD I	X10
	SNA
	TAD	(12	/USE 10 FOR DIM
	IAC
	DCA	TEMP3
	TAD I	X10	/GET DIM
	SNA
	TAD	(10	/USE 16 IF NO SIZE SPEC
	DCA	TEMP2
	TAD	TEMP3
	DCA	SUBLO	/PREPARE FOR MULT
	DCA	SUBHI
	CDF
	TAD	TEMP2	/GET NUM WORDS PER STRING
	TAD	(3
	CLL RAR
	JMS I	(MUL12	/GET ARRAY SIZE
	JMS I	(SUB	/DO SUBTRACTION
	TAD	FREELO	/SAVE ADDR
	DCA I	X11
	JMS I	(FREEF
	DCA I	X11
	TAD	TEMP2	/AND STRING SIZE
	CIA		/(SIZES ARE NEG)
	DCA I	X11
	TAD	TEMP3	/AND NUMBER OF STRINGS
	DCA I	X11
	ISZ	X10	/SKIP NEXT NAME
	ISZ	X10	/AND NEXT SYM NUMBER
	ISZ	SACNT
	JMP	DOSARY
	JMP I	(RELCIT
INWORD,	0		/READ FROM CODE FILE
	ISZ	ICOUNT	/ANYTHING IN BUFFER
	JMP	NOREAD	/YASSUH!
	JMS I	(7607	/READ NEXT BLOCK
	200
	1000		/NOTE: THIS OVERLAYS USED CODE
INBLOK,	0
	JMP I	(IOERR
	ISZ	INBLOK	/BUMP BLOCK COUNTER
	TAD	INBLOK-1/RESET BUFFER POINTER
	DCA	INPTR
	TAD	(-400	/AND COUNTER
	DCA	ICOUNT
NOREAD,	TAD I	INPTR	/GET WORD
	ISZ	INPTR	/BUMP POINTER
	JMP I	INWORD
INPTR,	0

CIPAT,	0	/PATCH TO MAKECI
	TAD	(1000
	DCA I	(JSW	/CHANGE JSW
COPT,	DCA I	(CISTRT+1	/&amp; TAKE CARE OF /C
	JMP I CIPAT

	PAGE
RELCIT,	TAD	LOCTRL	/FIND START OF CODE
	CLL IAC
	DCA	SUBLO	/BY SUBTRACTING
	RAL
	TAD	LOCTRH	/AMOUNT FROM FREE
	DCA	SUBHI
	JMS I	(SUB
	TAD	FREELO	/THIS IS THE START OF THE CODE
	DCA	CODBGN	/MINUS ONE
	TAD	FREEHI	/THIS IS THE FIELD NUMBER
	DCA	CODCDF
	TAD	LOCTRL	/SET UP PROG SIZE COUNT
	CLL CML CIA
	DCA	CODSZ1	/LOWER COUNT
	RAL
	TAD	LOCTRH
	CIA
	DCA	CODSZ2	/UPPER COUNT
	TAD	BLOCK	/SET UP FOR READ AND WRITE
	DCA I	(OUBLOK
	TAD	BLOCK
	DCA I	(INBLOK
	TAD	(-401
	DCA	OCOUNT
	CLA CMA
	DCA	ICOUNT
RELOOP,	JMS I	(INWORD	/GET A WORD OF CODE
	DCA	TEMP
	TAD	(3000
	TAD	TEMP	/CHECK FOR OPCODE 5000 (GOTO)
	AND	(7000
	SZA CLA
	JMP	NORELC	/NO JUMP
	TAD	TEMP	/REMOVE FIELD BITS
	AND	(340
	CLL RTR
	TAD	CDF0
	DCA	LBLFLD	/FIELD OF LABEL ENTRY
	TAD	TEMP	/ZERO FIELD BITS
	AND	(7437
	DCA	TEMP
	JMS I	(INWORD	/GET REST OF ADDR
	DCA	TEMP2
	JMS I	(CHKLBL	/CHECK FOR UNDEFINED LABEL
LBLFLD,	HLT
	TAD I	TEMP2
	AND	(7	/GET ADDR TO BE RELOCATED
	DCA	LOCHI
	ISZ	TEMP2
	TAD I	TEMP2
	CLL
	TAD	CODBGN	/ADD BASE ADDR
CDF0,	CDF
	DCA	LOCLO	/SAVE LOW PART OF JUMP
	RAL
	TAD	CODCDF	/GET HIGH PART
	TAD	LOCHI
	CLL RTL		/PUT IT INTO CORRECT PLACE
	RTL
	RAL
	TAD	TEMP	/PLUS INSTRUCTION
	JMS I	(OUTWRD
	ISZ	CODSZ1	/BUMP COUNTER
	SKP
	ISZ	CODSZ2	/CAN&#039;T BE LAST WORD
	TAD	LOCLO	/OUTPUT LOW ORDER ADDR
	SKP
NORELC,	TAD	TEMP	/JUST OUTPUT IT
RELOUT,	JMS I	(OUTWRD
	ISZ	CODSZ1	/DOUBLE WORD ISZ BUMP
	JMP	RELOOP
	ISZ	CODSZ2
	JMP	RELOOP
	JMP I	(LOADIT	/DONE RELOCATING, GO LOAD

	/PRINT ERROR MESSAGE

ERMSG,	0		/PRINT ERROR MESSAGE
	CDF
	TAD I	ERMSG	/GET CODE
	CLL RTR		/PRINT FIRST CHAR
	RTR
	RTR
	JMS	TTY
	TAD I	ERMSG	/PRINT SECOND CHAR
	JMS	TTY
	ISZ	ERMSG	/FIX RETURN ADDR
	TAD	(240	/PRINT SPACE
	JMS	TTY
	DCA	TTY	/USE TTY AS A SWITCH
	TAD	LINEH	/PRINT HIGH ORDER
	JMS I	(PSN
	TAD	LINEL	/THEN LOW ORDER
	JMS I	(PSN	/(LINE NUMBER NATCH !)
	TAD	(215	/PRINT CARRIAGE RETURN
	JMS I	(TTX
	TAD	(212	/PRINT LINE FEED
	JMS I	(TTX
	JMP I	ERMSG	/RETURN

TTY,	0		/CONVERT TO ASCII AND PRINT
	TAD	(240
	AND	(77
	TAD	(240
	JMS I	(TTX	/PRINT CHAR
	JMP I	TTY	/RETURN

	PAGE
LOADIT,	JMS I	(OUDUMP	/DUMP LAST BLOCK
	TAD	LOCTRL	/SET UP COUNTER
	CIA CLL CML
	DCA	CODSZ1
	RAL
	TAD	LOCTRH
	CIA
	DCA	CODSZ2
	TAD	CODBGN
	DCA	TEMP	/CODE BEGIN -1
	TAD	BLOCK	/SET UP BLOCK NUMBER
	DCA I	(INBLOK
	CLA CMA
	DCA	ICOUNT
	TAD	CODCDF	/SET UP CODE CDF
	CLL RTL
	RAL
	TAD	(6201
	DCA	CODCDF
	TAD	CODCDF
	DCA	CF
LODLUP,	ISZ	TEMP	/BUMP POINTER
	JMP	NOFJMP	/FIELD IS OK
	TAD	CF	/BUMP THE FIELD
	TAD	(10
	DCA	CF
NOFJMP,	JMS I	(INWORD	/GET NEXT WORD
CF,	HLT
	DCA I	TEMP	/SAVE THE WORD
CDFZER,	CDF
	ISZ	CODSZ1	/MORE CODE ?
	JMP	LODLUP	/YES
	ISZ	CODSZ2
	JMP	LODLUP	/YES
	TAD	CF	/GET THE FIELD
	DCA	CLEARF	/AND SAVE IT
CLRLUP,	TAD	CLREND	/IS THIS THE END OF CLEAR ?
	TAD	TEMP
	SZA CLA
	JMP	MORCLR	/NO, KEEP GOING
	TAD	CLRFLD	/DO FIELDS MATCH ?
	TAD	CLEARF
	SNA CLA
	JMP	DONCLR	/YES, ARRAYS ARE CLEARED
MORCLR,	ISZ	TEMP	/BUMP POINTER
	JMP	CLEARF	/DON&#039;T BUMP FIELD
	TAD	CLEARF	/DO BUMP FIELD
	TAD	(10
	DCA	CLEARF
CLEARF,	HLT
	DCA I	TEMP	/CLEAR THE WORD
	JMP	CLRLUP	/DO MORE
DONCLR,	TAD	CLEARF	/COPY THE FIELD
	DCA	STFLDM
	TAD	TEMP	/GET THE COUNT
	TAD	RESADR	/OF HOW MUCH SYMBOL TABLE
	DCA	TEMP2	/TO MOVE
	TAD	TEMP	/PUT IT INTO AUTO XR&#039;S
	DCA	X13
	TAD	X13
	DCA	X11
MOVSTL,	CDF
	TAD I	X11	/GET NEXT WORD OF ST
STFLDM,	HLT
	DCA I	X13	/STORE IT
	ISZ	TEMP2
	JMP	MOVSTL
	JMS	MOVFIN	/MOVE FINI PAGE INTO 7000-7177
	JMP I	(7000	/GO READ BRTS.SV
CHKLBL,	0		/CHECK LABEL FOR UNDEF
	TAD I	CHKLBL	/GET FIELD
	DCA	.+1
	HLT
	TAD I	TEMP2	/GET FIRST WORD OF LABEL
	SPA CLA
	JMP I	CHKLBL	/SIGN BIT IS DEFINED
	CLL CMA RAL	/GET ADDR OF LINE NUM
	TAD	TEMP2
	DCA	XLABEL
	TAD I	XLABEL	/GET HIGH ORDER LINE
	DCA	LINEH
	ISZ	XLABEL
	TAD I	XLABEL	/GET LOW ORDER
	DCA	LINEL
	CDF
	JMS I	(ERMSG	/PRINT MESSAGE
	2523
	JMP I	CHKLBL	/RETURN

FREEF,	0		/MAKE A CDF FROM FREEHI
	TAD	FREEHI
	CLL RTL
	RAL
	TAD	CDFZER
	JMP I	FREEF

ABORTL,	JMS	MOVFIN	/PUT FINI PAGE INTO 7000-7177
			/AND ABORT THE RUN
	JMP I	(ABORT-FINI+7000

MOVFIN,	0		/FINI PAGE MOVER
	CDF
	TAD	(FINI-1	/MOVE INT READING CODE
	DCA	X10
	TAD	(6777	/INTO 7000
	DCA	X11
	TAD	(-200
	DCA	TEMP	/PUT CORRECT COUNT HERE
	TAD I	X10
	DCA I	X11	/MOVE CODE
	ISZ	TEMP
	JMP	.-3
	JMP I	MOVFIN

	PAGE
FINI,	TAD I	XERMSG	/ANY ERRORS ?
	SZA CLA
	JMP	ABORT	/YES, DON&#039;T RUN IT
	TAD	XINT	/MOVE INT STUFF
	DCA	FTEMP
	TAD	M12	/10 KEY LOCATIONS
	DCA	FCNT
	TAD	XSAVE	/INTO A SAFE PLACE
	DCA	FTEMP2
	TAD I	FTEMP
	ISZ	FTEMP
	DCA I	FTEMP2
	ISZ	FTEMP2
	ISZ	FCNT
	JMP	.-5	/MOVE LOOP
	TAD	BRTS	/READ IN BRTS
	DCA	BRTSB
	JMS I	X7607
	BRTSIZ
	0
BRTSB,	0
	JMP	IOERR
	TAD	XSAVE
	DCA	FTEMP
	TAD	XINT	/MOVE STUFF BACK
	DCA	FTEMP2
	TAD I	FTEMP
	ISZ	FTEMP
	DCA I	FTEMP2
	ISZ	FTEMP2
	ISZ	M12
	JMP	.-5
	TAD	(JMP I FSTOP1	/PATCH ^C LOCATIONS
	DCA I	(7600
	TAD	(JMP I FSTOP1
	DCA I	(7605
	JMP I	(BRTBGN	/GO START BRTS

M12,	-12
XINT,	20
XERMSG,	ERMSG
X7607,	7607
XSAVE,	7001+XSAVE-FINI

MUL12,	0		/MULTIPLY 12BITS AND 24 BITS
	DCA	AC3	/SAVE 12 BIT THING
	DCA	AC2	/CLEAR REST OF AC
	DCA	AC1
	TAD	(-15	/ONLY TEST 12 BITS
	DCA	SC
	JMP	MULBGN
MULLUP,	SNL		/WAS BIT ON ?
	JMP	NOADD	/NO, DON&#039;T ADD
	TAD	SUBLO	/ADD TO HIGH ORDER 2/3&#039;S OF AC
	TAD	AC2
	DCA	AC2
	CML RAL
	TAD	SUBHI
NOADD,	TAD	AC1	/SHIFT AC RIGHT
	CLL RAR
	DCA	AC1
	TAD	AC2
	RAR
	DCA	AC2
MULBGN,	TAD	AC3
FTEMP,	RAR
FTEMP2,	DCA	AC3
FCNT,	ISZ	SC	/BUMP SHIFT COUNTER
	JMP	MULLUP
	TAD	AC2	/ANSWER IS LOWER 2/3&#039;S OF AC
	DCA	SUBHI
	TAD	AC3
	DCA	SUBLO
	JMP I	MUL12

IOERR,	DCA	LINEL	/ZERO LINE NUMBER
	JMS I	XERMSG	/PRINT MESSAGE
	1117
ABORT,	JMS I	(SWAP	/SWAP OS8 BACK
	JMS I (200	/CHECK OUT W/ CI BUILDER
	TAD	(4207	/RESTORE ^C LOCATIONS
	DCA I	(7600
	TAD	(6213
	DCA I	(7605
	TAD	ABORTX	/CALLED VIA CHAIN ?(FROM EDIT)
	SNA
	JMP I	(7600	/NO, RETURN TO OS8
	DCA	EDTBLK	/YES, SAVE EDITOR START
	JMS I	X7607	/READ IN EDITOR
	EDTSIZ		/THIS MUCH
	0
OWTEMP,
EDTBLK,	0
	JMP I	(7605	/ERROR
	JMP I	(EDTBGN	/GO START EDITOR

OUTWRD,	0		/OUTPUT WORD TO TEMP FILE
	ISZ	OCOUNT	/ANY ROOM ?
	JMP	NOWRIT	/YES
	DCA	OWTEMP	/SAVE WORD
	JMS	OUDUMP	/WRITE BLOCK
	ISZ	OUBLOK	/BUMP BLOCK NUMBER
	TAD	OUBLOK-1/RESET BUFFET POINTER
	DCA	OUPTR
	TAD	(-400
	DCA	OCOUNT	/AND COUNT
	TAD	OWTEMP	/RESTORE AC
NOWRIT,	CDF	10
	DCA I	OUPTR	/INTO BUFFER
	CDF
	ISZ	OUPTR
	JMP I	OUTWRD
OUPTR,	0
OUDUMP,	0		/WRITE BLOCK
	JMS I	X7607	/WRITE BLOCK
	4210
	0
OUBLOK,	0
	JMP	IOERR
	JMP I	OUDUMP

	END=FINI+200

	PAGE
	BLDCI=200	/PAGE INTO WHICH MAKECI GETS MOVED
	LOADBL=357	/LOC WHERE BCOMP LEAVES BLOAD BLOCK #

IMAGE,	0
	TAD I	(LOADBL	/COME HERE TO CREATE CORE IMAGE
	TAD	(6		/ALREADY HAVE THIS MUCH
	DCA I	(LDRBLK	/INIT BLOAD OVRLY READER
	CDF 10
	TAD I	(7644	/TEST FOR /V
	CDF
	AND	(4
	SZA CLA
	JMS I	(VERNUM
	CDF 10
	TAD I	(7643	/GET OPTION BITS
	CDF
	DCA	TEMP
	TAD	TEMP
	RTR
	SNL CLA		/HAVE K OPTION?
	JMP	LSTART	/NO: START LOADER
	TAD	TEMP
	RTL
	SZL CLA		/HAVE B OPTION?
	DCA I	(FLGRTS	/YES: FLAG IT
	TAD	TEMP	/TEST FOR /C
	RTL
	SPA CLA
	JMP	.+3
	TAD	(NOP
	DCA I	(COPT
	CDF 10
	TAD I	(7646	/GET =N
	CDF
	AND (7		/WIPE ALT MODE
	SNA
	CLL CML RTL	/DEFAULT=12K FOR NOW
	DCA	TEMP
	CLL CMA
	TAD	TEMP	/MUST BE &gt;1 HERE
	SNA CLA
	ISZ	TEMP
	TAD	TEMP
	CLL CMA
	TAD	HIFLD
	SNL CLA		/WHICH HAS MORE CORE?
	JMP	.+3		/TARGET MACHINE: TOUGH
	TAD	TEMP	/HOST MACHINE
	DCA	HIFLD	/FAKE OUT LOADER
	TAD	HIFLD
	CIA
	DCA I	(FLDCNT	/INIT CI BUILDER
	TAD I	(FLDCNT
	DCA I	(MYCORE	/AND CI STARTER
	CDF 10
	DCA I	(7646	/CLEAR =N BITS
	DCA I	(7643	/AND EARLY OPTIONS
	TAD I	(7644	/GET OPTION BITS
	CDF
	RTL
	SZL CLA		/HAVE N SWITCH?
	JMP	NOTDSY	/NEVER SEES TD8E SYSTEM
	TAD	HIFLD
	CLL RAR
	SNA CLA		/HAVE OVER 8K CORE?
	JMP	NOTDSY
	TAD	(NOP
	DCA I	(GOTTD	/YES: FORCE SYS=TD8E
	CDF 10		/THE QUESTION IS,
	TAD I	(DCB	/WAS IT A LITTLE WHITE ONE
	AND (770	/OR NOT?
	TAD	(-210
	CDF
	SNA CLA
	TAD I	(7612
	TAD	(-3
	SNA CLA
	JMP	.+3		/IT WAS TRUTH!
	TAD	(SWAP-LOADER+5600
	DCA I	(TDLIE	/LIES: MUST LIE TO SWAPPER ALSO
	CLA IAC
NOTDSY,	DCA I	(TDFLAG	/NOT 0 MEANS HAVE TD8E
	CMA
	DCA I	(ERMSG	/FORCE LOAD ABORT
LSTART,	TAD	(BLDCI-1	/MOVE CI BUILDER
	DCA	X10		/INTO LOW CORE
	TAD	(MAKECI-1
	DCA	X11
	TAD I	X11
	DCA I	X10
	ISZ	ICTR
	JMP	.-3
	TAD	HIFLD	/START OF BLOAD V1
	DCA	FREEHI
	JMP I	IMAGE	/RETURN TO LOADER

ICTR,	-200
CCLIST,	0		/1ST 4 WORDS OF CCB
	6203
	CISTRT
	1000		/JOB STATUS WORD

	PAGE
	CCB=1000	/LOC TO START BUILDING CCB

MAKECI,	0		/THIS PAGE GETS MOVED!
	TSF
	JMP	.-1		/SEE TAG &quot;ABORT&quot; IN BLOAD V1
	ISZ I	(ERMSG	/WHY ARE WE HERE?
	JMP	BOSFIX	/GENUINE ABORTION
	TAD	(CCB-1
	DCA	X10
	TAD	(CCLIST-1
	DCA	X11
	TAD I	X11	/1ST FOUR WORDS OF CCB
	DCA I	X10
	ISZ	MKCCNT
	JMP	.-3
CCSEGS,	TAD	FLDCNT
	CLL CIA RAL
	RTL		/THIS FIELD
	DCA	TEMP
	TAD	(70
	AND	CODCDF	/LOWEST FIELD USED
	CLL CIA
	TAD	TEMP
	SNL		/THIS FIELD USED?
	JMP	NOCODE	/NO: BYPASS IT
	SZA CLA		/IS IT FULL?
	JMP	ALLCODE	/YES
	TAD	CODBGN	/PROBABLY NOT
	AND	(7400
	DCA	TEMP2
	TAD	TEMP2
	CIA
	CLL RAR
	TAD	TEMP
	DCA	TEMP
	TAD	TEMP2
ALLCODE,DCA I	X10
	TAD	FLDCNT
	IAC
	TAD	TDFLAG
	SMA CLA		/NEED TOP PAGE?
	TAD	(3700	/NO: 37 PAGES
	TAD	TEMP	/YES: 40 PAGES
	AND	K3777
	DCA I	X10
	ISZ I	(CCB
NOCODE,	CLA CLL
	ISZ	FLDCNT	/NEXT FIELD ZERO?
	JMP	CCSEGS	/NO: LOOP
	TAD	FLGRTS
	SZA CLA		/NEED BRTS?
	TAD	(CISTRT
	DCA I	X10
	TAD	FLGRTS
	SZA CLA
	TAD	(200-3700
	TAD	(3700
	DCA I	X10
	TAD I	(CCB
	CMA
	DCA I	(CCB		/NEGATE SEG COUNT
	JMS I	(7607	/READ CI STARTER
KP200,	200		/FROM END OF BLOAD.SV
	CISTRT		/INTO HI CORE
LDRBLK,	0		/INIT BY &quot;IMAGE&quot;
BOSPT1,	7600		/CAN&#039;T GET THIS ERROR
	JMS I	JCIP
	TAD	TDFLAG	/PASS TD8E FLAG
	DCA I	(FLAGTD
	TAD	FLGRTS
	DCA I	(RTSFLG	/AND BRTS FLAG
	TAD	MYCORE
	DCA I	(NOCORE	/AND CORE LIMIT
	TAD	(17		/SAVE 10 KEY LOCATIONS
	DCA	X10
	TAD	(KEYLOC-1
	DCA	X11
	TAD I	X10
	DCA I	X11
	ISZ	MCICNT
	JMP	.-3
	JMS I	(7607	/CALL SYS HANDLER
	4200		/TO WRITE CCB
	CCB-200		/(AND PRECEDING PG)
	37		/INTO SCRATCH BLOCK
K3777,	3777		/CAN&#039;T GET THIS ERROR
	JMP I	(EXEUIT

MKCCNT,	-4
MCICNT,	-12
FLDCNT,	-7
TDFLAG,	1		/0 MEANS TD8E IS DEATH AT RT
FLGRTS,	-1		/0 MEANS INCL BRTS IN CI

BOSFIX,	TAD I 	(BIPCCL
	RAL
	SMA CLA
	JMP I	MAKECI	/BATCH NOT RUNNING
	TAD I	(7777
	AND	(70
	TAD	CDFZRO
	DCA	BOSCDF	/CDF TO BATCH FIELD
BOSLUP,	CDF 10
	TAD I	BOSPT1	/GET BATCH WRDS
BOSCDF,	CDF 10
	DCA I	BOSPT2	/BACK INTO POSITION
CDFZRO,	CDF
	ISZ	BOSPT1
	ISZ	BOSPT2
	JMP	BOSLUP
	JMP I	MAKECI

BOSPT2,	7774
MYCORE,	0
JCIP,	CIPAT

	PAGE
VERNUM,	0
	TAD	(VTEXT
	DCA	TEMP
MOREV,	TAD I	TEMP
	SNA
	JMP	VOUT
	CLL RTR
	RTR
	RTR
	JMS I 	(TTY
	TAD I TEMP
	JMS I 	(TTY
	ISZ	TEMP
	JMP	MOREV
VOUT,	TAD	(215
	JMS I	(TTX
	TAD	(212
	JMS I	(TTX
	JMP I	VERNUM

VTEXT,	TEXT	/BLOAD  V/
	*.-1
VERLOC,	100^VERSON+6001
	0

	PAGE
	*7000
	BSTART=200	/START ADDR FOR BRTS
CISTRT,	SKP		/RUNNED
	JMP CHAIN	/CHAINED
	TAD (7603
	DCA X10
	TAD (NAMLST-1
	DCA X11
	CDF	10
	DCA I	X10	/ZERO EDITOR
	DCA I	X10	/COMPILER
	DCA I	X10	/AND LOADER BLOCK #S
	CDF
	CIF 10
	JMS I (7700
	10		/USRIN
FINDSV,	TAD I	X11	/LOOKUP SOME SAVE FILES
	SNA
	JMP	LUBUF	/GO LOOK FOR BASIC.UF
	DCA	XXXXSV	/SAVE POINTER TO NAME
	CLA IAC		/THEY&#039;RE ON SYS
	CIF	10
	JMS I	(200
	2
XXXXSV,	0
	0
	JMS I	(ERRORX	/ERROR
	TAD	XXXXSV	/GET STARTING BLOCK
	IAC		/PLUS 1
	CDF	10
	DCA I	X10	/INTO INFO AREA
	CDF
	JMP	FINDSV	/LOOP
LUBUF,	CLA IAC
	CIF	10
	JMS I	(200	/LOOKUP BASIC.UF
	2
	BUFN		/(USER DEFINED FUNCTIONS)
	0
	JMP	.+3	/OK IF NOT THERE
	TAD	.-3	/GET STARTING BLOCK +1
	IAC
	CDF	10
	DCA I	X10	/INTO INFO BLOCK
	CDF 0
	CIF 10
	JMS I	(200
	11		/USR OUT
CHAIN,	CDF 10
	TAD I (7607	/GET BRTS STARTING BLK
	CDF
	DCA I	(BRTSST	/INTO RTS READER
	JMP I	(BINIT

NAMLST,	BRTSN
	BAFN
	BSFN
	BFFN
	0
BRTSN,	FILENAME BRTS.SV
BAFN,	FILENAME BASIC.AF
BSFN,	FILENAME BASIC.SF
BFFN,	FILENAME BASIC.FF
BUFN,	FILENAME BASIC.UF
CORE,	0
	TAD I	(BIPCCL
	AND COR70
	CLL RAR
	RTR
	SZA		/IS THERE A SYSTEM VALUE?
	JMP I CORE	/YES: USE IT
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
	CLA CMA		/HI FIELD IS #FIELDS-1
	TAD	CORSIZ
	JMP I CORE
CORLOC,	CORX
CORV,	1400
CORSIZ,	1

	PAGE
GETRTS,	0		/READ BRTS INTO 0-6777
	TAD BRTS
	DCA BRTSBB
	JMS I (7607
	BRTSIZ
	0
BRTSBB,	0
NOCORE,	-1		/CAN&#039;T GET THIS ERROR
	JMP I GETRTS
BINIT,	ISZ RTSFLG	/NEED BRTS?
	JMP BRTSIN	/GOT IT: START IT
	JMS I	(7607
	BRTSIZ
	0
BRTSST,	0
SR2,	20		/CAN&#039;T GET THIS ERROR
BRTSIN,	CDF	10	/WHAT ARE WE RUNNING ON?
	ISZ EKOUNT
	TAD I	(DCB	/CHECK FOR TD8E SYSTEM
	AND	(770	/ED FRIEDMAN GAVE ME THIS CODE
	TAD	(-210	/AND I&#039;M TAKING IT ON FAITH
	CDF
	SNA CLA
	TAD I	(7642	/IS IT A ROM SYSTEM ?
	TAD	(-6223
	SZA CLA
	JMP PSADJ	/NO TD/8E OR ELSE ROM TD/8E
	TAD FLAGTD
	SNA CLA		/IMAGE OK ON TD8E?
	JMS ERRORX	/NO: DONT RUN IT
	TAD KEYLOC
	DCA CDFTOP
SWPLOOP,CDF 20
	TAD I TDCTR
	DCA GETRTS
CDFTOP,	CDF	70
	TAD I TDCTR
	DCA ERRORX
	TAD GETRTS
	DCA I TDCTR
	CDF 20
	TAD ERRORX
	DCA I TDCTR
	ISZ TDCTR
	JMP SWPLOOP
	CDF
	CLL CML RTL
	TAD CDFTOP	/PATCH MONITOR FIELD STUFF
	DCA I	(7642	/CDF CIF HI CORE
	IAC
	TAD CDFTOP
	DCA I	(7721	/CIF HI CORE
	TAD I	(7721
	DCA  I	(7727
CCHEK,	ISZ EKOUNT
	JMS I	(CORE	/HOW MUCH CORE DO WE HAVE?
	TAD NOCORE	/HOW MUCH DO WE NEED?
	SPA CLA
	JMS ERRORX	/INSUFFICIENT CORE
	TAD I SR1	/RESTORE KEY LOCATIONS
	DCA I SR2
	ISZ SR1
	ISZ SR2
	ISZ SR3
	JMP .-5
	TAD (JMP I FSTOP1	/PATCH CTRL/C LOCS
	DCA I (7600
	TAD (JMP I FSTOP1
	DCA I (7605
	TAD	SWPINF	/TELL BRTS OS/8 PG 17600 OUT NOW
	RAR
	STL RAL
	DCA	SWPINF
	JMP I	(BSTART	/START BRTS

ERRORX,	0
	CIF 10
	JMS I (7700
	7
EKOUNT,	1
	JMP I	(7605

EXEUIT,	TAD RTSFLG
	SNA CLA		/NEED BRTS?
	JMS GETRTS	/YES: READ IT
	TAD (4207	/RESTORE ^C HOOKS
	DCA I (7600
	TAD (6213
	DCA I (7605
	JMP I (7600	/BACK TO OS8
KEYLOC,	ZBLOCK 12
SR1,	KEYLOC
SR3,	-12
RTSFLG,	-1		/0 MEANS BRTS IS IN CORE
FLAGTD,	1		/1 IF TD8E IS OK AT RUNTIME
PSADJ,	TAD (4001
	AND KEYLOC+11
	TAD (2000
	DCA KEYLOC+11
	JMP CCHEK
TDCTR,	7600

	PAGE
	$$$$$
</pre>
<hr/>
</div>