<div id='wikitext'>
<pre><b> File: BLOAD.03 of Tape: OS8/OS8-V3/dec-s8-uextb-a-ua1</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/OS8 BASIC LOADER, V3
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL&#039;S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/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=300
/ OS8 BASIC COMPILER POST PROCESSOR
	X10=10
	X11=11
	X13=13
	STACK=15
	STCDF=20	/KEY INTERPRETER LOCATIONS
	NSTADR=STCDF+1
	NASTAD=NSTADR+1
	SSTADR=NASTAD+1
	SASTAD=SSTADR+1
	CODCDF=SASTAD+1
	CODBGN=CODCDF+1
	DATTOP=CODBGN+1
	DATPTR=DATTOP+1
	SWPINF=DATPTR+1
	VARCNT=40	/LOCATIONS DEFINED BY COMPILER
	SVCNT=VARCNT+1
	ACNT=SVCNT+1
	SACNT=ACNT+1
	LOCTRH=SACNT+1
	LOCTRL=LOCTRH+1
	BLOCK=LOCTRL+1
	HIFLD=BLOCK+1
	BRTS=HIFLD+1
	DLSIZE=BRTS+1
	ABORTX=DLSIZE+1
	FREEHI=ABORTX+1	/LOCATIONS USED BY RELOCATION CODE
	FREELO=FREEHI+1
	TEMP=FREELO+1
	TEMP2=TEMP+1
	TEMP3=TEMP2+1
	WORD1=TEMP3+1
	WORD2=WORD1+1
	WORD3=WORD2+1
	NCHARS=WORD3+1
	SUBHI=NCHARS+1
	SUBLO=SUBHI+1
	CODSZ1=SUBLO+1
	CODSZ2=CODSZ1+1
	LOCHI=CODSZ2+1
	LOCLO=LOCHI+1
	CODB=LOCLO+1
	CODF=CODB+1
	ICOUNT=CODF+1
	OCOUNT=ICOUNT+1
	AC1=OCOUNT+1
	AC2=AC1+1
	AC3=AC2+1
	SC=AC3+1
	LINEH=SC+1
	LINEL=LINEH+1
	XLABEL=LINEL+1
	CLRFLD=XLABEL+1
	CLREND=CLRFLD+1
	RESADR=CLREND+1
	SVARST=1036	/MORE COMPILER DEFINITIONS
	ARAYST=2132
	SARYST=2332
	STEMPS=2560
	LITRL=STEMPS+2
	SLITRL=LITRL+2
	DATLST=SLITRL+2
	STACKA=7120	/MAIN STACK OF COMPILER
	EDTBGN=3012	/START OF EDITOR
	EDTSIZ=1700	/SIZE OF EDITOR
	BRTBGN=200	/START OF BRTS
	BRTSIZ=3400	/SIZE OF BRTS
	DCB=7760
	*400
