.MCALL	.MODULE
.MODULE	BATCH,VERSION=14,COMMENT=<BATCH Stream Compiler>,AUDIT=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion 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
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;
;	Edit	Who	Date		Description of modification
;	----	---	----		---------------------------
;	001	WLD	02-JAN-91	Removed references to FBMON$
;					and special code for the RT-11
;					v5.5 Single Job Monitor.
;--
; Edit History:
;
; 001	07-Jan-80 12:44    Metsch, James (29602) [240,122]
;	Expand wildcard copy command to *.* without /X switch
;	(001)
; 002	07-Jan-80 13:45    Metsch, James (29602) [240,122]
;	Fixes /U switch causing 'Not enough memory' message
;	from KMON
;	(002)
; 003	30-Jan-80 18:59    Gentry, Martin (70039) [240,121]
;	BATCH directive stacking for $CALL (as per SPR 11-27947)
;	(003)
; 004	10-Feb-80 15:43    Gentry, Martin (70039) [240,121]
;	Fix of /NOWAIT problem (PHASE III QAR)
;	(004)
; 005	17-Jul-80 04:30 PM Kent, Jeff [240,94]
;	Patch to handler suffix
;	(005)
; 006	25-Jul-84 Liz Bausman [240,307]
;	BATCH will not run if SL is set ON
;
; 007	???
;
; 008	01-Nov-1990 JFW
;	bracket error messages with ;+/;ERROR/.../;-
;
; 010	04-Apr-1991	WFG
;	Action #7448, add devices to DEVLST
;
; 011	24-Apr-1991	WFG
;	Action #7451, Fix embedded prompt string in $MOUNT ASSIGN line
;
; 012	24-Apr-1991	WFG
;	Action #7452, Fix display of device in $MOUNT COMMAND
;
; 013	11-Jun-1991	WFG
;	Action #7479, Add "AUDIT=YES" to .MODULE line
;
	ELBAT	== 0			;Edit level
;+
; RT-11 BATCH COMPILER
;
; MARCH 1975/ JUNE 1977/ JANUARY 1978/ NOVEMBER 1979
;
; JD/DV
;
; JM/BC
;
; MBG
;
; FOLLOWING ARE EDITS MADE FOR RT-11 V03B:				;001
;
;BC5  - FIXES BUG IN XM WHERE BATCH USED BA.SYS NOT BAX.SYS FOR BATCH ST
;	ALSO UPDATES DEVLST FOR RL01 AND RX02/4.
;
; MODIFICATIONS FOR RT-11 V04:
;
; V03.04 13-AUG-79	Modified error reporting macros and added a
;	   -MBG-	common error processor to support the setting
;			of the user program error status byte (53).
;			Also added code to support protected file
;			errors.						;MG01
;
; CG	 21-Sep-79	New copyright statement and fix the UNLOAD BA
;			string to include trailing colon for correct
;			operation under system tasking monitors.
;
; X05.00 16-NOV-79	New copyright statement
;	   -MBG-
;
;-
	.SBTTL	SYMBOLS AND DEFINITIONS

;+
;
;THE BATCH COMPILER HAS A HIGH SEG (PURE CODE) AND
;A LOW SEG (NOT SO PURE CODE)
;BATCH EXPECTS THAT R4 POINTS TO THE LOW SEG
;*******************************************************************

	PIC	= 0			;SET TO 0 IF NO P.I.C. WANTED

;*******************************************************************
;******************************************************************
; 100 WORDS OF PATCH SPACE HAVE BEEN ALLOCATED AT THE END OF THE
; BATCH COMPILER.  IT BEGINS AT LABEL PATCH:, AND SHOULD ONLY
; BE USED IF A IN-LINE PATCH CANNOT BE MADE.
;*******************************************************************
;*******************************************************************
;
;-

; ASCII CHARACTER DEFINITIONS

	NL	= 12			;NEW LINE;LINE FEED
	FORM	= 14			;FORM FEED
	RET	= 15			;RETURN;CARRIAGE RETURN
	CTRL.Z	= 32			;CONTROL Z;EOF
	SPC	= 40			;SPACE,BLANK

; RT-11 MONITOR DEFINITIONS

	RONLY$	= 40000			;DEVICE IS READ ONLY
	WONLY$  = 20000			;DEVICE IS WRITE ONLY
	SPECL$	= 10000			;DEVICE IS NON-RT-11-DIRECTORIED.
	BATBLK	= 6			;BLK 6 OF BA.SYS USED FOR BATCH STACK
	JSW	= 44
	SLEDI$	= 20			;SL AVAILABLE
	SLKMO$	=  2			;KMON SHOULD USE SL
	CHNIF$	= 4000			;CHAIN TO @FILE BIT IN JSW	;BC3
	ERRBYT	= 52			;RT-11 ERROR BYTE		;MG01+
	USERRB	= 53			;RT-11 ERROR SEVERITY BYTE
		ERR$$I	= 0		;	INFORMATIONAL
		ERR$$W	= 1		;	WARNING
		ERR$$E	= 2		;	ERROR
		ERR$$F	= 3		;	FATAL/SEVERE ERROR
		ERR$$U	= 4		;	UNCONDITIONAL ABORT	;MG01-
	SYSPTR	= 54
	$CSW	= 4			;OFFSET TO CHAN. 0
	CONFIG	= 300			;OFFSET TO MONITOR CONFIGURATION WD
	KT11$	= 10000			;RUNNING MAPPED SYSTEM WITH KT11 ;BC5
	EMT16	= 316
	CONTXT	= 320			;->CURRENT JOB'S IMPURE AREA
		BATRN$	= 000002 ;BATCH IS RUNNING FOR THIS JOB
	CHAIN	= 400
	HSUFFX  = 412			;MONITOR SUFFIX			;005
	CHNTXT	= 510			;PLACE WHERE TEXT CAN BE FOUND
					; ON CHAIN (RT11)

; BATCH COMPILER DEFINITIONS

	SAVNUM	= 9.			;# OF ARGS. SAVED ON BATCH STACK;003
					;PER RECURSION OF THE COMPILER.
	ARGLST	= 13			;NUMBER OF ARGUMENTS PASSED BETWEEN
					; BATHND AND BATCH
	BATSW1	= ARGS			;->BATSW1 LOC. IN BATCH HANDLER
	SOURCE	= 4		; 1=>GET A CHARACTER THROUGH BATCH HANDLER
				; 0=>LET THE EMT GO TO THE MONITOR
	BSOURC	= 40000		; 1=>INPUT COMES FROM THE BATCH STREAM
				; 0=>INPUT COMES FROM THE CTY
	DESTON	= 2		; 1=>OUTPUT TO BATCH
				; 0=>OUTPUT TO RMON
	BDESTN	= 100		; 1=>BATCH LOG IS OUTPUT
				; 0=>CTY IS OUTPUT
	DATA	= 40		; 1=>CHARACTERS FOLLOWING ARE USER DATA
				; 0=>KMON
	ACTIVE	= 20			;CTY IS ACTIVE
	COMWAT	= 10			;A COMMAND IS WAITING
	BEXIT	= 100000		;EXIT DURING DATA MODE
	NOTTYB	= 400			;I/O LOGGING BIT		;003
	BGET	= 200			;"\G" MODE
	HELP	= 1			; HELP MODE

	INDATA	= ARGS+2		;POINTER TO INDATA
	ODATA	= ARGS+4		;POINTER TO ODATA
	OUTBUF	= ARGS+6		;POINTER TO BATHND OUTPUT BUFFER
	BATOPT	= ARGS+10		;POINTER TO OUTPUT CHARACTER POINTER
	BATOCT	= ARGS+12		;POINTER TO OUTPUT CHARACTER COUNTER
	BATICT	= ARGS+14		;POINTER TO INPUT CHARACTER COUNTER
	O$EXT	= ARGS+16
	O$TIN	= ARGS+20
	O$TOT	= ARGS+22
	O$PRN	= ARGS+24
	OUBSIZ	= 400			;SIZE OF BATHND OUTPUT BUFFER
	.SBTTL	LOW (IMPURE) SEGMENT DEFINITION

	.CSECT	IMPURE

	.GLOBL	BATSWT,TMPSWT,LINSIZ,LOWSEG

	LINSZ	= ^D80			;LENGTH OF LINE BUFFER(MUST BE EVEN!)
	LOTSZ	= ^D132			;LENGTH OF LINE OUTPUT BUFFER
	ERSIZE	= ^D5			;MAXIMUM NUMBER OF ERROR MESSAGES/LINE
	INBSIZ	= 400			;LENGTH OF EACH INPUT BUFFER
	OTBSIZ	= 400			;LENGTH OF EACH OUTPUT BUFFER
	SOBSIZ	= 400			;LENGTH OF TEMP SOURCE OUTPUT BUFFER
	QSIZE	= 4			;NUMBER OF EXTRA I/O QUEUE ELEMENTS
	DEFLOG	= 100			;DEFAULT LOG FILE SIZE

	.MCALL	..V1..,	.REGDE
	.REGDE
	..V1..

	.MCALL	.TTYIN,	.DELET,	.CLOSE,	.EXIT,	.TTYOU,	.PRINT
	.MCALL	.SRESE,	.RCTRL,	.HERR,	.SERR,	.GVAL			;BC4/5

.MACRO	ENTRLO	NAME,A1,A2,A3,A4,A5,A6,A7,A8,A9
	.CSECT	IMPURE
	.IF NB NAME
	  NAME = .-LOWSEG
	.ENDC
	.IRP X,<A1,A2,A3,A4,A5,A6,A7,A8,A9>
	  .IIF NB <X>,.WORD X
	.ENDR
	.CSECT	PROGRM
	.ENDM

;LOWSEG IS THE START OF THE IMPURE AREA
;*****THE COMPILER ASSUMES THAT BATSWT IS THE FIRST ENTRY IN*****
;*****LOWSEG. REFERENCES TO BATSWT ARE ABBREVIATED TO (R4).*****

LOWSEG:	ENTRLO	BATSWT,0		;BATCH CONTROL SWITCHES
	ABORT	= 100000		;DON'T ATTEMPT TO RUN AFTER COMPILE
	DATDOL	=  40000		;DATA/DOLLARS SET
	NO	=  20000		;/"NO"SWITCH IS SET
	CTYOUB	=  10000		;"\@" CTY: OUTPUT SENT
	LOGOUB	=   4000		;"\C" LOG OUTPUT
	DATOUB	=   2000		;"\D" USER DATA
	COMOUB	=   1000		;"\E" KMON REQUEST
	JOB	=    400		;$JOB SEEN

;******* KEEP MAKEB AT 200 *******

	MAKEB	=    200		;MAKE BATCH LINKAGE FROM .TTYIN FIRST
	COMMA	=    100		;COMMA TERMINATED COMMAND
	BFORLI	=     40		;NEXT LINK REQUIRES FORLIB.OBJ
	UNIQUE	=     20		;FOR UNIQUE MATCHES
	BANNER	=     10		;PRINT BANNER ON $JOB,$EOJ
	RT11	=      4		;RT11 DEFAULT ON NO DOLLAR IN COLUMN 1
	TIME	=      2		;PRINT TIME OF DAY
	MAKE	=      1		;MAKE SOURCE FILE

	ENTRLO	BATSW2,0
	EOJ	=      1
	XSWT	=      2		;(DEBUG ONLY)
;	BEOF	=      4
	LSTDAT	=     10		;LIST DATA SECTIONS
	BNOEOJ	=     20		;$JOB/$SEQ SEEN BEFORE PREVIOUS $EOJ
	STAROK	=     40		;OK TO LET * NAME/EXTENSION GO THROUGH
	STARFD	=    100		;STAR SEEN IN FD FIELD
;	MAKEB	=    200		;DITTO FROM BATSWT
	COMSWB	=    400		;COMMAND SWITCHES
	LSTBIT	=   1000		;REQUEST TEMPORARY LISTING
	SEQ	=   2000		;$SEQ HAS APPEARED IN STREAM
	SBIT	=   4000		;/S SWITCH ON THIS COMMAND
	FIRST	=  10000		;1ST CARD OF THIS JOB PROCESSED
;	ABORT	= 100000		;SECOND TIME THROUGH ABORT

	ENTRLO	TMPSWT,0		;TEMPORARY COMMAND SWITCH
	ENTRLO	COMSWT,.-.
	ENTRLO	LINSIZ,LINSZ		;INPUT LINE BUFFER SIZE

;********* KEEP IN ORDER ********

	BFREE	= 1			;BUFFER STATUS BIT, 0=>BUFFER IS FREE
	BWAIT	= 2			;IN I/O WAIT (BFREE*2)
	BEOF	= 4			;END OF FILE IN BUFFER
	ENTRLO	BINLCT,0		;LAST BUFFER CHARACTER COUNTER
	ENTRLO	INSTAT,0		;INPUT BUFFER STATUS BYTES
	ENTRLO	ICHRPT,.-.		;INPUT CHARACTER POINTER
	ENTRLO	BINCTR,0		;INPUT BUFFER COUNTER
	ENTRLO	BINARG,10*400+3		;INPUT FILE EMT ARG. LIST
	ENTRLO	BATIBK,0		;INPUT BLOCK #
	ENTRLO	BATIBP,.-.,INBSIZ,0	;INPUT BUFFER ADDRESS,SIZE,WAIT I/O

	ENTRLO	BOTLCT,OTBSIZ*2		;LAST BUFFER CHARACTER COUNTER
	ENTRLO	OTSTAT,BFREE*400+BFREE	;OUTPUT BUFFER STATUS
	ENTRLO	OCHRPT,.-.		;OUTPUT CHARACTER POINTER
	ENTRLO	BOTCTR,OTBSIZ*2		;OUTPUT COUNTER
	ENTRLO	BOTARG,11*400+0		;OUTPUT EMT ARG. LIST
	ENTRLO	BATOBK,0		;OUTPUT BLOCK #
	ENTRLO	BATOBP,.-.,OTBSIZ,0	;OUTPUT BUFFER ADDRESS,SIZE,WAIT I/O

;*********************************

	ENTRLO	STACK,.-.		;STACK POINTER SAVE AREA
	ENTRLO	ARGS			;ARGUMENTS EXCHANGED BETWEEN
					; BATCH AND BA
	.CSECT	IMPURE
	.BLKW	ARGLST

;********* CSI BUFFER *************

	ENTRLO	SPC0,0,0,0,0,0		;ENTRIES ARE: DEVICE, FILE NAME,
	ENTRLO	SPC1,0,0,0,0,0		;FILE EXTENSION, AND REQUESTED SIZE.
	ENTRLO	SPC2,0,0,0,0,0
	ENTRLO	SPC3,0,0,0,0
	ENTRLO	SPC4,0,0,0,0
	ENTRLO	SPC5,0,0,0,0
	ENTRLO	SPC6,0,0,0,0
	ENTRLO	SPC7,0,0,0,0
	ENTRLO	SPC8,0,0,0,0

;**********************************

	ENTRLO	LINIMP,0		;POINTER TO COMMAND LINE BUFFER
	ENTRLO	LINIMM			;LINIMM IS LINBAD

	.CSECT	IMPURE

	.NLIST	BIN

LINBAD:	.REPT	LINSZ			;INPUT LINE BUFFER
	.BYTE	0
	.ENDR
	.BYTE	0
	.BYTE	-1			;FLAG
	.EVEN
	ENTRLO	LINIMS
	.CSECT	IMPURE
	.REPT	LINSZ			;INPUT LINE BUFFER SAVE AREA
	.BYTE	0
	.ENDR
	.EVEN
	ENTRLO	LIBLST
	.CSECT	IMPURE
	.ASCIZ	/SY:SYSLIB/						;BC3
	.REPT	LINSZ-7
	.BYTE	0
	.ENDR
.LIST	BIN
	.EVEN
BATIBF:	.BLKW	INBSIZ*2		;INPUT BUFFERS
BATOBF:	.BLKW	OTBSIZ*2		;OUTPUT BUFFERS
	ENTRLO	QSET

	.CSECT	IMPURE
	.BLKW	10.*QSIZE		;ROOM FOR I/O QUEUE ELEMENTS	;BC3
	.SBTTL	HIGH SEGMENT SECTION DEFINITIONS

;******* HIGH SEG SECTIONS *******

	.CSECT	TABEL1
	.GLOBL	KEYTAB
KEYTAB:
	.CSECT	TABEL2
	.GLOBL	KEYWRD
KEYWRD:	.BYTE 0
	.CSECT	TABEL3
	.GLOBL	SWIT
SWIT:	.BYTE 0
	.CSECT	TABEL4
	.GLOBL	SWTADD
SWTADD:
	.CSECT	ERRLST
	.GLOBL	ERRADD
ERRADD:
	.CSECT	PROGRM
	.SBTTL	MACRO DEFINITIONS

.MACRO ADDR,ADDRESS,REG
	.IF EQ PIC
	  MOV	#ADDRESS,REG
	.IFF
	  MOV	PC,REG
	  ADD	#ADDRESS-.,REG
	.ENDC
	.ENDM

	SWTNUM	= -1

.MACRO SWTDEF,SWITCH
	SN$'SWITCH = SWTNUM
	SWTNUM = SWTNUM-1
	.CSECT	TABEL3
	. = .-1
	C = 0
	.IRPC X,SWITCH
	  .IIF EQ C, .BYTE -''X
	  .IIF NE C, .BYTE ''X
	  C = C+1
	.ENDM
	.BYTE 0
	.CSECT	TABEL4
	.IF EQ PIC
	  .WORD SA$'SWITCH
	.IFF
	  .WORD SA$'SWITCH'-SWTJMP-2
	.ENDC
	.CSECT	PROGRM
	.ENDM

	BITNUL	= 100000		;NO SWITCHES SPECIFIED FOR COMMAND

; COMMAND IS USED TO DFINE A BATCH COMMAND AND ITS LEGAL SWITCHES

.MACRO COMMAND,NAME,S,S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,SB,SC,SD,SE,SF
	.SBTTL     $'NAME PROCESSOR
	.CSECT	TABEL1
DSW'NAME:	.WORD	0
	.IF EQ PIC
	  .WORD C$$'NAME
	.IFF
	  .WORD C$$'NAME'-FNDJMP-2
	.ENDC
	.CSECT	TABEL2
	. = .-1
CN$'NAME:	.ASCII	/NAME/
	.BYTE	SN$NUL			;DUMMY END OF LINE
	C = 40000
	.IRP X,<S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,SB,SC,SD,SE,SF>
	  .IF NB <X>
	    .BYTE SN$'X
	    BIT'X=C
	  .ENDC
	  C = C/2
	.ENDR
	.BYTE 0
	.CSECT	PROGRM
.LIST	MEB
C$$'NAME:
.NLIST	MEB
	.ENDM

.MACRO	DEFAULT	SWITCH	A,B,C,D,E,F,G,H,I,J,K,L,M,N,O
	BIT = 0
	.CSECT	TABEL1
	. = .-4
	X = BIT'A!BIT'B!BIT'C!BIT'D!BIT'E!BIT'F!BIT'G!BIT'H!BIT'I!BIT'J
	.WORD	BITNUL!X!BIT'K!BIT'L!BIT'M!BIT'N!BIT'O
	. = .+2
	.CSECT	PROGRM
	.ENDM

.MACRO	SWITCH	NAME
	.SBTTL	SWITCH	NAME
SA$'NAME:
	.ENDM

	ERRNUM	= 0

; ENTMES ENTERS AN ERROR MESSAGE IN THE ERRLST CSECT

.MACRO	ENTMES,LABEL,MESSAGE,CR
	.IF NB <MESSAGE>
	  .CSECT ERRLST
..'LABEL==.+1
LABEL:	.ASCII	%MESSAGE%
	  .IF NB CR
	    .BYTE 0
	  .IFF
	    .BYTE 200
	  .ENDC
	  .CSECT PROGRM
	.ENDC
	.ENDM

.MACRO	STRING	ADDRESS,LABEL,MESSAGE,CR
	ENTMES	LABEL,MESSAGE,CR
	.IF EQ PIC
	  JSR	R5,ADDRESS
	  .IF NB LABEL
	    .WORD LABEL
	  .IFF
	    .WORD NULINE
	  .ENDC
	.IFF
	  . = .+2
	  .IF NB LABEL
	    TST LABEL
	  .IFF
	    TST NULINE
	  .ENDC
	  . = .-6
	  JSR	R5,ADDRESS
	  . = .+2
	.ENDC
	.ENDM
	.CSECT	ERRLST

NULINE:	.BYTE	200			;NULL LINE

.MACRO COMOUT	LABEL,TEXT,CR
	STRING	COMOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	LOGOUT	LABEL,TEXT,CR
	STRING	LOGOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	DATOUT,LABEL,TEXT,CR
	STRING	DATOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	MESOUT,LABEL,TEXT,CR
	STRING	MESOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	OUTPUT,LABEL,TEXT,CR
	STRING	OUTSTR,LABEL,TEXT,CR
	.ENDM

.MACRO	HOUT,LABEL,TEXT,CR
	STRING	HOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	IOUT,LABEL,TEXT,CR
	STRING	IOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	KOUT,LABEL,TEXT,CR
	STRING	KOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	LABOUT,LABEL,TEXT,CR
	STRING	LABOUX,LABEL,TEXT,CR
	.ENDM

