/MARK SENSE BATCH AND PIP
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974, 1975, 1977
/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.
/
/
/
/
/
/
/MARK SENSE BATCH AND PIP		JANUARY 9, 1974
/
/
/
/			AUTHOR: 
/			MARK B. ROSENTHAL
/			DIGITAL EQUIPMENT CORPORATION
/
/ VERSION 3A 	M.H.	28-APR-77
/ VERSION 3B
/
/
/
/
/
/
/
/
/
/
/
/
/




L7775=CLA CLL CMA RTL
L7776=CLA CLL CMA RAL
L7777=CLA CLL CMA
L0002=CLA CLL CML RTL
L0001=CLA CLL IAC
CONTCH=3	/CONTINUATION CHARACTER
RUBOUT=7	/RUBOUT BITS
JOBBIT=0200	/BIT POSITION OF $JOB IN COLUMN 1
EOFCHR=6004	/END OF FILE CARD CHARACTER IS _
TABCHR=6010	/TAB CHARACTER
FFCHR=3010	/FORM FEED CHARACTER
NOCHR=6400	/# CHARACTER
RCSE=6672	/CARD READER SELECT AND SKIP IF READY
RCSD=6671	/CARD READER SKIP IF CARD DONE
RCRD=6674	/CARD READER CLEAR CARD DONE FLAG
RCSF=6631	/CARD READER SKIP IF DATA READY
RCRB=6634	/CARD READER READ BINARY
KCF=6030	/CLEAR KEYBOARD FLAG
SYSNO=CLA CLL IAC	/OS8 DEVICE NUMBER FOR SYS:
DSKNO=CLA CLL CML RTL	/OS8 DEVICE NUMBER FOR DSK:
FETCH=1
LOOKUP=2
ENTER=3
CLOSE=4
DECODE=5
CHAIN=6
USRIN=10
USROUT=11
F0=0
F1=10
JSBITS=7746		/JOB STATUS WORD



*10
XR1,	0
XR2,	0
XRCDR,	0
XROPT,	0


*20
ERROR=JMS I .;	XERR
CONVRT=JMS I .;	XCONVR
OUT=JMS I .;OUTAD,	XOUT
SAVFLD=JMS I .;XSAVDF
USR=JMS I .;	200
KEYWD,	0;0;0;0
TEMP1,	0
TEMP2,	0
TEMP3,	0
TEMP4,	0
TEMP5,	0
OPTCNT,	0	/OUTPUT BUFFER COUNT
OPTSW,	0	/OUTPUT BUFFER THREE WAY SWITCH
KEYADR,	0
KEYVAL,	0
ERRFLG,	0
ERRCNT,	0
CONFLG,	0
LNCNT,	0
USRFLG,	0
OFILE,	ZBLOCK 5	/OUTPUT FILE DEVICE, LENGTH, AND NAME
CDRFLG,	-1	/CDRIN TO PASSES LAST CARD IF 0
BCLSW,	0
CDREOF,	-1
DEVENT,	0	/ENTRY ADDRESS OF OUTPUT DEVICE HANDLER
IOERR,	0	/ERROR NUMBER
VERNO9,	ISZ IOERR
IOER8,	ISZ IOERR
CDRER7,	ISZ IOERR
OPTER6,	ISZ IOERR
OPTER5,	ISZ IOERR
OPTER4,	ISZ IOERR
OPTER3,	ISZ IOERR
OPTER2,	ISZ IOERR
OPTER1,	JMP I .+1
	IOERR1


