/Commercial BASIC Loader, EX
/
/
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1972, 1973, 1974, 1975, 1978, 1979, 1982
/Digital Equipment Corporation, Maynard, Ma.
/
/
/
/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 any other
/copies thereof, may not be 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 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
/Equipment Corporation.
/
/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,1978,1979, 1982
/
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD,MASSACHUSETTS 01754
/
/AUGUST 19, 1972
/
/HANK MAURER, 1972
/SHAWN SPILMAN, 1973
/
/
/
/
/ASSEMBLE AND LOAD AS FOLLOWS:
/
/	.PAL BLOAD/E/W
/	.LOAD BLOAD
/	.SA SYS BLOAD;3000=2000
/
	VERSON=	"B&77	/VERSION WORD LOCATED AT TAG "VERLOC"
	PATCH=	"0&77

/	.R BLOAD 	TO GET BLOAD VERSION NUMBER

/
/CORRECTIONS MADE FOR V4		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
/

/	30-APR-77	UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT 
/			RUNNING
/	05-DEC-77	START COMMERCIAL BASIC FIELD 1 CHANGES
/	31-JAN-78	ADD 7 BIT ASCII SUPPORT
/	22-MAR-78	ADD GENERAL 2 PAGE SYSTEM HANDLER CODE
/	27-MAR-78	MAKE BRTS FIELD 1 LOAD CHANGES
/	18-APR-78	CLEAN UP CORE IMAGE CREATION LOGIC, REMOVE /C SWITCH
/	16-May-78	ADD FANCY ERROR MESSAGES, GENERAL CORESIZE HANDLING
/			USING /B SWITCH
/	17-May-78	PUT IN TEMP FILE READ/WRITE BYPASS OPTIMIZATION
/	2/23/79		CHANGED BRTS FIELD 1 LOADING CONSTANTS FOR
/			ENHANCED HANDLER CHANGE TO BRTS
/	5-Mar-79	Make source fixes for published patches
/	30-Aug-81	Changed symbol table setup to allow more string
/			literals
/	01-JAN-82	REMOVED BASIC.UF REFERENCES
	/OS8 BASIC COMPILER POST PROCESSOR

	/AUTO INDEX REGISTERS

	X10=	10
	X11=	11
	X13=	13
	STACK=	15
	NEXT=	16	/Highest S.T. location used passed by BCOMP

	AC7775=	CLL STA RTL

	/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
FREFLD,	0		/CDF to highest S.T. location used by BCOMP
OUTFLG,	0		/Flag passed by BCOMP, zero if no temp file writes done

	/PAGE 0 LOCATIONS USED BY LOADER

FREEHI,	0
FREELO,	0
TEMP,	0
TEMP2,	0
TEMP3,	0
WORD1,	0
WORD2,	0
WORD3,	0
NCHARS,	0
NWORDS,	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
PUTLOC,	0
QOUTWRD,0
	/MORE COMPILER DEFINITIONS

	KEYEND=	1665
	VARST=	KEYEND
	SVARST=	VARST+436
	ARAYST=	SVARST+1074
	SARYST=	ARAYST+200
	SNUMS=	SARYST+200
	TEMPS=	SNUMS+24
	STEMPS=	TEMPS+2
	LITRL=	STEMPS+2
	SLITRL=	LITRL+2
	DATLST=	SLITRL+2

	INFO=	7604	/BASIC SYSTEM INFORMATION AREA