.MACRO	CHROUT,X
	.IF NB <X>
	  .IF IDN X,<#',>
	    JSR PC,.COMMA
	    .MEXIT
	  .ENDC
	  .IF IDN X,#32
	    JSR PC,.CTRLZ
	    .MEXIT
	  .ENDC
	  .IF IDN X,#'0
	    JSR PC,.ASCI0
	    .MEXIT
	  .ENDC
	  .IF IDN X,#12
	    JSR PC,.LF
	    .MEXIT
	  .ENDC
	  .IF IDN X,#'=
	    JSR PC,.EQUAL
	    .MEXIT
	  .ENDC
	  .IF IDN X,#'2
	    JSR PC,.ASCI2
	    .MEXIT
	  .ENDC
	  .IF IDN X,#40
	    JSR PC,.SPACE
	    .MEXIT
	  .ENDC
	  .IF IDN X,R2
	    JSR PC,.R2
	    .MEXIT
	  .ENDC
	  .IF IDN X,(SP)+
	    JSR PC,.SPPOP
	    .MEXIT
	  .ENDC
	  .IF IDN X,#'A
	    JSR PC,.ASCIA
	    .MEXIT
	  .ENDC
	  MOVB X,R3
	.ENDC
	JSR	PC,PUTCHR
	.ENDM

.MACRO	INTVAR,V,X
	KOUT	NULINE
	CHROUT	V
	CHROUT	#'1
	CHROUT	X
	.ENDM

.MACRO	IFOUT	V,X,LABEL,TEXT,CR
	IOUT
	CHROUT	V
	CHROUT	X
	OUTPUT	LABEL,TEXT,CR
	.ENDM

.MACRO	SCAN,LABEL,TEXT
	.IF	NB	LABEL
	  ENTMES LABEL,TEXT
	  ADDR LABEL,R1
	.ENDC
	JSR	R5,SCANX
	.ENDM

	YES	= 200							;MG01+
									;004
.MACRO	$ERR	LVL,MSG,CR
	ERRNUM = ERRNUM+1
	.IRP XXX,\ERRNUM
	  JSR R5,ERRPRO
	  .WORD ERR$$'LVL
	  .WORD ERR'XXX
	.CSECT	ERRLST
ERR'XXX:
	.ENDR
	.IF EQ CR-YES
	  .ASCIZ /MSG/
	.IFF
	  .ASCII /MSG/<40><200>
	.ENDC
	.CSECT	PROGRM
	.ENDM

.MACRO	$LERR	LVL,MSG
	ERRNUM = ERRNUM+1
	.IRP XXX,\ERRNUM
	  JSR R5,ERRLOG
	  .WORD ERR$$'LVL
	  .WORD ERR'XXX
	.CSECT	ERRLST
ERR'XXX:
	.ENDR
	.ASCIZ /MSG/
	.CSECT	PROGRM
	.ENDM								;MG01-

.MACRO	GETFD	NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
	.CSECT	ERRLST
NAME:
	C = 40000
	.BYTE	SN$NUL
	NAME'NUL = 100000
	.IF NB S1
	  .IRP X,<S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15>
	    .IF NB <X>
	      .BYTE SN$'X
	      NAME''X = C
	    .ENDC
	    C = C/2
	  .ENDR
	  .BYTE 0
	.ENDC
	.CSECT	PROGRM
	.IF EQ PIC
	  JSR R5,GETFD$
	  .WORD	NAME
	.IFF
	  . = .+2
	  TST NAME+2
	  . = .-6
	  JSR R5,GETFD$
	  . = .+2
	.ENDC
	.WORD	0
	.ENDM

.MACRO	EXCLUSIVE NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
	. = .-2
	C = 0
	.IRP X,<S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15>
	  .IF NB <X>
	    C = C+NAME''X
	  .ENDC
	.ENDR
	.WORD	^C<C>
	.WORD	0
	.ENDM

.MACRO	FINDFD	NAME,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15
	JSR	R5,FDFIND
	.IF NB S1
	  C = 0
	  .IRP X,<S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15>
	    .IF NB <X>
	      C = C+NAME''X
	    .ENDC
	  .ENDR
	  .WORD C
	.IFF
	  .WORD NAME'NULL
	.ENDC
	.ENDM

.MACRO	DMPOBJ	X
	JSR	R5,OBJDMP
	.WORD	X
	.ENDM
	.CSECT	ERRLST

SAVTMP:	.ASCIZ	"000000.SAV"

	ENTRLO	SOUTMP,"00,"00,"00,".S,"OU,0

	ENTRLO OBJTMP,"00,"00,"0/,".O,"BJ,0

.MACRO	ISIT	LABEL,ADDRESS,ARGS
	.IF NB <ARGS>
	  .CSECT ERRLST
LABEL:	.ASCIZ	ARGS
	  .CSECT PROGRM
	.ENDC
	.IF EQ PIC
	  JSR R5,ISIT$
	  .WORD LABEL
	  .WORD ADDRESS
	.IFF
	  . = .+4
	  TST ADDRESS+2
	  . = .-6
	  TST LABEL
	  . = .-6
	  JSR R5,ISIT$
	  . = .+4
	.ENDC
	.ENDM

; SWITCH DEFINITIONS

	.IRP X,<NULL,DOLLARS,WAIT,RUN,DATA,MAP,PHYSICAL,DELETE>
	  SWTDEF X
	.ENDR
	.IRP X,<BASIC,CREF,FORTRAN,MACRO,INPUT,TIME,LOGICAL,SOURCE,EXECUTE>
	  SWTDEF X
	.ENDR
	.IRP X,<WRITE,VID,LIST,OBJECT,OUTPUT,RT11,BANNER,UNIQUE,LIBRARY>
	  SWTDEF X
	.ENDR

ENDBAT:	.ASCIZ	<15><12>/END BATCH/
	.EVEN
	.SBTTL	ERROR PROCESSOR

;+									;MG01+
;
; CALL TO THIS ROUTINE IS MADE BY:
;
;	JSR	R5,ERROR
;	 .WORD	error_level
;	 .WORD	error_message_pointer
;
; Where 'error_level' is the severity of the error represented by a number
; 0,1,2,3 or 4 corresponding to the prefix characters I,W,E,F and U, and
; 'error_message_pointer' is the address of the message to be printed.
;
;-

ERRPRO:	MOV	R0,-(SP)		;SAVE R0 FOR AWHILE
	MOV	(R5)+,R0		;GET THE SEVERITY LEVEL
	BISB	MSKLST(R0),@#USERRB	;REPORT THE SEVERITY
	MOVB	CHRLST(R0),ERRLVL	;COMPLETE THE PREFIX
	.PRINT	#PREFIX			;AND PRINT IT
	MOV	(R5)+,R0		;R0->ERROR MESSAGE CONTINUATION
	.PRINT				;PRINT IT
	MOV	(SP)+,R0		;RESTORE R0
	RTS	R5			;AND RETURN

PREFIX:	.NLCSI	TYPE=I,PART=PREFIX
ERRLVL:	.ASCII	/x-/<200>

MSKLST:	.BYTE	0,2,4,10,20
CHRLST:	.ASCII	/IWEFU/
	.EVEN								;MG01-
	.SBTTL	COMPILER ENTRY POINT
	.CSECT	PROGRM

;+
;
; BATCH STARTS BY INITIALIZING ITS BUFFER POINTERS AND THEN DOING
; A .DSTAT ON THE BA HANDLER. THIS SERVES TWO PURPOSES: IT TESTS
; FOR BA HANDLER RESIDENCY AND  SUPPLIES THE BA ENTRY POINT
; FOR USE IN THE START2 CODE. IN ADDITION, A TEST IS MADE FOR
; THE LOG HANDLER, WHICH MUST ALSO BE RESIDENT AND ASSIGNED TO LOG:
;
;-

	.ENABL	LSB

	.GLOBL	START

START:	.GVAL	#SLAREA			;GET CONFIG WORD		;006
	BIT	#SLEDI$!SLKMO$,R0	;CHECK TO SEE IF SL IS ON	;006
	BNE	5$			;SL IS ON, PRINT MESS AND EXIT	;006
	MOV	#LOWSEG,R4		;PUT ADDRESS OF IMPURE AREA IN R4
	MOV	SP,STACK(R4)		;SAVE STACK PTR FOR RESET
	MOV	#LINIMM,LINIMP(R4)	;LINIMP->COMMAND LINE BUFFER
	ADD	R4,LINIMP(R4)		;DON'T DO ADDRLO LINIMM,LINIMP(R4)
	.GVAL	#HAREA			;GET MONITOR SUFFIX		;005
	MOV	#^RBA ,BATST2		;PUT BA <SPACE> RAD50 IN BATST2	;005
	ADD	R0,BATST2		;ADD SUFFIX			;005
4$:	.RCTRLO				;RESET CTRL/O			;**-4
	MOV	#QSET,-(SP)
	ADD	R4,(SP)
	MOV	#QSIZE,R0
	EMT	^O353			;.QSET
	MOV	#BATIBF-LOWSEG+INBSIZ+INBSIZ,R0
	ADD	R4,R0
	MOV	R0,BATIBP(R4)		;INITIALIZE I/O BUFFER POINTERS
	MOV	#BATOBF-LOWSEG,R0
	ADD	R4,R0
	MOV	R0,OCHRPT(R4)
	ADD	#OTBSIZ*2,R0
	MOV	R0,BATOBP(R4)
	MOV	#WDBLK5,-(SP)		;ONLY NEED 4 OF THE 5
	ADD	R4,(SP)			;USE WDBLK5 FOR .DSTAT ON BA
	MOV	#LOGNAM,R0		;R0->LOG: (RAD50)
	EMT	16*20+2			;.DSTATUS
	BCS	1$			;BR IF LOG: NOT ASSIGNED
	TST	WDBLK5+4(R4)		;IS IT RESIDENT?
	BNE	2$			;BR IF HANDLER IN MEMORY
	$ERR	F,<Please load LOG handler>,CR=YES			;MG01
	BR	6$

;+
;ERROR
1$:	$ERR	F,<Please assign LOG,LST>,CR=YES			;MG01
;-
	BR	6$

2$:	MOV	WDBLK5(R4),LOGTYP(R4)	;SAVE DEVICE STATUS OF LOG
	BIT	#RONLY$,LOGTYP(R4) 	;CAN IT BE USED FOR LOG?
	BNE	7$			;NO
	BIT	#SPECL$,LOGTYP(R4)
	BEQ	3$
	BIT	#WONLY$,LOGTYP(R4)
	BNE	3$			;IT'S OKAY
;+
;ERROR
7$:	$ERR	F,<Invalid LOG device>,CR=YES				;MG01
;-
	BR	6$

3$:	MOV	#BATHND,R0		;R0 --> BATCH HANDLER NAME
	MOV	#WDBLK5,-(SP)
	ADD	R4,(SP)

	EMT	16*20+2			;DSTATUS
	BCS	NOTRES			;IF CS, BA NOT KNOWN TO SYSTEM??
	MOV	WDBLK5+4(R4),-(SP)
	BNE	START1
;+
;ERROR
NOTRES:	$ERR	F,<Batch handler not resident>,CR=YES			;MG01
;-
	BR	6$
;+
;ERROR
5$:	$ERR	F,<Cannot run with SL ON>,CR=YES			;006
;-
6$:	.EXIT

	.DSABL	LSB

BATHND:	.RAD50	/BA /			;HANDLER BA <SPACE>		;005
HAREA:	.WORD	0,HSUFFX		;TO ACCESS MONITOR HSUFFIX WORD	;005
SLAREA:	.WORD	0,CONFIG		;TO ACCESS CONFIG WORD FOR SL
	ENTRLO	LOGTYP,0		;LOG DEVICE STATUS SAVE AREA	;**-2

; TEST FOR BA HANDLER. IF BA IS RESIDENT, DO A NULL READ TO BA
; TO INITIALIZE IT. BA WILL RETURN A LIST OF ITS LOCATIONS
; WHICH MUST BE PRESERVED ON A RECURSION.

START1:	MOV	#BATHND,R3		;R3 -> BATCH HANDLER NAME
	MOV	#WDBLK2+2,R0		;DO A .LOOKUP ON CH. 16
	ADD	R4,R0
	MOV	R3,(R0)			;FOR BA .SYS
	MOV	#1*400+16,-(R0)
	EMT	375

; AN ERROR SHOULDN'T OCCUR HERE BECAUSE BA IS NOT FILE-STRUCTURED.

	BCS	NOTRES			;BRANCH IF BA.SYS NOT RESIDENT
	MOV	#ARGS,R3		;O.K., DO A NULL READ TO BA.SYS
	ADD	R4,R3
	MOV	#ARGARG,R0
	ADD	R4,R0
	MOV	R3,4(R0)
	EMT	375			;READW BATHND (INITIALIZE THE HANDLER)
	BCC	START2
;+
;ERROR
	$ERR	F,<Invalid copy of handler>,CR=YES			;MG01
;-
	.EXIT

; RELOCATE POINTERS PASSED FROM BA HANDLER, INITIALIZE BATCH
; STACK BLOCK ON SY:, THEN PROCESS THE COMPILER COMMAND LINE.

START2:	ADD	(SP),(R3)+		;RELOCATE THE POINTER OFFSETS
	BCC	START2			;UNTIL NEGATIVE OFFSET FOUND.
	TST	@BATSW1(R4)		;TEST FOR $CALL
	BNE	GETCOM			;BR IF THIS IS A $CALL
	JSR	PC,RDSTK		;ELSE READ IN BATCH STACK
	MOV	#-<SAVNUM*2-2>,@BATOBP(R4) ;SET 1ST WORD TO INITIALIZE
	JSR	PC,START3		;AND WRITE IT BACK OUT.
GETCOM:	CLR	INSTAT(R4)		;RESET INSTAT IN CASE OF ERROR
	CLR	BINCTR(R4)		;ZERO INPUT COUNTER
	CLR	BATIBK(R4)		;AND INPUT BLOCK NUMBER
	CLR	(R4)			;CLEAR BATSWT
	CLR	BATSW2(R4)		;AND BATSW2
	MOV	#SPC0,R0
	ADD	R4,R0
	MOV	R0,-(SP)
	MOV	#DEFEXT,R0		;R0 -> DEFAULT EXTENSIONS
	MOV	R0,-(SP)
	CLR	-(SP)
2$:	BIT	#CHAIN,@#JSW
	BEQ	1$			;DID WE COME FROM CHAIN??
	BIC	#CHAIN,@#JSW		;YES
	MOV	#CHNTXT,(SP)		;PICK UP CHAIN TEXT
1$:	EMT	16*20+5			;.CSISPC
	BCC	CSIOK			;BR IF LEGAL COMMAND
	TSTB	@#ERRBYT		;WHAT WAS THE ERROR?
	BNE	ILLDEV			;BR IF ILLEGAL DEVICE
;+
;ERROR
	$ERR	F,<Invalid command>,CR=YES				;MG01
	BR	GETCOM			;GET COMMAND

ILLDEV:	$ERR	F,<Invalid device>,CR=YES				;MG01
;-
	BR	GETCOM

; EMT ARGUMENT LIST FOR BATCH HANDLER INITIALIZATION

	ENTRLO	ARGARG,10*400+16,0,.-.,0,0

DEFEXT:	.RAD50	/BAT/			;INPUT DEFAULT
	.WORD	0			;SPC0, CTL OR MAKE FILE, NO DEFAULT
LOGNAM:	.RAD50	/LOG/			;SPC1, BATCH LOG PUTPUT
	.WORD	0			;NO SPC2 YET

CSIOK:	TST	SPC2(R4)		;MORE THAN 2 OUTPUT FILES SPECIFIED?
	BNE	1$			;#JBM# YES, ERROR
	TST	SPC3(R4)		;#JBM# WAS THERE A OUTPUT FILE?
	BNE	START4			;#JBM# YES, GO PROCESS ANY SWITCHES
	MOV	SPC0(R4),-(SP)		;#JBM# NO, WERE THERE ANY INPUT FILES
	BIS	SPC1(R4),(SP)+
	BNE	START4			;#JBM# IF NOT EQUAL, PROCESS SWITCHES
	BR	SWTV			;#JBM# SHOULD VERSION I.D. BE TYPED

;+
;ERROR
1$:	$ERR	F,<Too many output files>,CR=YES			;MG01
;-
	.SBTTL COMPILER SWITCH PROCESSING:

START4:	MOV	(SP)+,R0		;# OF SWITCHES TO R0
	BNE	2$			;BR IF ANY SWITCHES TO PROCESS
	JMP	ENTSPC			;NO, GO DO THE ENTERS

2$:	MOV	#SWTLST,R1		;R1->LIST OF SWITCH NAMES
	MOV	#JMPSWT,R2		;R2->TABLE OF OFFSETS TO
					; SWITCH HANDLING ROUTINES
	DEC	R0			;DECREMENT SWITCH COUNT
	MOV	(SP)+,R3		;PICK UP A SWITCH
	MOV	R0,-(SP)		;PUT SWITCH COUNT BACK ON STACK
1$:	TST	(R2)+			;BUMP OFFSET TABLE PTR.
	CMPB	(R1)+,R3		;COMPARE SWITCH WITH LIST
	BGT	1$			;FIND THE SWITCH
	BNE	BDSWT			;CAN'T FIND IT
	MOV	@R2,-(SP)		;GET OFFSET TO SWITCH
	ADD	PC,@SP			;MAKE IT ABSOLUTE
	ASL	R3			;CARRYSET => SWITCH VALUE
JMPSWT:	JMP	@(SP)+			;DISPATCH TO SWITCH HANDLER
	SWTX-JMPSWT+2			;X, MISTRY SWITCH. (DEBUG ONLY)
	SWTU-JMPSWT+2
	SWTT-JMPSWT+2
	SWTS-JMPSWT+2
	SWTR-JMPSWT+2
	SWTN-JMPSWT+2
	SWTM-JMPSWT+2
	SWTD-JMPSWT+2
	SWTB-JMPSWT+2			;***** REVERSE ALPHABETIC ORDER *****
SWTLST:	.ASCIZ	"XUTSRNMDB"
	.EVEN

; TEST FOR SWITCH BEING ENTERED FROM CTY, WITH BA.SYS IDLE. THAT IS
; ILLEGAL FOR /B,/D,/M,/S,/R.

TSTSWT:	TST	@BATSW1(R4)		;IS BA ACTIVE?
	BEQ	BDSWT			;BR IF BA INACTIVE
	RTS	PC			;O.K.

;+
;ERROR
BDSWT:	$ERR	F,<Invalid option>,CR=YES
;-
	BR	GETCOM
	.SBTTL	/X COMPILER SWITCH

; INPUT FILE IS ASSUMED TO BE PRE-COMPILED.

SWTX:	BCS	BDSWT			;ERROR IF C BIT SET
	BIS	#XSWT,BATSW2(R4)	;INPUT ALREADY COMPILED
	BR	START4			;PROCESS ANY OTHER SWITCHES
	.SBTTL	<CR> COMPILER SWITCH (VERSION)

; PRINT VERSION I.D.

SWTV:	TST	(SP)			;WERE ANY SWITCHES SPECIFIED?
	BNE	START4			;YES, DON'T PRINT VERSION I.D.
	.PRINT	#VERID			;PRINT VERSION I.D. MESSAGE
	JMP	GETCOM			;GET THE NEXT COMMAND

	.GLOBL	VERID

VERID:	.NLCSI
	PATLVL	== .-2
	.EVEN
	.SBTTL	/U COMPILER SWITCH

; THIS SWITCH PERMITS THE BATCH HANDLER TO BE UNLOADED AFTER
; EXITING FROM THE COMPILER.

SWTU:	BCS	BDSWT			;ERROR IF C BIT SET
	MOV	@#SYSPTR,R0		;MAKE R0 POINT TO
	MOV	EMT16(R0),-(SP)		;LIST OF EMT 16 FUNCTIONS
	ADD	(SP)+,R0
	MOV	@O$TIN(R4),(R0)		;REMOVE BATCH HANDLER
	ADD	O$TIN(R4),(R0)
	SUB	R0,(R0)
	MOV	@O$TOT(R4),1*2(R0)	;HOOKS FROM MONITOR.
	ADD	O$TOT(R4),1*2(R0)
	SUB	R0,1*2(R0)
	MOV	@O$EXT(R4),10*2(R0)
	ADD	O$EXT(R4),10*2(R0)
	SUB	R0,10*2(R0)
	MOV	@O$PRN(R4),11*2(R0)
	ADD	O$PRN(R4),11*2(R0)
	SUB	R0,11*2(R0)
	CLR	@BATSW1(R4)		;CLEAR ACTIVITY WORD

	.CSECT	ERRLST			;DO AUTO UNLOAD OF BA		;BC3+

BAMSG:	.ASCIZ	/Unload BA:/		;LINE TO PASS TO KMON
BAMSGE	= .								;002

	.CSECT	PROGRM

	MOV	#510,R0			;POINT TO CHAIN INFO AREA	;002
	MOV	#BAMSG,R2		;POINT TO LINE FOR KMON
	MOV	#BAMSGE-BAMSG,(R0)+	;STORE BYTE COUNT
1$:	MOVB	(R2)+,(R0)+		;STORE A BYTE
	BNE	1$			;IF NE, MORE TO DO
	BIS	#CHNIF$,@#JSW		;SET CHAIN TO @FILE BIT
	CLR	R0			;MUST DO HARD EXIT		;BC3-
	.EXIT
	.SBTTL	/T COMPILER SWITCH

SWTT:	BCC	BDSWT			;/T:N 0=NO TIME <>0=TIME, N REQUIRED
	MOV	2(SP),R2		;SWITCH VALUE TO R2
	MOV	(SP)+,(SP)		;REPLACE WITH SWITCH COUNT
	TST	R2			;TEST VALUE FOR ZERONESS
	BEQ	1$			;IF EQUAL DON'T PRINT TIME
	BIS	#TIME,(R4)		;PRINT TIME OF DAY
	BR	START4			;RETURN TO PROCESS ANY OTHER SWITCHES

1$:	BIC	#TIME,(R4)		;DON'T PRINT TIME OF DAY
ST4LNK:	BR	START4			;RETURN TO PROCESS ANY OTHER SWITCHES
	.SBTTL	/S COMPILER SWITCH

;+
;
; THE /S SWITCH IS USED BY BATCH TO CALL ANOTHER BATCH STREAM.
; IT CAUSES THE CURRENT BA HANDLER STACK TO BE PUSHED DOWN
; SO IT CAN CONTINUE WHERE IT LEFT OFF WHEN THE NEW BATCH STREAM
; DECLARES END OF JOB.
;
;-