LOADER,	JMP I .+1	/CORE IMAGE FILE PATCH...
	IMAGE
	TAD	(7577	/EXECUTION RESUMES HERE
	DCA	FREELO
	DCA	SWPINF	/CLEAR SWAPPER WORD
	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	TAD	STACK	/ANY UNCLOSED FOR&#039;S ?
	CIA
	TAD	(STACKA-1
	SNA CLA
	JMP	.+3	/NO
	JMS	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	STSTUF
	DCA	TEMP
	TAD	(7410	/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	7642	/IS IT A ROM SYSTEM ?
	TAD	(-6223
	SZA CLA
GOTTD,	JMP	NOTD8E	/NO TD/8E OR ROM TD/8E
	TAD	(7377	/TD8E SYS WASTES 400 WORDS
	DCA	FREELO
	CLL CML RAR	/SET SWAP INFO
NOTD8E,	IAC
	DCA	SWPINF
	JMS	FREEF	/GET CDF TO HIGHEST FIELD
	DCA	SWPF1	/INTO 2 PLACES
	TAD	SWPF1
	DCA	SWPF2
	JMS	SWAP	/MOVE OS8 OUT
	ISZ	SWPFLAG
	JMP	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	7642
	TAD	SWPF1
	IAC		/CIF N0
	DCA	7721
	TAD	7721
	DCA	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
	TAD	SWPFLAG	/WHICH WAY ?
	SZA CLA
	JMP	SWPF2	/PUT OS8 BACK
SWP1,	HLT
	TAD I	TEMP2	/GET PART OF RESIDENT
SWPF1,	JMP	SWPRET	/RETURN IF 8K ONLY
	DCA I	TEMP	/INTO HI FIELD
	ISZ	TEMP	/BUMP POINTER
	ISZ	TEMP2	/AND PTR/CTR
	JMP	SWP1	/LOOP
	CDF
	JMP I	SWPSUB
SWPF2,	JMP I	SWAP	/IF 8K JUST RETURN
	TAD I	TEMP	/GET WORD OF HI FIELD
SWP2,	HLT
	DCA I	TEMP2	/BACK WHERE IT BELONGS
	ISZ	TEMP
	ISZ	TEMP2
	JMP	SWPF2
	CDF
	TAD	L6221	/SET UP TO FIX FIELD 0 CDFS
	DCA	SWPF1
	JMP I	SWPSUB
	PAGE
NODATA,	CDF
	JMS	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	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	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	TTY	/ANY DIGITS YET ?
	SNA CLA
	JMP	LEAD0	/NO, ITS A LEADING ZERO
NOZERO,	TAD	(60	/MAKE IT ASCII
	JMS	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	ERMSG	/WRITE MESSAGE
	2402		/TOO BIG
	JMP	ABORTL	/ABORT RUN
TTX,	0		/PRINT CHAR ON TTY
	TSF		/WAIT FOR PREVIOUS CHAR
	JMP	.-1
	TLS		/PRINT THIS ONE
	CLA
	JMP I	TTX
/    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; .
	PAGE
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	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	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	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	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	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	SLFLD	/ENTRY WHERE IT DOES THE MOST GOOD
	JMP	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	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	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	ERMSG	/PRINT ERROR MESSAGE
	2404
	JMP	ABORTL
TMSLIT,	DCA	LINEH	/CLEAR THE LINE NUMBER
	DCA	LINEL
	JMS	ERMSG	/PRINT MESSAGE
	2423
	JMP	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	MUL12
	JMP	TIMES3	/MULT BY 3
ONLY1,	DCA	TEMP3	/ZERO SECOND DIMENSION
	TAD	TEMP2
	DCA	SUBLO
TIMES3,	TAD	(3	/MULT SIZE BY 3
	JMS	MUL12
	JMS	SUB	/SUBTRACT FROM FREE
	TAD	FREELO
	DCA I	X11	/SAVE ADDR IN S.T.
	JMS	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	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	MUL12	/GET ARRAY SIZE
	JMS	SUB	/DO SUBTRACTION
	TAD	FREELO	/SAVE ADDR
	DCA I	X11
	JMS	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	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	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
	PAGE
RELCIT,	TAD	LOCTRL	/FIND START OF CODE
	CLL IAC
	DCA	SUBLO	/BY SUBTRACTING
	RAL
	TAD	LOCTRH	/AMOUNT FROM FREE
	DCA	SUBHI
	JMS	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	OUBLOK
	TAD	BLOCK
	DCA	INBLOK
	TAD	(-401
	DCA	OCOUNT
	CLA CMA
	DCA	ICOUNT
RELOOP,	JMS	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	INWORD	/GET REST OF ADDR
	DCA	TEMP2
	JMS	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	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	OUTWRD
	ISZ	CODSZ1	/DOUBLE WORD ISZ BUMP
	JMP	RELOOP
	ISZ	CODSZ2
	JMP	RELOOP
	JMP	LOADIT	/DONE RELOCATING, GO LOAD
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	SPACE	/PRINT SPACE
	JMS	TTY
	DCA	TTY	/USE TTY AS A SWITCH
	TAD	LINEH	/PRINT HIGH ORDER
	JMS	PSN
	TAD	LINEL	/THEN LOW ORDER
	JMS	PSN	/(LINE NUMBER NATCH !)
	TAD	(215	/PRINT CARRIAGE RETURN
	JMS	TTX
	TAD	(212	/PRINT LINE FEED
	JMS	TTX
	JMP I	ERMSG	/RETURN
TTY,	0		/CONVERT TO ASCII AND PRINT
	AND	(77	/SIX BITS ONLY
	TAD	(-40	/WHAT SIDE OF FORTY ?
	SPA
	TAD	(100	/LOW SIDE
	TAD	(240	/HIGH SIDE
	JMS	TTX	/PRINT CHAR
	JMP I	TTY	/RETURN
	PAGE
LOADIT,	JMS	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	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	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	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	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	M12
	DCA	FCNT
	TAD I	FTEMP
	ISZ	FTEMP
	DCA I	FTEMP2
	ISZ	FTEMP2
	ISZ	FCNT
	JMP	.-5
	TAD	(5561	/PATCH ^C LOCATIONS
	DCA	7600
	TAD	(5561
	DCA	7605
	JMP	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	SWAP	/SWAP OS8 BACK
	JMS I (200	/CHECK OUT W/ CI BUILDER
	TAD	(4207	/RESTORE ^C LOCATIONS
	DCA	7600
	TAD	(6213
	DCA	7605
	TAD	ABORTX	/CALLED VIA CHAIN ?(FROM EDIT)
	SNA
	JMP	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	7605	/ERROR
	JMP	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=351	/LOC WHERE BCOMP LEAVES BLOAD BLOCK #

IMAGE,	TAD LOADBL	/COME HERE TO CREATE CORE IMAGE
	TAD (5		/ALREADY HAVE THIS MUCH
	DCA LDRBLK	/INIT BLOAD OVRLY READER
	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 FLGRTS	/YES: FLAG IT
	CDF 10
	TAD I (7646	/GET =N
	CDF
	AND (7		/WIPE ALT MODE
	SNA
	CLL IAC RAL	/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 FLDCNT	/INIT CI BUILDER
	TAD FLDCNT
	DCA 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 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 (7642
	TAD (-6223
	SNA CLA
	JMP .+3		/IT WAS TRUTH!
	TAD (SWAP-LOADER+5600
	DCA TDLIE	/LIES: MUST LIE TO SWAPPER ALSO
	CLA IAC
NOTDSY,	DCA TDFLAG	/NOT 0 MEANS HAVE TD8E
	CMA
	DCA 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 LOADER+2	/START 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 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 BOSPT1
	DCA I X10	/START SAVING HERE
	TAD CODBGN
	CIA
	TAD KP200
	AND BOSPT1
	CLL RAR
	TAD TEMP
	DCA TEMP
	SKP
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 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
	ISZ CCB
	TAD CCB
	CIA
	DCA CCB		/NEGATE SEG COUNT
	JMS 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
	TAD TDFLAG	/PASS TD8E FLAG
	DCA FLAGTD
	TAD FLGRTS
	DCA RTSFLG	/AND BRTS FLAG
	TAD MYCORE
	DCA 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 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 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 7777
	AND (70
	SNA
	JMP I MAKECI	/BATCH NOT RUNNING
	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
	*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	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
CHAIN,	CDF 10
	TAD I (7607	/GET BRTS STARTING BLK
	CDF
	DCA BRTSST	/INTO RTS READER
	CIF 10
	JMS I (200	/USROUT
	11
	JMP 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 7777
	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
	NOSWAP=335	/FIRST BRTS CALL TO SWAPPER
	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 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	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 7642	/CDF CIF HI CORE
	IAC
	TAD CDFTOP
	DCA 7721	/CIF HI CORE
	TAD 7721
	DCA 7727
CCHEK,	ISZ EKOUNT
	JMS 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 (5561	/PATCH CTRL/C LOCS
	DCA I (7600
	TAD (5561
	DCA I (7605
	DCA NOSWAP	/FOOL BRTS SWAPPER
	JMP BSTART	/START BRTS
ERRORX,	0
	CIF 10
	JMS I (7700
	7
EKOUNT,	1
	JMP 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
	$$$$$
</pre>
<hr/>
</div>