X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape2%2Fbload.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape2%2Fbload.pa;h=4bd98b2b9d871bdf49bbb807f8663d949285b78c;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/os8/v3d/sources/extensions/dectapes/dectape2/bload.pa b/sw/os8/v3d/sources/extensions/dectapes/dectape2/bload.pa
new file mode 100644
index 0000000..4bd98b2
--- /dev/null
+++ b/sw/os8/v3d/sources/extensions/dectapes/dectape2/bload.pa
@@ -0,0 +1,1560 @@
+/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<BLOAD.03
+/	.R ABSLDR
+/	*BLOAD$
+/	.SA SYS BLOAD;7605
+/
+/NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
+/THE SOURCE AFTER TAG "IMAGE" AND THEN:
+/
+/	.R SRCCOM
+/	*LPT:<BLOAD.01,BLOAD.03
+/	*
+/
+/ALL CODE FOLLOWING TAG "IMAGE" IS NEW FOR VERSION 3
+/
+	VERSON=	5	/VERSION WORD LOCATED AT TAG "VERLOC"
+			/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'S ?
+	CIA
+	TAD	(STACKA-1
+	SNA CLA
+	JMP	.+3	/NO
+	JMS I	(ERMSG	/YES
+	2506
+	CLA CMA
+	TAD	HIFLD	/NO CDF'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'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'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 "INWORD"
+/    IS CALLED. THIS FIRST HAPPENS
+/    AFTER THE TAG "RELCIT" .
+
+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'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	/& 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'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'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'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'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'T ADD
+	TAD	SUBLO	/ADD TO HIGH ORDER 2/3'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'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 >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 "ABORT" 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 "IMAGE"
+BOSPT1,	7600		/CAN'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'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'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'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'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'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
+	$$$$$
+