SWTS:	BCS	SWTU			;BR IF ILLEGAL VALUE
	JSR	PC,TSTSWT		;TEST IF BA ACTIVE
	BIS	#SBIT,BATSW2(R4)	;FLAG FOR LATER ACTION
	BR	ST4LNK			;CONTINUE PROCESSING

; EOJSUB -- SUBROUTINE SHARED BY /S,/R SWITCHES. EOJSUB PUSHES THE
; CURRENT BATCH  HANDLER PARAMETERS ONTO THE BATCH "STACK", WHICH
; IS STORED IN PHYSICAL BLOCK 5 OF THE SYSTEM DEVICE. IT
; DECREMENTS THE BLOCK # OF THE CURRENT INPUT FILE BEFORE STORING
; IT SO THAT THE BLOCK MAY BE RE-READ WHEN BATCH RETURNS FROM A CALL.

EOJSUB:	JSR	PC,RDSTK		;READ BATCH STACK INTO MEMORY
	MOV	BATOBP(R4),R0		;R0->CURRENT PLACE IN STACK
	ADD	#SAVNUM*2,(R0)		;MOVE FOREWARD # OF BYTES TO SAVE
	CMP	#360,(R0)		;TEST FOR STACK  FULL
	BLT	BSOUFL			;BATCH STACK OVERFLOW
	ADD	(R0),R0
	MOV	BATICT(R4),R1		;R1 -> INPUT CHARACTER COUNT
	MOV	(R1),(R0)+		;BATICT
	MOV	-(R1),(R0)+		;BATIPT
	MOV	INDATA(R4),R1
	TST	(R1)+
	DEC	(R1)			;SUBTRACT 1 FROM THE BLOCK NUMBER
	MOV	(R1)+,(R0)+		;INBLOK
	MOV	@BATSW1(R4),(R0)+	;STACK THE STATUS WORD ALSO	;003
	ADD	#6,R1
	JSR	PC,WRTSTK		;WRITE OUT BATCH STACK
	RTS	PC
	.SBTTL	WRTSTK,START3,RDSTK SUBROUTINES

;+
;
; WRTSTK -- COMMON SUBROUTINE USED BY /R AND /S CODE TO WRITE OUT
; 		THE BATCH STACK. USES R0,R2,R5.
;
; RDSTK -- SUBROUTINE TO READ INTO MEMORY THE BATCH STACK(BLK 5 OF SY:BA.SYS)
;		USES R0,R1
;
;-

WRTSTK:	JSR	PC,BLT10		;INSAV,+2,+4,+6,+10
START3:	MOV	#STKBLK,R0
	ADD	R4,R0
	MOV	#11*400+16,(R0)		;.WRITW CHAN. 16
	EMT	375
	BCS	WTBSER			;WRITE BATCH STACK ERROR
	.CLOSE	16
CALRTP:	RTS	PC

WTBSER:	MOV	PC,R0			;SAVE OFFENDING PC
	BR	FTLNK			;TAKE FATAL EXIT

RDSTK:	.CLOSE	16			;MAKE SURE ITS CLOSED
	MOV	#WDBLK2+2,R0		;WDBLK2 IS ARG. LIST
	ADD	R4,R0
	MOV	BATOBP(R4),STKBLK+4(R4)
	MOV	#BATSTK,R1		;R1 -> BATCH STACK F.D.
	MOV	R1,(R0)			;PUT IN ARG. LIST
	MOV	#1*400+16,-(R0)		;PUT IN EMT CODE
	EMT	375			;.LOOKUP
	BCS	1$			;FATAL ERROR!
	MOV	#STKBLK,R0
	ADD	R4,R0
	MOV	#10*400+16,(R0)
	EMT	375			;.READW
	BCC	CALRTP			;BR IF READ O.K.
	MOV	PC,R0			;SAVE OFFENDING PC
	BR	FTLNK			;TAKE FATAL EXIT

1$:	MOV	PC,R0			;SAVE PC FOR ANALYSIS
FTLNK:	JMP	BATFTL			;GO TO FATAL EXIT

BSOUFL:	CLR	@BATSW1(R4)		;***SPR #11-10583 CLEAR ACTIVITY WORD
;+
;ERROR
	$LERR	F,<Batch stack overflow>				;MG01
;-
	.EXIT
	.SBTTL	/R COMPILER SWITCH

SWTR:	BCS	SWTS
	JSR	PC,TSTSWT		;TEST FOR BA ACTIVE
SWTR1:	JSR	PC,RDSTK		;READ BATCH STACK INTO BATOBF
	MOV	BATOBP(R4),R1		;R1 -> STACK
	TST	(R1)			;IS IT EMPTY?
	BMI	BATFIN			;BR IF SO, WE'RE DONE!
	ADD	(R1),R1			;R1 -> CURRENT PLACE IN STACK
	SUB	#SAVNUM*2,@BATOBP(R4)	;REDUCE COUNT
	MOV	BATICT(R4),R0		;R0 -> INPUT CHAR. COUNT
	MOV	(R1)+,(R0)		;RESTORE INPUT COUNT
	MOV	(R1)+,-(R0)		;AND INPUT POINTER
	MOV	INDATA(R4),R0		;R0 -> INPUT EMT BLOCK IN BA
	TST	(R0)+			;R0 -> INPUT BLOCK #
	MOV	(R1),-(SP)		;SAVE THE BLOCK NUMBER
	INC	(R1)			;BUMP THE BLOCK # IN BA
	MOV	(R1)+,(R0)+		;AND PLACE IN EMT BLOCK
	MOV	R0,-(SP)		;POINTER TO INBUF POINTER
	MOV	(R1)+,@BATSW1(R4)	;RESTORE STACKED STATUS WORD	;003
	ADD	#6,R0			;R0 -> INPUT SAVE STATUS AREA IN BA
	MOV	R1,-(SP)		;SAVE PTR TO BATCH STACK
	JSR	PC,WRTSTK		;WRITE OUT THE STACK
	TST	4(SP)
	BPL	2$
	BIC	#ABORT,(R4)
	JMP	SWTR3

2$:	MOV	#WDBLK2+2,R0
	ADD	R4,R0
	MOV	(SP)+,(R0)		;R0 -> BATCH STACK

; REOPEN THE INPUT FILE THAT WAS PREVIOUSLY SAVED WHEN A
; NEW BATCH STREAM WAS $CALLED.

	MOV	#6*400,-(R0)		;.REOPEN
	EMT	375
	BCS	REOPER			;REOPEN ERROR
	MOV	#STKBLK,R0
	ADD	R4,R0
	MOV	@(SP)+,STKBLK+4(R4)	;GET POINTER TO BA INPUT BUFFER
	MOV	(SP)+,STKBLK+2(R4)	;THEN THE BLOCK #
	MOV	@#SYSPTR,R5
	BIS	#BATRN$,@CONTXT(R5)	;INDICATE BATCH FOR THIS JOB

; NOW READ IN THE BLOCK THAT WAS IN THE BA HANDLER'S BUFFER WHEN THE
; $CALL WAS MADE. SINCE POINTER AND CHARACTER COUNT WERE PRESERVED,
; BATCH STREAM SHOULD CONTINUE WHERE IT LEFT OFF AT $CALL.

	MOV	#10*400,(R0)		;READW
	EMT	375
	BCS	REOPER
	BIC	#BATRN$,@CONTXT(R5)	;YES, RESET 'BATCH RUNNING' BIT
	JMP	SWTR2

;+
;ERROR
REOPER:	$ERR	F,<Return from call error>,CR=YES			;MG01
;-