/INFO    STARTING BLOCK +1 OF BASIC.SV
/INFO+1  STARTING BLOCK +1 OF BCOMP.SV
/INFO+2  STARTING BLOCK +1 OF BLOAD.SV
/INFO+3  STARTING BLOCK +1 OF BRTS.SV
/INFO+4  STARTING BLOCK +1 OF BASIC.OV
/INFO+5  STARTING BLOCK +1 OF BASIC.EX
/INFO+6  *UNUSED*
/INFO+7  *UNUSED*
/INFO+10 STARTING BLOCK OF BASIC.TM
/INFO+11 SIZE IN BLOCKS OF BASIC.TM
/INFO+12 INPUT HANDLER ENTRY ADDRESS
/INFO+13 SIZE AND DEVICE NUMBER OF INPUT FILE
/INFO+14 STARTING BLOCK OF INPUT FILE
/INFO+15 THROUGH
/INFO+20 NAME OF WORKSPACE

	/MISC DEFINES

	STRMAX=	205	/MAX LENGTH OF STRING IN CHARS
	STRMIN=	22	/MIN LENGTH TO DEFAULT UNDIMENSIONED STRINGS TO
	BLDCI=	200	/PAGE WHERE MAKECI GETS MOVED
	STACKA=	7120	/MAIN STACK OF COMPILER
	EDTBGN=	0201	/START OF EDITOR
	EDTSIZ=	2400	/SIZE OF EDITOR

	JSW=	7746	/OS/8 JOB STATUS WORD IN FIELD 0
	CDOPT2=	7642	/HIGH ORDER CD = OPTION AND ALTMODE FLAG
	CDOPT3=	7643	/CD SWITCHES [ABC DEF GHI JKL]
	CDOPT4=	7644	/CD SWITCHES [MNO PQR STU VWX]
	CDOPT5=	7645	/CD SWITCHES [YZ0 123 456 789]
	CDOPT6=	7646	/LOW ORDER CD = OPTION
	BIPCCL=	7777	/OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD

	BABORT=	6	/CONTAINS ADDR OF BCOMP/BLOAD ^C HOOK IN SYS:
	INBUF=	400	/BLOAD Temp file input buffer in FIELD 1
			/overlays BCOMP output buffer
	XERMSG=	1000	/Error message printer which executes in BCOMP input buffer
	STPACK=	2000	/LOAD ADDRESS OF STRING ARITH PACKAGE IN FIELD 1
	BRTSZ1=	2600	/HANDLER SIZE CONTROL WORD FOR BRTS FIELD 1 CODE
	BRTLD1=	0000	/STARTING LOCATION OF BRTS LOAD FOR FIELD 1
	BRTBG1=	0400	/SUBROUTINE ENTRY ADDR FOR BRTS STARTUP IN FIELD 1
	BRTND1=	5400	/END OF BRTS FIELD 1 SECTION
	OVSEP=	7	/OFFSET FROM START OF BLOAD OF BLOAD OVERLAY
	MAGIC=	1234	/MAGIC NUMBER PASSED IN HIGH ORDER = OPTION FOR FAST
			/.SV IMAGE STARTUP

	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
	UFMSG		/UNCLOSED FOR LOOP
	AC7775
	TAD I	(7612	/TEST IF 2 PAGE SYSTEM HANDLER
	SZA CLA		/SKP IF YES
GOTTD,	JMP	NOTD8E	/JMP IF NO NEED TO ALLOCATE EXTRA PAGE
			/PREV INSTR NOP'D TO FORCE SPACE IF FOR CORE IMAGE
	TAD	(7377	/ALLOCATE HANDLER EXTENSION PAGE
	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
	TAD	SWPF1	/PASS NEW FIELD BITS FOR ANY 2 PAGE HANDLER
	JMS	SWAP	/MOVE OS8 OUT
	JMP I	(STSTUF	/DO SYMBOL TABLE STUFF
	/PATCH SYSTEM HANDLER AND MOVE OS/8 OUT OR IN
	/ENTRY AC = FIELD BITS FOR HANDLER IN BITS 6-8

SWAP,	0
	AND	(70	/MASK EXTRANEOUS BITS
	DCA	FBITS
	AC7775		/TEST MAGIC LOCATION IN HANDLER
	TAD I	(7612	/FOR A 3
	SZA CLA
	JMP	NOFADJ	/NO MATCH, BYPASS ADJUSTMENT
	TAD	(7635	/OK, RELOCATE ANYTHING BEYOND 7635
	DCA	HNDPTR
HNDLP,	TAD I	HNDPTR	/RANGE CHECK BITS 0-8
	TAD	(-6300
	CLL
	TAD	(70
	SNL CLA		/SKP IF  CIF/CDF N0
	JMP	NOPAT	/ELSE TRY NEXT WORD
	TAD I	HNDPTR	/OK, NOW GET THE INSTRUCTION BITS
	AND	(7707
	TAD	FBITS	/ADD NEW FIELD
	DCA I	HNDPTR	/STORE IT BACK
NOPAT,	ISZ	HNDPTR	/BUMP PTR
	JMP	HNDLP	/TRY AGAIN
NOFADJ,	TAD	SWPINF	/IS ROOM ALLOCATED 2 PAGE SYSTEM HANDLER?
	SPA CLA		/SKP IF NO, JUST MOVE 1 PAGE
	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
	CDF	20
L7600,	7600
SWPRET,	CLA
	JMP I	SWAP
HNDPTR,	0
FBITS,	0
	/SWAPPER

SWPSUB,	0
	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/POINTER
	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

/Store a word in the symbol table
/STBCDF is set up at init time; point to symbol table with X11
/Returns with data field of zero

STOSTB,	0
	JMP	SETUP	/Set up the field
STOCDF,	HLT		/Change to symbol table field
	DCA I	X11	/Store the word
	CDF	0	/Back to field zero
	JMP I	STOSTB	/Return to caller

SETUP,	DCA	STOTMP	/Save the word
	TAD	STCDF	/Get symbol table CDF
	DCA	STOCDF	/Store in line
	TAD	(NOP	/Clear the initialization
	DCA	STOSTB+1
	TAD	STOTMP	/Restore the data word
	JMP	STOCDF	/Store it
STOTMP,	0
	PAGE
NOSL,	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	(4000+STRMIN /IF UNDEF USE DEFAULT NO 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	(STRMAX	/GIVE IT MAX SIZE
	DCA	TEMP3
	JMS	SVSTOR	/ALOOCATE IT
	JMP	STMLUP	/LOOP
	/MAKE ENTRY FOR STRING VARIABLE

SVSTOR,	0
	TAD	TEMP2	/FIND ST ADDR
	CLL RAL
	TAD	TEMP2
	TAD	SSTADR
	DCA	X11
	TAD	TEMP3	/NUMBER OF CHARS
	JMS I	(CVT3F2
	DCA	SUBLO	/NUMBER OF WORDS
	DCA	SUBHI
	JMS	SUB	/FREEHI,LO=FREEHI,LO-SUBHI,LO
	TAD	FREELO	/SAVE ADDR
	JMS I	(STOSTB
	JMS I	(FREEF	/AND FIELD
	JMS I	(STOSTB
	TAD	NWORDS	/PUT IN TOTAL SIZE IN WORDS
	JMS I	(STOSTB
	JMP I	SVSTOR
	/DOUBLE PRECISION SUBTRACT

SUB,	0
	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	(BRTND1	/SEE IF ABOVE BRTS FIELD 1 SECTION
	CLL CIA
	TAD	FREELO	/DOUBLE WORD COMPARE
	STA RAL
	TAD	FREEHI
	SMA CLA		/WILL IT FIT?
	JMP I	SUB	/YUP
	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	JMS I	(ERMSG	/WRITE MESSAGE
	TBMSG		/TOO BIG
	JMP I	(ABORTL	/ABORT RUN

	/CHECK LABEL FOR UNDEFINED

CHKLBL,	0
	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
	USMSG
	JMP I	CHKLBL	/RETURN


	PAGE
	/SYMBOL TABLE SETUP

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	X11	/IN THE
	JMS I	(STOSTB	/SCALAR TABLE
	JMS I	(STOSTB
	JMS I	(STOSTB
	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
	TAD	WORD1	/NOW PUT LITERAL INTO TABLE
	JMS I	(STOSTB
	TAD	WORD2
	JMS I	(STOSTB
	TAD	WORD3
	JMS I	(STOSTB
	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
	JMP I	(DODATA	/Do the data now
NODATA,	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
	JMS I	(CVT3F2
	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	NWORDS	/GET NUMBER OF WORDS
	CIA
	DCA	TEMP3	/(SAVE NUMBER OF WORDS)
	TAD	NWORDS	/Check if room
	DCA	SUBLO
	DCA	SUBHI
	JMS I	(SUB	/Do double precision subtract
	TAD	FREELO	/Set pointer for move
	DCA	PUTLOC
	JMS I	(FREEF	/And the field
	CDF	0
	DCA I	(PUTCDF
	TAD	FREELO	/STICK THE ADDR
	IAC
	JMS I	(STOSTB	/INTO THE ST ENTRY
	JMS I	(FREEF	/ALSO THE FIELD
	JMS I	(STOSTB
	TAD	NWORDS	/ALSO THE SIZE IN WORDS
	JMS I	(STOSTB
	TAD	NCHARS	/PUT IN THE LENGTH TOO
	CIA		/(NEGATIVE)
	JMP	.+3
MOVSL,	JMS I	(SFLD
	TAD I	X10
	JMS I	(PUTWD	/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
	/HANDLE DATA NOW

DODATA,	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 X11 TO FILL LIST
	DCA	X11
	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
	JMS I	(STOSTB	/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
	TDMSG
	JMP I	(ABORTL

	PAGE
	/HANDLE NUMERIC ARRAYS

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
	JMS I	(STOSTB	/SAVE ADDR IN S.T.
	JMS I	(FREEF
	JMS I	(STOSTB
	TAD	TEMP2	/ALSO DIMS
	JMS I	(STOSTB
	TAD	TEMP3
	JMS I	(STOSTB
	ISZ	X10	/SKIP SYMBOL NUMBER
	ISZ	ACNT
	JMP	DOARAY
	/HANDLE STRING ARRAYS

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	(STRMIN	/USE DEFAULT IF NO SIZE SPEC
	DCA	TEMP2
	TAD	TEMP3
	DCA	SUBLO	/PREPARE FOR MULT
	DCA	SUBHI
	CDF
	TAD	TEMP2	/GET NUM WORDS PER STRING
	JMS I	(CVT3F2
	JMS I	(MUL12	/GET ARRAY SIZE
	JMS I	(SUB	/DO SUBTRACTION
	TAD	FREELO	/SAVE ADDR
	JMS I	(STOSTB
	JMS I	(FREEF
	JMS I	(STOSTB
	TAD	NWORDS	/AND SIZE IN WORDS
	JMS I	(STOSTB
	TAD	TEMP3	/AND NUMBER OF STRINGS
	JMS I	(STOSTB
	ISZ	X10	/SKIP NEXT NAME
	ISZ	X10	/AND NEXT SYM NUMBER
	ISZ	SACNT
	JMP	DOSARY
	JMP I	(RELCIT
	/READ FROM THE CODE FILE

INWORD,	0
	ISZ	ICOUNT	/ANYTHING IN BUFFER
	JMP	NOREAD	/YASSUH! (Spreak Ingresh troop!)
	JMS I	(7607	/READ NEXT BLOCK
	210
	INBUF	
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,	CDF	10
	TAD I	INPTR	/GET WORD
	CDF
	ISZ	INPTR	/BUMP POINTER
	JMP I	INWORD
INPTR,	INBUF

	PAGE
	/Relocate GOTO/GOSUB addresses now
	/In order to minimize I/O we use the code in the BCOMP output
	/buffer directly if no more than 1 bufferfull is used.
	/In addition, a test is made if the code will fit above the BCOMP
	/Symbol Table, and if so code is stored directly instead of passing
	/through the temp file first.

RELCIT,	DCA I	(PUTWD	/Clear 'loaded' flag
	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	CODBGN	/SET UP CODE STORE ROUTINE
	DCA	PUTLOC	/STARTING ADDR-1
	TAD	CODCDF
	CLL RTL
	RAL
	TAD	(6201
	DCA I	(PUTCDF	/STARTING CDF
	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
	TAD	OUTFLG	/SEE IF BCOMP DID ANY WRITES TO TEMP FILE
	SNA CLA		/SKP IF YES, FORCE READ AND WRITE
	TAD	(400	/ELSE SET COUNT TO USE STUFF IN BUFFER AS IS
	CMA
	DCA	ICOUNT
	TAD	CODBGN	/COMPARE LOWEST CORE LOC USED BY CODE-1
	CLL CIA
	TAD	NEXT	/TO HIGHEST S.T. ADDR USED
	CLA CML RAL
	TAD I	(PUTCDF	/CODE CDF
	CIA
	TAD	FREFLD	/S.T. CDF PASSED BY BCOMP
	SPA CLA		/SKP IF CODE LOWER THAN SYMBOL TABLE END
	TAD	(PUTWD-OUTWRD	/ELSE WE CAN STORE DIRECTLY AND SAVE SOME I/O
	TAD	(OUTWRD
	DCA	QOUTWRD	/SET THE PROPER OUTPUT ROUTINE POINTER
RELOOP,	JMS I	(INWORD	/GET A WORD OF CODE
	DCA	TEMP
	TAD	(-5000
	TAD	TEMP	/CHECK FOR OPCODE 5000 (GOTO)
	AND	(7400
	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	QOUTWRD
	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	QOUTWRD
	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
	ISZ	ERMSG
	CIF CDF	10
	JMS I	(XERMSG	/CALL FIELD 1 ERROR MESSAGE PRINTER
	JMP I	ERMSG

	PAGE
LOADIT,	TAD	PUTWD	/SEE IF CODE IS ALREADY LOADED
	SZA CLA		/SKP IF NO
	JMP	LOADED	/ELSE SKIP READ AND LOAD
	TAD I	(OUDUMP	/TEST IF OUTPUT BUFFER WRITTEN
	SZA CLA		/SKP DUMP IF YES
	JMS I	(OUDUMP	/DUMP LAST BLOCK
	TAD	LOCTRL	/SET UP COUNTER
	CIA CLL CML
	DCA	CODSZ1
	RAL
	TAD	LOCTRH
	CIA
	DCA	CODSZ2
	DCA I	(INPTR	/ASSUME OUTPUT BUFFER USABLE AS IS
	TAD I	(OUDUMP	/TEST IF TEMP FILE WRITES DONE
	SNA CLA		/SKP IF YES
	TAD	(400	/ELSE SET COUNT TO ALLOW READ FROM BUFFER AT ONCE
	CMA		/FORCE NORMAL READ IF MORE THAN ONE BUFFERFULL
	DCA	ICOUNT	/STORE THE INPUT COUNT
	TAD	BLOCK	/SET UP BLOCK NUMBER
	DCA I	(INBLOK
LODLUP,	JMS I	(INWORD	/GET A WORD FROM TEMP FILE (OR BUFFER)
	JMS	PUTWD	/PUT IN CORE NOW
	ISZ	CODSZ1	/MORE CODE ?
	JMP	LODLUP	/YES
	ISZ	CODSZ2
	JMP	LODLUP	/YES
LOADED,	TAD	CODCDF	/SETUP CODE CDF
	CLL RTL
	RAL
	TAD	CDFZER
	DCA	CODCDF
CLRLUP,	TAD	CLREND	/IS THIS THE END OF CLEAR ?
	TAD	PUTLOC
	SZA CLA
	JMP	MORCLR	/NO, KEEP GOING
	TAD	CLRFLD	/DO FIELDS MATCH ?
	TAD	PUTCDF
	SNA CLA
	JMP	DONCLR	/YES, ARRAYS ARE CLEARED
MORCLR,	JMS	PUTWD
	JMP	CLRLUP
DONCLR,	JMS	MOVFIN	/MOVE FINI PAGE INTO 7000-7177
	JMP I	(7000	/GO READ BRTS.SV

	/BUMP POINTER AND STORE WORD IN CORE

PUTWD,	0
	ISZ	PUTLOC	/PRE INCREMENT POINTER
	JMP	PUTCDF	/JMP IF FIELD NOT CROSSED
	DCA	PUTTMP	/SAVE WORD
	TAD	PUTCDF	/PROPAGATE CARRY INTO CDF
	TAD	(10
	DCA	PUTCDF
	TAD	PUTTMP	/GET WORD BACK
PUTCDF,	HLT
	DCA I	PUTLOC
	CDF
	JMP I	PUTWD
PUTTMP,	0
	/MAKE A CDF FROM FREEHI

FREEF,	0
	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
CDFZER,	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

	/Large core image save problem fix

PATCHI,	CLA STL RTL	/TEST IF ABOUT TO SAVE FIELD 1 OR 2
	TAD I	(FLDCNT&177+200
	CLL RAR
	SZA CLA
	JMP	FLDN	/JMP IF NOT FIELD 1 OR 2
	SZL		/LINK ON IF FIELD 1
	JMP	FLD1	/JMP IF FIELD 1 TO LEAVE LAST PAGE ALONE
	TAD I	(TDFLAG&177+200 /IF FIELD 2, TEST IF 2 PAGE SYSTEM HANDLER
	SZA CLA		/SKP IF NOT 2 PAGE SYSTEM HANDLER, 27600 IS USED
FLD1,	TAD	(3700
FLDN,	TAD	TEMP
	JMP I	(RETN&177+200

	PAGE
	/ROUTINES AT START OF THIS PAGE ARE RELOCATED BY "MOVFIN"
	/TO *7000 JUST PRIOR TO EXECUTION (EDITOR OVERLAYS HERE, ETC)

FINI,	TAD I	(ERMSG	/ANY ERRORS ?
	SZA CLA
	JMP	ABORT	/YES, DON'T RUN IT
	TAD	BRTS	/READ IN BRTS FIELD 1 SECTION
	DCA	BRTSB
	JMS I	(7607
	BRTSZ1+10
	BRTLD1		/INTO HERE
BRTSB,	0
	JMP	IOERR
	CIF	10	/NOW JMS TO FIELD 1 STARTUP CODE
	TAD	BRTSB	/PASS STARTING BLOCK OF BRTS IN AC
	JMS I	(BRTBG1
	STCDF		/CALL+1 CONTAINS ADDR OF BRTS PARAMETERS

IOERR,	DCA	LINEL	/ZERO LINE NUMBER
	JMS I	(ERMSG	/PRINT MESSAGE
	IOMSG
ABORT,	TAD	(20	/PASS FIELD BITS TO RESTORE HANDLER CIF/CDFS
	JMS I	(SWAP	/SWAP OS8 BACK
	TAD	(4207	/NOW REMOVE ^C HOOKS FROM SYS:
	DCA I	(7600
	TAD	(6213
	DCA I	(7605
	JMS I	(200	/CHECK OUT W/ CI BUILDER (RELOCATED MAKECI ROUTINE)
	TAD	ABORTX	/CALLED VIA CHAIN ?(FROM EDIT)
	SNA
	JMP I	(7600	/NO, RETURN TO OS8
	DCA	EDTBLK	/YES, SAVE EDITOR START
	JMS I	(7607	/READ IN EDITOR
	EDTSIZ		/THIS MUCH
	0
OWTEMP,
EDTBLK,	0
	JMP I	(7605	/ERROR
	JMP I	(EDTBGN	/GO START EDITOR

	/FOLLOWING ROUTINES EXECUTE IN THIS PAGE NORMALLY

	/MULTIPLY 12 BITS AND 24 BITS

MUL12,	0
	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

	/OUTPUT WORD TO TEMP FILE

OUTWRD,	0
	ISZ	OCOUNT	/ANY ROOM ?
	JMP	NOWRIT	/YES
	DCA	OWTEMP	/SAVE WORD
	JMS	OUDUMP	/WRITE BLOCK
	ISZ	OUBLOK	/BUMP BLOCK NUMBER
	TAD	OUBLOK-1/RESET BUFFER 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	(7607	/WRITE BLOCK
	4210
	0
OUBLOK,	0
	JMP	IOERR
	JMP I	OUDUMP
	/CONVERT CHAR COUNT TO NUMBER OF 3/2 WORDS+1
	/CALCULATES 1+INT(2*(N+1)/3)

CVT3F2,	0
	CLL IAC		/CALCULATE 2*(N+1)
	CLL RAL		/LEAVE A CLEAR LINK
	DCA	AC1
	TAD	(-10	/SET FOR 8 STAGE SUBTRACT-SHIFT DIVIDE
	DCA	SC
	TAD	AC1	/GET 2*(N+1)
CVTLP,	STL
	TAD	(4000-600
	SMA		/SIGN BIT COMPLEMENTS IF WENT IN
	TAD	(4000+600 /RESTORE AND COMPLEMENT OTHERWISE
	RAL		/SHIFT IN QUOT BIT AND DISCARD SIGN BIT
	ISZ	SC
	JMP	CVTLP	/ITERATE
	AND	(377	/NOW MASK OUT REMAINDER
	IAC		/ALLOW FOR SIZE WORD
	DCA	NWORDS	/SAVE THE TOTAL SIZE
	TAD	NWORDS	/RETURN IT IN AC
	JMP I	CVT3F2	/--RETURN--

	END=FINI+200

	PAGE
	/ROUTINE USED TO INITIALIZE LOADER

IMAGE,	0
	TAD	(ABORTL	/MODIFY ^C HOOK POINTER FOR BLOAD TRAP ROUTINE
	DCA	BABORT
	JMS I	(ERMOVE	/SHUFFLE ERROR MESSAGE PRINTER TO FIELD 1
	CDF 10
	TAD I	(INFO+2	/GET STARTING BLOCK OF BLOAD
	TAD	(OVSEP	/OFFSET TO BLOAD OVERLAY
	CDF
	DCA I	(LDRBLK	/STORE INLINE
	CDF	10
	TAD I	(CDOPT4	/GET OPTION BITS [MNO PQR STU VWX]
	CDF
	AND	(4	/TEST FOR /V
	SZA CLA
	JMS I	(VERNUM	/JMS IF YES TO EXHIBIT BLOAD VERSION
	CDF 10
	TAD I	(CDOPT3	/GET OPTION BITS [ABC DEF GHI JKL]
	CDF
	AND	(40	/TEST IF /G SET
	SZA CLA		/SKP IF NO, COMPILE ONLY
	JMP	LSTART	/ELSE START LOADER NOW
	TAD	HIFLD
	CIA
	DCA I	(FLDCNT	/INIT CI BUILDER
	TAD I	(FLDCNT
	DCA I	(MYCORE	/AND CI STARTER
	CDF 10
	DCA I	(CDOPT6	/CLEAR =N BITS
	DCA I	(CDOPT3	/AND EARLY OPTIONS
	TAD I	(CDOPT4	/GET OPTION BITS [MNO PQR STU VWX]
	CDF
	RTL
	SZL CLA		/HAVE N SWITCH?
	JMP	NOTDSY	/DISALLOW RUNNING ON 2 PAGE SYSTEM HANDLER SYSTEM IF YES
	TAD	HIFLD
	CLL RAR
	SNA CLA		/SKP IF OVER 8K CORE
	JMP	NOTDSY	/ELSE JMP AROUND EXTRA PAGE ALLOCATION
	DCA I	(GOTTD	/FORCE EXTRA PAGE
	CLA IAC		/FLAG THE EXTRA PAGE
NOTDSY,	DCA I	(TDFLAG
	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

	PAGE
	CCB=1000	/LOC TO START BUILDING CCB

MAKECI,	0		/THIS PAGE GETS MOVED TO *200
	NOP		/NOP'D FOR VT278
	NOP		/NOP'D FOR VT278
	ISZ I	(ERMSG	/WHY ARE WE HERE?
	JMP	BOSFIX	/GENUINE ABORTION
	TAD	(CCB-1	/INITIALIZE FIRST 4 WORDS OF CCB
	DCA	X10
	DCA I	X10	/ZERO SEGMENT COUNT
	TAD	(CIF CDF /SET CIF CDF ENTRY POINT
	DCA I	X10
	TAD	PCISTRT	/ENTRY ADDR
	DCA I	X10
	TAD	(1000	/JSW BITS
	DCA I	X10
/	TAD	TDFLAG	/TEST IF SPACE ALLOCATED FOR 2 PAGE SYSTEM HANDLER
/	SZA CLA		/SKP IF NO
/	TAD	(3700	/SET FLAG TO DECREMENT HIGHEST CCB FIELD SEGMEMT 1 PAGE
/	DCA	HIDECR	/ IF YES
CCSEGS,	TAD	FLDCNT	/GET MINUS CURRENT FIELD
	CIA		/MAKE POSITIVE
	CLL RAL		/SHIFT TO AC6-8
	RTL
	DCA	TEMP	/SAVE
	TAD	CODCDF	/GET FIELD BITS OF LOWEST FIELD USED
	AND	(70
	CLL CIA
	TAD	TEMP	/COMPARE TO CURRENT FIELD
	SNL		/SKP IF CURRENT FIELD GE LOWEST FIELD
	JMP	NOCODE	/ELSE FIELD IS UNUSED
	SZA CLA		/SKP IF LOWEST FIELD
	JMP	ALLCODE	/JMP IF NOT, SAVE WHOLE FIELD
	TAD	CODBGN	/ISOLATE BLOCK BITS IN AC0-3
	AND	(7400
	DCA	TEMP2	/SAVE THEM
	TAD	TEMP2	/FORM POSITIVE PAGE COUNT
	CIA
	CLL RAR		/IN AC1-5
	TAD	TEMP	/ADD TO FIELD BITS
	DCA	TEMP
	TAD	TEMP2	/PICK UP START OF BLOCK IN CORE
ALLCODE,DCA I	X10	/STORE THE SEGMENT STARTING ADDR
	TAD	TEMP	/PICK UP PAGE COUNT/FIELD WORD
/	TAD	HIDECR	/DECREMENT PAGE COUNT IF SECOND SYS HANDLER PAGE ALLOCATED
/	AND	(3777	/MASK OUT SIGN BIT
	JMP I	(PATCHI
RETN,	AND	(3777	/MASK OUT SIGN BIT
	DCA I	X10	/NOW STORE PAGE COUNT/FIELD WORD
/	DCA	HIDECR	/ZERO OUT THE HIGH FIELD FLAG
	ISZ I	(CCB	/TALLY THE SEGMENT
NOCODE,	CLA CLL
	ISZ	FLDCNT	/NEXT FIELD ZERO?
	JMP	CCSEGS	/NO: LOOP
	TAD	PCISTRT	/STORE ADDR OF OUR STARTUP CODE
	DCA I	X10
	TAD	O300	/NOW THE PAGE COUNT/FIELD WORD
	DCA I	X10
	TAD I	(CCB
	CMA
	DCA I	(CCB	/NEGATE SEG COUNT
	JMS I	(7607	/READ CI STARTER
O300,	300		/FROM END OF BLOAD.SV
PCISTRT,CISTRT		/INTO HI CORE
LDRBLK,	0		/INIT BY "IMAGE"
	HLT		/CRASH SYS ON ERROR HERE
	TAD	(1000	/SET THE JSW NON RESTARTABLE NOW!
	DCA I	(JSW
	TAD	TDFLAG	/PASS 2 PAGE SYSTEM HANDLER FLAG
	DCA I	(FLAGTD
	TAD	MYCORE
	DCA I	(NOCORE	/AND CORE LIMIT
	TAD	(STCDF-1 /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
	HLT		/CRASH SYSTEM ON ERROR HERE
	JMP I	(7600	/FINAL SUCCESSFUL EXIT TO OS/8 -- IMAGE IS LOADED

MCICNT,	-12
FLDCNT,	-7
TDFLAG,	1		/ZERO IF BIG SYSTEM HANDLER ILLEGAL AT RUNTIME
			/NONZERO IF SPACE WAS ALLOCATED FOR IT
MYCORE,	0
/HIDECR,0		/SET TO 3700 TO DECREMENT PAGE COUNT OF HIGHEST
/			/MEMORY FIELD USED FOR 2 PAGE SYSTEM HANDLERS
	/RESTORE BATCH STATE AND EXIT IF ANY COMPILE ERROR

BOSFIX,	TAD I	(JSW	/TEST IF BATCH WAS UNTOUCHED
	AND	(400
	SNA CLA		/SKP IF YES, NO NEED TO RESTORE BATCH STATE
	TAD I 	(BIPCCL
	RAL
	SMA CLA
	JMP I	MAKECI	/BATCH NOT RUNNING
	TAD I	(BIPCCL
	AND	(70
	TAD	CDFZRO
	DCA	BOSCDF	/CDF TO BATCH FIELD
BOSLUP,	CDF 10
	TAD I	BOSPT1	/GET BATCH WRDS
BOSCDF,	HLT
	DCA I	BOSPT2	/BACK INTO POSITION
CDFZRO,	CDF
	ISZ	BOSPT1
	ISZ	BOSPT2
	JMP	BOSLUP
	JMP I	MAKECI

BOSPT1,	7600
BOSPT2,	7774

	PAGE
	/ENTRY ADDR FOR .R BLOAD JUST PRINTS VERSION NUMBER AND EXITS

	TLS
	TSF
	JMP	.-1
	CLA CLL
	JMS	VERNUM	/PRINT THE VERSION
	JMP I	(7605	/RETURN TO OS/8

	/PRINT VERSION

VERNUM,	0
	TAD	(VTEXT
	DCA	TEMP
MOREV,	TAD I	TEMP
	SNA
	JMP	VOUT
	CLL RTR
	RTR
	RTR
	JMS	TTY
	TAD I TEMP
	JMS	TTY
	ISZ	TEMP
	JMP	MOREV
VOUT,	TAD	(15
	JMS	TTX
	TAD	(12
	JMS	TTX
	JMP I	VERNUM

VTEXT,	TEXT	/BLOAD  V /
	*.-1
VERLOC,	VERSON^100+PATCH
	0


TTY,	0
	TAD	(40
	AND	(77
	TAD	(40
	JMS	TTX
	JMP I	TTY

TTX,	0
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	TTX

	/ONCE ONLY ROUTINE TO MOVE ERROR MESSAGE PRINTER TO FIELD 1

ERMOVE,	0
ERLUP,	TAD I	ERAD1
	CDF	10
	DCA I	ERAD2
	CDF
	ISZ	ERAD1
	ISZ	ERAD2
	ISZ	ERCNT
	JMP	ERLUP
	JMP I	ERMOVE
ERAD1,	ERLOC0
ERAD2,	XERMSG
ERCNT,	-400

	PAGE
ERLOC0,
	RELOC	XERMSG

	/ERROR MESSAGE PRINTER
	/EXECUTES (IF AT ALL) IN FIELD 1 IN BCOMP TEMP FILE OUTPUT BUFFER

XERMSG,	0
	DCA	EADDR	/STORE MESSAGE POINTER PASSED IN AC
	TAD	(77	/FIRST PRINT "?"
	JMS	SPCH
	JMS	SCRIBE	/WRITE IT
EADDR,	0
	CDF
	TAD I	(LINEH	/SEE IF LINE NUMBER PRESENT
	SNA
	TAD I	(LINEL
	CDF	10
	SNA CLA
	JMP	NOLINO	/JMP IF NO, DON'T PRINT IT (IGNORES LINE 0)
	JMS	SCRIBE	/WRITE "at Line"
	ATLINE
	CDF
	DCA	SPCH	/Clear leading zero flag
	TAD I	(LINEH	/PRINT HIGH ORDER DIGITS
	JMS	PSN
	CDF
	TAD I	(LINEL	/PRINT LOW ORDER DIGITS
	JMS	PSN
NOLINO,	TAD	(15	/NOW PRINT CR,LF
	JMS	SPCH
	TAD	(12
	JMS	SPCH
	CIF CDF		/RETURN TO FIELD 0
	JMP I	XERMSG

SCRIBE,	0
	TAD I	SCRIBE	/GET MESSAGE ADDR
	ISZ	SCRIBE
	DCA	MSGPTR
SCRLP,	TAD I	MSGPTR
	SNA		/SKP IF NOT EOM
	JMP I	SCRIBE	/ELSE EXIT
	JMS	SPCH
	ISZ	MSGPTR
	JMP	SCRLP
MSGPTR,	0

SPCH,	0
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	SPCH

PSN,	0
	CDF	10
	DCA	LWORD	/SAVE LINE NUMBER WORD
	AC7775		/DO 3 DIGITS
	DCA	LCNTR
/	DCA	SPCH	/CLEAR LZ SWITCH
PSNLP,	TAD	LWORD	/SHIFT NEXT DIGIT UP
	RTL
	RTL
	DCA	LWORD
	TAD	LWORD
	RAL
	AND	(17
	SZA
	JMP	NOZERO	/PRINT IT IF NONZERO
	TAD	SPCH	/ANY PREV DIGITS
	SNA CLA
	JMP	LEAD0	/NO, IGNORE IT
NOZERO,	TAD	(60
	JMS	SPCH	/OUTPUT DIGIT
LEAD0,	ISZ	LCNTR
	JMP	PSNLP
	JMP I	PSN
LWORD,	0
LCNTR,	0

ATLINE,	":;" ;0
	PAGE
UFMSG,	"U;"n;"c;"l;"o;"s;"e;"d;" ;"F;"O;"R;"-;"N;"E;"X;"T;" ;"L;"o;"o;"p;0
TBMSG,	"P;"r;"o;"g;"r;"a;"m;" ;"t;"o;"o;" ;"b;"i;"g;" ;"t;"o;" ;"r;"u;"n;0
TDMSG,	"T;"o;"o;" ;"m;"u;"c;"h;" ;"D;"A;"T;"A;0
USMSG,	"U;"n;"d;"e;"f;"i;"n;"e;"d;" ;"L;"i;"n;"e;" ;"N;"u;"m;"b;"e;"r;0
IOMSG,	"I;"/;"O;" ;"E;"r;"r;"o;"r;" ;"o;"n;" ;"S;"Y;"S;":;0

	PAGE

	RELOC
	/MAIN ENTRY POINT FOR PRE COMPILED PROGRAMS

	*7000

CISTRT,	JMP	RUNNED	/JMP IF DIRECT RUN
	CDF	10	/ELSE SEE IF BRTS PASSED MAGIC = OPTION
	TAD I	(CDOPT2	/IN HIGH ORDER BITS
	TAD	(-MAGIC
	SNA CLA		/SKP IF NO, DO FULL BASIC SYSTEM INITIALIZATION
	JMP I	(CHAIN	/JMP IF YES FOR FAST STARTUP
RUNNED,	TAD	(INFO-1	/INITIALIZE SYSTEM INFORMATION AREA ON RUN
	DCA	X10
	TAD	(NAMLST-1
	DCA	X11
	CDF	10
	DCA I	X10	/ZERO EDITOR BLOCK NUMBER
	CDF
	CIF 10
	JMS I (7700
	10		/USRIN
FINDSV,	TAD I	X11	/LOOKUP SOME SAVE FILES
	SNA
	JMP	USROUT	/DONE, KICK USR OUT
	DCA	XXXXSV	/SAVE POINTER TO NAME
	CLA IAC		/THEY'RE ON SYS
	CIF	10
	JMS I	(200
	2
XXXXSV,	0
	0
	JMP	NOTFND	/JMP IF NOT FOUND
	ISZ	X11	/BUMP TO NEXT FILE
	TAD	XXXXSV	/GET STARTING BLOCK
	IAC		/PLUS 1
ZERFIL,	CDF	10
	DCA I	X10	/INTO INFO AREA
	CDF
	JMP	FINDSV	/LOOP
NOTFND,	ISZ I	X11	/SKP IF ESSENTIAL SYSTEM COMPONENT
	JMP	ZERFIL	/JMP BACK IF NOT
	JMS I	(ERRORX	/TAKE ERROR EXIT
	1		/INCOMPLETE SYSTEM
USROUT,	CIF	10
	JMS I	(200
	11		/USR OUT
	JMP I	(CHAIN	/JMP TO CONTINUE STARTUP PROCESSING

NAMLST,	BCOMPN;0	/NOTE THAT BRTS MUST CHECK FOR BOTH
	BLOADN;0	/BCOMP AND BLOAD BEFORE ATTEMPTING A CHAIN TO BCOMP
	BRTSN;-1
	BOVN;-1
	0
BRTSN,	FILENAME BRTS.SV
BOVN,	FILENAME BASIC.OV
BCOMPN,	FILENAME BCOMP.SV
BLOADN,	FILENAME BLOAD.SV
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
	/CONTINUATION OF SAVE IMAGE STARTUP

CHAIN,	CDF	10
	DCA I	(CDOPT2
	DCA I	(CDOPT3	/ZERO OUT CD OPTION BITS
	DCA I	(CDOPT4
	DCA I	(CDOPT5
	TAD I	(INFO+3	/GET BRTS START BLOCK FROM INFORMATION AREA
	CDF
	DCA	BRTSST	/STORE INLINE
	JMS I	(7607	/NOW READ FIELD 1 SEGMENT IN
	BRTSZ1+10
	BRTLD1		/INTO HERE
BRTSST,	0
	JMS I	(ERRORX	/TAKE ERROR EXIT ON ERROR HERE
	4
	JMS I	(CORE	/GET HOST CORE SIZE
	TAD	NOCORE	/COMPARE TO REQUIRED CORE
	SPA CLA		/SKP IF HOST GE REQUIRED
	JMS I	(ERRORX	/ELSE PRINT USER ERROR MESSAGE
	3
	AC7775		/NOW SEE IF 2 PAGE SYSTEM HANDLER
	TAD I	(7612
	SZA CLA
	JMP	NOT2PG	/JMP IF NO
	TAD	FLAGTD	/IF YES, SEE IF SPACE ALLOCATED FOR IT
	SNA CLA
	JMS I	(ERRORX	/JMS IF NO TO GIVE ERROR
	2
	TAD	KEYLOC	/GET CDF TO HIGH CORE
	DCA	CDFTOP	/STORE INLINE
SWPLOOP,CDF	20	/SWAP SECOND PAGE OF HANDLER OUT NOW
	TAD I	SPTR
	DCA	STMP1
CDFTOP,	HLT
	TAD I	SPTR
	DCA	STMP2
	TAD	STMP1	/MOVE HANDLER WORD UP TO HIGH FIELD
	DCA I	SPTR
	CDF	20
	TAD	STMP2	/MOVE HIGH FIELD WORD TO FIELD 2
	DCA I	SPTR
	ISZ	SPTR
	JMP	SWPLOOP
	CDF		/NOW ADJUST THE HANDLER CIF/CDF'S TO MATCH
	TAD	CDFTOP
	AND	(70	/ISOLATE FIELD BITS
	DCA	CDFTOP
ADJLUP,	TAD I	SPTR0
	TAD	(-6300	/RANGE CHECK WORD FOR CIF/CDF N0
	CLL
	TAD	(70
	SNL CLA
	JMP	NOADJ	/JMP IF NOT CIF/CDF
	TAD I	SPTR0	/ELSE FIX DF
	AND	(7707
	TAD	CDFTOP
	DCA I	SPTR0
NOADJ,	ISZ	SPTR0
	JMP	ADJLUP	/LOOP UP TO END OF FIELD
NOT2PG,	TAD	KEYLOC+SWPINF-STCDF /SET LOW BIT INDICATING 17600 NOT SWAPPED
	RAR
	STL RAL
	DCA	KEYLOC+SWPINF-STCDF
	TAD I	(BIPCCL	/SEE IF BATCH RUNNING NOW
	RAL
	SMA CLA
	JMP	NOBAT	/JMP IF NO
	TAD I	(BIPCCL
	AND	(70	/ELSE GET SET TO SAVE BATCH STATE
	TAD	CDFO
	DCA	BATCDF	/STORE INLINE
BATCDF,	HLT
	TAD I	BATAD1	/GET A WORD
	CDF	10
	DCA I	BATAD2	/SAVE A WORD
	ISZ	BATAD2
	ISZ	BATAD1
	JMP	BATCDF
CDFO,	CDF
NOBAT,	TAD	BRTSST	/PASS STARTING BLOCK OF BRTS IN AC
	CIF	10	/NOW JMS TO FIELD 1 STARTUP OF BRTS
	JMS I	(BRTBG1
	KEYLOC		/CALL+1 CONTAINS PTR TO PARAMETER BLOCK FOR BRTS

NOCORE,	0
FLAGTD,	1
KEYLOC,	ZBLOCK	12
SPTR0,	7635		/POINTER FOR HANDLER FIELD FIXES
STMP1,	0
STMP2,	0
SPTR,	7600
BATAD1,	7774
BATAD2,	7600

	PAGE
	/ERROR MESSAGE PRINTER FOR CORE IMAGE STARTUP

ERRORX,	0
	TAD I	ERRORX	/CALL+1 CONTAINS MESSAGE NUMBER
	TAD	(MSGTAB-1
	DCA	ERRORX
	TAD I	ERRORX
	DCA	ERRORX	/POINT AT 6BIT TEXT
ERRLUP,	TAD I	ERRORX	/GET A WORD
	CLL RTR
	RTR
	RTR
	JMS	P6CH	/PRINT A CHAR
	TAD I	ERRORX	/GET WORD AGAIN
	JMS	P6CH	/PRINT ANOTHER
	ISZ	ERRORX
	JMP	ERRLUP

P6CH,	0
	AND	(77	/GET 6 BITS
	SNA		/SKP IF NOT END OF MESSAGE
	JMP	EOMESG
	TAD	(40	/MAKE 7 BITS
	AND	(77
	TAD	(40
	JMS	PCH	/PRINT IT
	JMP I	P6CH

EOMESG,	TAD	(15	/PRINT CR,LF
	JMS	PCH
	TAD	(12
	JMS	PCH
	JMP I	(7605	/EXIT TO KBM

PCH,	0
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	PCH

MSGTAB,	MSG1
	MSG2
	MSG3
	MSG4

MSG1,	TEXT	/INCOMPLETE SYSTEM/
MSG2,	TEXT	/CANNOT RUN WITH 2 PAGE SYSTEM HANDLER/
MSG3,	TEXT	/INSUFFICIENT CORE/
MSG4,	TEXT	/SYSTEM ERROR/

	PAGE