*200
START,	ISZ USRFLG;SKP	/IS THE USR IN CORE?
	JMP CD		/YES
	CIF 10;JMS I (7700;USRIN  /LOCK USR IN CORE
CD,	L7777		/SET FLAG FOR USR IN CORE
	DCA USRFLG
	CIF 10;USR;DECODE;0	/DELETE TENTATIVE FILES
	TAD (7577	/COPY OUTPUT FILE #1 (NAME AND DEVICE)
	DCA XR1
	CDF F1
	TAD I (7644	/TEST /V SWITCH
	AND (4
	SZA CLA
	JMP VERNO9	/YES - PRINT VERSION NUMBER
	TAD I XR1
	SNA		/IF NOT SPECIFIED,
	DSKNO		/USE DEVICE DSK:
	DCA OFILE
	TAD I XR1
	SNA		/WAS A NAME GIVEN?
	JMP OPTER1	/NO
INIT1,	DCA OFILE+1
	TAD I XR1
	DCA OFILE+2
	TAD I XR1
	DCA OFILE+3
	TAD I XR1
	DCA OFILE+4
	TAD (OFILE+1
	DCA BLOKNO	/SET FILE NAME ADDRESS
	TAD I (7605	/GET SECOND OUTPUT DEVICE SPECIFICATION
	DCA I (7600	/MOVE TO FIRST FOR SPOOLING IN BATCH
	CDF
	TAD BLOKNO	/GET ADDRESS OF FILE NAME
	DCA I (CLOSNM	/AND SAVE FOR CALL TO CLOSE
	TAD (OPTDEV&7600+1	/SET DEVICE HANDLER SPACE
	DCA DEVHDL
	TAD OFILE
	CIF 10;USR;FETCH	/FETCH DEVICE HANDLER
DEVHDL,		OPTDEV&7600+1	/2 PAGES
		JMP OPTER2	/ERROR - CANNOT FETCH HANDLER
	TAD DEVHDL	/MOVE ENTRY ADDRESS
	DCA DEVENT	/TO PAGE ZERO
	TAD OFILE	/ENTER THE FILE NAME AS TENTATIVE
	CIF 10;USR;ENTER
BLOKNO,		OFILE+1		/FILE NAME, STARTING BLOCK RETURNED HERE
FILLEN,		0		/RETURNS FILE LENGTH HERE
		JMP OPTER3	/CANNOT ENTER FILE
	CIF 10;USR;USROUT	/DISMISS THE USR
	DCA USRFLG	/CLEAR USR IN CORE FLAG 
	CDF 10
	TAD BLOKNO	/SAVE STARTING BLOCK NO. FOR BATCH
	DCA I (7620
	TAD OFILE	/SAVE DEVICE NO. FOR BATCH
	AND (17
	DCA I (7617
	TAD I (7643	/GET OPTIONS
	CDF F0
	AND (2100	/      /B OR /F
	SNA
	DCA I (EOFJMP	/IF NEITHER, THEN WE CHAIN TO BATCH
	CLL RTL		/GET /B OUT OF AC
	SZA CLA		/IF AC=0 START WITH BASIC KEYWORDS
	TAD (FORKEY-BASKEY
	TAD (BASKEY-15
	DCA KEYADR
	JMP I (INIT5


PAGE
INIT5,	TAD (BPRI2	/TAILOR IT FOR BATCH PROCESSING
	DCA I (BPRKEY	/"PRINT #4,"
	TAD (BINP2
	DCA I (BINKEY	/"INPUT #3,"
	TAD (BSTO2
	DCA I (BSTKEY	/"CLOSE# 4\STOP"
	TAD (BEND2
	DCA I (BENKEY	/"CLOSE #4\END"
	CDF F1
	DCA I (CBAS5	/NO JUMP
	DCA I (DATL48	/NO JUMP
	TAD (CL2M1A	/".R LOADER_*GENIOX"
	DCA I (CL2SX
	TAD I (7643	/TEST /I OPTION (INTERACTIVE)
	AND (10
	SNA CLA
	JMP INIT6
	TAD BASJMP	/SET UP FOR FILES 0 & 1
	DCA I (CBAS5	/SET UP THE JMP
	TAD BASJM1	/SET UP JUMP
	DCA I (DATL48
	TAD (CL2M1	/".R LOADER_*"
	DCA I (CL2SX
	CDF F0
	TAD (BPRI
	DCA I (BPRKEY
	TAD (BINP
	DCA I (BINKEY
	TAD (BSTO
	DCA I (BSTKEY
	TAD (BEND
	DCA I (BENKEY
INIT6,	CDF 10
	TAD I (7644	/TEST /T OPTION
	AND (20
	SNA CLA
	TAD (BATLPT-BATTTY
	TAD (BATTTY
	CIF CDF F1
	JMS I (MOVODV
	TAD I (7645	/TEST /2 OPTION
	AND (200
	SNA CLA
	JMP INIT3
	TAD (CF2	/FORTRAN 2
	DCA I (FORADR
	TAD (CL2
	DCA I (LOAADR
	TAD (DATX2
	JMP INIT4
INIT3,	TAD (CF4	/FORTRAN 4
	DCA I (FORADR
	TAD (CL4
	DCA I (LOAADR
	TAD (DATX4	/INITIALIZE $DATA
INIT4,	DCA I (DATFTN
	TAD I (DATFTN
	DCA I (DATADR
	TAD (SAVARA
	DCA I (SAVPNT
	DCA I (NAMCNT
	CDF F0
	DCA BCLSW	/NO BCL CARDS YET
	L7777
	DCA CDREOF	/RESET EOF SWITCH
	TAD I (BLOKNO	/SET STARTING BLOCK NUMBER
	DCA I (OPTBLK
	TAD (OPTBUF-1
	DCA XROPT
	TAD (-200
	DCA OPTCNT
	L7775
	DCA OPTSW
	DCA ERRCNT	/CLEAR COUNT OF CARDS IN ERROR
	JMP I (READY

BASJMP,	JMP CBAS7&177+INIT5
BASJM1,	JMP DATL49&177+INIT5


PAGE
READY,	JMS I (CDRIN	/READ A CARD
	JMP I (EOF	/END OF FILE SENSED
	TAD I XRCDR	/GET COLUMN 1
	DCA KEYWD	/SAVE AS KEYWORD BITS
	TAD XRCDR
	DCA XR2


/TRANSLATE LINE NUMBER
	TAD (-5
	DCA TEMP1
	DCA LNCNT	/CLEAR COUNT
	DCA KEYWD+3	/CLEAR COLUMN 2-6 KEYWORD BITS
LNLP,	TAD I XRCDR	/GET LINE NO. COLUMN
	DCA TEMP2	/SAVE CHAR
	TAD (6000
	AND TEMP2	/GET KEYWORD BITS
	CLL RAL
	RTL
	TAD KEYWD+3
	CLL RTL
	DCA KEYWD+3
	TAD (1777
	AND TEMP2	/GET CHAR
	SNA
	JMP LNLPEN	/IGNORE BLANKS
	CONVRT		/TRANSLATE
	JMP LNLPEN	/IGNORE RUBOUTS
	TAD (-"9
	SMA SZA
	JMP LNERR	/NOT A NUMBER
	TAD ("9-"0
	SPA
	JMP LNERR	/NOT A NUMBER
	TAD ("0
LNLP1,	DCA I XR2	/INSERT CHARACTER IN OUTPUT BUFFER
	ISZ LNCNT	/COUNT THIS CHARACTER
LNLPEN,	ISZ TEMP1	/GOT ALL LINE NUMBER COLUMNS?
	JMP LNLP	/NO - LOOP.
	JMP I (KEYTRA	/GO TRANSLATE KEYWORD


LNERR,	ERROR
	JMP LNLP1


MAKNA2,	0		/FIELD 1 OUTPUT ROUTINE FOR MAKNAM
	CIF CDF F1
	JMS I (MAKNA3
	JMP I MAKNA2

OOUT2,	0
	OUT
	CIF CDF F1
	JMP I OOUT2

GETCD1,	0
	TAD I XRCDR
	CIF CDF F1
	JMP I GETCD1

/FOR RETURN TO CALLING FIELD
/PRESERVES AC AND LINK WHILE PUTTING
/CIF CDF TO DATA FIELD AT ADDRESS
/SPECIFIED AS FIRST WORD AFTER CALL
XSAVDF,	0
	DCA XSAVD1
	RDF
	TAD (CIF CDF
	DCA XSAVD2
	CDF
	TAD I XSAVDF
	ISZ XSAVDF
	DCA XSAVD3
	TAD XSAVD2
	DCA I XSAVD3
	TAD XSAVD1
	JMP I XSAVDF
XSAVD1,	0
XSAVD2,	0
XSAVD3,	0

PAGE
XERR,	0
K7600,	7600
	TAD ("?		/OUTPUT A "?"
	ISZ ERRFLG	/FLAG ERROR ON THIS CARD
	JMP I XERR

TIME=12

CDRIN,	0		/READ A CARD INTO THE BUFFER
	SAVFLD;CDRCIF	/SAVE DATA FIELD FOR RETURN
	DCA ERRFLG	/CLEAR ERROR FLAG FOR THIS CARD
	ISZ CDREOF	/HAVE WE SEEN EOF?
	JMP CDRCIF	/YES - STILL EOF
	ISZ CDRFLG	/SHOULD WE PASS LAST CARD?
	JMP REINIT	/YES
CDRIN6,	JMS CDRIN5	/RESET TIME OUT COUNTERS
	TAD (-50	/YES - READ IT INTO THE CDR BUFFER
	DCA TEMP1	/40 COLUMNS (DECIMAL)
	TAD (CDRBUF-1
	DCA XRCDR
CDRIN3,	RCSE		/CARD READY?
	JMP CDRIN4	/TEST TIME OUT
	JMS CDRIN5	/RESET TIME OUT COUNT
CDRIN1,	JMS KBRD	/TEST KEYBOARD (AFTER TIME OUT LOOP)
	RCSD		/CARD DONE?
	SKP
	JMP CDRIN7	/YES - TOO FEW COLUMNS
	RCSF		/CHARACTER READY?
	JMP CDRIN1	/NO - TRY CARD DONE
	JMS CDRIN5	/RESET TIME OUT COUNT
	RCRB		/YES - READ BINARY
CDRIN2,	DCA I XRCDR	/AND STORE IT
	ISZ TEMP1	/DON'T READ MORE THAN BUFFER CAN HOLD
	JMP CDRIN1	/TRY CARD DONE AGAIN
	RCSD		/WAIT FOR END OF CARD - OR ELSE!
	JMP .-1
	RCRD	/IF THIS ISN'T CLEARED, 
		/FORTRAN IV BECOMES VERY UNHAPPY!
	JMP CDRIN8
CDRIN7,	RCRD	/FORTRAN IV AGAIN
	ISZ TEMP1	/ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL)
	JMP CDRER7	/ERROR!
	DCA I XRCDR
CDRIN8,	TAD (CDRBUF-1	/INIT BUFFER POINTERS AGAIN
	DCA XRCDR
	TAD (-50
	DCA TEMP1
	TAD (-EOFCHR	/TEST FOR FIRST COLUMN=EOFCHR AND REST =0
EOFLP,	TAD I XRCDR	/GET NEXT COLUMN
	SZA CLA
	JMP REINIT	/NON-ZERO - NOT EOF
	ISZ TEMP1
	JMP EOFLP	/LOOP
	JMP CDRCIF	/END OF FILE CARD
REINIT,	TAD (CDRBUF-1
	DCA XRCDR
	ISZ CDRIN	/SKIP RETURN IF NOT EOF
	L7777		/RESET EOF SWITCH
CDRCIF,	0
	DCA CDREOF
	L7777		/SET TO READ A NEW CARD NEXT TIME
	DCA CDRFLG
	JMP I CDRIN

CDRIN4,	JMS KBRD	/TEST TIME OUT
	JMP CDRIN3	/TRY SELECTING CARD AGAIN

CDRIN5,	0	/RESET TIME OUT
	DCA TIMOUT
	TAD (-TIME
	DCA TIMOU2
	JMP I CDRIN5

KBRD,	0
	KSF		/KEYBOARD?
	JMP KBRDTM	/NO - TIME
	KRS		/IS IT ^C?
	AND (177
	TAD (-3
	SNA CLA
	JMP I K7600	/YES - RETURN TO OS-8
KBRDTM,	ISZ TIMOUT	/TIMED OUT YET?
	JMP I KBRD	/NO
	ISZ TIMOU2
	JMP I KBRD	/LIKEWISE
	KCF		/IGNORE ANYTHING TYPED BEFORE THIS
	TAD (207	/NOTHING - WAKE HIM UP
	JMS I (TOUT
	TAD (MSGJAM	/IT COULD BE JAMMED
	DCA TEMP1
	JMS I (TTYOUT
KBRD1,	KSF		/WAIT FOR A CHARACTER OR READER
	JMP KBRD3
KBRD2,	KRS		/GET THE CHAR
	AND (177	/WITHOUT PARITY
	TAD (-3		/IS IT ^C?
	SNA
	JMP I K7600	/YES - TO MONITOR
	KCF	/IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT.  ELSE CLEAR IT
	TAD (3-32	/IS IT ^Z?
	SNA CLA
	JMP CDRCIF	/YES - EOF
	JMP CDRIN6	/GO BACK AND TIME OUT AGAIN
KBRD3,	RCSE		/SELECT A CARD?
	JMP KBRD1	/NO - TRY KEYBOARD
	TAD (-50	/RESET COUNT
	DCA TEMP1
	TAD (CDRBUF-1	/AND POINTER
	DCA XRCDR
	JMP CDRIN3+2	/YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT

CDRJA1,	KSF
	JMP .-1
	JMP KBRD2

TIMOUT,	0
TIMOU2,	0

PAGE
KEYTRA,	TAD I XRCDR	/GET KEYWORD COLUMN
	DCA KEYWD+1
	TAD I XRCDR	/DITTO
	DCA KEYWD+2
/CONVERT KEYWORD BITS TO NUMBER
	TAD (KEYWD-1	/POINT INDEX REGISTER TO KEYWORD BUFFER
	DCA XR1
	TAD (-4		/SET COUNT OF WORDS
	DCA TEMP1
	DCA KEYVAL	/ZERO KEYWORD VALUE
WRDLP,	TAD (-14	/SET BIT COUNT
	DCA TEMP2
	TAD I XR1	/GET WORD
BITLP,	ISZ KEYVAL	/BUMP BIT VALUE
	CLL RAL		/SHIFT INTO LINK
	SZL		/IS THIS ONE ON?
	JMP KEYFND	/YES - KEYWORD FOUND
	ISZ TEMP2	/COUNT BITS
	JMP BITLP
	ISZ TEMP1	/COUNT WORDS
	JMP WRDLP
	JMS I (LNOUT	/SEND THE LINE NO.
	JMP I (TEXTRA	/ALL BITS OFF - NO KEYWORD


KEYBAD,	ERROR
	OUT
	JMP KEYBLK


	TAD I XR1	/GET NEXT WORD
KEYFND,	SZA CLA		/TEST THIS WORD
	JMP KEYBAD	/ERROR - MORE THAN ONE KEYWORD MARKED
	ISZ TEMP1	/COUNT WORDS
	JMP KEYFND-1	/AND LOOP

/OUTPUT THE KEYWORD
	TAD KEYVAL	/IS IT A BATCH CONTROL LANGUAGE COMMAND?
	TAD (-14
	SMA SZA CLA
	JMP KEYOUT
	L7777		/FOUND A BCL CARD
	DCA BCLSW	/GENERATE "$END" BEFORE CLOSING FILE
	CIF CDF F1
	JMP I (BCLTRA	/YES - HANDLE THAT SPECIALLY


KEYOUT,	JMS I (LNOUT	/SEND LINE NUMBER
	TAD KEYADR
	TAD KEYVAL
	DCA TEMP1
	TAD I TEMP1	/GET ADDRESS OF KEYWORD
	SNA
	JMP KEYBAD	/IF ZERO - UNUSED KEYWORD
	DCA TEMP1	/ELSE SAVE IT
	TAD TEMP1	/IS THIS "INPUT" OR "PRINT
	TAD (-BPRI2	/BEING FUDGED UNDER BASIC?
	SNA
	JMP NOSGN	/PRINT - CHECK FOR NUMBER SIGN
	TAD (BPRI2-BINP2
	SZA CLA
	JMP KEYOU5	/NONE - ALL'S WELL
NOSGN,	TAD (-40	/SET COUNT
	DCA TEMP3
NOSGN1,	TAD I XRCDR	/IS NEXT CHAR BLANK?
	SZA
	JMP NOSGN2	/NO - IS IT #
	ISZ TEMP3
	JMP NOSGN1
	JMP NOSGN3	/REST IS BLANK
NOSGN2,	TAD (-NOCHR	/IS IT "#"?
	SZA CLA
	JMP NOSGN3	/NO
	TAD TEMP1	/YES - USE "INPUT" OR "PRINT"
	TAD (-BPRI2
	SZA CLA
	TAD (BINP-BPRI
	TAD (BPRI
	DCA TEMP1
NOSGN3,	TAD (CDRBUF+7
	DCA XRCDR
KEYOU5,	JMS I (UNPACK	/AND OUTPUT KEYWORD
KEYBLK,	TAD (" 		/INSERT BLANK AFTER KEYWORD
	OUT
	JMP I (TEXTRA


PAGE
UNPACK,	0	/OUTPUT PACKED 6-BIT ASCII TEXT
	TAD I TEMP1	/IS FIRST CHAR = 00?
	AND (7700
	SZA CLA
	JMP KEYOU1	/NO - NORMAL 6-BIT TRANSLATE
	TAD (211	/YES - THIS IS TAB RATHER THAN END
	OUT		/OUTPUT IT
	JMP KEYOU3	/AND GET SECOND CHARACTER
KEYOU1,	TAD I TEMP1	/GET FIRST CHARACTER
	CLL RTR
	RTR
	RTR
	JMS KEYOU2	/AND OUTPUT IT
KEYOU3,	TAD I TEMP1	/GET SECOND CHARACTER
	JMS KEYOU2	/AND OUTPUT IT
	ISZ TEMP1	/POINT TO NEXT TWO CHARACTERS
	JMP KEYOU1	/ETC.

KEYOU2,	0
	AND (77		/MASK FOR THE LOW ORDER BITS
	SNA
	JMP I UNPACK	/CHARACTER IS 00 - END OF KEYWORD
	TAD (-37	/<CR>?
	SNA
	TAD (215-337	/THIS WILL BE 215 WHEN WE'RE DONE
	SPA
	TAD (100
	TAD (237
	OUT		/OUTPUT THE CHARACTER
	JMP I KEYOU2

TTYOUT,	0	/USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY
	TAD (TOUT	/SWITCH OUTPUT ROUTINES
	DCA OUTAD
	JMS UNPACK
	TAD (XOUT	/RESET OUTPUT ROUTINES
	DCA OUTAD
	JMP I TTYOUT	/RETURN


LNOUT,	0		/OUTPUT THE LINE NUMBER
	SAVFLD;LNCIF
	TAD LNCNT	/GET NUMBER OF CHARS
	CMA
	DCA TEMP1
	TAD (CDRBUF	/START WITH COLUMN 2
	DCA XR2
LNOUT1,	ISZ TEMP1;SKP	/MORE DIGITS?
	JMP LNOUT2	/NO
	TAD I XR2;OUT
	JMP LNOUT1
LNOUT2,	TAD LNCNT	/ANY DIGITS?
	SNA CLA
	JMP LNCIF
	TAD (" ;OUT	/YES - SUFFIX A BLANK
LNCIF,	0
	JMP I LNOUT


PAGE
/TRANSLATE TEXT
TEXTRA,	DCA CONFLG	/CLEAR CONTINUATION FLAG
	DCA TEMP1	/CLEAR COUNT OF BLANK CHARACTERS
	TAD (-40	/32 COLUMNS OF TEXT (DECIMAL)
	DCA TEMP3
TEXLP1,	TAD I XRCDR
	SNA		/BLANK?
	JMP TEXBLK	/YES - COUNT A BLANK
	TAD (-CONTCH	/CONTINUATION CHARACTER?
	SNA
	JMP TEXCON	/YES - ENOUGH OF THIS CARD
	TAD (CONTCH
	CONVRT		/TRANSLATE THE CHARACTER
	JMP TEXLP2	/RUBOUT? - GET THE NEXT CHARACTER
	DCA TEMP2	/SAVE THE CHARACTER
	JMS TEXBOU	/OUTPUT THE COUNTED BLANKS
	TAD TEMP2
	OUT		/OUTPUT THE CHARACTER
TEXLP2,	ISZ TEMP3	/COUNT COLUMNS
	JMP TEXLP1
	TAD (215	/OUTPUT A <CR>
	OUT
	JMP TEXFIN


TEXCON,	JMS TEXBOU
	CLA CMA
	DCA CONFLG	/SET THE CONTINUATION FLAG
	JMP TEXFIN


TEXBLK,	ISZ TEMP1	/COUNT THE BLANKS
	JMP TEXLP2	/GET THE NEXT CHARACTER


TEXBOU,	0		/OUTPUT BLANKS
	TAD TEMP1
	CMA
	DCA TEMP1
TEXBO1,	ISZ TEMP1	/MORE BLANKS
	SKP
	JMP I TEXBOU	/NO - RETURN
	TAD (" 		/YES - OUTPUT A BLANK
	OUT
	JMP TEXBO1


TEXFIN,	TAD ERRFLG	/DID THIS CARD HAVE AN ERROR?
	SZA CLA
	ISZ ERRCNT	/YES - COUNT IT
	JMP I (READY	/PROCESS NEXT CARD


/CARD CODE TO ASCII CONVERSION ROUTINE
XCONVR,	0		/INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII
	SAVFLD;XCOCIF	/SAVE DATA FIELD FOR RETURN
	DCA CONVR1	/SAVE 12 BIT CARD CODE
	TAD (RUBOUT
	AND CONVR1
	TAD (-RUBOUT
	SNA CLA		/WAS CHARACTER RUBBED OUT?
	JMP XCOCIF	/YES - RETURN 0 IN AC
	ISZ XCONVR	/NOT RUBBED OUT - SKIP RETURN
	TAD CONVR1
	RTL
	RTL
	AND (7		/GET ZONE BITS
	CLL RAL
	DCA CONVR2	/2*ZONE BITS
	TAD CONVR2
	RTL
	TAD CONVR2	/10*ZONE BITS
	DCA CONVR2
	TAD CONVR1
	RTL
	RAL
	AND (7770	/1-9 "PUNCHES"
	SNA
	JMP CONVR3	/IF ALL OFF DON'T INCREMENT COUNT
	CLL RAL		/SHIFT NEXT BIT INTO LINK
	ISZ CONVR2	/COUNT THE BIT
	SNL
	JMP .-3		/LOOP IF OFF
	SZA CLA
	JMP CONILL	/IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER
CONVR3,	TAD CONVR2	/GET DISPLACEMENT OF CHAR IN TABLE
	CLL RAR		/GET WORD DISPLACEMENT IN AC
	TAD (TRTAB	/ADDRESS OF WORD
	DCA CONVR2
	TAD I CONVR2	/GET WORD
	SZL
	JMP .+4		/IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD
	RTR
	RTR
	RTR
	AND (77		/MASK FOR LOW PART OF WORD
	SNA
	JMP CONVR4	/ZERO IN TABLE IS ILLEGAL CODE (MAYBE)
	TAD (240
	JMP XCOCIF	/RETURN WITH 8 BIT ASCII IN AC
CONVR4,	TAD CONVR1	/GET 12-BIT CARD CODE
	TAD (-TABCHR	/IS IT A TAB CHAR?
	SNA
	JMP CONVR5	/YUP!
	TAD (TABCHR-FFCHR	/HOW ABOUT A FORM FEED?
	SZA CLA
	JMP CONILL	/NOPE - IT'S REALLY BAD
	TAD (214-211	/IT'S FORM FEED
CONVR5,	TAD (211	/IT'S TAB
	JMP XCOCIF
CONILL,	ERROR		/SET ERROR FLAG; RETURN "?" IN AC
XCOCIF,	0
	JMP I XCONVR

CONVR1,	0
CONVR2,	0


PAGE
/OUTPUT A CHARACTER.  RETURNS .+1 IF CHARACTER IS
/JUST STORED IN BUFFER.  RETURNS .+2 IF NO MORE SPACE IN
/EMPTY.  RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE
/MORE BLOCKS IN THE EMPTY.
XOUTP,	0		/OUTPUT ROUTINE
	ISZ OPTSW	/THREE WAY SWITCH
	JMP XOUT1
	DCA XOUT2	/SAVE CHAR IN TEMP
	L7777
	TAD XROPT	/BACK UP 2 WORDS
	DCA XOUT3
	TAD XOUT2	/GET FIRST HALF OF CHARACTER
	RTL
	RTL
	AND K7400
	TAD I XOUT3	/ADD IN FIRST CHARACTER
	DCA I XOUT3
	ISZ XOUT3
	TAD XOUT2	/GET SECOND HALF OF CHARACTER
	RTR
	RTR
	RAR
	AND K7400
	TAD I XOUT3	/ADD IN SECOND CHARACTER
	DCA I XOUT3
	ISZ OPTCNT	/IS BUFFER FULL?
	JMP XOUT6	/NO - RETURN NORMALLY
	JMS I DEVENT	/CALL DEVICE HANDLER
		4200	/TWO PAGES OF OUTPUT FROM FIELD 0
		OPTBUF	/BUFFER ADDRESS
OPTBLK,		0	/BLOCK NUMBER
		JMP OPTER4	/ERROR DOING OUTPUT
	ISZ OPTBLK	/INCREMENT BLOCK NUMBER
	TAD (OPTBUF-1	/RESET BUFFER POINTER
	DCA XROPT
	TAD (-200	/AND BUFFER LENGTH /2
	DCA OPTCNT
	ISZ XOUTP	/SKIP RETURN IF BLOCK WRITTEN
	ISZ I (FILLEN	/MORE BLOCKS IN EMPTY?
	ISZ XOUTP	/YES - SKIP AGAIN
XOUT6,	L7775		/RESET 3-WAY SWITCH
	DCA OPTSW
	JMP I XOUTP	/RETURN

XOUT1,	DCA I XROPT	/SAVE CHARACTER IN BUFFER
	JMP I XOUTP

XOUT2,	0
XOUT3,	0


XOUT,	0
	DCA CLOSLN	/SAVE CHAR IN A CONVENIENT TEMP
	TAD CLOSLN
	JMS XOUTP	/OUTPUT THE CHARACTER
	SKP
	JMP OPTER5	/FILLED UP AVAILABLE SPACE BEFORE ^Z
	TAD CLOSLN	/WAS IT <CR>?
	TAD (-215
	SZA CLA
	JMP I XOUT	/RETURN
	TAD (212
	JMP XOUT+1


EOF,	DCA KEYVAL	/FINISH UP ANY BCL CARD IN PROGRESS
	DCA CONFLG	/ZERO THESE TO GET US AROUND
	DCA LNCNT	/THE TESTS IN BCLHUH
	CIF CDF F1
	JMP I (BCLTRA
EOF2,	ISZ BCLSW	/WERE THERE ANY BCL CARDS?
	JMP EOF1	/NO
	TAD (MEND	/YES - SEND "$END"
	DCA TEMP1
	JMS I (UNPACK
EOF1,	TAD (32		/^Z
	JMS XOUTP	/OUTPUT CHAR
	JMP .-1		/BLOCK NOT YET FULL
K7400,	7400		/BLOCK WRITTEN
	TAD I (BLOKNO	/BLOCK WRITTEN
	CIA
	TAD OPTBLK	/GET LENGTH OF FILE WRITTEN
	DCA CLOSLN	/SET LENGTH FOR CLOSE
	ISZ USRFLG;SKP	/IS USR IN CORE?
	JMP EOF3	/YES
	CIF 10;JMS I (7700;USRIN	/BRING IN THE USR
EOF3,	L7777		/SET USR IN CORE FLAG
	DCA USRFLG
	TAD OFILE	/GET DEVICE NUMBER
	CIF 10;USR;CLOSE
CLOSNM,		0	/POINTER TO NAME
CLOSLN,		0	/LENGTH OF FILE
		JMP OPTER6
	TAD CLOSLN
	CIA
	RTL
	RTL
	AND (7760	/GET MINUS LENGTH IN BITS 0-7
	CDF 10
	TAD I (7617
	DCA I (7617	/SET LENGTH AND DEVICE NO. FOR BATCH
	CDF
	JMP I (ERRDEC	/CONVERT NUMBER OF ERRORS TO DECIMAL


PAGE
/CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE
ERRDEC,	TAD (DECN-1	/START POWERS OF 10 AT 1000
	DCA XR1
	TAD (-4
	DCA TEMP1	/FOUR POWERS OF 10
	DCA TEMP5	/CLEAR LEADING ZEROES FLAG
	TAD ERRCNT	/SET VALUE
	DCA TEMP4
	TAD (TOUT	/FUDGE OUTPUT CALL
	DCA OUTAD
	JMS CONDEC	/CONVERT TO DECIMAL
	TAD (XOUT	/RESTORE OUTPUT CALL
	DCA OUTAD
	TAD (NOMES	/SET UP TO PRINT "NO"
	DCA TEMP1
	TAD TEMP5	/DID WE PRINT A NUMBER?
	SNA CLA
	JMS I (TTYOUT	/NO - PRINT "NO"
	TAD (CDMES	/PRINT "CARDS IN ERROR"
	DCA TEMP1
	JMS I (TTYOUT
EOFJMP,	JMP I (CD	/DONE WITH THIS ONE - CALL COMMAND DECODER
	SYSNO		/LOAD SYS: NUMBER FOR LOOKUP
	CIF 10;USR;LOOKUP
BATBLK,		BATNAM
		0
		JMP IOER8
	TAD BATBLK
	DCA CHNBLK
	L0001
	DCA I (JSBITS	/KEEP USR ACROSS CHAIN
	CIF 10;USR;CHAIN	/NOW CHAIN TO BATCH
CHNBLK,		0


CONDEC,	0		/CONVERT A NUMBER TO DECIMAL
	SAVFLD;CONCIF	/SAVE DATA FIELD FOR RETURN
DIGLP,	TAD I XR1	/GET THIS POWER OF 10
	DCA TEMP2	/AND SAVE IT
	DCA TEMP3	/CLEAR THIS DIGIT
DIGLP1,	TAD TEMP4	/GET NUMBER TO BE CONVERTED
	TAD TEMP2	/DIVIDE BY SUBTRACTING
	SPA
	JMP DIGLP2	/WENT NEGATIVE - DONE
	ISZ TEMP3	/BUMP COUNT
	DCA TEMP4	/SAVE REDUCED VALUE
	JMP DIGLP1
DIGLP2,	CLA
	TAD TEMP3	/GET VALUE OF THIS DIGIT
	SZA
	JMP DIGOUT	/NOT A ZERO - PRINT IT
	TAD TEMP5	/IF ZERO - IS IT LEADING?
	SNA CLA
	JMP DIGLPE	/YES - DON'T PRINT IT
DIGOUT,	ISZ TEMP5	/IF PRINTING, THEN ZEROES ARE NOT LEADING
	TAD (260	/CONVERT TO ASCII
	OUT
DIGLPE,	ISZ TEMP1	/LAST DIGIT?
	JMP DIGLP	/NO - LOOP
CONCIF,	0
	JMP I CONDEC	/RETURN


TOUT,	0		/SEND A CHARACTER TO THE TTY
	TLS
	TSF
	JMP .-1
	TAD (-215	/WAS THE CHARACTER <CR>?
	SZA CLA
	JMP I TOUT	/NO - RETURN
	TAD (212	/YES - TYPE A LINE FEED
	JMP TOUT+1


IOERR1,	CDF F0
	CLA		/TYPE ERROR MESSAGE
	TAD IOERR	/GET NUMBER
	CLL RAL
	TAD (IOETAB-1
	DCA XR1
	TAD I XR1	/GET ADDRESS OF MESSAGE
	DCA TEMP1
	DCA IOERR	/CLEAR ERROR NUMBER
	JMS I (TTYOUT	/PRINT IT
	TAD I XR1	/GO TO RESTART ADDRESS
	DCA TEMP1
	JMP I TEMP1



PAGE
OPTDEV,	ZBLOCK 400	/TWO PAGES FOR DEVICE HANDLER
OPTBUF,	ZBLOCK 400	/TWO PAGES FOR OUTPUT BUFFER
CDRBUF,	DECIMAL;ZBLOCK 40;OCTAL
BATNAM,	TEXT "BATCH@SV";*.-1
MEND,	TEXT "_$END_"
NOMES,	TEXT "NO"
CDMES,	TEXT " CARDS IN ERROR_"
MSGJAM,	TEXT "LOAD MORE CARDS OR TYPE ^Z_"
IOEM1,	TEXT "NO OUTPUT FILE SPECIFIED_"
IOEM2,	TEXT "CAN'T FETCH DEVICE HANDLER_"
IOEM3,	TEXT "CAN'T ENTER FILE_"
IOEM4,	TEXT "OUTPUT ERROR_"
IOEM5,	TEXT "FILE TOO BIG_"
IOEM6,	TEXT "CAN'T CLOSE FILE_"
IOEM7,	TEXT "CARD IN READER BACKWARDS.  TYPE SPACE TO CONTINUE._"
IOEM8,	TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/
VERM9,	TEXT "MSBAT - VERSION 3B_@@@@@@"

IOETAB,	IOEM1;START
	IOEM2;START
	IOEM3;START
	IOEM4;START
	IOEM5;START
	IOEM6;START
	IOEM7;CDRJA1
	IOEM8;7600
	VERM9;START

	DECIMAL
DECN,	-1000
	-100
	-10
	-1
	OCTAL

/CHARACTER CODE TRANSLATION TABLE
TRTAB,
/0 IN ROWS 12-0
	0021 /?1
	2223 /23
	2425 /45
	2627 /67
	3031 /89
/1
	2043 /0C
	4651 /FI
	5457 /LO
	6265 /RU
	7004 /X$
/2
	1442 /,B
	4550 /EH
	5356 /KN
	6164 /QT
	6772 /WZ
/3
	3632	/>:
	0106	/!&
	7540	/]@
	0000	/<FORM FEED>  ?
	0000	/??
/4
	1641 /.A
	4447 /DG
	5255 /JM
	6063 /PS
	6671 /VY
/5
	3400 /<?
	0000 /??
	0000 /??
	0000 /??
	0000 /??
/6
	3303	/;#
	0705	/'%
	7337	/[?	THE REAL ?
	0077	/<TAB>  _
	0000	/??
/7
	7435	/\=
	1315	/+-
	1217	/*/
	7610	/^(
	1102	/)"


/BASIC KEYWORDS
BDAT,	TEXT "DATA"
BCAL,	TEXT "CALL"
BCLO,	TEXT "CLOSE"
BDEF,	TEXT "DEFINE"
BCHN,	TEXT "CHAIN"
BDIM,	TEXT "DIM"
	TEXT "NSION"
BCHG,	TEXT "CHANGE"
BEND,	TEXT "END"
BEND2,	TEXT "CLOSE #4\END"
BFIL,	TEXT "FILE"
BGOS,	TEXT "GOSUB"
BIF,	TEXT "IF"
BINP,	TEXT "INPUT"
BINP2,	TEXT "INPUT #3:"
BLIS,	TEXT "LIST"
BNEX,	TEXT "NEXT"
BOLD,	TEXT "OLD"
BPRI,	TEXT "PRINT"
BPRI2,	TEXT "PRINT #4:"
BREA,	TEXT "READ"
BRES,	TEXT "RESTORE"
BRUN,	TEXT "RUN"
BFOR,	TEXT "FOR"
BGOT,	TEXT "GOTO"
BIFE,	TEXT "IF END"
BLET,	TEXT "LET"
BLIN,	TEXT "LINPUT"
BNEW,	TEXT "NEW"
BON,	TEXT "ON"
BRND,	TEXT "RANDOM"
BOV,	TEXT "OVERLAY"
BREP,	TEXT "REPLACE"
BUNS,	TEXT "UNSAVE"
BREM,	TEXT "REMARK"
BRET,	TEXT "RETURN"
BSAV,	TEXT "SAVE"
BSTO,	TEXT "STOP"
BSTO2,	TEXT "CLOSE #4\STOP"

/FORTRAN KEYWORDS
FCMN,	TEXT "@COMMON"
FASN,	TEXT "@ASSIGN"
FCPX,	TEXT "@COMPLEX"
FBKS,	TEXT "@BACKSPACE"
FCNT,	TEXT "@CONTINUE"
FBKD,	TEXT "@BLOCK DATA"
FDTA,	TEXT "@DATA"
FCAL,	TEXT "@CALL"
FDEF,	TEXT "@DEFINE FILE"
FDO,	TEXT "@DO"
FEND,	TEXT "@END"
FEQU,	TEXT "@EQUIVALENCE"
FFOR,	TEXT "@FORMAT"
FGOT,	TEXT "@GO TO"
FINT,	TEXT "@INTEGER"
FPAU,	TEXT "@PAUSE"
FREAL,	TEXT "@REAL"
FREW,	TEXT "@REWIND"
FSBR,	TEXT "@SUBROUTINE"
FCMT,	TEXT "C"	/COMMENT
FDIM,	TEXT "@DIMENSION"
FDBP,	TEXT "@DOUBLE PRECISION"
FEF,	TEXT "@END FILE"
FEXT,	TEXT "@EXTERNAL"
FFUN,	TEXT "@FUNCTION"
FIF,	TEXT "@IF"
FLOG,	TEXT "@LOGICAL"
FREAD,	TEXT "@READ"
FRET,	TEXT "@RETURN"
FSTO,	TEXT "@STOP"
FWRI,	TEXT "@WRITE"
BASKEY,
/COLUMN 7		ROW
	BDEF		/12
	BIFE		/11
	BLET		/0
	BLIS		/1
	BNEW		/2
	BON		/3
	BOV		/4
	BRND		/5
	BREM		/6
	BRES		/7
	BRUN		/8
BSTKEY,	BSTO		/9
/COLUMN 8		ROW
	BDIM		/12
BINKEY,	BINP		/11
	BLIN		/0
	BNEX		/1
	BOLD		/2
	BFIL		/3
BPRKEY,	BPRI		/4
	BREA		/5
	BREP		/6
	BRET		/7
	BSAV		/8
	BUNS		/9
/COLUMNS 2-6	COLUMN	ROW
	BCAL	/2	12
BENKEY,	BEND	/2	11
	BCLO	/3	12
	BFOR	/3	11
	BCHN	/4	12
	BGOS	/4	11
	BCHG	/5	12
	BGOT	/5	11
	BDAT	/6	12
	BIF	/6	11


FORKEY,
/COLUMN 7		/ROW
	FCAL		/12
	FDEF		/11
	FDO		/0
	FEND		/1
	FEQU		/2
	FFOR		/3
	FGOT		/4
	FINT		/5
	FPAU		/6
	FREAL		/7
	FREW		/8
	FSBR		/9
/COLUMN 8		ROW
	FCMT		/12
	FDIM		/11
	FDBP		/0
	FEF		/1
	FEXT		/2
	FFUN		/3
	FIF		/4
	FLOG		/5
	FREAD		/6
	FRET		/7
	FSTO		/8
	FWRI		/9
/COLUMN 2-6	COLUMN	ROW
	0	/2	12
	0	/2	11
	0	/3	12
	FCMN	/3	11
	FASN	/4	12
	FCPX	/4	11
	FBKS	/5	12
	FCNT	/5	11
	FBKD	/6	12
	FDTA	/6	11


	FIELD 1





*17


OXR1,	0
OTEMP1,	0
CHAR,	0
PUTPNT, 0
GETPNT, 0
DATFTN,	0		/ADDRESS OF FORTRAN $RUN
GETCHR=JMS I .;XGETCH
PUTCHR=JMS I .;XPUTCH
BCLIN=JMS I .;XBCLIN
OPTION=JMS I .;XOPTIO
MOV6=JMS I .;XMOV6
COLNAM=JMS I .;XCOLNA
OUTNAM=JMS I .;XOUTNA
ISIT=JMS I .;XISIT
SEND=JMS I .;XSEND
TSTCR=JMS I .;XTSTCR
CDRTRA=JMS I .;BCLTRA+1
ISNUM=JMS I .;XISNUM
OUT1=JMS I .;OOUT1
*200


/PUT A CHARACTER INTO A 6-BIT BUFFER
PUTCH1=XGETCH
PUTCH4=CON628
XPUTCH, 0
        TAD (-215       /IF <CR>, IT BECOMES 37
        SZA
        TAD (215-337
        TAD (337
        AND (77         /AND OFF 6 BITS
        DCA PUTCH1      /SAVE IT IN A TEMP
        TAD PUTPNT      /GET POINTER TO CHARACTER IN 6-BIT BUFFER
        ISZ PUTPNT      /AND BUMP POINTER
        CLL RAR		/GET WORD DISPLACEMENT
        TAD I XPUTCH    /ADD IN BASE ADDRESS
        ISZ XPUTCH      /BUMP RETURN ADDRESS
        DCA PUTCH4      /SAVE ADDRESS OF WORD CONTAINING CHAR
        SZL             /LINK HAS FIRST OR LAST HALF INDICATOR
        JMP PUTCH2
        TAD PUTCH1      /FIRST HALF - ROTATE CHAR INTO HIGH BITS
        CLL RTL;RTL;RTL
        DCA PUTCH1
        TAD I PUTCH4    /GET ANY CHARACTER ALREADY THERE
        AND (77
        JMP PUTCH3
PUTCH2, TAD I PUTCH4
        AND (7700       /GET CHARACTER ALREADY THERE
PUTCH3, TAD PUTCH1      /ADD IN NEW CHARACTER
        DCA I PUTCH4    /STORE THEM BOTH
        JMP I XPUTCH    /AND RETURN


/GET A CHARACTER FROM A 6-BIT BUFFER
XGETCH, 0
        TAD XGETCH      /MOVE RETURN ADDRESS TO CON628
        DCA CON628
        TAD GETPNT      /GET POINTER TO CHARACTER
        ISZ GETPNT      /BUMP IT FOR NEXT TIME
        JMP CON628+1    /ENTER CONVERSION ROUTINE


/CONVERT 6-BIT ASCII TO 8-BIT
/AC HAS POINTER TO CHARACTER
/ARGUMENT IS BASE ADDRESS OF BUFFER
CO628X=XGETCH
CON628, 0
        CLL RAR /GET WORD DISPLACEMENT IN AC
        TAD I CON628    /ADD BASE ADDRESS OF BUFFER
        ISZ CON628      /BUMP RETURN ADDRESS
        DCA CO628X      /SAVE ADDRESS
        TAD I CO628X    /GET WORD CONTAINING CHARACTER
        SZL             /LINK HAS INDICATOR FOR FIRST OR LAST CHAR
        JMP .+4
        RTR;RTR;RTR     /FIRST CHAR - PUT IN LOW BITS
        AND (77
        JMS XSEND3   /GET PROPER 8-BIT REPRESENTATION
	DCA CHAR	/SAVE IT
	TAD CHAR	/RETURN WITH IT IN AC
        JMP I CON628    /RETURN


XSEND3,	0
	TAD (-37
	SNA
	TAD (215-337
	SPA
	TAD (100
	TAD (237
	JMP I XSEND3


GETCDR,	0
	CIF CDF F0
	JMS I (GETCD1	/GET A CHAR FROM THE CDR BUFFER
	JMP I GETCDR


OOUT1,	0
	CIF CDF F0
	JMS I (OOUT2
	JMP I OOUT1


MOVODV,	0
	DCA .+2
	MOV6;0;BATOUT
	CIF F0	/RETURN DF=1
	JMP I MOVODV


XTSTCR,	0
	GETCHR;BCLBUF
	TAD (-215
	SNA CLA
	ISZ XTSTCR
	L7777
	TAD GETPNT
	DCA GETPNT
	JMP I XTSTCR


PAGE
/SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE
/BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL.  AN OPTION IS
/RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/".  IT'S NAME
/IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," ,
/"=",OR <CR>.  THE NAME IS TERMINATED BY ANY ONE OF THE
/PREVIOUS DELIMITERS.  IF IT IS TERMINATED BY A "=" AND
/THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME,
/THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A
/"/" , "," , OR <CR>.  THE SUBROUTINE CALL IS FOLLOWED BY A
/POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY
/A ZERO ENTRY.  EACH ENTRY POINTS TO AN OPTION CONTROL
/BLOCK IN THE FOLLOWING FORM:
/               OPTION CONTROL WORD
/               (FILE NAME SPACE IF NEEDED - 6 WORDS)
/               TEXT "OPTION NAME"
/
/THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS:
/               BIT 0:  ON RETURN THIS BIT WILL BE SET IF
/                       THE OPTION WAS FOUND, AND CLEARED
/                       IF NOT
/		BIT1:	ON RETURN THIS BIT IS SET IF A NAME
/			WAS GIVEN WITH THE OPTION
/               BIT 2:  SET IF OPTION HAS ALLOCATED 6 WORDS
/                       FOR A POSSIBLE FILE NAME.  CLEARED
/                       IF NOT
/               BITS 6-8:  NUMBER OF CHARACTERS -1 OF SHORT
/                       FORM OF OPTION
/               BITS 9-11: DIFFERENCE BETWEEN SIZES OF
/                       SHORT AND LONG FORMS
/                       THE SUM OF BITS 6-8 AND BITS 9-11
/                       SHOULD TOTAL THE LENGTH OF THE
/                       LONG FORM-1
/
/THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT
/DEVICE, NAME, AND EXTENSION.
/
XOPTIO, 0

/TURN OFF ALL OPTIONS
        TAD I XOPTIO    /GET ADDRESS OF LIST OF OPTION ADDRESSES
        DCA OPTLIS      /SAVE IT
OPTIO1, TAD I OPTLIS    /GET OPTION ADDRESS
        ISZ OPTLIS      /POINT TO NEXT ONE
        SNA
        JMP OPTIO2      /DONE TURNING OFF ALL OPTIONS
        DCA OPTCTL
        TAD I OPTCTL    /GET OPTION CONTROL WORD
        AND (1777       /CLEAR FIRST BIT
        DCA I OPTCTL
        JMP OPTIO1      /LOOP

/SEARCH BCL BUFFER FOR "/"
OPTIO2, DCA GETPNT      /START AT BEGINNING OF BATCH CONTROL LINE
OPTIO3, GETCHR;BCLBUF	/GET A CHARACTER FROM THE BUFFER
	ISIT		/IS IT "/" OR <CR>?
		OPTIS3;OPTIS4-1
	JMP OPTIO3	/NO - KEEP LOOKING
OPTI3A,	TAD GETPNT      /YES - SAVE IT'S POSITION
        DCA OPTBEG
        TAD I XOPTIO    /GET ADDRESS OF LIST AGAIN
        DCA OPTLIS      /AND SAVE IT

/FOUND A "/" - TRY ALL OPTIONS
OPTIO4, TAD OPTBEG      /START COMPARISON OF OPTION WITH CHARACTER AFTER "/"
        DCA GETPNT
        TAD I OPTLIS    /GET ADDRESS OF OPTION CONTROL WORD
        ISZ OPTLIS      /AND BUMP POINTER FOR NEXT TIME
        SNA             /IS THE LIST ENDED?
	JMP I (OPTIER	/YES - OPTION WAS INVALID
        DCA OPTCTL      /NO - SAVE ADDRESS OF CONTROL WORD
        TAD I OPTCTL    /GET CONTROL WORD
        RTL
        SPA CLA         /DOES IT HAVE SPACE FOR A FILE NAME
        TAD (6          /YES - ADD SIZE OF THE SPACE
        TAD OPTCTL      /ADD ADDRESS OF OPTION
        IAC             /BUMP ONE FOR CONTROL WORD
        DCA OPTTEX      /SAVE ADDRESS OF OPTION TEXT
        TAD I OPTCTL    /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD
        RAR;RTR
        AND (7
        CMA             /NEGATE IT (INCREMENTED BY ONE)
        DCA OPTCT1      /SAVE IN COUNTER
        DCA OPTCT2      /ZERO CHARACTER POSITION
/COMPARE OPTION WITH CONTENTS OF BCL BUFFER
OPTIO5,	JMS OPTI6A
        SZA CLA         /ARE THEY THE SAME?
        JMP OPTIO4      /NO - TRY NEXT OPTION
        ISZ OPTCT1      /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE?
        JMP OPTIO5      /NO - KEEP COMPARING

        TAD GETPNT      /SAVE CURRENT BUFFER POSITION
        DCA OPTTM2
        TAD I OPTCTL    /GET REMAINING LENGTH FROM CONTROL WORD
        AND (7
        CMA
        DCA OPTCT1
OPTIO6, ISZ OPTCT1      /DONE WITH REMAINING CHARACTERS?
        SKP
        JMP OPTIO7	/YES - SUCCESS
	JMS OPTI6A
        SNA CLA         /ARE THEY THE SAME?
        JMP OPTIO6      /YES - KEEP GOING
        TAD OPTTM2      /NO - MOVE POINTER BACK TO SHORT FORM
        DCA GETPNT
	JMP OPTIO7

OPTI6A,	0
	TAD OPTCT2
	ISZ OPTCT2
	JMS I (CON628
OPTTEX,		0
	CIA
	DCA OPTTM1
	GETCHR;BCLBUF
	TAD OPTTM1
	JMP I OPTI6A


OPTRET,	ISZ XOPTIO	/INCREMENT RETURN ADDRESS
	DCA GETPNT	/SET POINTER TO BEGINNING OF BUFFER
        JMP I XOPTIO


OPTLIS, 0
OPTCTL,	0
OPTBEG, 0
OPTCT1, 0
OPTCT2, 0
OPTTM1, 0
OPTTM2, 0


/TEST DELIMITER AFTER OPTION
OPTIO7, GETCHR;BCLBUF	/GET NEXT BUFFER CHARACTER
	ISIT		/IS IT "=", "," ,"/", OR <CR>?
		OPTIS1;OPTIS2-1
	JMP I (OPTIER	/NONE OF THESE
OPTIO8,	TAD I OPTCTL    /YES - GET CONTROL WORD
        RTL
        SMA CLA         /DOES IT TAKE A FILE NAME?
	JMP I (OPTIER      /NO - ERROR
        TAD OPTCTL      /GET ADDRESS OF FILE NAME SPACE
        IAC
        DCA .+2
	COLNAM		/AND COLLECT A NAME INTO IT
OPTTM3,         0
		JMP I (OPTIER      /ERROR RETURN
	TAD I OPTCTL	/TURN ON NAME BIT
	AND (1777
	TAD (2000
	DCA I OPTCTL
OPTIO9,	TAD I OPTCTL    /GET CONTROL WORD
        AND (3777
        TAD (4000       /TURN ON OPTION FOUND BIT
        DCA I OPTCTL
	JMP I (OPTI10


PAGE
/ON ERROR, REPORT IT
OPTIER,	TAD I (OPTBEG	/OPTION BEGINS AT THIS POSITION
	JMS OUTERR	/OUTPUT THE ERROR
		OPTERM

/SQUISH THE CURRENT OPTION OUT OF BCL BUFFER
OPTI10,	L7777           /BACK UP OVER "/"
	TAD I (OPTBEG	/POINT TO BEGINNING OF OPTION
	JMS BCLSQU	/SQUISH OUT THIS OPTION
        L7777
	TAD I (OPTBEG
	JMP I (OPTIO2	/GO LOOK FOR MORE OPTIONS


/SQUISH OUT A PORTION OF THE BCL BUFFER
/	TAD X	/POSITION OF FIRST CHAR OF SQUISH
/	JMS BCLSQU
/GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER
/SQUISH CHARS.  ONE CHAR PRECEDING IT IS TESTED,
/AND IS KEPT IF IT IS A "/" OR <CR>
BCLSQU,	0
	DCA PUTPNT	/AC POINTS TO BEGINNING OF AREA TO BE SQUISHED
	TAD PUTPNT	/SAVE THE POINTER
	DCA OUTERR
	L7777
	TAD GETPNT
	DCA GETPNT	/TEST LAST CHAR OF STUFF TO BE SQUISHED
	GETCHR;BCLBUF
	ISIT		/IS IT "/", OR <CR>?
		BCLIS1;BCLIS2-1
BCLSQ1,	GETCHR;BCLBUF	/GET A CHAR
	TAD (-215	/IS IT <CR>?
	SNA CLA
	JMP BCLSQ3	/YES - DONE
BCLSQ2,	TAD CHAR	/RESTORE CHAR
	PUTCHR;BCLBUF	/PUT THE CHAR IN THE BUFFER
	JMP BCLSQ1	/GET ANOTHER CHAR
BCLSQ3,	TAD (215	/PUT A <CR>
	PUTCHR;BCLBUF
	TAD OUTERR	/RESTORE POINTER
	DCA GETPNT
	JMP I BCLSQU	/RETURN


/SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER
/TO THE OUTPUT BUFFER
/	TAD X	/POSITION OF FIRST CHAR IN BUFFER TO BE SENT
/	JMS OUTERR
/	A	/ADDRESS OF ERROR MESSAGE TO PRECEDE IT
/		/SIX-BIT ASCII
OUTERR,	0
	DCA GETPNT	/SET BEGINNING OF BCL LINE TO OUTPUT
	TAD I OUTERR	/GET ERROR MESSAGE ADDRESS
	ISZ OUTERR
	SEND		/PRINT IT
OUTER1,	GETCHR;BCLBUF	/GET A CHARACTER
	ISIT		/IS IT "," ,"/", OR <CR>?
		OUTIS1;OUTIS2-1
	TAD CHAR	/NO - SEND CHAR
	OUT1
	JMP OUTER1
OUTER2,	TAD (215
	OUT1
	JMP I OUTERR	/RETURN


/TEST A CHAR AND JUMP IF IN LIST
/	JMS XISIT
/	A1	/ADDRESS OF LIST OF NEGATIVE OF CHARS
/		/TERMINATED BY A POSITIVE OR ZERO
/	A2-1	/ADDRESS -1 OF LIST OF
/		/TRANSFER ADDRESSES
XISIT,	0
	DCA ISIT1	/SAVE CHAR
	TAD I XISIT	/GET LIST OF CHARS
	ISZ XISIT
	DCA ISIT2
	TAD I XISIT	/GET LIST OF ADDRS - 1
	ISZ XISIT
	DCA ISIT3
ISIT4,	TAD I ISIT2	/GET THE NEXT CHAR
	ISZ ISIT2
	ISZ ISIT3
	SMA
	JMP ISIT5	/END OF LIST SIGNALLED BY ENTRY>=0
	TAD ISIT1	/IS IT THE CHAR?
	SZA CLA
	JMP ISIT4	/NO - TRY THE NEXT
	TAD I ISIT3	/GET SEND ADDRESS
	DCA XISIT
ISIT5,	CLA
	JMP I XISIT

ISIT1,	0
ISIT2,	0
ISIT3,	0


PAGE
/COLLECT A NAME FROM THE BUFFER
/	JMS XCOLNA
/		X	/ADDRESS OF SPACE TO RECEIVE NAME
/	JMP ERR		/INVALID NAME
XCOLNA,	0
	TAD I XCOLNA
	DCA .+3
	MOV6;ZER6;0
	TAD I XCOLNA	/ARGUMENT IS ADDRESS TO PUT NAME
	ISZ XCOLNA
	DCA COLPU1+2	/SAVE IT FOR USE AS PUTCHR ARG
	L7776		/SET NAME - EXTENSION SWITCH FOR NAME
	DCA COLSW
	TAD (COLIS1	/SET TO COLLECT ANYTHING
	DCA COLIS3	/I.E. DEVICE, FILE, OR EXTENSION
	TAD (COLIS2-1
	DCA COLIS3+1
	TAD GETPNT	/SAVE POINTER TO BEGINNING OF NAME
	DCA COLNP1
COLGE1,	TAD GETPNT	/SAVE POINTER TO BEGINNING OF SECTION
	DCA COLNP2	/OF NAME
COLGE2,	GETCHR;BCLBUF	/GET A CHAR
	ISIT		/IS IT ":",".","/", "," , OR <CR>?
COLIS3,		0;0
	JMP COLGE2

COLDEV,	JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0
	ISZ COLIS3	/REMOVE ":" FROM LIST
	ISZ COLIS3+1
	JMP COLGE1	/COLLECT NEXT PART OF NAME

COLFIL,	JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
	ISZ COLSW	/NEXT TIME COLLECT EXTENSION
	TAD (COLIS1+2	/REMOVE "." FROM LIST
	DCA COLIS3
	TAD (COLIS2+1
	DCA COLIS3+1
	JMP COLGE1	/COLLECT NEXT PART OF NAME

COLEXT,	ISZ COLSW	/ARE WE COLLECTING NAME OR EXTENSION?
	JMP COLEX1	/NAME
	JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12
	JMP COLEX2
COLEX1,	JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
COLEX2,	ISZ XCOLNA	/NO ERRORS
	JMP COLEX3

COLERR,	CLA
	TAD COLNP1	/POINT TO BEGINNING OF NAME
	JMS I (OUTERR	/SEND IT AS ERROR MESSAGE
		COLERM
COLEX3,	TAD COLNP1	/POINT TO BEGINNING OF NAME
	JMS I (BCLSQU	/SQUISH IT OUT
	JMP I XCOLNA	/RETURN

COLMOV,	0
	TAD I COLMOV	/FIRST ARG IS POSITION
	ISZ COLMOV
	DCA PUTPNT
	TAD I COLMOV	/SECOND ARG IS COUNT
	ISZ COLMOV
	DCA COLCT1
	TAD CHAR	/GET DELIMITER
	CIA
	DCA COLCH1	/SAVE FOR TEST
	TAD CHAR
	TAD (-"Z
	DCA COLCH2	/ANOTHER TEST
	TAD COLNP2	/POINT TO BEGINNING OF THIS PART
	DCA GETPNT
COLMV1,	GETCHR;BCLBUF	/GET NEXT CHAR
	TAD COLCH1	/SUBTRACT THE DELIMITER
	SNA
	JMP I COLMOV	/DELIMITER - WE'RE DONE
	TAD COLCH2	/CHAR-"Z"
	SMA SZA
	JMP COLERR	/NOT ALPHA-NUMERIC
	TAD ("Z-"A
	SMA
	JMP COLPUT	/ALPHABETIC
	TAD ("A-"9
	SMA SZA
	JMP COLERR	/NOT NUMERIC
	TAD ("9-"0
	SPA
	JMP COLERR	/NOT NUMERIC
COLPUT,	CLA
	ISZ COLCT1	/HAVE WE USED UP OUR COUNT?
	JMP COLPU1	/NO - PUT THE CHAR
	L7777		/YES - SET COUNTER TO SKIP
	DCA COLCT1
	JMP COLMV1	/GET NEXT CHAR
COLPU1,	TAD CHAR
	PUTCHR;0	/PUT THE CHAR IN THE USER SPACE
	JMP COLMV1	/GET THE NEXT CHAR


COLSW,	0	/FILE NAME OR EXTENSION SWITCH
COLNP1,	0	/POINTER TO BEGINNING OF NAME
COLNP2,	0	/POINTER TO BEGINNING OF NAME PART
COLCH1,	0	/TEMP LOC FOR COLMOV
COLCH2,	0	/DITTO
COLCT1,	0	/DITTO

PAGE
XMOV6,	0
	TAD I XMOV6	/GET "FROM" ADDRESS
	ISZ XMOV6
	DCA MOV61
	TAD I XMOV6	/GET "TO" ADDRESS
	ISZ XMOV6
	DCA MOV62
	TAD (-6
	DCA MOV63
MOV64,	TAD I MOV61
	DCA I MOV62
	ISZ MOV61
	ISZ MOV62
	ISZ MOV63
	JMP MOV64
	JMP I XMOV6	/RETURN
MOV61,	0
MOV62,	0
MOV63,	0


XBCLIN,	0
	DCA PUTPNT	/START AT BEGINNING OF BCL BUFFER
	JMS I (SENDKY	/SEND THE KEYWORD
	DCA MOV61	/CLEAR THE BLANK COUNTER
BCLIN5,	JMS BCLIN3	/GET NEXT CARD AND PUT IT INTO BCL BUFFER
	JMP BCLIN7+2	/CARD NOT CONTINUED - DONE
	CIF F0
	JMS I (CDRIN	/READ ANOTHER CARD
	JMP BCLIN7+2	/EOF
	TAD (-10
	DCA BCLIN4
BCLIN6,	JMS I (GETCDR	/GET FIRST 8 CHARS
	SZA CLA		/TEST FOR ZERO
	JMP BCLIN7	/NON-ZERO - ERROR
	ISZ BCLIN4
	JMP BCLIN6
	JMP BCLIN5	/OK - PUT IT IN BUFFER

BCLIN7,	CDF F0
	DCA I (CDRFLG	/SET CDRIN TO RETURN THIS CARD AGAIN
	CDF F1
	TAD (215	/PUT A <CR>
	PUTCHR;BCLBUF
	TAD (215;OUT1
	DCA GETPNT	/SET POINTER TO BEGINNING
	JMP I XBCLIN	/RETURN

BCLIN4,	0
BCLIN3,	0
	TAD (-40
	DCA BCLIN4
BCLIN9,	JMS I (GETCDR	/GET NEXT CDR CHAR
	SNA
	JMP BCLI13	/BLANK
	TAD (-CONTCH
	SNA
	JMP BCLI10	/CONTINUATION
	TAD (CONTCH
	CIF F0
	JMS I (XCONVR
	JMP BCLIN8	/RUBOUT
	DCA XMOV6	/SAVE THE CHAR
	JMS BCLI14	/SEND THE BLANKS
	TAD XMOV6
	OUT1		/SEND IT
	TAD XMOV6
	PUTCHR;BCLBUF	/PUT IT
	TAD PUTPNT
	TAD (-BCLSIZ^2+2	/BCL BUFFER FULL?
	SMA CLA
	JMP BCLI11	/FULL - ERROR
BCLIN8,	ISZ BCLIN4	/COUNT COLUMNS
	JMP BCLIN9	/LOOP
	JMP I BCLIN3
BCLI10,	ISZ BCLIN3	/SKIP RETURN FOR CONTINUATION
	DCA MOV61	/CLEAR THE BLANK COUNTER
	SEND;BCL10E	/"_$"
	TAD (211;OUT1	/<TAB>
	JMP I BCLIN3	/RETURN

BCLI11,	SEND;BCL11E	/SEND ERROR
BCLI12,	CIF F0
	JMS I (CDRIN	/GET THE NEXT CARD
	JMP BCLIN7+2
	JMS I (GETCDR	/GET THE NEXT COLUMN
	DCA BCLIN4	/SAVE THIS COLUMN
	TAD (JOBBIT	/IS THIS A $JOB CARD?
	AND BCLIN4
	SNA CLA
	JMP BCLI12	/NO - FLUSH TO $JOB
	TAD (-JOBBIT-1
	AND BCLIN4
	SZA CLA
	JMP BCLI12
	JMP BCLIN7	/YES - DONE

BCLI13,	ISZ MOV61	/ANOTHER BLANK
	JMP BCLIN8

BCLI14,	0
	TAD MOV61
	CMA
	DCA MOV61
BCLI15,	ISZ MOV61;SKP
	JMP I BCLI14
	TAD (" ;OUT1
	JMP BCLI15




PAGE
BCLTRA,	JMP I .+1	/GO FINISH UP LAST BCL COMMAND
	BCLHUH	/HUH? - I.E. WHICH COMMAND WAS IT?
	CIF CDF F0
	JMP I (TEXFIN	/TO COPY A DECK UNTIL THE NEXT BCL
			/COMMAND - JMS BCLTRA+1

BCLHU1,	0		/JMS HERE WITH ARG = TRANSFER ADDRESS
	TAD I BCLHU1	/GET TRANSFER ADDRESS
	DCA BCLHU1
	TAD (BCLHUH	/ON NEXT BCL CARD - NOTHING TO FINISH
	DCA BCLTRA+1
	CIF CDF F0	/FIELD 0!
	JMP I BCLHU1	/GO GO GO


BCLHUH,	CDF F0
	TAD I (KEYVAL	/GET KEYWORD VALUE
	CDF F1
	TAD (BCLGO	/USE IT TO GET TRANSFER ADDRESS
	DCA OTEMP1
	TAD I OTEMP1
	DCA OTEMP1
	CDF F0
	TAD I (CONFLG	/WAS LAST CARD CONTINUED?
	CDF F1
	SZA CLA
	JMS BCLHU2	/YES - ERROR
	CDF F0
	TAD I (LNCNT	/DID THIS CARD HAVE A LINE NUMBER?
	CDF F1
	SNA CLA
	JMP I OTEMP1	/YES - GO TO IT!
	CIF CDF F0
	JMS I (LNOUT	/OUTPUT THE LINE NUMBER
	JMS BCLHU2	/WHAT'S IT DOING WITH A NUMBER ANYWAY?
	JMP I OTEMP1	/NOW WE GO.

BCLHU2,	0
	CDF F0
	ISZ I (ERRFLG
	CDF F1
	SEND;BCLHM1	/"?_"
	JMP I BCLHU2


BCLEOF,	JMS BCLHU1;EOF2


CERR,	JMS BCLHU1;KEYBAD


XOUTNA,	0
	TAD I XOUTNA	/GET ADDRESS OF NAME
	ISZ XOUTNA
	DCA OUTNA2
	TAD GETPNT	/SAVE BUFFER INPUT POINTER
	DCA OUTNA6
	DCA OUTNA3	/SET FLAG FOR NO NAME
	JMS OUTNA4;0;-4	/SEND 4 CHARS FROM POSITION 0
	TAD OUTNA3
	SNA CLA
	JMP .+3		/NO DEVICE - NO ":"
	TAD (":
	OUT1
	JMS OUTNA4;4;-6	/SEND 6 CHARS FROM POSITION 4
	TAD (12		/SET UP TO GET EXTENSION
	DCA GETPNT
	JMS OUTNA1	/GET FIRST CHAR
	JMP OUTNA5	/NO EXTENSION
	CLA
	TAD (".
	OUT1
	JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12
OUTNA5,	TAD OUTNA6	/RESTORE BUFFER INPUT POINTER
	DCA GETPNT
	JMP I XOUTNA

OUTNA1,	0
	GETCHR
OUTNA2,	0
	TAD (-300	/IS IT NULL?
	SNA
	JMP I OUTNA1	/YES - DONE
	ISZ OUTNA1	/SKIP RETURN
	TAD (300
	JMP I OUTNA1
OUTNA3,	0	/NAME PRESENT SWITCH

OUTNA4,	0
	TAD I OUTNA4	/GET CHAR POSITION
	ISZ OUTNA4
	DCA GETPNT
	TAD I OUTNA4	/GET NO OF CHARS
	ISZ OUTNA4
	DCA OUTN41
OUTN42,	JMS OUTNA1	/GET A CHAR
	JMP I OUTNA4	/NULL - DONE
	OUT1
	ISZ OUTNA3	/SET NAME PRESENT
	ISZ OUTN41
	JMP OUTN42
	JMP I OUTNA4	/DONE - RETURN
OUTN41,	0
OUTNA6,	0


PAGE
XSEND,	0
	SZA		/IF AC =0, ADDRESS IS ARG OF CALL
	JMP XSEND4
	TAD I XSEND		/GET MESSAGE ADDRESS
	ISZ XSEND
XSEND4,	DCA OTEMP1
XSEND1,	TAD I OTEMP1
	CLL RTR;RTR;RTR
	JMS XSEND2
	TAD I OTEMP1
	JMS XSEND2
	ISZ OTEMP1
	JMP XSEND1

XSEND2,	0
	AND (77
	SNA
	JMP I XSEND	/NULL ENDS MESSAGE
	JMS I (XSEND3	/GET 8-BIT REPRESENTATION
	OUT1
	JMP I XSEND2


MAKNAM,	0
	TAD (DECN	/START CONVERSION AT 100
	CDF F0
	DCA I (XR1
	L7775		/CONVERT 3 DIGITS
	DCA I (TEMP1
	ISZ NAMCNT	/BUMP NAME COUNTER
	TAD NAMCNT
	DCA I (TEMP4
	L0001
	DCA I (TEMP5	/SAVE LEADING ZEROES
	TAD (MAKNA2
	DCA I (OUTAD
	CDF F1
	TAD I MAKNAM	/MOVE DEFAULT NAME TO OUTPUT AREA
	DCA .+3
	MOV6;FILNAM;0
	TAD I MAKNAM
	ISZ MAKNAM
	DCA MAKNA3+2
	TAD (7		/PUT NUMBER AT POSITION 7-9
	DCA PUTPNT
	CIF F0
	JMS I (CONDEC	/OUTPUT NUMBER
	TAD (XOUT	/RESTORE OUTPUT ROUTINE
	CDF F0
	DCA I (OUTAD
	CDF F1
	JMP I MAKNAM	/RETURN

MAKNA3,	0
	PUTCHR;0
	CIF CDF F0
	JMP I MAKNA3
NAMCNT,	0


XISNUM,	0
	TAD (-"9
	SMA SZA
	JMP XISNU1
	TAD ("9-"0
	SMA
	ISZ XISNUM
XISNU1,	CLA
	JMP I XISNUM


SAVNAM,	0
	TAD SAVPNT
	DCA SAV1+2	/PUT NAME IN LIST
	TAD SAVPNT
	TAD (-SAVTOP		/ARE WE AT TOP OF LIST?
	SNA
	JMP I SAVNAM	/YES - DON'T SAVE NAME
	TAD (SAVTOP+6
	DCA SAVPNT	/ADVANCE POINTER FOR NEXT TIME
	TAD I SAVNAM	/GET NAME TO SAVE
	DCA SAV1+1
	ISZ SAVNAM
SAV1,	MOV6;0;0
	JMP I SAVNAM

SAVPNT,	SAVARA		/POINT TO SAVE AREA


UNSNAM,	0
	TAD I UNSNAM
	ISZ UNSNAM
	DCA UNSNA1+2	/POINT TO SPACE TO RECEIVE NAME
	TAD SAVPNT
	TAD (-6-SAVARA
	SPA
	JMP UNSNA2	/EMPTY - RETURN
	TAD (SAVARA
	DCA SAVPNT	/BACK UP
	TAD SAVPNT
	DCA UNSNA1+1	/SET ADDRESS FROM WHICH NAME WILL COME
UNSNA1,	MOV6;0;0
	ISZ UNSNAM	/SKIP RETURN UNLESS EMPTY
UNSNA2,	CLA
	JMP I UNSNAM


PAGE
/
/
/	$DECK
/
/
CDECK,	BCLIN		/GET THE LINE
	OPTION;CDEOPT		/ANALYZE THE OPTIONS
	TSTCR		/END OF LINE?
	JMP CDECK1	/NO - GET A NAME
CDECK3,	MOV6;CDEDEF;NAME1	/YES - MOVE DEFAULT NAME
	JMP CDECK2
CDECK1,	COLNAM;NAME1	/COLLECT A NAME
		JMP CDECK3	/FAIL - BAD NAME
CDECK2,	SEND;CDEM1	/".R PIP_*"
	OUTNAM;NAME1	/SEND THE NAME
	SEND;CDEM2	/"<BAT:_"
	TAD I (OPFOR	/WAS "/FOR" SPECIFIED?
	SMA CLA
	TAD (BASKEY-FORKEY	/NO - USE BASIC
	TAD (FORKEY-15
	CDF F0
	DCA I (KEYADR
	CDF F1
	CDRTRA		/TRANSLATE THE CARDS
	SEND;CMEOD	/"$EOD_"
	TAD I (OPNOL	/WAS "/NOLIST" SPECIFIED?
	SPA CLA
	JMP I (BCLHUH	/YES - DONE
	TAD ("*;OUT1
	JMS I (PIPOUT;BATOUT /SEND NAME OF LISTING DEVICE
	TAD ("<;OUT1
	OUTNAM;NAME1	/SEND NAME OF FILE
	TAD (215;OUT1
	JMP I (BCLHUH


/
/
/	$BASIC
/
/
CBAS,	BCLIN		/GET BCL LINE
	OPTION;CBAOPT	/ANALYZE OPTIONS
	TSTCR		/END OF LINE?
	JMP CBAS2	/NO - GET NAME
CBAS1,	MOV6;CBATK;NAME1	/MOVE IN BAT:
	SEND;CBAM1	/.R PIP *PROG.BA<
	OUTNAM;NAME1	/SEND NAME
	JMP	CONT
CBAS2,	COLNAM;NAME1	/COLLECT THE NAME
		JMP CBAS1 /FAIL - USE DEFAULT
CBAS3,	SEND;CBAM1	/".R PIP_*PROG.BA<"
	SEND;CBAM6
CONT,	TAD (215;OUT1
CBAS5,	JMP CBAS7	/SET OR CLOBBERED IN INIT
	TAD (211;OUT1
	SEND;CBAM3	/'FILE #0,"DATA.DA"\FILEV #1,"'
	OUTNAM;BATOUT	/"TTY:" OR "LPT:"
	SEND;CBAM4	/'"_'
CBAS7,	TAD (BASKEY-15
	CDF F0
	DCA I (KEYADR	/SET KEYWORD LIST
	CDF F1
	CDRTRA		/TRANSLATE CARDS
	SEND;CMEOD	/"$EOD_"
	SEND;CBAM7
	SEND;CBAM5
	OUTNAM;NAME1
	SEND;CBAM8
	TAD I (OPNOL	/WAS "/NOLIST SPECIFIED?"
	SPA CLA
	JMP CBAS4
	SEND		/SEND AN EOD (MH)
	CMEOD		/(MH)
	SEND		/SEND AN .R PIP * (MH)
	CDEM1		/(MH)
	JMS I (PIPOUT;BATOUT
	SEND;CBAM2	/"<PROG.BA_"
CBAS4,	TAD (DATBAS
	DCA I (DATADR	/SET "$DATA" ROUTINE
	JMP I (BCLHUH	/DONE


/
/
/	$RUN		(AFTER $BASIC)
/
/
DATBAS,	BCLIN
	OPTION;ZER6	/NO OPTIONS
	SEND;DATBM1	/".R PIP_*DATA.DA<BAT:_"
	CDRTRA		/TRANSLATE THE CARDS
	SEND;DATBM2	/"$EOD_.R BCOMP_*PROG.BA_"
	TAD DATFTN	/$RUN IS FORTRAN NOW
	DCA I (DATADR
	JMP I (BCLHUH	/DONE


PAGE
/
/
/	$FORTRAN	(FORTRAN IV)
/
/
CF4,	BCLIN		/GET BCL LINE
	OPTION;CF4OPT	/ANALYZE OPTIONS
	TSTCR		/END OF LINE?
	JMP CF42
CF41,	JMS I (MAKNAM;NAME1	/YES - MAKE A NAME
	JMP CF43
CF42,	COLNAM;NAME1	/NO - COLLECT A NAME
		JMP CF41 /BAD NAME - MAKE ONE
CF43,	SEND;CF4M1	/".R PIP_*"
	OUTNAM;NAME1	/SEND THE NAME
	TAD ("<;OUT1
	TAD I (OPSRC;RAL	/WAS A SOURCE FILE GIVEN
	SMA CLA
	JMP CF44	/NO
	OUTNAM;OPSRC+1	/YES - SEND IT
	TAD (215;OUT1
	JMP CF45
CF44,	SEND;CF4M2	/"BAT:_"
CF45,	TAD (FORKEY-15	/FORTRAN CARDS
	CDF F0
	DCA I (KEYADR
	CDF F1
	CDRTRA		/TRANSLATE THE CARDS
	SEND;CF4M3	/"$EOD_.R F4_*"
	OUTNAM;NAME1
	TAD I (OPNOL	/WAS "/NOLIST" SPECIFIED?
	SPA CLA
	JMP CF46	/YES - DON'T GENERATE LIST FILES
	TAD (",;OUT1
	TAD I (OPLIS
	RAL
	SPA CLA		/WAS A NAME GIVEN?
	JMP CF47	/YES - GET IT
	MOV6;BATOUT;OPLIS+1 /NO - GIVE LIST DEV
CF47,	OUTNAM;OPLIS+1	/SEND NAME OF LISTING FILE
CF46,	TAD ("<;OUT1
	OUTNAM;NAME1
	TAD I (OPRALF	/PRODUCE RALF LISTING?
	SMA CLA
	JMP CF48	/NO
	SEND;CF4M4	/"/F"
CF48,	TAD (215;OUT1
	TAD (DATF4
	DCA I (DATADR	/SET "$DATA" ADDRESS
	JMS I (SAVNAM;NAME1	/SAVE NAME FOR "$LOAD"
	JMP I (BCLHUH	/DONE


/
/
/	$RUN		(FORTRAN II)
/
/
DATF2,	BCLIN
	JMS I (CL2S	/DO $LOAD STUFF
	JMP DATL21
DATL2,	BCLIN
	OPTION;ZER6	/NO OPTIONS IF ALREADY LOADED
	JMP DATL21
DATX2,	BCLIN
	JMS I (DATNAM	/GET A NAME
	TAD I (NAMELD	/WAS A DEVICE SPECIFIED?
	SZA CLA
	JMP DATL21	/YES
	TAD (0423	/NO - USE "DSK"
	DCA I (NAMELD
	TAD (1300
	DCA I (NAMELD+1
DATL21,	SEND;DTF2M1	/".RUN "
	OUTNAM;NAMELD
	TAD (215;OUT1
	CDRTRA		/WITH GENIOX, INPUT IS FROM BATCH STREAM
	SEND;CMEOD	/"$EOD_"
	TAD DATFTN	/$DATA IS NOW FORTRAN
	DCA I (DATADR
	JMP I (BCLHUH



PAGE
/
/
/	$LOAD		(FORTRAN IV)
/
/
/THIS SUBROUTINE IS USED WITH EITHER A $LOAD OR $RUN
CL4S,	0
	OPTION;CL4OPT	/ANALYZE OPTIONS
	SEND;CL4SM1	/".R LOAD_*"
	TAD I (OPIMAG	/WAS "/IMAGE" FILE SPECIFIED
	RAL
	SMA CLA
	JMP CL4S1	/NO
	MOV6;OPIMAG+1;NAMELD /YES - MOVE NAME
	JMP CL4S2
CL4S1,	MOV6;CL4DEF;NAMELD /USE DEFAULT NAME
CL4S2,	OUTNAM;NAMELD	/SEND THE NAME OF THE IMAGE FILE
	TAD I (OPLIS	/WAS "/LIST" FILE GIVEN?
	SMA CLA
	JMP CL4S4
	TAD I (OPLIS;RAL
	SPA CLA
	JMP CL4S3
	MOV6;BATOUT;OPLIS+1
CL4S3,	TAD (",;OUT1
	OUTNAM;OPLIS+1
CL4S4,	TAD I (OPSSYM	/LIST SYSTEM SYMBOLS?
	SMA CLA
	JMP CL4S11	/NO
	SEND;CL4SM8	/"/S"
CL4S11,	SEND;CL4SM2	/"<_*"
	TAD I (OPLIB;RAL	/WAS "/LIBRARY" FILE SPECIFIED?
	SMA CLA
	JMP CL4S5
	OUTNAM;OPLIB+1	/SEND NAME OF LIBRARY
	SEND;CL4SM3	/"/L_*"
CL4S5,	TAD I (OPNOA	/WAS "/NOAUTO" SPECIFIED?
	SPA CLA
	JMP CL4S7	/YES - DON'T BOTHER WITH SAVED NAMES
CL4S6,	JMS I (UNSNAM;NAME1	/GET A SAVED NAME
		JMP CL4S7 /OUT OF NAMES
	OUTNAM;NAME1	/SEND IT
	SEND;CL4SM4	/"/C_*"
	JMP CL4S6
CL4S7,	TSTCR;SKP	/END OF LINE?
	JMP CL4S10
	GETCHR;BCLBUF	/GET NEXT CHARACTER
	DCA CHRSAV
	GETCHR;BCLBUF
	TAD (-"=
	SZA CLA
	JMP CL4S8
	TAD CHRSAV
	ISIT;CLIS1;CLIS2-1 /IS IT "L" OR "O"
CL4S8,	L7776
	TAD GETPNT	/BACK UP 2
	DCA GETPNT
CL4S9,	COLNAM;NAME1
		JMP CL4S7 /BAD NAME
	OUTNAM;NAME1	/SEND THE NAME
	SEND;CL4SM4	/"/C_*"
	JMP CL4S7
CL4SL,	SEND;CL4SM5	/"/O"
CL4SO,	SEND;CL4SM6	/"_*"
	L7776
	TAD GETPNT	/BACK 2
	JMS I (BCLSQU
	JMP CL4S9
CL4S10,	SEND;CL4SM7	/"$_"
	DCA I (NAMCNT
	JMP I CL4S	/RETURN


/$LOAD
CL4,	BCLIN		/GET THE LINE
	JMS CL4S	/ANALYZE IT
	TAD (DATL4	/SET "$DATA" ADDRESS
	DCA I (DATADR
	JMS I (BCLHU1;TEXFIN

CHRSAV,	0

PAGE
/
/
/	$RUN		(FORTRAN IV) - FORMERLY CALLED $DATA
/
/
/THIS SUBROUTINE IS CALLED FROM DATF4 - THE REAL $RUN PROCESSOR
DAT4,	0
	TAD (-12^7	/ZERO OUT CONTROL WORD
	DCA DEVASC	/FOR EACH DEVICE NUMBER
	TAD (DEVASN-1
	DCA OXR1
DEVAS1,	DCA I OXR1
	ISZ DEVASC
	JMP DEVAS1
	BCLIN		/GET THE INPUT LINE
DAT41,	GETCHR;BCLBUF	/GET A CHAR
DAT411,	ISIT;OPTIS3;DATIS1-1 /IS IT "/" OR <CR>?
	JMP DAT41	/NO
DAT42,	L7777
	TAD GETPNT	/SAVE POINTER TO "/"
	DCA DEVAST
	GETCHR;BCLBUF
	ISNUM
	JMP DAT411	/IT'S NOT A NUMBER
	TAD CHAR
	TAD (-"0
	CIA
	DCA DEVASC
	TAD DEVASC
	CIA
	CLL RAL;RTL
	TAD DEVASC	/NUMBER*7
	TAD (DEVASN
	DCA DEVASC
DAT47,	GETCHR;BCLBUF	/GET ANOTHER CHAR
	ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="?
	JMP DAT411	/NO
DAT44,	TAD I DEVASC	/"N" SETS BIT 1
	AND (5777
	TAD (2000
	DCA I DEVASC
	JMP DAT47
DAT45,	TAD I DEVASC	/"C" SETS BIT 2
	AND (6777
	TAD (1000
	DCA I DEVASC
	JMP DAT47
DAT46,	TAD GETPNT	/SAVE POINTER TO POSSIBLE NAME
	DCA DEVASP
	GETCHR;BCLBUF	/GET THE NEXT CHAR
	ISNUM
	JMP DAT48	/NOT A NUMBER
	TAD CHAR	/SAVE THE NUMBER
	DCA DEVASS
	GETCHR;BCLBUF
	ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR <CR>?
DAT48,	TAD DEVASP	/RESET NAME POINTER
	DCA GETPNT
	TAD I DEVASC	/ZERO OUT NUMBER
	AND (7400
	DCA I DEVASC
	TAD DEVASC;IAC	/GET POINTER TO DEVICE BLOCK
	DCA .+2
	COLNAM;0	/COLLECT NAME
		JMP DAT49	/BAD NAME
DAT412,	TAD I DEVASC	/NAME OR NUM OK - SET BIT 0
	AND (3777
	TAD (4000
	DCA I DEVASC
DAT49,	TAD DEVAST	/SQUISH
	JMS I (BCLSQU
	JMP DAT41
DAT410,	TAD I DEVASC	/ADD NUMBER TO CONTROL WORD
	AND (7400
	TAD DEVASS
	DCA I DEVASC
	JMP DAT412
DAT43,	JMP I DAT4


DEVASP,	0
DEVASC,	0
DEVASS,	0
DEVAST,	0


/SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY:
PIPOUT,	0
	TAD I PIPOUT	/GET ADDRESS OF NAME
	ISZ PIPOUT
	DCA PIPPNT
	OUTNAM		/SEND IT
PIPPNT,		0
	TAD I PIPPNT	/GET CHAR OF DEVICE
	TAD (-2424	/IS IT "TT"?
	SZA CLA
	JMP I PIPOUT	/NO
	ISZ PIPPNT
	TAD I PIPPNT
	TAD (-3100	/IS IT "Y@"?
	SZA CLA	
	JMP I PIPOUT	/NO
	SEND;PIPM1	/"/T"
	JMP I PIPOUT


PAGE
/$RUN (FORTRAN IV)
DATF4,	JMS I (DAT4	/PROCESS DEVICE NUMBER STUFF
	JMS I (CL4S	/DO LOAD STUFF
	JMP DATL46
DATL4,	JMS I (DAT4
	OPTION;ZER6	/NO OPTIONS
	JMP DATL46
DATX4,	JMS I (DAT4	/DO DEVICE NUMBER STUFF
	JMS DATNAM	/COLLECT A NAME
DATL46,	SEND;DTF4M1	/".R PIP_*DATA.DA<BAT:_"
	CDRTRA		/TRANSLATE CARDS
	SEND;DTF4M2	/"$EOD_.R FRTS_*"
	OUTNAM;NAMELD	/SEND LOADER NAME
DATL48,	JMP DATL49	/ZEROED OR CREATED IN INIT
	SEND;DTF4M6	/"_*DATA.DA/4_*"
	OUTNAM;BATOUT
	SEND;DTF4M7	/"/5"
	JMP DTL410
DATL49,	SEND;DTF4M8	/"_*/5=4"
DTL410,	SEND;DTF4M3	/"_*"
	TAD (-12	/TRANSLATE THE DEVICE NUMBERS
	DCA DATF4C
	TAD (DEVASN-7
	DCA DATF4P
DATL41,	TAD (7
	TAD DATF4P
	DCA DATF4P
	TAD I DATF4P
	SMA CLA		/WAS THIS ONE SPECIFIED?
	JMP DATL47	/NO
	TAD I DATF4P
	AND (377	/WAS IT A NUMBER?
	SNA
	JMP DATL42
	DCA CHAR	/YES - SAVE IT
	TAD ("=;OUT1
	TAD CHAR;OUT1
	JMP DATL43
DATL42,	TAD DATF4P;IAC	/POINT TO NAME
	DCA .+2
	OUTNAM;0	/SEND IT
DATL43,	TAD I DATF4P	/"N"?
	RAL
	SMA CLA
	JMP DATL44	/NO
	TAD ("<;OUT1
DATL44,	TAD I DATF4P	/"C"?
	RTL
	SMA CLA
	JMP DATL45	/NO
	SEND;DTF4M4	/"/C"
DATL45,	TAD ("/;OUT1
	TAD DATF4C
	TAD ("0+12;OUT1
	SEND;DTF4M3	/"_*"
DATL47,	ISZ DATF4C
	JMP DATL41
	SEND;DTF4M5	/"$_"
	TAD DATFTN	/"$DATA" IS NOW FORTRAN
	DCA I (DATADR
	JMP I (BCLHUH

DATF4C,	0
DATF4P,	0


DATNAM,	0
	OPTION;ZER6	/NO OPTIONS
	TSTCR;SKP	/IS THERE A NAME?
	JMP DATNO	/NO
	COLNAM;NAMELD	/YES - COLLECT IT
		JMP DATNO /INVALID NAME
	JMP I DATNAM	/RETURN
DATNO,	SEND;DATNO1	/"?NO PROGRAM TO RUN_"
	JMS I (BCLHU1;TEXFIN


PAGE
/
/
/	$FORTRAN	(FORTRAN II)
/
/
CF2,	BCLIN
	OPTION;CF2OPT	/ANALYZE OPTIONS
	TSTCR		/END OF LINE?
	JMP CF22
CF21,	JMS I (MAKNAM;NAME1	/CREATE A NAME
	JMP CF23
CF22,	COLNAM;NAME1	/COLLECT A NAME
		JMP CF21 /FAIL - CREATE A NAME
CF23,	SEND;CF2M1	/".R PIP_*"
	OUTNAM;NAME1
	TAD ("<;OUT1
	TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN?
	SMA CLA
	JMP CF24	/NO
	OUTNAM;OPSRC+1
	TAD (215;OUT1
	JMP CF25
CF24,	SEND;CF2M2	/"BAT:_"
CF25,	TAD (FORKEY-15	/FORTRAN CARDS
	CDF F0
	DCA I (KEYADR
	CDF F1
	CDRTRA		/TRANSLATE THE CARDS
	SEND;CF2M3	/"$EOD"
	TAD I (OPNOL	/WAS "/NOLIST" SPECIFIED?
	SPA CLA
	JMP CF27
	SEND;CF2M4	/"_*"
	TAD I (OPLIS;RAL /WAS A LISTING FILE GIVEN?
	SPA CLA
	JMP CF26	/YES
	MOV6;BATOUT;OPLIS+1 /NO - USE LISTING DEVICE
CF26,	JMS I (PIPOUT;OPLIS+1
	TAD ("<;OUT1
	OUTNAM;NAME1
CF27,	SEND;CF2M5	/"_.R FORT_*"
	OUTNAM;NAME1
	TAD I (OPNOL	/NOLIST?
	SPA CLA
	JMP CF28	/YES
	TAD I (OPSABR	/WAS "/SABR" SPECIFIED?
	SMA CLA
	JMP CF28	/NO
	TAD (",;OUT1
	OUTNAM;OPLIS+1
CF28,	TAD ("<;OUT1
	OUTNAM;NAME1
	TAD (215;OUT1
	TAD (DATF2
	DCA I (DATADR	/ENABLE $DATA
	JMS I (SAVNAM;NAME1 /SAVE THE NAME FOR $LOAD
	JMP I (BCLHUH	/DONE


/
/
/	$EOD
/	$MSG
/
/
CEOD,
CMSG,
	JMS SENDKY	/OUTPUT THE BCL KEYWORD
	JMS I (BCLHU1;TEXTRA

/
/
/	$JOB
/
/
CJOB,	TAD (SAVARA	/RESET SAVED NAMES
	DCA I (SAVPNT
	DCA I (NAMCNT	/ZERO MAKNAM COUNTER
	TAD DATFTN	/$RUN IS NOW FORTRAN
	DCA I (DATADR
	BCLIN		/SEND THE LINE TO THE BATCH STREAM
	SEND;MJOB1	/".R FOTP_*FIL???.*/D_"
	JMS I (BCLHU1;TEXFIN

SENDKY,	0
	CDF F0
	TAD I (KEYVAL
	CDF F1
	TAD (BCLKEY-1
	DCA OTEMP1
	TAD I OTEMP1
	SEND
	TAD (" ;OUT1
	JMP I SENDKY


PAGE
/
/
/	$LOAD		(FORTRAN II)
/
/
/THIS SUBROUTINE IS CALLED BY CL2 OR DATF2
CL2S,	0
	OPTION;CL2OPT	/ANALYZE OPTIONS
	SEND	/".R LOADER_*" OR ".R LOADER_*GENIOX"
CL2SX,		CL2M1	/OR CL2M1A
	TAD I (OPINP	/WAS "/INPUT" SPECIFIED?
	SMA CLA
	JMP CL2S1
	SEND;CL2M3	/"/I"
CL2S1,	TAD I (OPOPT	/WAS "/OUTPUT" SPECIFIED?
	SMA CLA
	JMP CL2S2
	SEND;CL2M4	/"/O"
CL2S2,	TAD I (OPTWO	/WAS "/TWO" SPECIFIED?
	SMA CLA
	JMP CL2S3
	SEND;CL2M5	/"/H"
CL2S3,	SEND;CL2M6	/"_*"
	TAD I (OPLIB;RAL /WAS A LIBRARY SPECIFIED?
	SMA CLA
	JMP CL2S4
	OUTNAM;OPLIB+1
	SEND;CL2M7	/"/L_*"
CL2S4,	TAD I (OPLIS	/WAS "/LIST" SPECIFIED?
	SMA CLA
	JMP CL2S6
	TAD I (OPLIS;RAL /WAS A NAME GIVEN?
	SPA CLA
	JMP CL2S5	/YES
	MOV6;BATOUT;OPLIS+1
CL2S5,	OUTNAM;OPLIS+1
	SEND;CL2M8	/"</M_*"
CL2S6,	TAD I (OPNOA	/WAS "/NOAUTO" SPECIFIED?
	SPA CLA
	JMP CL2S8
CL2S7,	JMS I (UNSNAM;NAME1	/GET A SAVED NAME
		JMP CL2S8	/EMPTY
	OUTNAM;NAME1
	SEND;CL2M6	/"_*"
	JMP CL2S7
CL2S8,	TSTCR;SKP	/END OF LINE?
	JMP CL2S9	/YES
	COLNAM;NAME1
	OUTNAM;NAME1
	SEND;CL2M6	/"_*"
	JMP CL2S8
CL2S9,	SEND;CL2M9	/"$_.SAVE "
	TAD I (OPIMAG;RAL /WAS AN IMAGE FILE NAME GIVEN?
	SMA CLA
	JMP CL2S10	/NO - USE DEFAULT
	TAD I (OPIMAG+1	/WAS A DEVICE GIVEN?
	SZA CLA
	JMP CL2S11	/YES
	TAD (0423	/"DS"
	DCA I (OPIMAG+1
	TAD (1300	/"K"
	DCA I (OPIMAG+2
CL2S11,	MOV6;OPIMAG+1;NAMELD
CL2S12,	OUTNAM;NAMELD
	TAD (215;OUT1
	JMP I CL2S

CL2S10,	MOV6;CL2SN2;NAMELD
	DCA I (NAMCNT
	JMP CL2S12


/$LOAD
CL2,	BCLIN
	JMS CL2S
	TAD (DATL2	/$DATA DOES NOT DO LOAD
	DCA I (DATADR
	JMS I (BCLHU1;TEXFIN


PAGE
BCLBUF,	ZBLOCK 400	/SPACE FOR A WHOLE BUNCH OF CONTINUATION CARDS
BCLSIZ=.-BCLBUF
SAVARA,	ZBLOCK 6^62	/SPACE FOR SAVED NAMES
SAVTOP=.
/OPTION LISTS
CDEOPT,	OPBAS;OPFOR;OPNOL;0	/$DECK
CBAOPT,	OPNOL;0			/$BASIC
CF4OPT,	OPSRC;OPNOL;OPLIS;OPRALF;0	/$FORTRAN (F4)
CL4OPT,	OPIMAG;OPLIS;OPLIB;OPNOA;OPSSYM;0 /$LOAD (F4)
CF2OPT,	OPSRC;OPNOL;OPLIS;OPSABR;0 /$FORTRAN (F2)
CL2OPT,	OPINP;OPOPT;OPTWO;OPIMAG;OPLIS;OPLIB;OPNOA;0 /$LOAD (F2)
/OPTIONS WITHOUT ASSOCIATED FILE NAME
OPBAS,	0004;TEXT "BASIC"	/B
OPFOR,	0006;TEXT "FORTRAN"	/F
OPNOL,	0023;TEXT "NOLIST";*.-1	/NOL
OPRALF,	0003;TEXT "RALF";*.-1	/R
OPNOA,	0023;TEXT "NOAUTO";*.-1	/NOA
OPSSYM,	0013;TEXT "SSYMB"	/SS
OPSABR,	0012;TEXT "SABR";*.-1	/SA
OPINP,	0013;TEXT "INPUT"	/IN
OPOPT,	0023;TEXT "OUTPUT";*.-1 /OUT
OPTWO,	0020;TEXT "TWO"		/TWO
/OPTIONS WITH ASSOCIATED FILE NAME
OPSRC,	1002;ZBLOCK 6;TEXT "SRC"	/S
OPLIS,	1003;ZBLOCK 6;TEXT "LIST";*.-1	/L
OPIMAG,	1013;ZBLOCK 6;TEXT "IMAGE"	/IM
OPLIB,	1024;ZBLOCK 6;TEXT "LIBRARY"	/LIB
/FILE NAMES
NAME1,	ZBLOCK 6
NAMELD,	ZBLOCK 6
BATOUT,	ZBLOCK 6
ZER6,	ZBLOCK 6
BATTTY,	TEXT "TTY@@@@@@@@@";*.-1
BATLPT,	TEXT "LPT@@@@@@@@@";*.-1
CDEDEF,	TEXT "@@@@DECK@@@@";*.-1
CBATK,	TEXT "BAT@@@@@@@@@";*.-1
CL4DEF,	TEXT "@@@@PROG@@LD";*.-1
FILNAM,	TEXT "@@@@FIL@@@@@";*.-1
CL2SN2,	TEXT "DSK@PROG@@@@";*.-1
/SPACE FOR DEVICE ASSIGNMENTS UNDER FORTRAN 4
DEVASN,	ZBLOCK 7^12
/LISTS FOR ISIT
CLIS1,	-"L;-"O;0
CLIS2,	CL4SL;CL4SO
DATIS1,	DAT42	/"/"
	DAT43	/<CR>
DATIS2,	-"N;-"C;-"=;0
DATIS3,	DAT44;DAT45;DAT46
DATIS5,	DAT410;DAT410;DAT410
OPTIS2,	OPTIO8	/"="
	OPTIO9	/","
	OPTIO9	/"/"
	OPTIO9	/<CR>

OPTIS4,	OPTI3A
	OPTRET

OPTIS1,	-"=
DATIS4,
OUTIS1,	-",
OPTIS3,
BCLIS1,	-"/;-215
/LIST MUST BE TERMINATED BY A POSITIVE WORD
	0

COLIS2,	COLDEV	/":"
	COLFIL	/"."
	COLEXT	/"/"
	COLEXT	/","
	COLEXT	/<CR>


COLIS1,	-":;-".;-"/;-",;-215
/TERMINATE LIST WITH POSITIVE WORD
	0

BCLIS2,	BCLSQ2	/"/"
	BCLSQ3	/<CR>

OUTIS2,	OUTER2	/","
	OUTER2	/"/"
	OUTER2	/<CR>

/LIST OF BCL ROUTINE ADDRESSES
BCLGO,	BCLEOF	/FOR FINISHING UP BEFORE CLOSING FILE
	CBAS	/$BAS
FORADR,	CF4	/$FOR
DATADR,	DATX4	/$DATA
LOAADR,	CL4	/$LOAD
	CJOB	/$JOB
	CMSG	/$MSG
	CDECK	/$DECK
	CEOD	/$EOD
	CERR
	CERR
	CERR
	CERR
/LIST OF BCL KEYWORDS
BCLKEY,	MBAS
	MFOR
	MDATA
	MLOAD
	MJOB
	MMSG
	MDECK
	MEOD
/ERROR MESSAGES
OPTERM,	TEXT "?INVALID OPTION: /"
COLERM,	TEXT "?INVALID FILE SPECIFICATION - "
BCL11E,	TEXT "?_BCL LINE TOO LONG_"
/MESSAGES
BCLHM1,	TEXT "?_"
BCL10E,	TEXT "_$"
CF4M1,
CF2M1,
CDEM1,	TEXT ".R PIP_*"
CDEM2,	TEXT "<BAT:_"
CMEOD,	TEXT "$EOD_"
CBAM1,	TEXT ".R PIP"
	*.-1
CBAM7,	TEXT	"_*PROG.BA<"
CBAM2,	TEXT "<PROG.BA"
	*.-1
CBAM8,	TEXT	"_"
CBAM3,	TEXT 'FILE #3:"DATA.DA"\FILEV #4:"'
CBAM4,	TEXT '"_'
CBAM5,	TEXT	"PROG.BA,"
CBAM6,	TEXT	"BAT:,"
PIPM1,	TEXT "/T"
DTF4M1,
DATBM1,	TEXT ".R PIP_*DATA.DA<BAT:_"
DATBM2,	TEXT "$EOD_.R BCOMP_*PROG.BA_"
CF2M2,
CF4M2,	TEXT "BAT:_"
CF4M3,	TEXT "$EOD_.R F4_*"
CF4M4,	TEXT "/F"
CL4SM1,	TEXT ".R LOAD_*"
CL4SM2,	TEXT "<_*"
CL2M7,
CL4SM3,	TEXT "/L_*"
CL4SM4,	TEXT "/C_*"
CL4SM5,	TEXT "/O"
DTF4M3,
CF2M4,
CL2M6,
CL4SM6,	TEXT "_*"
DTF4M5,
CL4SM7,	TEXT "$_"
CL4SM8,	TEXT "/S"
DTF4M2,	TEXT "$EOD_.R FRTS_*"
DTF4M4,	TEXT "/C"
DTF4M6,	TEXT "_*DATA.DA/4_*"
DTF4M7,	TEXT "/5"
DTF4M8,	TEXT "_*/5=4"
DATNO1,	TEXT "?NO PROGRAM TO RUN_"
CF2M3,	TEXT "$EOD"
CF2M5,	TEXT "_.R FORT_*"
CL2M1,	TEXT ".R LOADER_*"
CL2M1A,	TEXT ".R LOADER_*GENIOX"
CL2M3,	TEXT "/I"
CL2M4,	TEXT "/O"
CL2M5,	TEXT "/H"
CL2M8,	TEXT "</M_*"
CL2M9,	TEXT "$_.SAVE "
DTF2M1,	TEXT ".RUN "
MBAS,	TEXT "$BASIC"
MFOR,	TEXT "$FORTRAN"
MJOB1,	TEXT ".R FOTP_*FIL???.*/D_"
MEOD,	TEXT "$EOD"
MJOB,	TEXT "$JOB"
MMSG,	TEXT "$MSG"
MDECK,	TEXT "$DECK"
MLOAD,	TEXT "$LOAD"
MDATA,	TEXT "$RUN"
$