;***************[SPR #11-10924]***************

BATFIN:	TST	@BATSW1(R4)		;BA ACTIVE?
	BEQ	2$			;NO, SKIP LOG FLUSH
	CLR	R0			;SETUP TO FLUSH LOG BUFFER
	MOV	#400,R1			;WITH 400 NULLS
	MOV	#SOURCE+DESTON+BSOURC+BDESTN,@BATSW1(R4)
1$:	.TTYOUT
	DEC	R1
	BNE	1$
	CLR	@BATSW1(R4)		;CLEAR BATSW1 TO MAKE BA IDLE
2$:	.PRINT	#ENDBAT
	.EXIT

;*********************************************

BATSTK:	.RAD50 "SY BA    SYS"
	BATST2	= BATSTK+2		;'BAX' REPLACES 'BA' IF XM MONITOR;BC5

; ARGUMENT LIST FOR READ/WRITE OF BATCH STACK BLOCK (#5 OF BA.SYS FILE)

	ENTRLO	STKBLK,10*400+16,BATBLK,.-.,400,0
	.SBTTL	/N COMPILER SWITCH

SWTN:	BCS	SWTR
	BIS	#ABORT,(R4)		;DON'T RUN AFTER COMPILE
	JMP	START4
	.SBTTL	/M COMPILER SWITCH

; THE /M SWITCH IS USED ONLY BY THE BATCH COMPILER TO CREATE (MAKE)
; SOURCE FILES FOR ITS OWN USE.

SWTM:	BCS	SWTN
	JSR	PC,TSTSWT		;TEST FOR BA ACTIVE
	MOV	#DEFCHN,R2		;ADDRESS OF DEFAULT CHANNEL NUMBERS
	ADD	R4,R2
	JSR	R5,ENTER		;ENTER SPECIFIED FILE
	 SPC0
	 .WORD	0
	 .RAD50	/DK /
	BR	2$

;GET DATA UNTIL CTRL/Z ENCOUNTERED, THEN CLOSE FILE.
; DATA IS FED TO THIS CODE FROM THE CTL FILE VIA THE .TTYIN
; REQUEST. THE BA HANDLER THINKS THE TEXT FOLLOWING THE $CREATE
; COMMAND IS JUST PROGRAM DATA FOR SOME STRANGE PROGRAM CALLED BATCH.

1$:	MOVB	R0,R3
	JSR	PC,PUTCHR
2$:	.TTYIN				;GET NEXT CHARACTER FROM CTL FILE
	CMPB	R0,#CTRL.Z		;^Z?
	BNE	1$			;NO, CONTINUE GETTING DATA
	JSR	PC,CLOSE0		;YES, CLOSE OUTPUT FILE
	.EXIT
	.SBTTL	/B COMPILER SWITCH

;+
;
; THE /B SWITCH ON A COMMAND TO THE BATCH COMPILER IS USED TO CONTINUE
; THE BATCH STREAM WHEN A NEW JOB IN A CARD STREAM IS ENCOUNTERED OR
; WHEN A $JOB OR $SEQ CARD IS ENCOUNTERED WITHOUT A PRECEDING $EOJ
; COMMAND. WHAT HAS HAPPENED IS THE BATCH COMPILER HAS CREATED A
; TEMPORARY FILE THAT CONTAINS THE COMMAND:
;	.R BATCH
;	*/B
;
; FOLLOWED BY SOME BINARY DATA THAT IT WISHES TO PRESERVE THROUGH
; ANOTHER CALL OF  THE BATCH COMPILER.THIS IS NECESSARY BECAUSE BATCH
; REALLY ISN'T REENTRANT. THE DATA THAT FOLLOWS IN THE CTT FILE IS FED
; TO THE COMPILER A BYTE AT A TIME THROUGH THE .TTYIN REQUEST  AND USED
; TO RESTORE INPUT AND OUTPUT BUFFER POINTERS AND THE NAME OF THE .BAT
; FILE BEING EXECUTED.
;
; AN EXAMPLE OF THIS HAPPENING IS WHEN THE COMPILER DISCOVERS A $JOB CARD
; THAT WASN'T PRECEDED BY AN $EOJ CARD. BATCH ASSUMES THIS IS THE
; START OF A NEW JOB AND THE PREVIOUS JOB IS FLUSHED BY ZEROING THE OUTPUT
; BUFFER AND BLOCK #, EFFECTIVELY FLUSHING ANY OUTPUT DONE UP TO NOW.
; BATCH THEN CREATES A  CTT FILE WITH THE /B COMMAND TO ITSELF, AND
; SAVES THE OUTPUT FILE POINTERS AND ITS CURRENT PLACE IN THE INPUT
; .BAT FILE, WHICH IS POINTING AT THE $JOB COMMAND. IT THEN PASSES
; THIS CTT FILE TO THE BA HANDLER WHICH EXECUTES IT, RE-RUNNING BATCH.
; THE /B SWITCH CAUSES BATCH TO PICK UP THE INPUT AND OUTPUT FILE
; POINTERS, EFFECTIVELY STARTING BATCH UP AT THE POINT OF THE
; NEW $JOB COMMAND.
;
;-

SWTB:	BCS	SWTM			;A VALUE IS ILLEGAL
	JSR	PC,TSTSWT		;TEST FOR BA ACTIVE
	BIS	#MAKEB,(R4)		;SET MAKEB SWITCH
	.TTYIN				;GET A CHARACTER
	MOVB	R0,BINARG(R4)		;REPLACE CHAN. # IN INPUT EMT BLK
	.TTYIN
	MOVB	R0,BATIBK(R4)		;THEN THE INPUT BLOCK #
	.TTYIN
	MOVB	R0,BATIBK+1(R4)
	MOV	#SPC0,R1		;POINT TO CTL FILE DESCR.
	ADD	R4,R1
	MOV	#^D39*2,R2		;TRANSFER 39. BYTES
1$:	.TTYIN
	MOVB	R0,(R1)+
	DEC	R2
	BNE	1$
	JMP	ENTSPC			;THEN CONTINUE LIKE NOTHING HAPPENED
					; BUT REMEMBER MAKEB BIT IS SET!
	.SBTTL	DEFCHN - DEFAULT CHANNEL NUMBERS

;+
;
;IN THE EVENT THAT YOU WISH TO CHANGE THE CHANNEL ASSIGNMENTS
;FOR THE SPC'S, HERE IS A HANDY-DANDY LIST.
;( DEFCHN: .BYTE SPC0#,...,SPC8# )
;
;-

	ENTRLO	DEFCHN

	.CSECT	IMPURE

	.BYTE 0,1,2,3,4,5,6,7,10
	.EVEN

	.CSECT	PROGRM
	.SBTTL	/D COMPILER SWITCH

;+
;
; THE /D SWITCH IS USED BY $MOUNT AND $DISMOUNT TO PRINT THE PHYSICAL
; DEVICE NAME ASSOCIATED WITH A LOGICAL NAME ON THE CTY. IT DOES
; THIS BY FETCHING THE HANDLER, DOING A .LOOKUP, AND THEN A .DSTATUS
; AND .SAVESTATUS TO EXTRACT DEVICE NAME AND UNIT NUMBER.
; NOTE: DEVLST BELOW MUST BE ORDERED IDENTICALLY WITH THE DEVICE
; IDENTIFICATION CODES USED BY THE RT-11 MONITOR.
;
;-

SWTD:	BCS	SWTM
	JSR	PC,TSTSWT		;TEST FOR BA ACTIVE
	MOV	@BATSW1(R4),-(SP)
	CLR	@BATSW1(R4)
	MOV	#SPC3,R3
	ADD	R4,R3
	CLR	2(R3)			;MAKE SURE IT'S NULL NAME
	JSR	PC,DOFET		;FETCH HANDLER			;BC4
	BCS	DSMTER
	MOV	#WDBLK2+2,R0
	ADD	R4,R0
	MOV	R3,(R0)
	MOV	#1*400+0,-(R0)		;CHANNEL 0
	EMT	375			;LOOKUP
	BCS	DSMTER
	MOV	#WDBLK5,-(SP)
	ADD	R4,(SP)
	MOV	R3,R0
	EMT	16*20+2			;.DSTATUS
	BCS	DSMTER
	MOVB	WDBLK5(R4),R1
	ASL	R1
	MOV	#DEVLST,R2
	ADD	R2,R1
	.TTYOUT	(R1)+
	.TTYOUT	(R1)+

; TO GET UNIT # WITHOUT DOING A SAVESTAUS (ILLEGAL FOR MT AND CT)
; GO DIRECTLY TO CHANNEL 0, WHICH STARTS 4 BYTES BEYOND FRONT OF
; RMON AND EXTRACT THE HIGH BYTE OF THE FIFTH WORD.

	MOV	@#SYSPTR,R2		;R2 -> RMON
	MOVB	$CSW+11(R2),R0		;GET UNIT # FROM CH 0
	ADD	#60,R0
	.TTYOUT
DSMTDN:	MOV	R3,R0			;POINT TO DEVICE NAME AGAIN
	CLR	-(SP)			;SET UP TO DO A
	EMT	343			;.RELEAS
	MOV	(SP)+,@BATSW1(R4)
1$:	.TTYIN
	BR	1$
.SBTTL	DEVLST	RT-11 DEVICE-NAME LIST
; Device names for DSTATUS codes 00-67(8)

DEVLST:
	.ASCII	/RKDTELLPTTDLDYPC/	; Codes 00-07(8)
	.ASCII	/VSMTRFCTCR  DSHG/	; Codes 10-17(8)
	.ASCII	/MMDPDXDM  NLAXCP/	; Codes 20-27(8)
	.ASCII	/VLLQLRLSDDMSP3P5/	; Codes 30-37(8)
	.ASCII	/  LSMQIBXTCOLDVM/	; Codes 40-47(8)
	.ASCII	/DUSLDZDWPISPMPXL/	; Codes 50-57(8)
	.ASCII	/MUNCSDSTDCUB    /	; Codes 60-67(8)

	.EVEN

;*	*	*	*	*	*	*	*	*	*
;+
;ERROR
DSMTER:	$ERR	F,<Mount,Dismount error>,CR=YES				;MG01
;-
	BR	DSMTDN

;
; ROUTINE TO FETCH DEVICE HANDLER AND TO CATCH FATAL FETCH ERRORS
; PREVIOUSLY, BATCH COULD GET THE FATAL MONITOR TRAP BY
; LOADING HANDLERS OVER THE USR IF THERE WASN'T ENOUGH MEMORY.  THIS
; ERROR IS NOW CAUGHT SO PROPER MESSAGE CAN BE ISSUED.
;

DOFET:	.SERR				;SO WE CATCH FATAL FETCH ERRORS	;BC4+
	MOV	R3,R0			;POINT TO DEV NAME
	MOV	DEVSPC(R4),-(SP)	;AREA TO FETCH HANDLER INTO
	EMT	343			;DO THE FETCH
	BCC	1$			;IF CC, NO ERROR, JUST RETURN
	TSTB	@#ERRBYT		;ERROR, WAS IT FATAL?
	BMI	2$			;IF MI, YES, ISSUE ERROR AND EXIT
	.HERR				;NO, REVERT TO NORMAL ERROR PROCESSING
	SEC				;REPORT ILLEGAL DEVICE ERROR ON FETCH
1$:	RTS	PC			;RETN, C IS SET IF ERROR

2$:	CLR	BATSW1(R4)		;FATAL ERROR, CLEAR ACTIVITY WORD
;+
;ERROR
	$ERR	F,<Insufficient memory>,CR=YES ;NOT ENOUGH MEMORY TO
;-
					; FETCH HANDLER			;MG01
	.EXIT				;EXIT				;BC4-
	.ENABL	LSB

;+
;ERROR
NOCH3:	$ERR	F,<Input file>,CR=YES					;MG01
;-
	JMP	GETCOM

; ENTSPC TESTS FOR AN INPUT FILE WHICH MUST BE SPECIFIED. IT THEN
; OPENS OUTPUT FILES FOR THE CTL AND LOG OUTPUT.

ENTSPC:	MOV	#DEFCHN,R2		;ADDRESS OF THE DEF. CHAN NUM.
	ADD	R4,R2
	TST	SPC3(R4)
	BEQ	NOCH3
	BIT	#XSWT,BATSW2(R4)	;IS X SWITCH ON?
	BEQ	2$			;BRANCH IF NOT /X
	CMP	SPC3+6(R4),(PC)+	;DID CSI PUT IN BAT EXT?
	 .RAD50	/BAT/
	BNE	1$			;NO, O.K.
	MOV	RADCTL,SPC3+6(R4)	;YES, MAKE IT CTL
	BR	1$

2$:	CMP	SPC3+6(R4),(PC)+	;DID CSI PUT IN CTL EXTENSION
RADCTL:	 .RAD50	/CTL/
	BEQ	1$			;YES
	JSR	R5,ENTER		;ENTER SPC0
	 SPC0				;DEFAULT COMPILER NAME
	 .RAD50	/CTL/
	 .RAD50	/DK /
1$:	INC	R2			;NEXT CHANNEL

; IF LOG FILE SPECIFICATION DIDN'T INCLUDE A FILE SIZE, USE
; DEFAULT SIZE DEFLOG TO MAKE SURE FILE IS BIG ENOUGH.

	BIT	#SBIT,BATSW2(R4)	;SKIP LOG FILE IF /S SWITCH
	BNE	4$			;BRANCH IF /S SET
	BIT	#MAKEB,(R4)		;DITTO FOR /B
	BNE	4$
	TST	SPC1+10(R4)		;SIZE SPECIFIED?
	BNE	3$			;YES, USE THAT SIZE
	MOV	#DEFLOG,SPC1+10(R4)	;USE DEFAULT SIZE
3$:	JSR	R5,ENTER
	 SPC1
	 .RAD50	/LOG/
	 .RAD50	/LOG/
4$:	MOV	#6,R5			;COUNTER
	MOV	#SPC3,R3
	ADD	R4,R3
	CMPB	(R2)+,(R2)+

	.DSABL	LSB

; LOOKUP TESTS THE 6 POSSIBLE INPUT CHANNELS FOR FILE SPECIFIERS
; AND OPENS AS MANY CHANNELS AS ARE SPECIFIED. AT LEAST CHANNEL 3
; MUST BE SPECIFIED. LOOKUP FETCHES A HANDLER FOR EACH INPUT FILE,
; WHERE REQUIRED.

LOOKUP:	TST	(R3)
	BEQ	LUKUPN			;NO FILE
	JSR	PC,DOFET		;FETCH HANDLER, CHECK FOR ERROR	;BC4
	BCC	LUKUPF			;LOOKUP THE INPUT CHANNELS
;+
;ERROR
	$ERR	F,<Invalid device>,CR=YES				;MG01
;-
	BR	LUKXIT

	ENTRLO	DEVSPC,BATEND

; LUKUPF DOES LOOKUPS ON ALL CHANNELS

LUKUPF:	MOV	R0,DEVSPC(R4)		;UPDATE THE HANDLER SPACE POINTER
	MOV	#WDBLK2+2,R0
	ADD	R4,R0
	MOV	R3,(R0)
	MOV	#1*400,-(R0)		;LOOKUP
	MOVB	(R2),(R0)		;SET IN THE CHANNEL NUMBER
	EMT	375
	BCC	LUKUPN
;+
;ERROR
	$ERR	F,<File not found>,CR=YES				;MG01
;-
LUKXIT:	JSR	PC,CLOSE		;CLOSE INPUT FILES, IF OPEN
	.EXIT

LUKUPN:	INC	R2
	ADD	#10,R3
	DEC	R5
	BGT	LOOKUP

; AT THIS POINT MUST TEST FOR /S SWITCH AND CALL EOJSUB TO PUSH
; THE BATCH STACK BEFORE CONTINUING.

	BIT	#SBIT,BATSW2(R4)	;WAS /S SWITCH USED?
	BEQ	1$			;NO, SKIP THIS
	JSR	PC,EOJSUB		;YES, PUSH DOWN A LEVEL
2$:	JMP	STRT8A			;SKIP LOG SETUP ON /S

1$:	BIT	#MAKEB,(R4)		;COMING FROM /B?
	BNE	2$			;BR IF SO, SKIP LOG SETUP

;**** KEEP TOGETHER ****

	ENTRLO	WDBLK2,0,0,0		;EXTRA 0 FOR LOOKUPS
	ENTRLO	WDBLK5,0,0,0,0,0

;***********************

; IF LOG DEVICE IS FILE-STRUCTURED, A FIXED LENGTH FILE WAS ENTERED.
; TO MAKE THIS PERMANENT UNDER CURRENT RT-11 FILE PRACTICES, BATCH
; MUST INITIALIZE THE FILE BY WRITING ZEROES IN ALL BLOCKS. THIS
; CAN BE ELIMINATED IF RT-11 SUPPORTS CTRL/Z AS EOF.

	TST	LOGTYP(R4)
	BPL	STRT8B			;NON FILE STRUCTURED
	MOV	#WDBLK5+12,R2
	ADD	R4,R2
	MOV	#BATOBF-LOWSEG,R1	;R1 -> OUTPUT BUFFER
	ADD	R4,R1
	CLR	-(R2)			;WRITW
	MOV	#1000,-(R2)		;WC
	MOV	R1,-(R2)		;BUFFER
	MOV	#1000,R3		;SET TO CLEAR OUTPUT BUFFER
1$:	CLR	(R1)+
	DEC	R3
	BNE	1$
	CLR	-(R2)			;START AT BLOCK 0
	MOV	R2,R1			;COPY PTR TO BLOCK #
	MOV	#11*400,-(R2)		;WRITE CHANNEL
	MOVB	DEFCHN+1(R4),(R2)	;SET IN THE CHANNEL NUMBER
2$:	MOV	R2,R0			;COPY ARG. LIST POINTER
	EMT	375			;.WRITE WITH WAIT
	INC	@R1			;BUMP BLOCK #
	INC	@R1
	BCC	2$			;KEEP WRITING UNTIL EOF
	TSTB	@#ERRBYT		;ERROR OR EOF?
	BNE	LOGERR			;ERROR ON WRITE
	BR	START8			;EOF, WE'RE DONE

	ENTRLO	FTLPC,0			;SAVE AREA FOR PC OF FATAL ERROR
BATFTL:	MOV	R0,FTLPC(R4)
	CLR	BATSW1(R4)		;***SPR #11-10583 CLEAR ACTIVITY WORD
;+
;ERROR
	$ERR	F,<Batch fatal error>,CR=YES				;MG01
;-
	.EXIT
	.SBTTL	ENTER OUTPUT FILES

;+
;
; ENTER IS A SUBROUTINE CALLED TO ENTER  OUTPUT FILES
; FOR THE BATCH COMPILER. CALLING SEQUENCE AND ARG. LIST IS:
;	JSR	R5,ENTER
;	OFFSET TO FILE NAME
;	DEFAULT EXTENSION
;	DEFAULT DEVICE
;
; R0,R1 ARE DESTROYED.
;
;-

	.ENABL	LSB

ENTER:	MOV	(R5)+,R1		;GET OFFSET
	ADD	R4,R1			;R1 -> FILE NAME
	MOV	(R5)+,R3		;R3 = DEFAULT EXTENSION
	MOV	(R5)+,R0		;R0 = DEFAULT DEVICE
	TST	(R1)+			;BRANCH IF DEVICE WAS SPECIFIED
	BNE	1$
	MOV	R0,-2(R1)		;NO, SO USE DEFAULT DEVICE
1$:	TST	@R1			;WAS FILE NAME SPECIFIED?
	BEQ	2$			;BR IF NOT, USE INPUT FILE NAME
	CMP	(R1)+,(R1)+		;POINT TO EXTENSION
	BR	4$

2$:	MOV	#SPC3+2,R0		;R0 -> INPUT FILE NAME
	ADD	R4,R0
	TST	(R0)			;BRANCH IF INPUT FILE EXISTS
	BNE	3$			;AND USE THAT AS OUTPUT NAME,
	MOV	#TMPSPC,R0		;ELSE USE THE TEMPORARY NAME.
3$:	MOV	(R0)+,(R1)+		;TRANSFER NAME
	MOV	(R0)+,(R1)+
4$:	TST	(R1)+			;WAS EXT SPECIFIED?
	BNE	5$			;YES, USE IT
	MOV	R3,-2(R1)		;NO, USE DEFAULT
5$:	MOV	#WDBLK5+6,R0
	ADD	R4,R0
	CLR	(R0)			;LAST WD IS 0(CT,MT ONLY)
	MOV	(R1),-(R0)		;SIZE
	SUB	#10,R1			;FIX IT UP
	MOV	R1,-(R0)		;POINTER TO DEVBLK
	MOV	#2*400,-(R0)		;ENTER
	MOVB	(R2),(R0)		;SET IN THE CHANNEL NUMBER
	EMT	375			;.ENTER
	BCS	6$
	RTS	R5

6$:	CLR	BATSW1(R4)		;***SPR #11-10583 CLEAR ACTIVITY WORD
	DECB	@#ERRBYT		;WHICH ERROR WAS IT?		;MG01+
	BEQ	7$			;ERROR 1...
	BGT	8$			;ERROR 3...
;+
;ERROR
	$ERR	F,<Channel in use>,CR=YES	;ERROR 0...
	.EXIT

7$:	$ERR	F,<Output device full>,CR=YES
	.EXIT

8$:	$ERR	F,<Protected file already exists>,CR=YES
;-
	.EXIT								;MG01-

	.DSABL	LSB

CRLF:	.WORD	0

TMPSPC:	.RAD50	/TEMP/
LOGERR:	CLR	BATSW1(R4)		;***SPR #11-10583 CLEAR ACTIVITY WORD
;+
;ERROR
	$ERR	F,<LOG device error>,CR=YES				;MG01
;-
	.EXIT

; THE LOG FILE MUST NOW BE CLOSED SO IT MAY BE LOOKED UP AND
; THEN .SAVESTATUSED FOR PASSING TO THE BA HANDLER.

STRT8B:	CLR	SPC1+10(R4)		;NON FILE STRUCTURED
START8:	MOV	#6*400,R0		;CLOSE
	BISB	DEFCHN+1(R4),R0		;PUT IN LOG CHANNEL #
	EMT	374			;DO THE CLOSE
	BCC	1$			;NO PROBLEMS...			;MG01+
	JMP	CLSERR			;MALICIOUS USER AT WORK AGAIN...

1$:	MOV	#SPC1,R1		;R1 -> LOG FILE DESCRIPTOR	;MG01-
	ADD	R4,R1
	MOV	#WDBLK2+2,R3
	ADD	R4,R3
	MOV	R3,R0			;COPY PTR TO EMT BLOCK
	MOV	R1,(R0)
	MOV	#1*400,-(R0)		;LOOKUP SPC1
	MOVB	DEFCHN+1(R4),(R0)	;PUT IN THE CHANNEL NUMBER
	EMT	375
	MOV	#WDBLK5,R1		;OF LOG FILE IN WDBLK5.
	ADD	R4,R1
	MOV	R3,R0			;COPY POINTER AGAIN
	MOV	R1,(R0)
	MOV	#5*400,-(R0)
	MOVB	DEFCHN+1(R4),(R0)	;SET IN THE CHANNEL NUMBER FOR SPC1
	EMT	375			;SAVESTATUS FOR LOG
	BCS	LOGERR
	MOV	ODATA(R4),R0		;R0 -> OUTPUT SAVE STATUS AREA IN BA
	JSR	PC,BEGSUB		;XFR SAVESTATUS DATA
STRT8A:	CMP	SPC3+6(R4),(PC)+
	 .RAD50	/CTL/
	BEQ	1$
	BIT	#XSWT,BATSW2(R4)	;IS X SWITCH ON?
	BNE	1$
	JMP	STCMPL			;NO, MUST COMPIL FIRST

; ONCE THE BATCH STREAM IS COMPILED, OR IF IT WAS PRE-COMPILED,
; CONTROL COMES HERE FOR FINAL PROCESSING BEFORE EXIT. IF THE ABORT
; BIT WAS SET DURING COMPILE, THE JOB IS NOT EXECUTED. ASSUMING ALL
; IS O.K., THE FOLLOWING CODE PASSES THE NECESSARY DATA TO THE
; BATCH HANDLER.

1$:	MOVB	DEFCHN+3(R4),-(SP)	;SPC3 IS A COMPILED INPUT
BEGIN:	MOV	#WDBLK2+2,R0
	ADD	R4,R0
	MOV	#WDBLK5,R1
	ADD	R4,R1
	MOV	R1,(R0)			;COPY POINTER
	MOV	#5*400,-(R0)
	MOVB	(SP)+,(R0)		;SET IN THE CHANNEL NUMBER
	EMT	375			;SAVE STATUS
	BCC	2$
	JMP	OUTERR

2$:	MOV	INDATA(R4),R0		;R0 -> INSAV-12 IN BA
	JSR	PC,BEGSUB		;MOVE INPUT CTL SAVESTATUS TO BA
	MOV	ODATA(R4),R0		;R0 -> LOG EMT BLOCK IN BA
	TST	(R0)+			;POINT TO OBLOK
	BIT	#SBIT+MAKEB,BATSW2(R4)	;IF THIS IS A $CALL (/S)
	BNE	SWTR3			;LEAVE LOG ALONE
	CLR	(R0)			;START AT BLOCK 0
	MOV	OUTBUF(R4),@BATOPT(R4)	;RESET BA OUT BUFFER PTR & CNT
	MOV	#OUBSIZ*2,@BATOCT(R4)
SWTR3:	MOV	INDATA(R4),R0
	TST	(R0)+			;POINT TO INBLOK
	CLR	(R0)			;START AT BLOCK 0
	CLR	@BATICT(R4)		;CLEAR INPUT CHAR. COUNT
	BIT	#EOJ,BATSW2(R4)
	BEQ	SWTR2
	JSR	PC,EOJSUB		;PUSH DOWN THE BATCH STACK
	MOV	(SP)+,SPC0+6(R4)
	BIC	#EOJ,BATSW2(R4)
	JMP	EOJEOJ

; INITIALIZE BA HANDLER SWITCH WORD TO INDICATE:
;	CHARACTERS ARE COMING IN THRU BA
;	CHARACTERS GOING OUT TO BA
;	TTY INPUT COMING FROM BA, NOT CTY
;	TTY OUTPUT GOING TO LOG, NOT CTY

SWTR2:	BIC	#^C<NOTTYB!HELP>,@BATSW1(R4) ;CLEAR ALL BUT I/O BITS	;003
	BIS	#SOURCE!DESTON!BSOURC!BDESTN,@BATSW1(R4)		;003
	BIT	#ABORT,(R4)
	BNE	ABORTT
ABORTX:	.EXIT

ELROER:	MOV	PC,R0			;SAVE PC OF ERROR
	JMP	BATFTL			;TAKE FATAL EXIT

ABORTT:	BIT	#ABORT,BATSW2(R4)
	BEQ	1$
	TST	@BATSW1(R4)
	BEQ	ABORTX

; THIS CODE FLUSHES THE LOG BUFFER BEFORE JOB ABORT.

	CLR	R0
	MOV	#1000,R1
7$:	.TTYOUT
	DEC	R1
	BNE	7$
	TST	CERRFG(R4)		;IS THIS A FATAL CTL FILE ERROR?;BC2
	BEQ	9$			;IF EQ, NO, JUST EXIT		;BC2
	JMP	BATFIN			;YES, ABORT BATCH COMPLETELY	;BC2

9$:	JMP	SWTR1

; THE JOB BEING COMPILED HAD AN ERROR, SO IT IS BEING ABORTED.
; FOLLOWING CODE LOGS THE ABORT MESSAGE, THEN REOPENS THE CTL
; FILE AND SEARCHES IT FOR LOG COMMENT LINES (BEGINNING WITH \C)
; WHICH REPRESENT THE COMMANDS IN THE ORIGINAL .BAT FILE. THESE
; LINES ARE LOGGED OUT TO GIVE THE OPERATOR INFORMATION ON COMPILE
; ERRORS, SINCE THEY WILL INCLUDE COMPILER DIAGNOSTIC COMMENTS.

1$:	JSR	PC,CLOSE		;CLOSE ALL INPUT CHANNELS
	MOV	#ABORT,BATSW2(R4)
	MOV	#WDBLK2,R0
	ADD	R4,R0
	MOV	#6*400+3,(R0)
	EMT	375
	BCS	ELROER			;ERROR LOG REOPEN ERROR(FATAL)
	MOV	#BINLCT,R0
	ADD	R4,R0
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+
	MOV	#10*400+3,(R0)+
	CLR	(R0)+
	MOV	#BATIBF-LOWSEG+INBSIZ+INBSIZ,(R0)
	ADD	R4,(R0)
	CLR	(R4)
;+
;ERROR
	$ERR	F,<Abort job>,CR=YES					;MG01
;-

; NOW LOG OUT ALL \C COMMENTS IN THE CTL FILE

2$:	JSR	PC,GETCHR		;GET NEXT CHARACTER
	CMPB	R3,#'\			;IS THIS CHARACTER A \?
	BNE	2$			;NO, GET THE NEXT CHARACTER
3$:	JSR	PC,GETCHR		;YES, GET CHAR. TO CHECK FOR C

;***************[SPR #11-10584]***************

8$:	CMPB	R3,#'C			;IS THIS CHARACTER A C?
	BNE	2$			;NO, START ALL OVER

; FOUND A \C LINE, SO OUTPUT TO LOG UNTIL ANOTHER \ FOUND.

4$:	JSR	PC,GETCHR		;GET NEXT CHARACTER
5$:	CMPB	R3,#'\			;IS THIS CHARACTER A \?
	BNE	7$
	JSR	PC,GETCHR
	CMPB	R3,#'\
	BNE	8$
7$:	.TTYOU	R3
6$:	CMPB	R3,#12			;<CR>?

;*********************************************

	BNE	4$			;NO,GET NEXT CHAR., LOOK FOR <CR>
	JSR	PC,GETCHR		;YES, GET NEXT CHAR.
	CMPB	R3,#15			;<LF>?
	BNE	5$			;NO, IT MAYBE A \ -- CHECK IT
	JSR	PC,GETCHR		;YES, GET NEXT CHAR.
	BR	6$			;LOOK FOR <CR>

BEGSUB:	ADD	#12,R0			;POINT TO OUTSAV
BLT10:	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	RTS	PC
	COMMAND	EOJ

	LABOUT	$ABORT,<<<$$$$$$>>>	;GOTO/IF TRANSFER CANT PASS THIS LABEL
	JSR	R5,FOUX			;DUMP THE LAST BUFFER
	 .WORD	NULINE
	JSR	R5,COMOUX
	 .WORD	RBATCH
	DATOUT	SLASHR,</R>,CR
	JSR	R5,COMOUX		;IN CASE OF A SUPRIOUS .EXIT
	 .WORD	NULINE
	JSR	R5,FOUX			;FINI
	 .WORD	CRLF
	JSR	PC,CLOSE0		;CLOSE CTL FILE
	BIS	#EOJ,BATSW2(R4)		;FLAG END OF JOB PROCESSED
	TSTB	(R4)			;IS MAKEB ON? I.E., /B SWITCH USED
	BPL	1$			;BR IF NOT
	BIS	#MAKEB,BATSW2(R4)	;YES, SET IN BATSW2
1$:	BIT	#BNOEOJ,BATSW2(R4)	;UNEXPECTED $JOB OR $SEQ?
	BNE	13$			;BR IF SO
12$:	JSR	PC,GETCHR
	BNE	11$
	BIC	#EOJ,BATSW2(R4)
	TSTB	BATSW2(R4)		;DID THIS COME FROM A MAKEB?
	BPL	EOJEOJ			;BRANCH IF NOT
	BIS	#EOJ,BATSW2(R4)		;YES, FLAG $EOJ IN BATSW2
	MOV	#CTRL.Z,R3		;EOF
11$:	TST	R3
	BEQ	12$
	CMPB	R3,#NL
	BEQ	12$
	CMPB	R3,#FORM
	BEQ	12$

; COME HERE IF BNOEOJ BIT SET, INDICATING A $JOB OR $SEQ FOUND
; WITHOUT A PRECEDING $EOJ COMMAND. THE COMPILER ASSUMES THE MISSING
; $EOJ COMMAND IS AN ERROR OF THE PREVIOUS JOB AND THE NEW $JOB OR $SEQ
;  IS THE START OF A NEW JOB. IT FLUSHES THE PRECEDING JOB AND
; STARTS FROM SCRATCH. TO DO THIS IT CREATES A FILE CALLED JOB.CTT USING
;  THE NAME OF THE CTL FILE UNDER CONSTRUCTION. IN THIS FILE IT SAVES
; THE INPUT FILE CHANNEL #, CURRENT INPUT BLOCK # AND CHARACTER
; POINTER, THE CTL AND LOG FILE DESCRIPTORS.THE FILE IS THEN GIVEN TO
; BA HANDLER FOR EXECUTION.

13$:	MOV	#BOTLCT,R0		;R0 -> OUTPUT BUFFER DATA
	ADD	R4,R0
	MOV	#OTBSIZ*2,R1		;INITIALIZE OUTPUT BUFFER
	MOV	R1,(R0)+
	MOV	#BFREE*400+BFREE,(R0)+
	MOV	#BATOBF-LOWSEG,(R0)
	ADD	R4,(R0)
	MOV	(R0)+,R2
	MOV	R1,(R0)+
	TST	(R0)+
	CLR	(R0)+
	MOV	R2,(R0)
	ADD	R1,(R0)
	MOV	#DEFCHN,R2		;R2 -> CTL CHAN. #
	ADD	R4,R2
	MOV	SPC0+6(R4),-(SP)	;SAVE CTL EXTENSION
	MOV	DOTS,SPC0+6(R4)		;PUT IN CTT EXT TEMP.
	MOV	R3,-(SP)
	JSR	R5,ENTER		;ENTER FILE.CTT
	 SPC0
DOTS:	 .RAD50	/CTT/
	 .RAD50	/DK /
	JSR	R5,COMOUX		;IN IT PUT .R BATCH
	 .WORD	RBATCH
	DATOUT	SLASHB,<<</B>>>,CR	;/B
	MOV	#BINARG,R0		;R0 -> INPUT FILE EMT ARG LIST
	ADD	R4,R0
	JSR	PC,BINOUT		;WRITE OUT INPUT FILE CHAN #
	MOV	#BATIBK,R0		;R0 -> INPUT BLOCK #
	ADD	R4,R0
	JSR	PC,BINOUT		;WRITE IT OUT
	JSR	PC,BINOUT
	MOV	#SPC0,R0		;R0 -> CTL FILE DESC.
	ADD	R4,R0
	MOV	2(SP),SPC0+6(R4)
	MOV	#^D39*2,R1		;RESTORE CTL EXT
25$:	JSR	PC,BINOUT		;WRITE OUT CTL AND LOG FD'S
	DEC	R1
	BNE	25$
	MOV	DOTS,SPC0+6(R4)		;RESTORE CTT EXT AGAIN
	MOV	(SP)+,R3
	BIT	#BNOEOJ,BATSW2(R4)
	BEQ	4$
	BIC	#BNOEOJ,BATSW2(R4)
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	CLR	R3
4$:	TST	R3
	BEQ	5$
	MOVB	R3,R3
	JSR	PC,PUTCHR
5$:	JSR	PC,GETCHR
	BNE	4$
	MOVB	#CTRL.Z,R3		;TERMINATE CTT FILE WITH EOF
	JSR	PC,PUTCHR
EOJX:	JSR	PC,CLOSE0						;BC2
EOJEOJ:	MOVB	DEFCHN+0(R4),-(SP)
	MOV	#SPC0,R1
	ADD	R4,R1
	MOV	#WDBLK2+2,R0
	ADD	R4,R0
	MOV	R1,(R0)
	MOV	#1*400,-(R0)		;LOOKUP SPC0
	MOVB	(SP),(R0)
	EMT	375			;DO THE LOOKUP
	BCS	CTLERR			;NO CTL FILE; SENT TO NON-DIR. DEVICE?
	JSR	PC,CLOSE		;CLOSE ALL INPUT CHANNELS
	JMP	BEGIN			;AND WE'RE OFF AND RUNNING

CTLERR:	CLR	BATSW1(R4)		;***SPR #11-10583 CLEAR ACTIVITY WORD
;+
;ERROR
	$ERR	F,<No control file>,CR=YES				;MG01
;-
	.EXIT

; FLUSH OUTPUT BUFFER, WAIT FOR I/O TO FINISH, THEN CLOSE CTL FILE.

	.ENABL	LSB

CLOSE0:	CLR	R3
2$:	BIT	#OTBSIZ*2-1,BOTCTR(R4)
	BEQ	1$
	JSR	PC,PUTCHR
	BR	2$

1$:	BIT	#BWAIT*400+BWAIT,OTSTAT(R4)
	BNE	1$			;WAIT FOR COMPLETION
	MOV	#6*400,R0		;SETUP .CLOSE
	BISB	DEFCHN+0(R4),R0		;OUTPUT CHANNEL NUMBER
	EMT	374			;.CLOSE
	BCC	3$			;NO PROBLEM...			;MG01+
;+
;ERROR
CLSERR:	$ERR	F,<File created:protected file already exists>,CR=YES
;-
	.EXIT

3$:	RTS	PC							;MG01-

	.DSABL	LSB

BINOUT:	MOVB	(R0)+,R3
	CMPB	R3,#'\
	BNE	1$
	MOVB	R3,R3
	JSR	PC,PUTCHR
1$:	MOVB	R3,R3
	JSR	PC,PUTCHR
	RTS	PC

; CLOSE ALL INPUT FILES ON CHANNELS 3-8

CLOSE:	MOV	#6*400+3,R1		;START AT CHAN 3
1$:	MOV	R1,R0			;COPY EMT ARG
	EMT	374			;CLOSE A CHANNEL
	INCB	R1			;BUMP CHAN # BYTE
	CMPB	R1,#9.			;DONE ALL 6?
	BLT	1$			;NO, CONTINUE
	RTS	PC
	.SBTTL	START TO COMPILE

	.ENABL LSB

COMPIL:	BIS	#FIRST,BATSW2(R4)	;FIRST CARD PROCESSED
STCMPL:	COMMAND	EOD			;END OF DATA
	CLR	IMMFLG			;Reset card image flag.
LINE:	MOV	STACK(R4),SP
	CLR	-(SP)
	BIT	#MAKE,(R4)
	BEQ	LINE1			;NO TEMP.SOURCE NEED BE CREATED
	BIC	#MAKE,(R4)
	MOV	LINIMP(R4),R0
	MOV	#LINIMS,R1
	ADD	R4,R1
	MOV	#LINSZ/2,R2
100$:	MOV	(R1)+,(R0)+
	DEC	R2
	BNE	100$
	SUB	#LINSZ,R0
	HOUT
	JSR	PC,.ASCI0
	BR	LINE2B

NOTUNI:	TST	(SP)+
	TST	(SP)+
;+
;ERROR
	$LERR	F,<Ambiguous command>
;-
LINE1:	JSR	PC,GETIMM		;GET A LINE OF CODE
LINE2B:	CMPB	(R0),#'$		;SEE IF FIRST CHARACTER IS A DOLLAR
	BNE	NODOLR			;NOT EQUAL, NO DOLLAR
	LOGOUT	CRLF
	JSR	R5,LOGOUX		;OUTPUT THE LINE IMAGE
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL

;************[SPR #11-10591  PART 1]*************

	JSR	PC,EDIT			;REMOVE COMMENTS AND COMPRESS
					; SPACES AND TABS
	INC	R0			;MOVE PAST THE DOLLAR

;************************************************

	TSTB	(R0)
	BEQ	LINE1			;'$ !COMMENT LINE'
	MOV	#KEYWRD,R1		;ADDRESS OF KEY WORD TABLE IN R1
	MOV	#KEYTAB-4,R5		;DISPATCH ADDRESS IN R5
	CLR	-(SP)			;INCASE OF UNIQUE SWITCH
1$:	ADD	#4,R5			;POINT TO NEXT COMMAND POINTER
	JSR	R5,SCANX		;TRY TO MATCH
	 BR	FOUND			;FOUND A MATCH
2$:	TSTB	(R1)			;END OF TABLE?
	BEQ	NFOUND			;YES
	INC	R1
	TSTB	(R1)			;SKIP OVER THE SWITCHES
	BGT	1$
	BR	2$

LINE2:	MOV	STACK(R4),SP
	CLR	-(SP)
	BR	LINE2B

FOUND:	BGE	NFOUND			;EXTRA CHARACTER AT END OF KEY
	TST	(SP)			;SHOULD BE 0
	BNE	NOTUNI			;NOT UNIQUE?
	MOV	R5,(SP)
	MOV	R3,-(SP)
	MOV	R1,-(SP)
	BIT	#UNIQUE,(R4)
	BNE	2$
NFOUND:	MOV	(SP)+,R1
	BEQ	UNKCOM
	MOV	(SP)+,R0		;UPDATE CURSOR
	MOV	(SP)+,R5
	MOV	(R5)+,TMPSWT(R4)	;PICK UP DEFAULT SWITCH SETTINGS
	BIS	#COMSWB,BATSW2(R4)
	JSR	PC,SWTCHK		;CHECK FOR VALID SWITCHES
	TST	(SP)+			;REMOVE ERROR FLAG

;*************[SPR #11-10591  PART 2]**************

	BIT	#TIME,(R4)		;PRINT TIME OF DAY
	BEQ	FNDJMP			;IF EQUAL NO

	.IF EQ PIC
	CMP	(R5),#C$$DATA		;$DATA COMMAND?
	.IFF
	CMP	(R5),#<C$$DATA-FNDJMP-2>;$DATA COMMAND?
	.IFTF
	BEQ	FNDJMP			;IF EQUAL YES
	.IFT
	CMP	(R5),#C$$EOD		;$OEDCOMMAND
	.IFF
	CMP	(R5),#<C$$EOD-FNDJMP-2>	;$EOD COMMAND?
	.ENDC

	BEQ	FNDJMP			;IF EQUAL YES
	COMOUT	CTIME,<TIME>,CR		;PRINT TIME OF DAY

;***************************************************

FNDJMP:	.IF EQ PIC
	JMP	@(R5)
	.IFF
	ADD	(R5),PC			;JUMP TO PROPER ADDRESS
	.ENDC

NODOLR:	BIT	#RT11,(R4)		;RT MODE
	BEQ	4$			;DON'T DEFAULT TO RT11 MODE
	JMP	DEFRT1			;DEFAULT

4$:	TST	(SP)			;SEE IF PREVIOUS ERROR
	BNE	LINE1			;NO
	INC	(SP)			;FLAG ERROR
;+
;ERROR
	$LERR	F,<'$' missing>						;MG01
;-
	BR	LINE1

	.DSABL LSB

;+
;ERROR
UNKCOM:	$LERR	F,<Unknown command>					;MG01
;-
	JMP	LINE
	.SBTTL	SCAN SUBROUTINE

;+
;
;SCAN COMPARES A STRING POINTED TO BY R0
;WITH A STRING POINTED TO BY R1. R0'S STRING IS TERMINATED BY
;A CHARACTER THAT IS NOT IN THE RANGE A-Z, OR 0-9.
;R1'S STRING IS ENDED WITH A BYTE < 0.
;CALL:	JSR	R5,SCANX		;(WITH R0 AND R1 SET UP)
;	(RETURN IF MATCH)
;	(RETURN IF NO MATCH)
;SCAN ALSO SETS CONDITION CODES; 0 IF TERMINATED IN 0-9
;+ IF TERMINATED IN A-Z; - IF ANYTHING ELSE
;SCAN LEAVES R0 ALONE, R3 POINTS TO CHARACTER AFTER MATCH IN R0
;SCAN USES REGISTERS (R0),R1,R2,R3,R5
;
;-

SCANX:	MOV	R0,R3			;USE R3 AS TEMPORARY CURSOR FOR LINE
SCAN2:	TSTB	(R1)			;ARE WE AT THE END OF A MATCH?
	BGT	3$			;NO
2$:	JSR	PC,CHRCHK		;YES, GET TYPE OF CHARACTER
					; AT END OF MATCH
	RTS	R5			;AND RETURN

3$:	JSR	PC,CHRCHK		;CHECK CHARACTER FOR ALPHA-NUMERICAL
	BGE	7$			;A-Z OR 0-9
	SUB	R0,R3			;SEE HOW MANY MATCHED
	BIT	#UNIQUE,(R4)
	BNE	4$			;IF UNIQUE SWITCH SET LET WHOEVER
					; CHECK FOR UNIQUENESS
	CMP	#3,R3
	BEQ	4$			;3 MATCHED, OK
8$:	TST	(R5)+			;NOT THERE, NOT OK
4$:	ADD	R0,R3			;RESTORE R3
5$:	TSTB	(R1)+			;MOVE R1 TO END OF STRING
	BGT	5$			;IF BRANCH, WE'RE NOT THERE
	DEC	R1			;THE END IS HERE
6$:	SEN				;SET "-" CONDITION
	RTS	R5

7$:	CMPB	(R1)+,(R3)+		;COMPARE THE TWO STRINGS
	BEQ	SCAN2			;STILL MATCHING
	DEC	R3
	BR	8$			;***** R3 GETS DESTROYED ON MISS MATCH
	.SBTTL	GETCHR SUBROUTINE

;+
;
;GETCHR GETS A CHARACTER FROM THE BATCH INPUT DEVICE AND PUTS IT IN R3
;IF IT RUNS OUT OF CHARACTERS IT GOES TO BATEOF
;THIS USES R3
;
;-

	.ENABL	LSB

1$:	JSR	R5,BATIO
	 .WORD	BINARG
	TST	BINCTR(R4)
	BEQ	2$
GETCHR:	TSTB	(R4)
	BMI	3$
	DEC	BINCTR(R4)
	BLT	1$			;BUFFER EMPTY
	MOVB	@ICHRPT(R4),R3		;PUT CHARACTER IN R3
	INC	ICHRPT(R4)		;BUMP POINTER
2$:	RTS	PC

3$:	MOV	R0,-(SP)
	.TTYIN
	MOV	R0,R3
	MOV	(SP)+,R0
	CMPB	R3,#CTRL.Z		;HAVE WE ENCOUNTERED A ^Z
	BNE	2$			;NO,RETURN
	BIC	#MAKEB,(R4)
	BR	GETCHR

	.DSABL	LSB
	.SBTTL	BATIO, DOUBLE BUFFERED I/O

;+
;
;PROGRAMMED WITH .READC AND .WRITEC RATHER THAN USING THE .WAIT CONSTRUCTION
;CALL:	JSR	R5,BATIO
;	.WORD	ARGPTR		(POINTER OFF OF R4 TO ARGUMENTS
;				 FOR READ OR WRITE)
;	(RETURN)
;
;THE ARGUMENT LIST MUST RESIDE IN THE IMPURE AREA AND THE "ARGPTR"
;MUST POINT TO THE FUNCTION WORD IN THE ARGUMENT BLOCK. THE LIST IS
;LAYED OUT AS FOLLOWS:
;
;	STATUS
;	CHARACTER POINTER
;	CHARACTER COUNTER
;	FUNCTION
;	BLOCK #
;	BUFFER POINTER
;	BUFFER SIZE
;	RESERVED FOR COMPLETION ADDRESS
;
;THERE IS A RESTRICTION THAT THE TWO INPUT AND THE TWO OUTPUT BUFFERS
;MUST BE ADJACENT. ALL REGISTERS ARE PRESERVED IF NO SYSTEM ERRORS.
;
;-

BATIO:	MOV	R0,-(SP)		;WE NEED
	MOV	R1,-(SP)		;	TO PRESERVE
	MOV	R2,-(SP)		;		THESE REGISTERS
	MOV	(R5)+,R0
	ADD	R4,R0			;POINTER TO FUNCTION WORD
BATIO2:	MOV	#COMPLE,R1		;COMPLETION ADDRESS IN R1
	MOV	4(R0),-4(R0)		;SET CHAR POINTER TO LAST
					; BUFFER TRANSFERED

;***************[SPR #11-10585]******************

	CLR	R2			;IN CASE OF EOF
	BIT	#BEOF*400+BEOF,-6(R0)	;EOF FOUND?
	BNE	BATIO4			;IF NOT EQUAL YES
	MOV	#BWAIT,R2		;STATUS BIT TO CHECK
	TST	-6(R0)			;WHICH BUFFER
	BMI	2$			;BUFFER 0
	SWAB	R2			;BUFFER 1
2$:	BIT	R2,-6(R0)		;I/O DONE YET?
	BNE	2$			;IF NOT EQUAL NO
	MOV	#BWAIT+BFREE,R2		;STATUS BITS TO SET

;************************************************

	MOV	6(R0),-(SP)		;WORD COUNT ON STACK
	ASL	(SP)			;CHARACTER COUNT
	TST	-6(R0)			;WHICH BUFFER
	BPL	1$			;BUFFER 0
	TST	(R1)+			;BUFFER 1, BUMP COMPLETION ADDRESS
	SWAB	R2			;BUFFER 1 STATUS BITS
	NEG	(SP)			;MOVE FOREWARD ONE BUFFER
1$:	SUB	(SP)+,4(R0)		;MOVE BACKWARD ONE BUFFER
	BIS	R2,-6(R0)		;SET IN THE WAIT BIT (AND NOT FREE)
	MOV	R1,10(R0)		;SET IN THE COMPLETION ADDRESS
BATIO3:	BIT	#EOJ,BATSW2(R4)
	BEQ	1$
	CMPB	1(R0),#11		;WRITE?
	BEQ	1$
	BIC	R2,-6(R0)
	CLR	R2
	BR	BATIO4

1$:	MOV	R0,-(SP)
	EMT	375			;DO .READC OR .WRITEC
	MOV	R0,R2			;SAVE WORD COUNT
	MOV	(SP)+,R0
	BCS	RWERR			;ERROR IN TRANSFER?
BATIO4:	ADD	R2,R2			;CHARACTER COUNT THAT IS
	MOV	-10(R0),-2(R0)		;MOVE IN OLD CHARACTER COUNT
	MOV	R2,-10(R0)		;RESET CHARACTER COUNT
	ASR	R2			;BACK TO WORD COUNT
	SWAB	R2			;TO BLOCK COUNT
	ADD	R2,2(R0)		;UPDATE BLOCK COUNT
	ADD	#100000,-6(R0)		;SWITCH BUFFERS (C WAS CLEAR)
	MOV	#BFREE,R2
	MOV	#BEOF,-(SP)
	BCS	1$			;C=1 BUFF 0,C=0 BUFF 1
	SWAB	(SP)
	SWAB	R2			;BUFFER 1
1$:	BIT	(SP)+,-6(R0)
	BEQ	3$
	BIS	#BEOF,BATSW2(R4)
	BIT	#EOJ,BATSW2(R4)
	BEQ	BATEOF
	BR	4$

3$:	BIT	#EOJ,BATSW2(R4)

;***************[SPR #11-10585***************

	BNE	4$
	BIT	R2,-6(R0)		;BUFFER FREE? (ONLY FIRST
					; TIME ON INPUT)
	BEQ	BATIO2			;YES, GO FILL THE SECOND BUFFER
4$:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0

;********************************************

	RTS	R5

BATEOF:	BIT	#JOB,(R4)
	BNE	1$
	BIT	#ABORT,BATSW2(R4)
	BNE	JMPABO
	JMP	SWTR1

;***************[SPR #11-10586]***************

;+
;ERROR
1$:	$LERR	F,<EOF with no $EOJ>					;MG01
;-
	JSR	PC,CLOSE0		;CLOSE OUTPUT FILE
	JMP	EOJEOJ			;COMPLETE PROCESSING

RWERR:	DECB	@#ERRBYT

;*********************************************

	BEQ	3$			;HARD ERROR
	BGT	1$			;FILE NOT OPEN. MAYBE EOF CONDITION
	BIT	#400,(R0)		;EOF, READ OR WRITE?
	BNE	WBEOF			;WRITE BEYOND END OF FILE
	INC	(R0)			;TRY NEXT CHANNEL NUMBER (INPUT)
	BIT	#17,(R0)		;DID WE PASS CHANNEL 17
	BEQ	4$			;YES, GIVE EOF
	CLR	2(R0)			;NEW CHANNEL, START AT BLOCK 0
	BR	BATIO3

1$:	BIT	#400,(R0)
	BNE	OFNO			;OUTPUT FILE NOT OPEN
4$:	MOV	#BEOF,R1
	TST	-6(R0)
	BGE	2$
	SWAB	R1
2$:	BIS	R1,-6(R0)
	BR	BATIO4

3$:	BIT	#400,(R0)
	BNE	OUTERR
;+
;ERROR
INERR:	$ERR	F,<Input error>,CR=YES					;MG01
;-
	BR	CERRX			;TAKE FATAL CTL FILE ERROR EXIT	;BC2

JMPABO:	JMP	ABORTT

COMPLE:	COM	R1			;BUFFER 0 COMPLETION
	MOV	R2,-(SP)		;BUFFER 1 COMPLETION
	MOV	R4,-(SP)
	MOV	#BWAIT*400,R2
	TST	R1			;0 OR 1 COMPLETION?
	BGE	1$
	SWAB	R2			;BUFFER 0
	COM	R1
1$:	MOV	#LOWSEG,R4
	ADD	#AREA0,R4		;POINT TO AREA0(AREA0)
	MOV	R1,-(SP)
	ASR	(SP)
	ASR	(SP)
	ASR	(SP)			;AREA DISPLACEMENT
	BIC	#177741,(SP)
	ADD	(SP)+,R4
	MOV	(R4),R4			;POINT TO IMPURE AREA
	BIT	#17,R1
	BEQ	2$			;OUTPUT (CHANNEL 0 MOD 20)
	BIC	R2,INSTAT(R4)
	BR	3$

2$:	BIC	R2,OTSTAT(R4)
3$:	ROR	R0			;WAS THERE AN ERROR TOO?
	BCS	RWERRC			;ERROR IN COMPLETION
	MOV	(SP)+,R4
	MOV	(SP)+,R2
	RTS	PC

	ENTRLO	AREA0,1000		;ONLY ONE IMPURE AREA AT THE MOMENT

RWERRC:	TST	R1			;INPUT OR OUTPUT
	BNE	INERR
;+
;ERROR
OUTERR:	$ERR	F,<Output error>,CR=YES					;MG01
	BR	CERRX			;TAKE FATAL CTL FILE ERROR EXIT	;BC2

WBEOF:	$ERR	F,<Output device full>,CR=YES				;MG01
;-
CERRX:	CLR	BOTCTR(R4)		;SO CLOSE0 DOESN'T WRITE	;BC2
	CLR	OTSTAT(R4)		;OR WAIT			;BC2
	BIS	#ABORT,(R4)		;WE'RE ABORTING COMPILE		;BC2
	MOV	SP,CERRFG(R4)		;SET FATAL CTL ERROR FLAG	;BC2
	JMP	EOJX			;GO CLEAN UP			;BC2

;+
;ERROR
OFNO:	$ERR	F,<Output file not open>,CR=YES				;MG01
;-
	BR	CERRX			;TAKE FATAL CTL FILE ERROR EXIT	;BC2

.CTRLZ:	MOV	#CTRL.Z,R3		;^Z-->R3
	BR	PUTCHR			;PUT INTO OUTPUT BUFFER

.LF:	MOV	#NL,R3			;LINEFEED --> R3
	BR	PUTCHR			;PUT IT INTO THE OUTPUT BUFFER

.EQUAL:	MOV	#'=,R3			;EQUAL --> R3
	BR	PUTCHR			;PUT IT INTO OUTPUT BUFFER

.ASCI2:	MOV	#'2,R3			;2 --> R3
	BR	PUTCHR			;PUT IT INTO OUTPUT BUFFER

.SPACE:	MOV	#SPC,R3			;SPACE --> R3
	BR	PUTCHR			;PUT IT INTO OUTPUT BUFFER

.R2:	MOV	R2,R3
	BR	PUTCHR

.SPPOP:	MOV	2(SP),R3
	MOV	(SP)+,(SP)
	BR	PUTCHR

.COMMA:	MOV	#',,R3			;COMMA --> R3
	BR	PUTCHR			;PUT IT INTO OUTPUT BUFFER

.ASCIA:	MOV	#'A,R3			;A --> R3
	BR	PUTCHR			;PUT IT INTO OUTPUT BUFFER

INCVAX:	KOUT	NULINE
	JSR	PC,PUTCHR
.ASCI0:	MOV	#'0,R3			;0 --> R3
PUTCHR:	MOVB	R3,@OCHRPT(R4)		;PUT CHARACTER INTO OUTPUT BUFFER
	INC	OCHRPT(R4)		;MOVE THE POINTER TO NEXT SPOT
					; IN BUFFER
	DEC	BOTCTR(R4)		;OUTPUT COUNTER GETS DECREMENTED
	BNE	PUTDON			;THERE'S STILL ROOM IN THE BUF
	JSR	R5,BATIO		;DO DOUBLE BUFFERED I/O
	 .WORD	BOTARG
PUTDON:	RTS	PC

PUTSTR:	MOVB	(R2)+,R3
	BLE	PUTDON
	JSR	PC,PUTCHR
	BR	PUTSTR

MESOUX:	JSR	R2,OUTPUX		;SEND CHAR. THAT FOLLOW TO TERMINAL
	 CTYOUB
	 .ASCII	"\@"

;AOUX:	JSR	R2,OUTPUX		;CHANGE INPUT SOURCE TO BE THE CONSOLE
;	 .WORD	0
;	 .ASCII	"\A"

LOGOUX:	JSR	R2,OUTPUX		;SEND FOLLOWING CHAR. TO LOG DEVICE
	 LOGOUB
	 .ASCII	"\C"

DATOUX:	JSR	R2,OUTPUX		;CONSIDER FOLLOWING AS USER DATA
	 DATOUB
	 .ASCII	"\D"

COMOUX:	JSR	R2,OUTPUX		;SEND FOLLOWING CHAR. TO RT MONITOR
	 COMOUB
	 .ASCII	"\E"

FOUX:	JSR	R2,OUTPUX		;FORCE OUTPUT OF CURRENT LOG BLOCK
	 .WORD	0
	 .ASCII	"\F"

GOUX:	JSR	R2,OUTPUX		;GET CHAR. FROM CONSOLE UNTIL <CR>
	 .WORD	0
	 .ASCII	"\G"

HOUX:	JSR	R2,OUTPUX		;HELP FUNCTION TO CHANGE LOG MODE
	 .WORD	0
	 .ASCII	"\H"

IOUX:	JSR	R2,OUTPUX		;CONDITIONAL TRANSFER
	 .WORD	0
	 .ASCII	"\I"

JOUX:	JSR	R2,OUTPUX		;JUMP, UNCONDITIONAL TRANSFER
	 .WORD	0
	 .ASCII	"\J"

KOUX:	JSR	R2,OUTPUX		;VARIABLE DIRECTIVE
	 .WORD	0
	 .ASCII	"\K"

LABOUX:	JSR	R2,OUTPUX		;INSERT LABEL
	 .WORD	0
	 .ASCII	"\L"
	.SBTTL	OUTPUX,OUTPU5,OUTPUL,CROUTP,OUTSTR SUBROUTINES

OUTPUX:	MOV	R3,-(SP)		;R2 ALREADY ON THE STACK
	BIT	(R2),(R4)		;JUST USED IT TO CALCULATE ADDRESS
	BNE	1$
	BIC	#CTYOUB+LOGOUB+DATOUB+COMOUB,(R4)
	BIS	(R2)+,(R4)
	MOVB	(R2)+,R3
	JSR	PC,PUTCHR
	MOVB	(R2),R3
	JSR	PC,PUTCHR
1$:	JSR	PC,OUTPU5		;OUTPUT THE MESSAGE
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RTS	R5

OUTPU5:	MOV	(R5)+,R2

	.IF NE PIC
	ADD	R5,R2
	.ENDC

OUTPUL:	JSR	PC,PUTSTR
	TSTB	R3
	BMI	OUTRTS			;NO C.R. ON 200
CROUTP:	MOVB	#15,R3			;CR --> R3
	JSR	PC,PUTCHR		;PUT IT INTO OUTPUT BUFFER
	JSR	PC,.LF			;THEN DO THE SAME WITH LF
OUTRTS:	RTS	PC			;RETURN

OUTSTR:	JSR	PC,OUTPU5		;OUTPUT THE MESSAGE
	RTS	R5			;RETURN
	COMMAND	SEQUENCE

	JSR	PC,SPACE$		;SKIP SPACES
	BIT	#JOB,(R4)		;$JOB ALREADY PROCESSED?
	BNE	NOEOJ			;YES, BRANCH ON ERROR
	BIT	#SEQ!FIRST,BATSW2(R4)	;$SEQ OR OTHER ALREADY PROCESSED?
	BNE	NOEOJ			;YES, AN ERROR
	BIS	#SEQ,BATSW2(R4)		;NO, FLAG FOR LATER REFERENCE
	CLR	R5
1$:	INC	R5			;COUNT # OF DIGITS IN SEQ. #
	MOVB	(R0)+,R2		;CHECK FOR NUMERIC CHARACTER
	JSR	PC,CHRCK
	BEQ	1$			;NUMBERS ARE OK
	TST	R2			;END OF SEQUENCE NUMBER?
	BNE	BADSEQ			;NO EOL,ERROR
	MOV	#OBJTMP+3,R3
	ADD	R4,R3
	MOV	#LSTTMP+7,R2
	ADD	R4,R2
	MOV	#SOUTMP+3,R1
	ADD	R4,R1
	DEC	R0
	DEC	R5			;ACTUALLY ONE LESS
	CMP	#3,R5			;MORE THAN 3 DIGITS?
	BGE	5$			;NO, USE THE COUNT
	MOV	#3,R5			;YES, USE JUST 3.
5$:	MOVB	-(R0),-(R3)
	MOVB	(R0),-(R2)
	MOVB	(R0),-(R1)
	DEC	R5
	BNE	5$
	JMP	STCMPL			;DON'T SET FIRST CARD BIT

	ENTRLO	LSTTMP,"LS,"T:,"00,200*400+'0

;+
;ERROR
BADSEQ:	$LERR	F,<Invalid sequence argument>				;MG01
;-
	COMMAND	JOB	SWITCH,TIME,RT11,BANNER,UNIQUE,LIST

	BIT	#BITLIS,COMSWT(R4)
	BEQ	2$
	BIS	#LSTDAT,BATSW2(R4)
	BR	3$

2$:	BIC	#LSTDAT,BATSW2(R4)
3$:	BIT	#JOB,(R4)
	BNE	NOEOJ
	BIS	#JOB,(R4)
	BIT	#FIRST,BATSW2(R4)	;FIRST CARD ALREADY PROCESSED?
	BNE	NOEOJ			;YES, AN ERROR
	BIT	#BANNER,(R4)
	BEQ	JMPCOM
	INTVAR	#'A,#1			;SET VARIABLE A TO 1
	LABOUT	DUMMY$,<<<!DUMMY>>>	;OUTPUT DUMMY LABEL
	JSR	R5,LOGOUX		;OUTPUT TO LOG THE LINE IMAGE
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	MOVB	#'A,R3
	JSR	PC,INCVAX
	IFOUT	#'A,#59.,IF$JOB,<<<!DUMMY0!DUMMY0!DUMMY1>>>
	LABOUT	DUMMY$
JMPCOM:	JMP	COMPIL			;MORE TO COMPILE

; $JOB OR $SEQ CARD WAS ENCOUNTERED BEFORE AN $EOJ. THIS IS ASSUMED
; TO BE THE START OF A NEW JOB (I.E., PREVIOUS JOB OMITTED THE $EOJ
; ERRONEOUSLY). THE COMPILER FLUSHES INPUT UP TO THIS POINT
; AND STARTS A NEW JOB.

;+
;ERROR
NOEOJ:	$LERR	F,<No $EOJ>						;MG01
;-
	BIS	#BNOEOJ,BATSW2(R4)
	JMP	C$$EOJ
	COMMAND	RUN

	GETFD	RUN
	COMOUT	CRUN,<<<RUN >>>
	FINDFD	RUN
	BEQ	NOFILE
	JSR	PC,OUTFD$		;GET FILE DESCRIPTION
	BNE	1$			;BRANCH IF ANOTHER FD EXISTS
	JSR	PC,BADPLU		;ELSE ITS AN ERROR
	BR	JMPCOM			;COMPILE

1$:	JSR	PC,CROUTP		;INSERT A CR/LF
	BR	JMPCOM			;COMPILE

;+
;ERROR
NOFILE:	$LERR	F,<No file>						;MG01
;-
	BR	JMPCOM			;COMPILE

;+
;ERROR
BADPLU:	$LERR	F,<Invalid '+'>						;MG01
;-
	RTS	PC
	.ENABL	LSB

	COMMAND	DIRECTORY

	BIS	#200,COMSWT(R4)
	JSR	PC,SVRDIR		;$DIR WILL CALL DIR, NOT PIP	;BC1
	BR	COPLUP			;BR INTO REST OF STUFF FOR $DIR	;BC1
	COMMAND	COPY	SWITCH,DELETE

	JSR	PC,SVRPIP
COPLUP:	TSTB	COMSWT(R4)
	BPL	COPFD
	GETFD	DIR	OUTPUT,INPUT,LIST
	EXCLUSIVE	DIR	OUTPUT,LIST
	FINDFD	DIR	OUTPUT,LIST
	BR	COPDIR

COPFD:	GETFD	COP	OUTPUT,INPUT
	FINDFD	COP	OUTPUT
COPDIR:	BNE	1$
	TSTB	COMSWT(R4)
	BPL	NOFILE
	JSR	PC,DIRDIR
	BR	COPLUP

1$:	BIC	#STARFD,BATSW2(R4)
	JSR	PC,OUTFD$		;OUTPUT THE OUTPUT FILE SPEC.	;BC3+
	BNE	2$			;IF NE, OK
	MOV	R0,-(SP)		;ERROR, SAVE R0
	MOV	R2,R0			;POINT TO THE BAD PLUS
	DEC	R0
	JSR	PC,BADPLU		;ERROR, GIVE MESSAGE
	MOV	(SP)+,R0		;RESTORE R0
2$:	TSTB	COMSWT(R4)		;OK - IS THIS $DIR?
	BMI	3$			;IF MINUS,YES,DON'T DO /U
	BIT	#STARFD,BATSW2(R4)
	BNE	3$
	DATOUT	SLASHU,<<</U>>>						;BC3-
3$:	JSR	PC,COPPRI
	BR	COPLUP
	COMMAND	PRINT	SWITCH,DELETE

	JSR	PC,SVRPIP
4$:	GETFD	PRI	NULL,INPUT
	DATOUT	LSTIT,<<<LST:>>>
	DATOUT	STARX,<<<*.*>>>						;001
	JSR	PC,COPPRI
	BR	4$
	COMMAND	DELETE

	JSR	PC,SVRPIP
5$:	GETFD	DEL	NULL
	JSR	PC,COPRDE
	BR	5$

	.DSABL	LSB

SVRPIP:	BIS	#STAROK,BATSW2(R4)
	JSR	R5,COMOUX
	 .WORD	RPIP
RTSPC:	RTS	PC

SVRDIR:	BIS	#STAROK,BATSW2(R4)	;SO $DIR WILL USE DIR, NOT PIP	;BC1+
	COMOUT	RDIR,<<<R  DIR>>>,CR
	RTS	PC			;BACK TO CALLER			;BC1-
	.ENABL	LSB

COPPRI:	JSR	PC,.EQUAL
DIRDIR:	FINDFD	COP	NULL,INPUT
	BNE	1$
	TSTB	COMSWT(R4)		;$DIR?
	BPL	NOFILE			;NO, GENERATE AN ERROR
1$:	JSR	PC,OTFDC$
	TSTB	COMSWT(R4)
	BPL	25$
	DATOUT	SLASHL,<<</L>>>
25$:	JSR	PC,CROUTP		;INSERT A CR/LF
	JSR	R5,FOUX			;DUMP THE LAST BUFFER
	 .WORD	NULINE
	DATOUT
	BIT	#BITDEL,COMSWT(R4)
	BEQ	COMCHK
COPRDE:	FINDFD	COP	NULL,INPUT
	CLR	R5
3$:	JSR	PC,OUTFD$
	BEQ	4$
	COM	R5
4$:	DATOUT	SLASHD
	TST	R5
	BEQ	3$
COMCHK:	BIT	#COMMA,(R4)
	BNE	RTSPC
	BIC	#STAROK,BATSW2(R4)
	JMP	COMPIL

	.DSABL	LSB
NXTRT1:	JSR	PC,CROUTP		;INSERT A CR/LF

	COMMAND	RT11
	JSR	PC,GETIMM
	CMPB	(R0),#'$		;IS FIRST CHARACTER A DOLLAR?
	BNE	DEFRT1			;DEFAULT TO RT
	JMP	LINE2

DEFRT1:	CMPB	(R0),#'*		;FIRST CHARACTER AN ASTERISK?
	BNE	TRYDOT			;NO,CHECK FOR A DOT
	DATOUT	NULINE
DOTGOT:	INC	R0
DATGOT:	MOVB	(R0)+,R3		;CHAR. IN LINE --> R3
	BEQ	NXTRT11			;=0...END OF RECORD, GIVE A CR/LF
	CMPB	R3,#''
	BEQ	2$
3$:	JSR	PC,PUTCHR		;PUT CHAR INTO OUTPUT BUFFER
	BR	DATGOT			;GET THE NEXT CHARACTER

2$:	MOVB	(R0)+,R3
	BEQ	RTERR
	CMPB	R3,#''
	BEQ	3$			;DOUBLE "'"
	CMPB	R3,#'"
	BEQ	QOTMES
	DEC	R0
	SCAN	CTY,<CTY>
	 BR	QCTY
	SCAN	FF,<FF>
	 BR	QFF
	SCAN	LF,<NL>
	 BR	QLF
	MOVB	(R0),R2
	JSR	PC,CHRCK
	BLE	RTERR
	KOUT	NULINE
;	JSR	R5,QERRQ
;	 BR	QERROR
	MOVB	(R0)+,R3
	JSR	PC,PUTCHR
	JSR	PC,.ASCI2
CLOSQT:	CMPB	(R0)+,#''
	BEQ	DATGOT
RTERR:	JSR	PC,BADIF
BC$RT1:	BR	C$$RT1

QCTY:	MOV	R3,-(SP)
	JSR	PC,QMBEL		;OUTPUT A ?,BELL,\G
	MOV	(SP)+,R3
	BR	SKIPQT			;SKIP OVER TO THE QUOTE

QLF:	MOV	R3,R0			;CHROUT DESTROYS R3
	MOVB	#NL,R3			;LINEFEED --> R3
	JSR	PC,PUTCHR		;PUT CHAR INTO OUTPUT BUFFER
	BR	CLOSQT

QFF:	JSR	R5,FOUX			;DUMP THE LAST BUFFER
	 .WORD	NULINE
	DATOUT
SKIPQT:	MOV	R3,R0			;SCAN LEFT R3 POINTING JUST RIGHT
	BR	CLOSQT			;MUST BE FOLLOWED BY A CLOSE '
QOTMES:	MESOUT
	BR	2$

1$:	JSR	PC,PUTCHR
2$:	MOVB	(R0)+,R3
	BEQ	RTERR
	CMPB	R3,#'"
	BNE	1$
	LOGOUT
	DATOUT
	BR	CLOSQT

TRYDOT:	CMPB	(R0),#'.		;IS THE CHAR. A DOT?
	BNE	NOTDOT			;NO,CHECK FOR ALPHA-NUMERIC
	COMOUT	NULINE
	BR	DOTGOT

NOTDOT:	JSR	PC,ALPNUM
	BEQ	NOLABL
	CMPB	R2,#':
BNRTER:	BNE	RTERR
	MOVB	#200,-(R0)
	JSR	R5,LABOUX
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	MOVB	#':,(R0)+
1$:	CMP	#6,R1
	BLE	NOLABL
	MOVB	#SPC,R3
	JSR	PC,PUTCHR
	INC	R1
	BR	1$
NOLABL:	JSR	R5,LOGOUX		;OUTPUT TO LOG THE LINE IMAGE
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	JSR	PC,EDIT			;REMOVE COMMENTS, COMPRESS
					; SPACES AND TABS
NOLAB:	TSTB	(R0)
	BEQ	BC$RT1
	CMPB	(R0)+,#40
	BEQ	1$
	DEC	R0
1$:	MOV	#'0,-(SP)
	SCAN	NOTTY,<NOTTY>
	 BR	CNOTTY
	SCAN	TTYIO,<TTYIO>
	 BR	CTTYIO
	SCAN	TTYIN,<TTYIN>
	 BR	CTTYIN
	SCAN	TTYOUT,<TTYOUT>
	 BR	CTTOUT
	TST	(SP)+
	SCAN	IF,<IF>
	 BR	CIF
	SCAN	GOTO,<GOTO>
	 BR	CGOTO
	SCAN	LET,<LET>
	 BR	CLET
	CMPB	(R0),#'%
	BNE	BNRTERR			;IMPLIED LET IS AN ERROR
	INC	R0			;BUMP THE VARIABLE
	JSR	R5,LETINC
	 .WORD	'0
	BR	NOLAB

CLET:	MOV	R3,R0
CLETIM:	JSR	R5,LETINC
	 .WORD	'1
	JSR	PC,SPACE$
	CMPB	(R0)+,#'=
	BNE	BNRTERR
	JSR	PC,ARGOUT
	BR	NOLAB

CGOTO:	MOV	R3,R0
	JSR	R5,JOUX
	 .WORD	NULINE
	JSR	PC,GETLAB
	BR	NOLAB

LETINC:	JSR	PC,SPACE$
	KOUT
;	JSR	R5,QERRQ
;	 BR	1$
	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BLE	BADVAR
	JSR	PC,.R2
1$:	MOVB	(R5),R3
	JSR	PC,PUTCHR
R5POP:	TST	(R5)+
	RTS	R5
;QERRQ:	SCAN	IFERROR
;	 BR	2$
;	BR	R5POP
;
;2$:	MOV	R3,R0
;	CHROUT	<#'@>
;	RTS	R5

;+
;ERROR
BADVAR:	$LERR	F,<Invalid variable>
;-
	TST	(R5)+
	RTS	R5

CTTYIN:	INC	(SP)
CNOTTY:	INC	(SP)
CTTYIO:	INC	(SP)
CTTOUT:	MOV	R3,R0
	HOUT
	JSR	PC,.SPPOP
BRNOLA:	BR	NOLAB

CIF:	MOV	R3,R0
	JSR	PC,IF$
JC$RT1:	JMP	C$$RT1

	.ENABL	LSB

IF$:	JSR	PC,SPACE$
	CMPB	(R0)+,#'(
	BNE	BADIF
	JSR	PC,SPACE$
;	SCAN	IFERROR,<ERROR>
;	 BR	IF.AT
	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BGT	1$			;A-Z
;+
;ERROR
BADIF:	$LERR	F,<Invalid construction>
;-
	RTS	PC

BADIF2:	TST	(SP)+
	BR	BADIF

;IF.AT:	MOV	#'@,R2
;	MOV	R3,R0
1$:	MOV	R2,-(SP)
	IOUT
	JSR	PC,.SPPOP
	JSR	PC,SPACE$
	CMPB	(R0)+,#'-
	BNE	3$			;NO MINUS SIGN?
	JSR	PC,ARGOUT
	BR	4$

3$:	CLR	R3
	MOVB	R3,R3			;COMPARE WITH 0
	JSR	PC,PUTCHR
	DEC	R0
4$:	JSR	PC,SPACE$
	CMPB	(R0)+,#')
	BNE	BADIF
	JSR	PC,GETLAB
	BEQ	6$
	CMPB	(R0)+,#',
	BNE	BADIF
6$:	JSR	PC,GETLAB
	BEQ	7$
	CMPB	(R0)+,#',
	BNE	BADIF2
7$:	JSR	PC,GETLAB
	LABOUT SPACE6
	BR	BRNOLAB

	.DSABL	LSB

	.CSECT	ERRLST

SPACE6:	.BYTE	40,40,40,40,40,40,200

	.CSECT	PROGRM

ARGOUT:	JSR	PC,SPACE$
	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BNE	5$
	CLR	-(SP)
2$:	SUB	#60,R2
	CMP	#10,R2
	BLE	BADIF2
	ASL	(SP)
	ASL	(SP)
	ASL	(SP)
	ADD	R2,(SP)
	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BEQ	2$
3$:	DEC	R0
4$:	JSR	PC,.SPPOP
	RTS	PC

5$:	CMPB	R2,#'"
	BNE	BADIF
	MOVB	(R0)+,-(SP)
	BR	4$

	.DSABL	LSB

GETLAB:	JSR	PC,SPACE$
	MOV	#'0,-(SP)
	CMPB	(R0),#'-
	BEQ	1$
	INC	(SP)
	CMPB	(R0),#'+
	BNE	2$
1$:	INC	R0
2$:	MOV	#6,-(SP)
3$:	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BLT	5$
	JSR	PC,.R2
	DEC	(SP)
	BGT	3$
4$:	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BGE	4$
45$:	TST	(SP)+
	JSR	PC,.SPPOP
	MOVB	-(R0),R2
	RTS	PC

5$:	JSR	PC,.SPACE
	DEC	(SP)
	BGT	5$
	BR	45$

SPACE$:	CMPB	(R0),#40		;DO WE HAVE A SPACE?
	BNE	1$			;IF NO, RETURN
	INC	R0			;IF YES, SKIP IT
1$:	RTS	PC
	COMMAND	MOUNT	SWITCH,WAIT,WRITE

	DEFAULT	SWITCH	WAIT
	COMOUT				;IN CASE OF UNEXPECTED .EXIT
	JSR	R5,MESOUX
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	GETFD	MOU	LOGICAL,PHYSICAL,VID
	EXCLUSIVE	MOU	NULL,PHYSICAL
	JSR	R5,COMOUX
	 .WORD	RBATCH
	FINDFD	MOU	PHYSICAL
	JSR	R5,MOUSUB
	 BR	NOPHDV
	JSR	PC,.R2
	DATOUT	SLASHD
	FINDFD	MOU	LOGICAL
	BEQ	MOUQUS
	ASSPAC=DASSPC+2							;BC3
	COMOUT	ASSPAC
	FINDFD	MOU	NULL,PHYSICAL,VID
	JSR	R5,MOUSUB
	 BR	NOPHDV
	JSR	PC,.SPACE
	FINDFD	MOU	LOGICAL
	JSR	R5,MOUSUB
	 BR	NOLODV
	JSR	PC,CROUTP		;INSERT A CR/LF
	JSR	PC,QUSBEL		;Signal the operator
	BR	JMCOMP
	COMMAND	DISMOUNT	SWITCH,WAIT

	DEFAULT SWITCH	WAIT
	COMOUT				;IN CASE OF UNEXPECTED .EXIT
	JSR	R5,MESOUX
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	GETFD	DIS	LOGICAL
	EXCLUSIVE	DIS	NULL,LOGICAL
	JSR	R5,COMOUX
	 .WORD	RBATCH
	FINDFD	DIS	NULL,LOGICAL
	MOV	R2,-(SP)		;(SAVE FOR DE-ASSIGN)
	JSR	R5,MOUSUB
	 BR	NOLODV
	JSR	PC,.R2
	DATOUT	SLASHD
	COMOUT	DASSPC,<<<DEASS >>>					;BC3
	MOV	(SP)+,R2
	JSR	R5,MOUSUB
	 BR	NOLODV			;THIS SHOULD NEVER HAPPEN
					; (BUT IT IS BETTER THAN A HALT)
	JSR	PC,CROUTP		;INSERT A CR/LF
	BR	MOUQUS

MOUSUB:	BEQ	3$
	MOV	R2,R0
1$:	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BMI	2$
	JSR	PC,.R2
	BR	1$

2$:	CMPB	R2,#':
	BNE	3$
	TST	(R5)+
3$:	RTS	R5

;+
;ERROR
NOPHDV:	$LERR	F,<No physical device>					;MG01
	BR	JMCOMP

NOLODV:	$LERR	F,<No logical device>					;MG01
;-
	BR	JMCOMP
	COMMAND	MESSAGE	SWITCHES,WAIT

	MESOUT
	MOV	R0,R2
	JSR	PC,OUTPUL
MOUQUS:	JSR	PC,QUSBEL
JMCOMP:	JMP	COMPIL

QUSBEL:	BIT	#BITWAI,COMSWT(R4)
	BEQ	OTFDRT
QMBEL:	MESOUT
	MOVB	#'?,R3
	JSR	PC,PUTCHR
	MOVB	#7,R3
	JSR	PC,PUTCHR
	JSR	R5,GOUX
	 .WORD	NULINE
OTFDRT:	RTS	PC
	COMMAND	CHAIN
	JSR	PC,CHNCAL
	JSR	PC,CROUTP		;INSERT A CR/LF
	JSR	PC,COMCHK
	BR	C$$CHA
	COMMAND	CALL
	JSR	PC,CHNCAL
	DATOUT	SLASHS,</S>,CR
	JSR	PC,COMCHK
	BR	C$$CAL

CHNCAL:	JSR	R5,FOUX			;DUMP THE LAST BUFFER
	 .WORD	NULINE
	COMOUT	RBATCH,<<<R  BATCH>>>,CR
	GETFD	CHA	INPUT
	FINDFD	CHA	NULL,INPUT
OTFDC$:	JSR	PC,OUTFD$
	BNE	OTFDRT
	JSR	PC,.COMMA
	BR	OTFDC$
; THESE SWITCHES MAY APPEAR ONLY ON THE $JOB CARD, HENCE
; THEY APPLY TO THE ENTIRE JOB. SETCLR SETS OR CLEARS THE
; BIT AS SPECIFIED BY THE $JOB CARD.

	SWITCH	UNIQUE
	JSR	R5,SETCLR
	 .WORD	BITUNI
	 .WORD	UNIQUE

	SWITCH	TIME
	JSR	R5,SETCLR
	 .WORD	BITTIM
	 .WORD	TIME

	SWITCH	RT11
	JSR	R5,SETCLR
	 .WORD	BITRT1
	 .WORD	RT11

	SWITCH	BANNER
	JSR	R5,SETCLR
	 .WORD	BITBAN
	 .WORD	BANNER

SETCLR:	BIT	(R5)+,TMPSWT(R4)
	BEQ	1$
	BIS	(R5),(R4)
	BR	2$

1$:	BIC	(R5),(R4)
2$:	MOV	(SP)+,R5
	BR	NXTSWT
	.SBTTL	CHRCHK SUBROUTINE

;+
;
; TESTS A CHARACTER POINTED TO BY R3
;TO SEE IF IT IS IN THE RANGE A-Z,0-9, OR OTHER
;RETURNS CONDITIONS + IF A-Z, 0 IF 0-9, - IF OTHER
;CHRCK COMPARE CHARACTER IN R2 FOR THE ABOVE
;CALL:	JSR	PC,CHRCHK (OR CHRCK)
;	(RETURN WITH CONDITIONS SET)
;USES R2
;
;-

CHRCHK:	MOVB	(R3),R2			;PUT CHARACTER TO TEST IN R2
CHRCK:	CMPB	#'Z,R2			;COMPARE TO Z,SET UP HIGH LIMIT
	BLT	1$			;NOT A-Z OR 0-9 RETURN LT
	CMPB	R2,#'@			;CHECK FROM LOW LIMIT
	BGT	1$			;A-Z RETURN GT
	CMPB	#'9,R2			;CHECK FROM HIGH LIMIT FOR #
	BLT	1$			;NOT A-Z,0-9 LT
	CMPB	R2,#'0			;CHECK FROM LOW LIMIT
	BLT	1$			;DITTO
	SEZ				;0-9 RETURN 0
1$:	RTS	PC

	.ENABL LSB

	SWITCH	VID
	CMPB	(R0)+,#'=
	BNE	2$
	CMPB	(R0)+,#'"
	BNE	3$
1$:	MOVB	(R0)+,R2
	BEQ	2$
	CMPB	R2,#'"
	BNE	1$
	BR	NXTSWT

3$:	JSR	PC,ALPNUM
	BNE	4$
;+
;ERROR
2$:	$LERR	F,<Invalid VID>
;-
4$:	DEC	R0
	BR	NXTSWT

	.DSABL LSB

	SWITCH	LIST
	BIT	#NO,(R4)
	BEQ	NXTSWT
	BIS	#LSTBIT,BATSW2(R4)
	BR	NXTSWT
	.SBTTL	SWTCHK SUBROUTINE

;+
;
; RETURNS A BIT MAP OF SWITCHES IN TMPSWT
;ENTER WITH R0 POINTING AT POSSIBLE SWITCH, AND R1
; POINTING TO ACCEPTABEL SWITCHES
;CALL:	JSR	PC,SWTCHK
;
;-

	.ENABL LSB

SWTCHK:	MOV	R3,-(SP)
	MOV	R5,-(SP)
	MOV	R1,-(SP)		;R1 POINTS TO LIST OF SWITCH NUMBERS
	BIC	#NO,(R4)		;SOME SWITCHES CAN'T TAKE A 'NO' VALUE
	SWITCH	BASIC
	SWITCH	CREATE
	SWITCH	FORTRAN
	SWITCH	INPUT
	SWITCH	LIBRARY
	SWITCH	LOGICAL
	SWITCH	MACRO
	SWITCH	NULL
	SWITCH	PHYSICAL
	SWITCH	SOURCE
	BIT	#NO,(R4)
	BNE	BADSW1			;THESE SWITCHES CAN'T HAVE 'NO' VALUES
	SWITCH	DATA
	SWITCH	DELETE
	SWITCH	DOLLAR
	SWITCH	EXECUTE
	SWITCH	MAP
	SWITCH	OBJECT
	SWITCH	OUTPUT
	SWITCH	RUN
	SWITCH	WAIT
	SWITCH	WRITE
NXTSWT:	CMPB	(R0),#'/
	BNE	NOSWT			;NONE OR NO MORE SWITCHES
NXTSW2:	INC	R0			;POINT TO FIRST CHARACTER OF SWITCH
	MOV	R0,R3			;R3 AS TEMPORARY CURSOR
	BIC	#NO,(R4)
	CMPB	(R3)+,#'N
	BNE	6$
	CMPB	(R3)+,#'O
	BNE	6$			;NO "NO"SWITCH
	BIT	#COMSWB,BATSW2(R4)
	BEQ	BADSW1			;'NO' ONLY IN COMMAND FIELDS
	MOV	R3,R0
	BIS	#NO,(R4)		;SET THE "NO"SWITCH
6$:	MOV	#SWIT,R1
	CLR	R5			;COUNTER OF VALID SWITCH NUMBER
	CLR	-(SP)			;UNIQUENESS FLAG
1$:	DEC	R5			;SWITCH NUMBERS ARE NEGATIVE
2$:	MOVB	(R1)+,R2		;FIRST CHARACTER OF SWITCH IS MINUS
	BGT	2$			;NOT FIRST CHARACTER
	BEQ	UNKSWT			;UNKNOWN SWITCH OR END OF TABLE
	NEG	R2
	MOV	R0,R3
	CMPB	(R3)+,R2
	BNE	1$
	JSR	R5,SCAN2		;LET SCAN DO THE REST
	 BR	3$			;MADE SOME KIND OF MATCH
	BR	1$			;NO MATCH

3$:	BGE	BADSWT			;EXTRA CHARACTERS AT END OF MATCH
	TST	(SP)			;UNIQUE?
	BNE	NOUNIQ
	MOV	R5,(SP)
	MOV	R3,-(SP)
	BR	1$

NOUNIQ:	MOV	(SP)+,R0
	TST	(SP)+			;PRUNE STACK
;+
;ERROR
	$LERR	F,<Ambiguous option>
;-
	BR	NXTSWT

4$:	CLC
	ROR	R3			;NEXT
5$:	MOVB	(R1)+,R2		;ANOTHER VALID SWITCH?
	BGE	BADSW1			;NO, BAD SWITCH
	CMP	R2,R5
	BNE	4$			;NOT THIS ONE
	BIT	#NO,(R4)
	BEQ	10$
	BIC	R3,TMPSWT(R4)
	BR	11$

10$:	BIS	R3,TMPSWT(R4)		;FOUND IT, SET IN THE CORESPONDING BIT
11$:	MOV	#SWTADD,R3		;ADDRESS OF SWITCH JUMP TABLE
	COM	R5
	ASL	R5
	ADD	R3,R5			;R5->SWITCH JUMP DISPLACEMENT TABLE

	.IF NE PIC
	MOV	(R5),R5			;WHEN GLOBAL ARITHMETIC COMES IN
					; DO AN 'ADD (R5),R5'
SWTJMP:	ADD	PC,R5			;JUMP ADDRESS IN R5
	JMP	@R5
	.IFF
	JMP	@(R5)
	.ENDC

UNKSWT:	MOV	(SP)+,R3
	BEQ	BADSW1
8$:	MOV	R3,R0			;UPDATE THE CURSOR
	MOV	(SP)+,R5
	MOV	#100000,R3		;SET UP SWITCH BIT
	MOV	(SP),R1			;ACCEPTABLE SWITCH TABLE
	BR	5$

BADSWT:	TST	(SP)+
;+
;ERROR
BADSW1:	$LERR	F,<Invalid option>					;MG01
;-
BADSW2:	CMPB	(R0),#'/
	BEQ	NXTSW2
	TSTB	(R0)
	BEQ	NOSWT2			;EOL
	CMPB	(R0),#40
	BEQ	NOSWT2
	INC	R0			;POINT TO NEXT SWITCH
	BR	BADSW2

NOSWT:	TST	TMPSWT(R4)
	BNE	9$
	MOV	#100000,TMPSWT(R4)
9$:	MOVB	(R0),R3
	ISIT	SPCCR,NOSWT2,<" ,+">
;+
;ERROR
	$LERR	F,<Separator missing>					;MG01
;-

	.DSABL LSB

NOSWT2:	BIT	#COMSWB,BATSW2(R4)
	BEQ	7$
	MOV	TMPSWT(R4),COMSWT(R4)
7$:	MOV	(SP)+,R1
	MOV	(SP)+,R5
	MOV	(SP)+,R3
	RTS	PC

ERRLOG:	MOV	R0,-(SP)
	MOV	R3,-(SP)
	BIS	#ABORT,(R4)		;SET ABORT SWITCH
	LOGOUT	CRLF
	JSR	R5,LOGOUX		;OUTPUT TO LOG THE LINE IMAGE
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	MOV	LINIMP(R4),R2
	SUB	R2,R0			;CHARACTER NUMBER AT ERROR
1$:	DEC	R0
	BMI	2$
	JSR	PC,.SPACE
	BR	1$

2$:	MOVB	#'^,R3
	JSR	PC,PUTCHR
	JSR	PC,CROUTP		;INSERT A CR/LF
	MOV	(R5)+,R2		;GET SEVERITY INDEX		;MG01+
	BISB	MSKLST(R2),@#USERRB	;REPORT THE SEVERITY
	MOVB	CHRLST(R2),ERRLVL	;COMPLETE THE PREFIX
	MOV	#PREFIX,R2		;PUT FATAL MESSAGE IN R2	;MG01-
	JSR	PC,PUTSTR		;PUT FATAL MESSAGE IN BUFFER
	JSR	PC,OUTPU5		;OUT PUT THE MESSAGE
	MOV	(SP)+,R3
	MOV	(SP)+,R0
	RTS	R5
	.SBTTL	ISIT SUBROUTINE

; TEST FOR ONE OF A LIST

ISIT$:	MOV	R1,-(SP)
	MOV	(R5)+,R1

	.IF NE PIC
	ADD	R5,R1			;POINTER TO LIST
	.ENDC

1$:	CMPB	(R1),R3			;R3 IS CHARACTER IN QUESTION
	BEQ	3$			;FOUND A MATCH
	TSTB	(R1)+			;CHECK FOR EOL
	BNE	1$
	TST	(R5)+			;BUMP OVER FOUND ADDRESS
2$:	MOV	(SP)+,R1
	RTS	R5

3$:	.IF EQ PIC
	MOV	(R5),R5
	.IFF
	ADD	(R5),R5			;SET TO FOUND TRANSFER ADDRESS
	.ENDC

	BR	2$
	.ENABL	LSB

	COMMAND	DATA	SWITCH,DOLLAR,LIST

	JSR	PC,TSTDOL		;TEST FOR /DOLLAR
	MOV	BATSW2(R4),-(SP)	;SAVE SWITCH WORD
	JSR	PC,TSTLST		;WAS /LIST REQUESTED?
	MOV	SP,IMMFLG		;Allow blank lines as $DATA
	JSR	PC,DATMAK
	BR	1$
	COMMAND	CREATE	SWITCH,DOLLAR,LIST

	GETFD	CRE	OUTPUT
	EXCLUSIVE	CRE	NULL,OUTPUT
	JSR	R5,COMOUX
	 .WORD	RBATCH
	FINDFD	CRE	NULL,OUTPUT
	BEQ	CREERR
	JSR	PC,TSTDOL		;TEST FOR /DOLLAR
	MOV	BATSW2(R4),-(SP)	;PRESERVE SWITCH VALUE
	JSR	PC,TSTLST		;WAS /LIST REQUESTED?
	MOV	SP,IMMFLG		;Allow blank lines in $CREATE
	JSR	PC,SOUMAK
	COMOUT
1$:	MOV	(SP)+,BATSW2(R4)	;RESTORE PREVIOUS SWITCH VALUE
	CLR	-(SP)			;COUNTER (CHECK COMPIL:)
	JMP	LINE2B

	.DSABL	LSB

ERRCRE:	JSR	PC,MAKBA2		;SWITCH LINIMS WITH LINIMM
CREERR:	JMP	NOFILE

	.ENABL	LSB

SOUMAK:	JSR	PC,OUTFD$
	DATOUT	BATCRE,<<</M=>>>,CR
DATMAK:	MOV	PC,-(SP)		;NON ZERO SWITCH ON STACK
	BIT	#LSTDAT,BATSW2(R4)
	BEQ	1$
5$:	HOUT
	MOVB	#'1,R3			;TTYIO
	JSR	PC,PUTCHR
1$:	JSR	PC,GETIMM
	CMPB	(R0),#'$
	BEQ	2$
10$:	JSR	R5,DATOUX
	 .WORD	NULINE
	MOV	LINIMP(R4),R2
	JSR	PC,OUTPUL
	CLR	(SP)			;CLEAR OUTPUT FLAG
	BR	1$

2$:	BIT	#DATDOL,(R4)
	BEQ	4$
	INC	R0
	MOV	#CN$EOD,R1
	JSR	R5,SCANX
	 BR	3$
	SCAN	CN$EOJ
	 BR	3$
	SCAN	CN$JOB
	 BR	3$
	SCAN	CN$SEQ
	 BR	3$
	BR	10$

3$:	MOV	LINIMP(R4),R0
4$:	MOVB	#CTRL.Z,R3
	JSR	PC,PUTCHR
	BIT	#LSTDAT,BATSW2(R4)
	BEQ	7$
	HOUT
	JSR	PC,.ASCI0
7$:	BIC	#DATDOL,(R4)
	TST	(SP)+
	BNE	ERRCRE			;NO DATA FOLLOWED??
	RTS	PC

	.DSABL	LSB
MAKSOU:	JSR	PC,MAKMAK
	JSR	R5,COMOUX
	 .WORD	RBATCH
	MOV	#SOUTMP,R2
	ADD	R4,R2
	JSR	PC,SOUMAK
MAKBA2:	MOV	#LINIMS,R1
	ADD	R4,R1
	MOV	#LINSZ/2,R2
2$:	MOV	(R0),R3
	MOV	(R1),(R0)+
	MOV	R3,(R1)+
	DEC	R2
	BNE	2$
	RTS	PC

MAKMAK:	BIS	#MAKE,(R4)
	MOV	LINIMP(R4),R0
	MOV	#LINIMS,R1		;LINE BUFFER SAVE AREA
	ADD	R4,R1
	MOV	#LINSZ/2,R2		;COUNTER
1$:	MOV	(R0)+,(R1)+		;MOVE A CHAR FROM COM BUFF
					; TO SAVE BUFF
	DEC	R2			;DECREMENT THE COUNTER
	BNE	1$			;IF NOT EQUAL, GET ANOTHER CHAR.
	RTS	PC

MAKBAS:	JSR	PC,MAKMAK
	JSR	PC,DATMAK
	BR	MAKBA2

TSTDOL:	BIT	#BITDOL,COMSWT(R4)	;A /DOLLAR SW. ON THIS CMD?
	BEQ	1$			;BRANCH IF NOT
	BIS	#DATDOL,(R4)		;YES, SET IN BATSWT
1$:	RTS	PC

TSTLST:	BIT	#BITLIS,COMSWT(R4) 	;WAS /LIST SET ON COMMAND
	BEQ	1$			;BRANCH IF NOT
	BIS	#LSTDAT,BATSW2(R4)	;SET IN BATSW2
1$:	RTS	PC
;$LINK, $MACRO & $FORTRAN ARE SO SIMILAR THAT A COMMON ROUTINE IS USED.
;IT IS VERY IMPORTANT THAT THE ORDER OF THEIR SWITCHES BE IDENTICAL
;WITH EXCEPTION OF THE MACRO SWITCH

	COMMAND	MACRO	SWITCHES,RUN,MAP,OBJECT,LIBRARY,DATA,DOLLARS,LIST,CREF

	MOV	COMSWT(R4),-(SP)
	BIT	#BITLIB,(SP)
	BEQ	C$MACR
	BIS	#BFORLIB,(R4)
C$MACR:	BIS	#1,(SP)			;SET IN $MACRO FLAG
	GETFD MAC INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY,LIST,MACRO,SOURCE
	EXCLUSIVE	MAC	INPUT,MACRO,SOURCE
	EXCLUSIVE	MAC	OUTPUT,OBJECT
	BR	FORMAC
	COMMAND	LINK	SWITCHES,RUN,MAP,OBJECT,LIBRARY

	DEFAULT	SWITCH,OBJECT
	MOV	COMSWT(R4),-(SP)
	BIT	#BITLIB,(SP)
	BEQ	1$
	BIS	#BFORLIB,(R4)
1$:	BIS	#2,(SP)
C$LINK:	GETFD	LIN	INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY
	EXCLUSIVE	LIN	INPUT,OBJECT
	EXCLUSIVE	LIN	EXECUTE,OUTPUT
	BR	C$LNK

;NOTE SECOND OBJECT IS A DUMMY FILL FOR LIBRARY IN $LINK AND $MACRO

	COMMAND	FORTRAN	SWITCHES,RUN,MAP,OBJECT,LIBRARY,DATA,DOLLARS,LIST

	MOV	COMSWT(R4),-(SP)
C$FORT:	GETFD FOR INPUT,EXECUTE,OBJECT,OUTPUT,MAP,LIBRARY,LIST,FORTRAN,SOURCE
	EXCLUSIVE	FOR	INPUT,FORTRAN,SOURCE
	EXCLUSIVE	FOR	OUTPUT,OBJECT
FORMAC:	FINDFD	FOR	NULL,INPUT,SOURCE,FORTRAN
	BIT	#BITDOL,COMSWT(R4)	;A /DOLLAR SW. ON THIS COMMAND?
	BEQ	1$			;BRANCH IF NOT
	BIS	#DATDOL,(R4)		;YES, SET IN BATSWT
1$:	MOV	R2,COMSWT(R4)		;TEMPORARY POINTER TO INPUT FD
	BNE	4$
	JSR	PC,MAKSOU
4$:	BIT	#1,(SP)

	.ENABL LSB

	BEQ	6$			;IF $FORTRAN
	COMOUT	RMACRO,<<<R  MACRO>>>,CR
	BR	8$

6$:	COMOUT	RFORT,<<<R  FORTRA>>>,CR
8$:	FINDFD	FOR	OBJECT,OUTPUT
	BNE	12$
	BIT	#BITRUN+BITOBJ+BITMAP,(SP)
	BNE	10$
	FINDFD	FOR	EXE,MAP
	BEQ	16$			;NO OBJECT
10$:	JSR	R5,OBJSOU		;GET A TEMPORARY OBJECT FILE
	 .WORD	OBJTMP
	JSR	PC,OTFD.$
	BR	14$

12$:	JSR	PC,OUTFD$
	BEQ	BBDFOR			;'+' IN OBJECT LIST?
14$:	BIT	#1,(SP)
	BNE	16$			;IF $MACRO DON'T SET FORLIB REQUEST
	BIS	#BFORLIB,(R4)
16$:	FINDFD	FOR	LIST
	BNE	18$
	BIT	#BITLIS+BITCRE,(SP)	;IS LIST SWITCH ON?
	BEQ	20$
	JSR	PC,LSTLST
	BR	20$

18$:	JSR	PC,COUTFD
	BEQ	BBDFOR
20$:	DATOUT	EQUALS,<<<=>>>

	.DSABL	LSB

	.ENABL	LSB

	MOV	COMSWT(R4),R2		;FINDFD	FOR FORTRAN,NULL,SOURCE,INPUT
	BNE	22$
	MOV	#SOUTMP,R2		;GET A SOURCE TEMPORARY
	ADD	R4,R2
22$:	JSR	PC,OTFDC$
	BIT	#BITCRE,(SP)
	BEQ	24$
	DATOUT	SLSHC,<<</C>>>
24$:	JSR	PC,CROUTP		;INSERT A CR/LF
	BIT	#1,(SP)			;IF $MACRO
	BNE	25$			;FLUSH BUFFER OF MACRO MESG.
	BIT	#BITLIS+BITCRE,(SP)	;DO FOR $FOR ONLY IF LISTING
	BEQ	26$
25$:	JSR	R5,FOUX			;FLUSH LOG BUFFER
	 .WORD	NULINE
	DATOUT				;KEEP FROM ABORTING
26$:	BIT	#MAKE,(R4)
	BEQ	28$
	JSR	R5,COMOUX
	 .WORD	RPIP
	MOV	#SOUTMP,R2		;GET A TEMPORARY SOURCE
	ADD	R4,R2
	JSR	PC,OUTFD$
	JSR	R5,DATOUX
	 .WORD	SLASHD
28$:	FINDFD	FOR	EXECUTE,MAP
	BNE	C$LNK
	BIT	#BITRUN+BITMAP,(SP)
	BNE	C$LNK
	JMP	FOREND

C$LNK:	COMOUT	RLINK,<<<R  LINK>>>,CR
	FINDFD	FOR	EXECUTE
	BNE	32$
	BIT	#2,(SP)
	BEQ	30$
	FINDFD	LIN	OUTPUT,EXECUTE
	BNE	32$
30$:	BIT	#BITRUN,(SP)
	BEQ	33$
	MOV	#SAVTMP,R2		;POINT TO TEMP FILENAME(000000.SAV)
	JSR	PC,OTFD.$		;PUT TEMP FILENAME IN CTL
	BR	33$

32$:	DATOUT
	JSR	PC,OUTFD$
	BEQ	BBDFOR
33$:	FINDFD	FOR	MAP

	.DSABL	LSB

	.ENABL	LSB

	BNE	34$
	BIT	#BITMAP,(SP)
	BEQ	36$
	JSR	PC,LSTLST
	BR	36$

34$:	JSR	PC,COUTFD
	BNE	36$
BBDFOR:	JMP	BADFLK
36$:	JSR	PC,.EQUAL
	BIT	#2,(SP)			;IS THIS A $LINK?
	BEQ	37$			;NO, THEN DON'T TEST /OBJ
	BIT	#BITOBJ,(SP)		;LINK IN TEMP OBJS?
	BEQ	40$			;NO,DON'T LINK THEM
37$:	JSR	PC,OBJCHK
	BEQ	40$
38$:	DMPOBJ	<'C+100000>
	TST	R3			;SEE IF CR.LF WAS LAST
	BEQ	40$			;YES
	BIT	#2,(SP)
	BEQ	39$			;BRANCH IF NOT $LINK
	FINDFD	LIN	NULL,INPUT,OBJECT
	BR	.39$

39$:	FINDFD	FOR	OBJ,OUT
.39$:	BEQ	40$
	JSR	PC,.COMMA
40$:	BIT	#2,(SP)
	BEQ	42$
	FINDFD	LIN	NULL,INPUT,OBJECT
	BEQ	46$
	JSR	PC,OTFDC$		;OUPUT MULTIPLE FD'S
	BR	46$			;THEN PROCESS LIBRARIES.

42$:	FINDFD	FOR	OBJ,OUT
	BEQ	46$
44$:	JSR	PC,OUTFD$
46$:	FINDFD	FOR	LIBRARY
	JSR	PC,NOUTFD
	BIT	#BFORLIB,(R4)
	BEQ	56$
	MOV	#LIBLST,R2
	ADD	R4,R2
	TSTB	(R2)
	BEQ	56$
	CLR	R5
	BR	52$

NOUTFD:	BEQ	48$
COUTFD:	JSR	PC,.COMMA
	JSR	PC,OUTFD$
48$:	RTS	PC

50$:	DATOUT	SLASHC,<<</C>>>,CR
	MOV	#5,R5
	BR	54$

52$:	JSR	PC,.COMMA
54$:	JSR	PC,OUTFD$
	BNE	56$
	DEC	R5
	BLE	50$
	BR	52$

56$:	JSR	PC,CROUTP		;INSERT A CR/LF
	BIT	#2,(SP)			;SKIP TEST OF BITOBJ IF
	BEQ	57$			; THIS IS A $LINK
	BIT	#BITOBJ,(SP)		;TEST FOR /NOOBJ SWITCH
	BEQ	60$			;DON'T DELETE TEMP. OBJ'S IF SET
57$:	JSR	PC,OBJCHK
	BEQ	60$
	COMOUT	RPIP,<<<R  PIP>>>,CR
	DMPOBJ	<'D>
	TST	R3			;SEE IF CR.LF WAS LAST
	BEQ	58$			;YES
	DATOUT	SLASHD,</D>,CR
58$:	MOV	#"0/,OBJTMP+4(R4)
	MOVB	#'0,OBJTMP+3(R4)
60$:	BIC	#BFORLIB,(R4)
	BIT	#BITRUN,(SP)

	.DSABL	LSB

BEFREN:	BEQ	FOREND

	.ENABL	LSB

;***************[PATCH ARTICLE]***************

	JSR	R5,COMOUX		;PRINT .RUN IN CTL FILE
	 .WORD	CRUN			;.RUN A TEMP FILE

;*********************************************

	FINDFD	FOR	EXE
	BNE	62$
	MOV	#SAVTMP,R2		;POINT TO TEMP FILENAME(000000.SAV)
	JSR	PC,OTFD.$		;PUT TEMP FILENAME IN CTL
	BR	64$

62$:	JSR	PC,OUTFD$
BADFLK:	BEQ	BADFOR
64$:	JSR	PC,CROUTP		;INSERT A CR/LF

;***************[SPR #11-10587]***************

	BR	FOREND

;*********************************************

	.DSABL	LSB

BADFOR:	JSR	PC,BADPLU
FOREND:	JSR	PC,COMCHK
	BIT	#1,(SP)
	BEQ	2$
	JMP	C$MACR

2$:	BIT	#2,(SP)
	BEQ	3$
	JMP	C$LINK

3$:	JMP	C$FORT
;*** YOU WILL NOTE THAT THE LIST SWITCH IS IN POSITION #2
;*** IT MUST BE IN THE SAME POSITION AS THE LIST SWITCH IN $DATA...

	COMMAND	BASIC	SWITCHES,RUN,LIST

MORBAS:	GETFD	BAS	BASIC,SOURCE,INPUT
	EXCLUSIVE	BAS	NULL,BASIC,SOURCE,INPUT
	COMOUT	RBASIC,<<<R  BASIC>>>,CR
	JSR	PC,CROUTP		;INSERT A CR/LF
	FINDFD	BAS	NULL,BASIC,SOURCE,INPUT
	BNE	GOTBAS
	DATOUT	SCRATCH,<<<SCRATCH>>>,CR
	MOV	BATSW2(R4),-(SP)
	JSR	PC,TSTLST		;WAS /LIST REQUESTED?
1$:	JSR	PC,MAKBAS
	MOV	(SP)+,BATSW2(R4)
	BR	RUNBAS

GOTBAS:	DATOUT	OLD,<<<OLD>>>,CR
	JSR	PC,OUTFD$
	BEQ	BASERR
	JSR	PC,CROUTP		;INSERT A CR/LF
RUNBAS:	BIT	#BITRUN,COMSWT(R4)
	BEQ	NORUNB
	DATOUT	RUNCR,<<<RUN>>>,CR
NORUNB:	JSR	PC,COMCHK
	BR	MORBAS

BASERR:	JSR	PC,BADPLU
	BR	NORUNB
	.ENABL	LSB

	COMMAND	LIBRARY

	GETFD	LIB
	MOV	#LIBLST,R5
	ADD	R4,R5
	CLRB	(R5)
	FINDFD	LIB	NULL
	BEQ	2$
1$:	MOVB	(R2)+,(R5)+
	BNE	1$
2$:	JSR	PC,COMCHK
;+
;ERROR
	$LERR	F,<No ',' in $LIB>					;MG01
;-
	JMP	COMPIL

FDFIND:	MOV	#FD0,R3
	ADD	R4,R3
3$:	MOV	(R3)+,R2
	BEQ	4$
	BIT	(R3)+,(R5)
	BEQ	3$
4$:	TST	(R5)+
	TST	R2
	RTS	R5

;I COULD PUT IN A CHECK TO BE SURE THAT WE DON'T GO OVER NNN999.OBJ?

OBJSOU:	MOV	(R5),R2
	ADD	R4,R2			;POINT TO NAME TO BUMP
	ADD	#5,R2			;LAST CHAR
5$:	INCB	(R2)
	CMPB	#'9,(R2)
	BGE	6$
	MOVB	#'0,(R2)
	DEC	R2
	BR	5$

6$:	MOV	(R5)+,R2
	ADD	R4,R2			;LEAVE WITH R2 POINTING TO NAME
	RTS	R5

;***************[SPR #11-010588]***************

LSTLST:	DATOUT
	JSR	PC,.COMMA
	MOV	R0,-(SP)

;**********************************************

	JSR	R5,DATOUX
	 .WORD	NULINE
	MOV	#LSTTMP,R2
	ADD	R4,R2
	JSR	PC,OUTPUL
	MOV	#';-1,R0		;EXTRA VARIABLES ARE ; < = > ?
7$:	INC	R0
	JSR	R5,KOUX
	 .WORD	NULINE
	MOVB	R0,R3
	JSR	PC,PUTCHR
	JSR	PC,.ASCI2
	CMPB	R0,#'=
	BNE	7$
8$:	MOVB	R0,R3
	JSR	PC,INCVAX
	IFOUT	R0,#'9,IF$LST,<<<!DUMMY1!DUMMY1!LSTNO1>>>
	JSR	R5,LABOUX
	 .WORD	IF$LST+16
	INTVAR	R0,#'0
	DEC	R0
	CMPB	R0,#';-1
	BNE	8$
	JSR	R5,LABOUX
	 .WORD	DUMMY$
	DATOUT
	MOV	(SP)+,R0
	RTS	PC

	.DSABL	LSB
OBJDMP:	MOV	#OBJTMP+2,R2
	ADD	R4,R2
	MOV	(R2)+,-(SP)
	MOV	(R2),-(SP)
	MOV	#"0/,(R2)
	MOVB	#'0,-(R2)
	CLR	-(SP)
1$:	JSR	R5,OBJSOU		;GET A TEMPORARY OBJECT FILE
	 .WORD	OBJTMP
	TST	(SP)
	BEQ	2$
	JSR	PC,.COMMA
2$:	INC	(SP)
	TST	(R5)
	BPL	5$
	JSR	PC,OTFD.$
	BR	6$

5$:	JSR	PC,OUTFD$
6$:	CMP	#5,(SP)
	BGT	3$
	MOVB	#'/,R3
	JSR	PC,PUTCHR
	MOVB	(R5),R3
	JSR	PC,PUTCHR
	JSR	PC,CROUTP		;INSERT A CR/LF
	CLR	(SP)
3$:	MOV	#OBJTMP+2,R2
	ADD	R4,R2
	CMP	(R2)+,4(SP)
	BNE	1$
	CMP	(R2),2(SP)
	BNE	1$
	MOV	(SP)+,R3		;IF 0 CR.LF WAS LAST
	MOV	(SP)+,(R2)
	MOV	(SP)+,-(R2)
	TST	(R5)+
	RTS	R5

OBJCHK:	MOV	#OBJTMP+3,R2
	ADD	R4,R2
	MOVB	(R2)+,R1
	ADD	(R2),R1
	CMP	#"0/+'0,R1
	RTS	PC

GETFD$:	BIC	#COMMA,(R4)
	BIC	#COMSWB,BATSW2(R4)
	CLR	SWTMSK(R4)
	MOV	#5,-(SP)		;HIGHEST FD NUMBER
	MOV	#FD0,R3
	ADD	R4,R3
GETFD0:	TSTB	(R0)			;CHECK FOR NO ARGUMENTS
	BNE	GETFD4
GTFD15:	CLR	(R3)			;INDICATE NO FD
1$:	TST	(R5)+
	BNE	1$
	TST	(SP)+
	RTS	R5

GTFD13:	TST	(R3)+
	DEC	(SP)
	BMI	TMFD			;TOO MANY FILE DESCRIPTORS
GETFD4:	JSR	PC,SPACE$
	MOV	R0,(R3)+		;POINTER TO FD GOES IN (R3)
	CLR	(R3)			;CLEAR OUT SWITCHES
	JSR	PC,NAMEXT
GETFD5:	CMPB	R2,#':			;CHECK FOR DEVICE
	BNE	GETFD7			;NOT A DEVICE
	JSR	PC,NAMEXT		;SPAN FILE NAME
GETFD7:	CMPB	R2,#'.			;NAME ENDING WITH .?
	BNE	GETFD8
	TST	R1
	BNE	GETFD9
;+
;ERROR
	$LERR	F,<No file name before ".">				;MG01
;-
GETFD9:	JSR	PC,NAMEXT
GETFD8:	DEC	R0

; PROCESS THE FILE DESCRIPTOR FIELD FOR SWITCHES.

	MOV	(R5),R1

	.IF NE PIC
	ADD	R5,R1
	.ENDC

	CLR	TMPSWT(R4)
	JSR	PC,SWTCHK		;CHECK FOR SWITCHES, RETURNED
					; IN TMPSWT
	BIC	#BITNUL,SWTMSK(R4)
	BIS	TMPSWT(R4),(R3)		;AND SWITCH INTO FD SLOT,
	BIT	(R3),SWTMSK(R4)		;THEN SEE IF ALREADY DEFINED.
	BEQ	GETFD1			;BRANCH IF O.K.
;+
;ERROR
	$LERR	F,<Duplicate option>
;-
GETFD1:	BIS	(R3),SWTMSK(R4)		;AND INTO SWTMSK
	MOV	R5,-(SP)
	TST	(R5)+

; TEST TO SEE IF TWO EXCLUSIVE SWITCHES, AS DEFINED BY THE EXCLUSIVE
; MACRO WHICH MUST FOLLOW THE MACRO (GETFD) WHICH INVOKES THIS CODE,
; HAVE BEEN SPECIFIED. THAT IS A SYNTAX ERROR.

1$:	MOV	(R5)+,R1
	BEQ	GETFD2
	MOV	SWTMSK(R4),R2
	BIC	R1,R2
	BEQ	1$
2$:	ASL	R2
	BCC	2$
	BEQ	1$
;+
;ERROR
	$LERR	F,<Invalid option combination>				;MG01
;-
	BIC	(R3),SWTMSK(R4)
GETFD2:	MOV	(SP)+,R5

; CHECK FOR MULTIPLE FILE DESCRIPTIONS, I.E., USE OF '+' TO
; SPECIFY MULTIPLE INPUT FILES. IF MORE IS TO COME, THE NULL
; SWITCH MUST BE CLEARED TO AVOID A MULTIPLE SWITCH ERROR.

GTFD11:	MOVB	(R0)+,R2		;END OF COMMAND?
	BEQ	GTFD14			;BRANCH IF SO.
	CMPB	R2,#'+			;CHECK TERMINATING CHAR
	BNE	GTFD12			;BRANCH IF NOT '+'
	BIC	#BITNUL,SWTMSK(R4)	;CLEAR NULL SWITCH
	JSR	PC,ALPNUM		;GET FD AFTER +
	BNE	GETFD5			;BRANCH IF ANOTHER FD EXISTS
	JSR	PC,BADPLU		;ELSE IT'S AN ERROR!
	BR	GTFD11

GTFD12:	CMPB	R2,#40			;SPACE?
	BEQ	GTFD13
	CMPB	R2,#',			;COMMA?
	BNE	GTFD16			;THERE MUST BE AN ILL CHAR
	BIS	#COMMA,(R4)
GTFD14:	TST	(R3)+
	BR	GTFD15			;ALL FILE DESCRIPTIONS IN ORDER

GTFD19:	TST	(SP)+
;+
;ERROR
GTFD16:	$LERR	F,<Invalid character>					;MG01
	BR	GETFD0

TMFD:	$LERR	F,<Too many file descriptors>				;MG01
;-
	BR	GTFD15

NAMEXT:	JSR	PC,ALPNUM		;SPAN DEVICE OR FILE NAME
	BNE	1$
	CMPB	R2,#'*
	BNE	1$
	BIT	#STAROK,BATSW2(R4)
	BEQ	GTFD19
	MOVB	(R0)+,R2
	JSR	PC,CHRCK
	BPL	GTFD19
	CMPB	R2,#':
	BEQ	GTFD19
	INC	R1
1$:	RTS	PC

	ENTRLO	SWTMSK,0
	ENTRLO	FD0,0,0
	ENTRLO	FD1,0,0
	ENTRLO	FD2,0,0
	ENTRLO	FD3,0,0
	ENTRLO	FD4,0,0
	ENTRLO	FD5,0,0,0		;EXTRA WORD FOR END FLAG

;*********************************************************************
;FLAG FOR FATAL CTL ERRORS-- PREVENTS CONTINUATION OF BATCH IF A FATAL
;CTL FILE ERROR IS DETECTED.  THIS IS IMPORTANT IF THE ERROR OCCURS
;IN A BATCH FILE WHICH IS $CALL'ED FROM A MAIN STREAM.  THE ENTIRE
;BATCH STREAM IS ABORTED IF THE CTL FILE OVERFLOWS, OR A HARD ERROR
;IS ENCOUNTERED WHILE GENERATING THE CTL FILE.  BC2

	ENTRLO	CERRFG,0		;FLAG#0 IF FATAL CTL FILE ERROR	;BC2

;*******************************************************************
	.ENABL	LSB

OTFD.$:	MOV	#'.,-(SP)
	BR	1$

OUTFD$:	MOV	PC,-(SP)
1$:	DATOUT
	BR	2$

OUTFDC:	JSR	PC,PUTCHR
2$:	MOVB	(R2)+,R3
	ISIT	CMSPCR,OUTFDE,<", ">
	CMP	(SP),R3
	BEQ	5$
	CMPB	R3,#'*
	BNE	3$
	BIS	#STARFD,BATSW2(R4)
3$:	CMPB	R3,#'+
	BEQ	5$
	CMPB	R3,#'/
	BNE	OUTFDC
4$:	ISIT	CMSPCR,OUTFDE
	MOVB	(R2)+,R3
	BR	4$

5$:	CLR	(SP)
OUTFDE:	TST	(SP)+
	RTS	PC

	.DSABL	LSB
; GETIMM GETS AN IMMAGE LINE

GETIM0:	TSTB	LINIMM(R4)		;Blank line?
	BNE	GETIM3			;Nope, return it.
	TST	(PC)+			;Yes, working on $DATA or $CREATE?
IMMFLG:	 .WORD	0			; : image flag
	BNE	GETIM3			;Yes, then return blank lines.
GETIMM:	MOV	LINIMP(R4),R0
GETIM1:	CLRB	(R0)
GETIM2:	JSR	PC,GETCHR
	ISIT	LFFF,GETIM2,<<12><14>>
	ISIT	CR,GETIM0,<<15>>
	MOVB	R3,(R0)+
	TSTB	(R0)			;SEE IF LINE TOO LONG
	BPL	GETIM1
	CLRB	-(R0)
	JSR	PC,GETIM3		;LOG THE LINE IMMAGE BUFFER
;+
;ERROR
	$LERR	F,<Line too long>					;MG01
;-
	BR	GETIMM

GETIM3:	MOV	LINIMP(R4),R0
	RTS	PC

ALPNUM:	CLR	R1			;CLEAR COUNTER
1$:	MOVB	(R0)+,R2
	INC	R1
	JSR	PC,CHRCK
	BGE	1$
	DEC	R1
	RTS	PC

EDIT:	MOV	R1,-(SP)		;REMOVE COMMENTS
	MOV	R2,-(SP)
	MOV	R0,-(SP)
EDIT1:	CLR	R1
1$:	MOVB	(R0)+,R2
	BEQ	COMPRS
	CMPB	R2,#'"
	BNE	2$
	INC	R1			;BUMP QUOTE COUNTER
2$:	CMPB	R2,#'!
	BNE	1$
	BIT	#1,R1
	BNE	1$
	CLRB	-(R0)
COMPRS:	MOV	(SP),R0			;COMPRESS SPACES AND TABS
	MOV	R0,R1
1$:	MOVB	(R1)+,R2
	BEQ	4$
	CMPB	R2,#40
	BEQ	2$
	CMPB	R2,#11
	BNE	3$
2$:	CMPB	-1(R0),#40		;SPACE BEFORE
	BEQ	1$
	MOV	#40,R2
3$:	MOVB	R2,(R0)+
	BR	1$

4$:	CMPB	-(R0),#'-
	BNE	5$
	CMPB	@LINIMP(R4),#'$		;ONLY ON $ LINES
	BNE	5$
	MOV	R0,-(SP)
	JSR	PC,GETIM1
	MOV	(SP)+,R0
	LOGOUT				;MUST BE IN LOGOUT MODE
	MOV	R0,R2
	JSR	PC,OUTPUL
	BR	EDIT1

5$:	CMPB	(R0),#40		;TRAILING SPACE MUST GO
	BEQ	6$
	INC	R0
6$:	CLRB	(R0)
	MOV	(SP)+,R0
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC
	.SBTTL	PATCH AREA

PATCH::	.BLKW	75.
	.CSECT	ERRLST			;MUST BE END OF LAST .CSECT
	.EVEN
BATEND:

	.END	START