.MCALL .MODULE
.MODULE KMON, VERSION=115, COMMENT=<Keyboard Monitor>

; 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.
;++
;  Facility:	Keyboard Monitor
;
;    Author:	
;
;  Abstract:	
;
;
;	Edit	Who	Date		Description of modification
;	----	---	----		---------------------------
;	102	WFG	05-APR-90	Add support for SET CLI
;	103	WFG	10-APR-90	Allow R and RUN if DCL is disabled
;	104	WFG	11-APR-90	CLASIFY: Cont at DCL
;					if UCF.SAV not found
;	105	WFG	09-MAY-90	Restore BGT near CMDBAS
;					to fix call to RESET
;	106	WLD	15-MAY-90	Changed CONTN% file names to CONT%%.
;					Added support for new monitor names.
;	112	JFW	13-Nov-1990	Added SET VBG [NO]RUN
;	113	DBB	14-Nov-1990	Add support for automatic VBGEXE
;--
	.IIF DF NLKMON,	.NLIST
	.NLIST	CND

.SBTTL	**************************************
.SBTTL	*      Keyboard Monitor For The      *
.IF EQ <MMG$T!SUP$Y>
   .IF NE RTE$M
      .SBTTL *  RT-11 Emulator (RTEM) Monitor  *
   .IFF ;NE RTE$M
      .IF NE VENU$C
         .SBTTL *  VENUS (VAX 8600) Console Monitor  *
      .IFF ;NE VENU$C
         .IF NE SB
            .SBTTL *  Single Background (SB) Monitor  *
         .IFF ;NE SB
            .SBTTL *  Foreground/Background (FB) Monitor  *
         .ENDC ;NE SB
      .ENDC ;NE VENU$C
   .ENDC ;NE RTE$M
.IFF ;EQ <MMG$T!SUP$Y>
   .IF EQ SUP$Y
      .IF NE SB
         .SBTTL *  Extended Background (XB) Monitor  *
      .IFF ;NE SB
         .SBTTL *  Extended Memory (XM) Monitor  *
      .ENDC
   .IFF ;EQ SUP$Y
      .IF NE SB
         .SBTTL *  Supervisor and I-D Background (ZB) Monitor  *
      .IFF ;NE SB
         .SBTTL *  Supervisor and I-D (ZM) Monitor  *
      .ENDC ;NE SB
   .ENDC ;EQ SUP$Y
.ENDC ;EQ <MMG$T!SUP$Y
.SBTTL	**************************************

	.LIST	CND
.SBTTL	Conditional summary
;+
;COND
;
; ABOR$$ 0	No ABORT command
; ABOR$$ 1	ABORT command
; ABOR$$ (M$INI) forced to 0 if SB=1
; AI$COD 0	No automatic installation code
; AI$COD 1	Automatic installation code
; ASSI$$ 0	No ASSIGN command
; ASSI$$ 1	ASSIGN command
; ASSI$$ (M$INI)
; B$$	 0	No B command
; B$$	 1	B command
; B$$	 (M$INI)
; BACK$$ 0	No BACKUP command
; BACK$$ 1	BACKUP command
; BACK$$ (U$TIL)
; BOOT$$ 0	No BOOT command
; BOOT$$ 1	BOOT command
; BOOT$$ (U$TIL)
; CLOS$$ 0	No CLOSE command
; CLOS$$ 1	CLOSE command
; CLOS$$ (M$INI)
; COMP$$ 0	No Compile command
; COMP$$ 1	Compile command
; COMP$$ (L$ANG)
; CONT$N 0	No MINC continuation command file
; CONT$N 1	MINC continuation command file
; COPY$$ 0	No COPY command
; COPY$$ 1	COPY command
; COPY$$ (U$TIL)
; CREA$$ 0	No CREATE command
; CREA$$ 1	CREATE command
; CREA$$ (U$TIL)
; D$$	 0	No D command
; D$$	 1	D command
; D$$	 (M$INI)
; DATE$$ 0	No DATE command
; DATE$$ 1	DATE command
; DATE$$ (M$INI)
; DEAS$$ 0	No DEASSIGN command
; DEAS$$ 1	DEASSIGN command
; DEAS$$ (M$INI)
; DELE$$ 0	No DELETE command
; DELE$$ 1	DELETE command
; DELE$$ (U$TIL)
; DIBO$$ 0	No DIBOL command
; DIBO$$ 1	DIBOL command
; DIBO$$ (L$ANG)
; DIFF$$ 0	No DIFFERENCE command
; DIFF$$ 1	DIFFERENCE command
; DIFF$$ (U$TIL)
; DIRE$$ 0	No DIRECTORY command
; DIRE$$ 1	DIRECTORY command
; DIRE$$ (U$TIL)
; DISM$$ 0	No DISMOUNT command
; DISM$$ 1	DISMOUNT command
; DISM$$ (M$INI)
; DUMP$$ 0	No DUMP command
; DUMP$$ 1	DUMP command
; DUMP$$ (U$TIL)
; E$$	 0	No E command
; E$$	 1	E command
; E$$	 (M$INI)
; EDIT$$ 0	No EDIT command
; EDIT$$ 1	EDIT command
; EDIT$$ (U$TIL)
; ERL$G  0	No error logging
; ERL$G  1	Error logging
; EXEC$$ 0	No EXECUTE command
; EXEC$$ 1	EXECUTE command
; EXEC$$ (L$ANG)
; FORM$$ 0	No FORMAT command
; FORM$$ 1	FORMAT command
; FORM$$ (U$TIL)
; FORT$$ 0	No FORTRAN command
; FORT$$ 1	FORTRAN command
; FORT$$ (L$ANG)
; FRUN$$ 0	No FRUN command
; FRUN$$ 1	FRUN command
; FRUN$$ (M$INI) forced to 0 if SB=1
; GET$$  0	No GET command
; GET$$  1	GET command
; GET$$  (M$INI)
; HJDB   (NDF)	No debugging code
; HJDB   DF	Debugging code
; HELP$$ 0	No HELP command
; HELP$$ 1	HELP command
; HELP$$ (M$INI)
; HSR$B  0	No high-speed ring buffering
; HSR$B  1	High-speed ring buffering
; IFBFSZ (1)	???
; INIT$$ 0	No INITIALIZE command
; INIT$$ 1	INITIALIZE command
; INIT$$ (U$TIL)
; INST$$ 0	No INSTALL command
; INST$$ 1	INSTALL command
; INST$$ (M$INI)
; KMCBFIN (200.) ???
; L$ANG	 0	No language commands
; L$ANG	 (1)	Language commands
; LIBR$$ 0	No LIBRARY command
; LIBR$$ 1	LIBRARY command
; LIBR$$ (L$ANG)
; LINK$$ 0	No LINK command
; LINK$$ 1	LINK command
; LINK$$ (L$ANG)
; LNK$IF 0	No LINK indirect command file
; LNK$IF 1	LINK indirect command file
; LNK$IF =0	Must be 0 (EDTGBL)
; LOAD$$ 0	No LOAD command
; LOAD$$ 1	LOAD command
; LOAD$$ (M$INI)
; MACR$$ 0	No MACRO command
; MACR$$ 1	MACRO command
; MACR$$ (L$ANG)
; MAKE$$ 0	No MAKE command
; MAKE$$ 1	MAKE command
; MAKE$$ (U$TIL)
; M$INI	 0	No minimal command set
; M$INI	 (1)	Minimal command set
; MMG$T  0	No memory management
; MMG$T  1	Memory management
; MOUN$$ 0	No MOUNT command
; MOUN$$ 1	MOUNT command
; MOUN$$ (M$INI)
; MTT$Y  0	No multi-terminal support
; MTT$Y  1	Multi-terminal support
; MUNG$$ 0	No MUNG command
; MUNG$$ 1	MUNG command
; MUNG$$ (U$TIL)
; NLKMON (NDF)	List KMON
; NLKMON DF	NList KMON
; OWN$ER 0	No device ownership table
; OWN$ER 1	Device ownership table
; OWN$ER (1)	forced to 0 if SB=1 (SB/XB)
; PRIN$$ 0	No PRINT command
; PRIN$$ 1	PRINT command
; PRIN$$ (U$TIL)
; PROT$$ 0	No PROTECT command
; PROT$$ 1	PROTECT command
; PROT$$ (U$TIL)
; REEN$$ 0	No REENTER command
; REEN$$ 1	REENTER command
; REEN$$ (M$INI)
; REMO$$ 0	No REMOVE command
; REMO$$ 1	REMOVE command
; REMO$$ (M$INI)
; RENA$$ 0	No RENAME command
; RENA$$ 1	RENAME command
; RENA$$ (U$TIL)
; RESE$$ 0	No RESET command
; RESE$$ 1	RESET command
; RESE$$ (M$INI)
; RESU$$ 0	No RESUME command
; RESU$$ 1	RESUME command
; RESU$$ (M$INI) forced to 0 if SB=1
; RTE$M  0	No RTEM support
; RTE$M  1	RTEM support
; SAVE$$ 0	No SAVE command
; SAVE$$ 1	SAVE command
; SAVE$$ (M$INI)
; SB	 0	Multi-job monitor (FB/XM)
; SB	 1	Single job monitor (SB/XB)
; SET$$	 0	No SET command
; SET$$	 1	SET command
; SET$$	 (M$INI)
; SHOW$$ 0	No SHOW command
; SHOW$$ 1	SHOW command
; SHOW$$ (U$TIL)
; SQUE$$ 0	No SQUEEZE command
; SQUE$$ 1	SQUEEZE command
; SQUE$$ (U$TIL)
; SRUN$$ 0	No SRUN command
; SRUN$$ 1	SRUN command
; SRUN$$ (M$INI) forced to 0 if SB=1 or SYT$K=0
; STAR$$ 0	No START command
; STAR$$ 1	START command
; STAR$$ (M$INI)
; SUP$Y  0	No supervisor mode support
; SUP$Y  1	Supervisor mode support
; SUSP$$ 0	No SUSPEND command
; SUSP$$ 1	SUSPEND command
; SUSP$$ (M$INI) forced to 0 if SB=1
; SYT$K  0	No system job support
; SYT$K  1	System job support
; TECO$$ 0	No TECO command
; TECO$$ 1	TECO command
; TECO$$ (U$TIL)
; TIME$$ 0	No TIME command
; TIME$$ 1	TIME command
; TIME$$ (M$INI)
; TYPE$$ 0	No TYPE command
; TYPE$$ 1	TYPE command
; TYPE$$ (U$TIL)
; U$CL   0	No UCL support
; U$CL   1	UCL support
; UNI$64 (0)	No extended device-unit support
; UNI$64 1	Extended device-unit support
; UNLO$$ 0	No UNLOAD command
; UNLO$$ 1	UNLOAD command
; UNLO$$ (M$INI)
; UNPR$$ 0	No UNPROTECT command
; UNPR$$ 1	UNPROTECT command
; UNPR$$ (U$TIL)
; U$TIL	 0	No utility commands
; U$TIL	(1)	Utility commands
;-
.SBTTL	Macro Calls

	.LIBRARY	"SRC:EDTL.MLB"
	.LIBRARY	"SRC:SYSTEM.MLB"
;<fut?>	.LIBRARY	"SRC:HARDWA.MLB"
;+
; Programmed Request and Miscellaneous Utility Macros
;-
	.MCALL	.ASSUME	.BR	.CHAIN	.CLOSE	.CRRG	;SYSMAC
	.MCALL	.DSTAT	.ENTER	.EXIT	.FETCH	.HERR	;SYSMAC
	.MCALL	.HRESET	.LOCK	.LOOKUP	.PRINT	.PURGE	;SYSMAC
	.MCALL	.RCTRLO	.READW	.RELEAS	.REOPEN	.SAVEST	;SYSMAC
	.MCALL	.SERR	.SETTOP	.SRESET	.TRPSET	.TTINR	;SYSMAC
	.MCALL	.TTOUTR	.TTYOUT	.UNLOCK	.UNPROT	..V1..	;SYSMAC
	.MCALL	.WRITW					;SYSMAC

	.MCALL	.ADDR					;SYSMAC
	.MCALL		.ASTX	BSS	DEFALT	SPL	;EDTL

	..V1..
;+
; Structure Definition Macros
;-
	.MCALL	..GTIM	..READ	..SDTT	..TRPS	..WRIT	;SYSTEM
	.MCALL	.CCLDF	.CF1DF	.CF2DF	.CF3DF	.CHADF	;SYSTEM
	.MCALL	.CHNDF	.CLIDF	.CMPDF	.CSWDF	.DATDF	;SYSTEM
	.MCALL	.DBKDF	.DIEDF	.DIHDF	.DSCDF	.DSTDF	;SYSTEM
	.MCALL	.DTMDF	.EMTDF	.HANDF	.HBGDF	.HS2DF	;SYSTEM
	.MCALL	.HSRDF	.HUMDF	.IBKDF	.IMPDF	.INDDF	;SYSTEM
	.MCALL	.ISTDF	.JSWDF	.JSXDF	.MCADF	.OWNDF	;SYSTEM
	.MCALL	.RCBDF	.RELDF	.SAVDF	.STWDF	.SYCDF	;SYSTEM
	.MCALL	.TCBDF	.TCFDF	.TIMDF	.TSTDF	.UEBDF	;SYSTEM
	.MCALL	.WCBDF	.WDBDF	.XEDDF	.XHEDF	.XLDDF	;SYSTEM
	.MCALL	.XTEDF					;SYSTEM
.SBTTL	Invoke Structure Definition Macros

	..GTIM		;.GTIM EMT Data Layout and Values
	..READ		;.READx EMT Data Layout and Values
	..SDTT		;.SDTTM EMT Data Layout and Values
	..TRPS		;.TRPSEt EMT Data Layout and Values
	..WRIT		;.WRITx EMT Data Layout and Values
	.CCLDF		;CCL Command String Layout
	.CF1DF		;CONFIG First System Configuration Word Format
	.CF2DF		;CONFG2 Second System Configuration Word Format
	.CF3DF		;CONFG3 Second System Configuration Word Format
	.CHADF		;CHAIN calling arguments area
	.CHNDF		;I/O Channel Format
	.CLIDF		;CLITYP,CLIFLG Bit Definitions
.IF NE	SUP$Y
	.CMPDF		;.CMAP Request and I.CMAP Bit Definitions
.ENDC ;NE SUP$Y
	.CSWDF		;Channel Status Word Bit Definitions
	.DATDF		;RT-11 Date Word Format
	.DBKDF		;Offsets in device block
	.DIEDF		;Directory Entry Format
	.DIHDF		;Directory Header Format
	.DSCDF		;Device Characteristics Bits for .DSTAT Code
	.DSTDF		;.DSTAT Return Area Format
	.DTMDF		;Date/Time Setting Block Format
	.EMTDF		;EMT Code and Subcode Definitions
	.HANDF		;Handler Prefix Area (Block 0) Format
	.HBGDF		;Handler .DRBEG Table (Block 1) Format
	.HS2DF		;Handler Status Word 2 Bit Definitions
	.HSRDF		;Handler Service Routine Code Definitions
	.HUMDF		;Format of H.64UM Word
	.IBKDF		;I.BLOK Job Blocking Bit Definitions
FIX$ED=0		;allow definition of floating symbols
	.IMPDF		;Impure Area Layout
FIX$ED=1
	.INDDF		;INDSTA - IND Status Byte Bit Definitions
	.ISTDF		;I.STAT Job State Word Bit Definitions
	.JSWDF		;$JSW Job Status Word Bit Definitions
	.JSXDF		;$JSX Extended Job Status Word Bit Definitions
.IF NE MMG$T
	.MCADF		;Memory Context Area Definitions
.ENDC ;NE MMG$T
	.OWNDF		;ownership table offsets and values
.IF NE MMG$T
	.RCBDF		;Region Control Block Definitions
.ENDC ;NE MMG$T
	.RELDF		;Block 0 .REL Image Definitions
	.SAVDF		;Save File Header Offset Definitions
	.STWDF		;STATWD DCL/@File Status Bit Definitions
	.SYCDF		;$SYCOM Definitions
.IF NE MTT$Y
FIX$ED=0		;allow definition of floating symbols
	.TCBDF		;Terminal Control Block Definitions
FIX$ED=1
	.TSTDF		;T.STAT Contains Dynamic Terminal Status
.ENDC ;NE MTT$Y
	.TCFDF		;Terminal Configuration Bits
	.TIMDF		;Time Word Pair Format
	.UEBDF		;$USRRB User Error Byte Codes
.IF NE MMG$T
	.WCBDF		;Window Control Block Format Definitions
	.WDBDF		;Window Definition Block Format
.ENDC ;NE MMG$T
	.XEDDF		;Chain to EDIT Argument Format
	.XLDDF		;Chain to LD Argument Format
	.XTEDF		;Chain to TECO Argument Format
	.XHEDF		;Chain to HELP Argument Format

.SBTTL	Delete Structure Definition Macros (Free Up Workfile Space)

	.MDELET	..GTIM	..READ	..SDTT	..TRPS	..WRIT
	.MDELET	.CCLDF	.CF1DF	.CF2DF	.CHADF	.CHNDF	.CLIDF
	.MDELET	.CMPDF	.CSWDF	.DATDF	.DBKDF	.DIEDF	.DIHDF
	.MDELET	.DSCDF	.DSTDF	.DTMDF	.EMTDF	.HANDF	.HBGDF
	.MDELET	.HS2DF	.HSRDF	.HUMDF	.IBKDF	.IMPDF	.INDDF
	.MDELET	.ISTDF	.JSWDF	.MCADF	.RCBDF	.RELDF	.STWDF
	.MDELET	.SYCDF	.TCBDF	.TCFDF	.TIMDF	.TSTDF	.UEBDF
	.MDELET	.WCBDF	.WDBDF	.XEDDF	.XHEDF	.XLDDF	.XTEDF
.SBTTL	Subsetting Command Conditionals

DEFALT	ABOR$$	M$INI	GLOBL	;ABORT
DEFALT	ASSI$$	M$INI	GLOBL	;ASSIGN
DEFALT	B$$	M$INI	GLOBL	;BASE
DEFALT	CLOS$$	M$INI	GLOBL	;CLOSE
DEFALT	D$$	M$INI	GLOBL	;DEPOSIT
DEFALT	DATE$$	M$INI	GLOBL	;DATE
DEFALT	DEAS$$	M$INI	GLOBL	;DEASSIGN
DEFALT	DISM$$	M$INI	GLOBL	;DISMOUNT
DEFALT	E$$	M$INI	GLOBL	;EXAMINE
DEFALT	FRUN$$	M$INI	GLOBL	;FRUN
DEFALT	GET$$	M$INI	GLOBL	;GET
DEFALT	HELP$$	M$INI	GLOBL	;HELP
DEFALT	INST$$	M$INI	GLOBL	;INSTALL
DEFALT	LOAD$$	M$INI	GLOBL	;LOAD
DEFALT	MOUN$$	M$INI	GLOBL	;MOUNT
DEFALT	REEN$$	M$INI	GLOBL	;REENTER
DEFALT	REMO$$	M$INI	GLOBL	;REMOVE
DEFALT	RESE$$	M$INI	GLOBL	;RESET
DEFALT	RESU$$	M$INI	GLOBL	;RESUME
DEFALT	SAVE$$	M$INI	GLOBL	;SAVE
DEFALT	SET$$	M$INI	GLOBL	;SET
DEFALT	SRUN$$	M$INI	GLOBL	;SRUN
DEFALT	STAR$$	M$INI	GLOBL	;START
DEFALT	SUSP$$	M$INI	GLOBL	;SUSPEND
DEFALT	TIME$$	M$INI	GLOBL	;TIME
DEFALT	UNLO$$	M$INI	GLOBL	;UNLOAD

DEFALT	COMP$$	L$ANG	GLOBL	;COMPILE
DEFALT	DIBO$$	L$ANG	GLOBL	;DIBOL
DEFALT	EXEC$$	L$ANG	GLOBL	;EXECUTE
DEFALT	FORT$$	L$ANG	GLOBL	;FORTRAN
DEFALT	LIBR$$	L$ANG	GLOBL	;LIBRARY
DEFALT	LINK$$	L$ANG	GLOBL	;LINK
DEFALT	MACR$$	L$ANG	GLOBL	;MACRO

DEFALT	BACK$$	U$TIL	GLOBL	;BACKUP
DEFALT	BOOT$$	U$TIL	GLOBL	;BOOT
DEFALT	COPY$$	U$TIL	GLOBL	;COPY
DEFALT	CREA$$	U$TIL	GLOBL	;CREATE
DEFALT	DELE$$	U$TIL	GLOBL	;DELETE
DEFALT	DIFF$$	U$TIL	GLOBL	;DIFFERENCES
DEFALT	DIRE$$	U$TIL	GLOBL	;DIRECTORY
DEFALT	DUMP$$	U$TIL	GLOBL	;DUMP
DEFALT	EDIT$$	U$TIL	GLOBL	;EDIT
DEFALT	FORM$$	U$TIL	GLOBL	;FORMAT
DEFALT	INIT$$	U$TIL	GLOBL	;INITIALIZE
DEFALT	MAKE$$	U$TIL	GLOBL	;MAKE
DEFALT	MUNG$$	U$TIL	GLOBL	;MUNG
DEFALT	PRIN$$	U$TIL	GLOBL	;PRINT
DEFALT	PROT$$	U$TIL	GLOBL	;PROTECT
DEFALT	RENA$$	U$TIL	GLOBL	;RENAME
DEFALT	SHOW$$	U$TIL	GLOBL	;SHOW
DEFALT	SQUE$$	U$TIL	GLOBL	;SQUEEZE
DEFALT	TECO$$	U$TIL	GLOBL	;TECO
DEFALT	TYPE$$	U$TIL	GLOBL	;TYPE
DEFALT	UNPR$$	U$TIL	GLOBL	;UNPROTECT

SUBM$$	=: 0			;SUBMIT (not allowed at this time)

.IF NE SB			;If SB/XB don't let them be smart
ABOR$$	=: 0
FRUN$$	=: 0
RESU$$	=: 0
SRUN$$	=: 0
SUSP$$	=: 0
.ENDC ;NE SB

.IF EQ SYT$K			;No SYS TASK support = no SRUN command
SRUN$$	=: 0
.ENDC ;EQ SYT$K
.SBTTL	Local Macro Definitions

;+
;ERROR
;
; .MACRO KMEROR	TEXT,ARG,ERRLEV
;
; Generate a call to the KMON Error Routine
; 'TEXT'   is the text of the error message.
; 'ARG'    is a FLAG: if NON-BLANK, text is generated IN-LINE.
; 'ERRLEV' is level of the error TEXT: WARN$, ERROR$, FATAL$, UNCONDITIONAL;
;	   if BLANK the error is FATAL$.
; NOTE: all resident messages are UNCON$.
;-

OERPTR	= 0		;Initialize error text offset pointer

.MACRO	KMEROR	TEXT,ARG,ERRLEV
  .IF NB ARG
	JSR	R0,MSGKM
	.ASCIZ	\?KMON-U-TEXT\
	.EVEN
    .ASSUME OVLYN LT 0, MESSAGE=<Error text in overlay>
  .IFF
    .IF GE OVLYN
	OCALL	ERROVR
    .IFF
	CALL	ERROVR
    .ENDC
	.WORD	OERPTR
    .IF DF OERBEG
	.CSECT	OVLYE
. = < OERBEG + OERPTR >
      .IF B ERRLEV
	  .BYTE FATAL$
      .IFF
	  .BYTE ERRLEV
      .ENDC
	.ASCIZ	\TEXT\
	.ASSUME <.-STADDR> LE <BK.BYT*OVLYSZ>,MESSAGE=<Error message overflow>
    .ENDC
	.NCHR	$TMPN,<TEXT>
OERPTR = < OERPTR + $TMPN + 2 >
    .IF GE OVLYN
      .IRP N,<\OVLYN>
	.CSECT	OVLY'N
      .ENDR
    .IFF
	.PSECT	RT11
    .ENDC
  .ENDC
.ENDM	KMEROR
OERPT2	= 0			;Initialize run time error text offset pointer

;+
;ERROR
;
; .MACRO KMRTMG	TEXT,ERRLEV,PRFILE
;
; Generate a call to the KMON Run Time Error Message Routine
; 'TEXT'   is the text of the error message
; 'ERRLEV' is level for the error TEXT: WARN$, ERROR$, FATAL$, UNCONDITIONAL;
;	   if blank the error is FATAL$.
; 'PRFILE' is the run time message directive;
;	if 'PRFILE' = JSTNAM only the name stored in RAD50 at INPFN is 
;	  converted to ASCII and is printed following the error text.
;	if 'PRFILE' = PFILE the DEV:FILENAME.EXT stored in RAD50 at INPFN: is
;	  converted to ASCII and is printed following the error text.
;	if 'PRFILE' = BCKASZ the Run Time DEVICE/FILENAME is stored in
;	  backward ASCII pointed to by R4. The error text is printed followed
;	  by the ASCII Run Time message.
;	if NEITHER SPECIFIED, the DEV: stored in RAD50 at INPFN: is converted
;	  to ASCII and is printed following the error text.
;
; NOTE: No resident messages may use this routine.
;-

.MACRO	KMRTMG	TEXT,ERRLEV,PRFILE
  .IF GE OVLYN
    .IF IDN <PRFILE>,<PFILE>
	OCALL	RTERR1
    .IFF 
      .IF IDN <PRFILE>,<BCKASZ>
	OCALL	RTERR3
      .IFF 
        .IF IDN <PRFILE>,<JSTNAM>
	  OCALL	RTERR4
        .IFF
	  OCALL	RTERR2
        .ENDC
      .ENDC
    .ENDC
  .IFF
    .IF IDN <PRFILE>,<PFILE>
	CALL	RTERR1
    .IFF
      .IF IDN <PRFILE>,<BCKASZ>
	CALL	RTERR3
      .IFF
        .IF IDN <PRFILE>,<JSTNAM>
	  CALL	RTERR4
        .IFF
	  CALL	RTERR2
        .ENDC
      .ENDC
    .ENDC
  .ENDC
	.WORD	OERPT2
  .IF DF OERBG2
	.CSECT	OVLYE2
. = < OERBG2 + OERPT2 >
    .IF B ERRLEV
	.BYTE FATAL$
    .IFF
	.BYTE ERRLEV
    .ENDC
	.ASCII	\TEXT\<200>
      .ASSUME <.-STADD2> LE <BK.BYT*OVLYSZ>, MESSAGE=<Error message overflow>
  .ENDC
	.NCHR	$TMPN,<TEXT>
OERPT2 = < OERPT2 + $TMPN + 2 >
  .IF GE OVLYN
    .IRP N,<\OVLYN>
	.CSECT	OVLY'N
    .ENDR
  .IFF
	.PSECT	RT11
  .ENDC
.ENDM	KMRTMG
;+
; Macro to Link to a KMON Overlay
; NOTE: This MACRO should only be used from a KMON Command
; Reversed .BYTE order
;-

.MACRO	OVLINK	CMD
  .IF GE OVLYN
	OJSR	R2,OVLINK
  .IFF
	JSR	R2,OVLINK
  .ENDC
  .IF EQ N.'CMD-1
	.BYTE	< O.'CMD / 2 >, < OVLY - KMON > / BK.BYT
  .IFF
	.BYTE	< O.'CMD / 2 >, N.'CMD + < < $RTEND-KMON+BD.BLK > / BK.BYT >
  .ENDC
.ENDM	OVLINK

;+
; This MACRO generates a table entry for KMON or OVERLAY routines
;-

.MACRO	CMDTBL	CMD
  .IF NDF CMD
	.WORD	< CCLENT - CMDBAS >
  .IFF
    .IF DF O.'CMD
      .IF EQ < N.'CMD - 1 >
	.BYTE	< O.'CMD / 2 >, < OVLY - KMON > / BK.BYT
      .IFF
	.BYTE	< O.'CMD / 2 >, N.'CMD + < < $RTEND-KMON+BD.BLK > / BK.BYT >
      .ENDC
    .IFF
	.WORD	< CMD - CMDBAS >
    .ENDC
  .ENDC
.ENDM	CMDTBL

.SBTTL	KUMOVE	- Slide KMON/USR Up or Down

	.PSECT	RT11		;Put KMON & USR here

;+
; "The awful shadow of some unseen power
;  Floats, tho' unseen, amongst us"
;	- Shelley, "Hymn to Intellectual Beauty"
;-

;+
; KUMOVE is responsible for moving the KMON and USR
; either up or down when a handler is loaded or unloaded,
; or when a Foreground Job is installed or removed.
; Calling Sequence:
;	R0 = Amount to move (<0 => down; >0 => up)
; Returns:
;	R4 -> KMON if down
;	      Start of freed area if up
; Destroys R1, (R3 if down)
;-

KMON::	.WORD	0		;This word stops the move loop
KUMOVE:	MOV	PC,R4		;Point R4 to KMON
	.LOCK			;LOCK USR before sliding it
	BR	KUMOV1		;Go to rest of KUMOVE routine
	............

;+
; This routine is here to keep MINMOV as small as possible
;-
	.ENABL	LSB

MOVEUP:	CLR	-(SP)		;Word to flag when we pass stack top
10$:	MOV	-(R1),-(R4)	;Move a word
	BNE	10$		;Loop while non-0
	CMP	R1,PC		;Was the 0 word below here ?
	BLO	20$		;Yes. Done !
	CMP	R1,SP		;Was it stack top ?
	BNE	10$		;No, just a strange 0
	MOV	R4,SP		;Make the new stack pointer
	TST	(SP)+		;Purge that 0 word
	BR	10$		;Move the rest
	............

20$:	MOV	R0,R1		;Must relocate addr
	ADD	R0,@SP		;Must relocate return addr
	RETURN
	............

	.DSABL	LSB

MINMOV	=: < . - KMON >		;Minimum size to move up
	.ENABL	LSB

KUMOV1:	CMP	-(R4),-(R4)	;Point R4 to beginning of KMON
	ASL	R0		;Fix R0 to bytes. Move up or down ?
	BCS	20$		;Down, go call mover
	ADD	#<KMSIZE+USRSIZ>,R4 ;Point to top of USR
	MOV	R4,R1		;R1 -> top of USR = source pointer
	ADD	R0,R4		;R4 is destination pointer
	BIT	#<IFDAT$>,@.STATWD ;Is there DCL/@File data above USR?
	BEQ	10$		;No
	ADD	@R1,R4		;Yes, size is just above USR, bump destination
	ADD	@R1,R1		; and source pointers
	ADD	R0,@.INBFPT	;Relocate pointer to data before move
	ADD	R0,ENBFPT	;Relocate end pointer, too
10$:	CALL	MOVEUP		;Call mover-upper
	BR	50$
	............

20$:	.ADDR	#<MOVEDN>,R3	;Point to start of move routine
	CALL	CLRLOW		;Clear out 40-53
	.ADDR	#<MOVEDE>,R4,PUSH ;Pointer to end of move routine
	MOV	@SP,R1		;Get KMON pointer
	ADD	#<KMSIZE+USRSIZ>,R1 ;Point to end of USR
30$:	MOV	-(R4),-(R1)	;Move MOVEDN routine to USR
	CMP	R4,R3		;Done?
	BNE	30$		;No
	MOV	@SP,R4		;Yes, restore pointer to start of KMON
	MOV	@.STATWD,@SP	;Save current state
	MOV	R1,-(SP)	;Save pointer to move routine
	MOV	R4,R1		;Point R1 properly
	ADD	R0,R4		;R4 is destination pointer
	BCC	MEMERR		;Carry clear => too much asked
.IF EQ MMG$T
	CMP	R4,#<STD.SP>	;Are we moving too low?
.IFF ;EQ MMG$T
	CMP	R4,#<PAR2-KMSIZE>;Moving too low? KMON cannot go into PAR1.
.ENDC ;EQ MMG$T
	BLO	MEMERR		;Yes, error
	CALL	@(SP)+		;Call mover-downer
	BIC	#^c<IFDAT$>,(SP)+ ;Is there DCL/@File data above USR?
	BEQ	50$		;No
	ADD	R0,@.INBFPT	;Yes, relocate pointer
	ADD	R0,ENBFPT	;Relocate end pointer, too
	MOV	@R1,R3		;We're pointing to size. Save it
40$:	MOV	(R1)+,(R4)+	;Move the data
	SUB	#<2>,R3		;Count down bytes
	BNE	40$		;Loop until done
	.BR	50$
	............
;+
; Now relocate some pointers in RMON
;-
50$:	MOV	R3,-(SP)	;Save R3
	JSR	R2,80$		;Save R2, point to rel list
	............

..USRL:: .WORD	< USRLOC - $RMON >	;-> USRLOC
.BUFLO:: .WORD	< BUFLOC - $RMON >	;-> BUFLOC
.KMLOC:: .WORD	< KMLOC  - $RMON >	;-> KMLOC
.$USRL:: .WORD	< $USRLC - $RMON >	;-> $USRLC
.$KMLO:: .WORD	< $KMLOC - $RMON >	;-> $KMLOC
..SYSL:: .WORD	< SYSLOW - $RMON >	;-> SYSLOW
	 .WORD	0		;Flag end of RMON list
	............

;+
;*** This must be updated with USR list ***
;-
60$:
	 .WORD	< .USRBU - RELUS4 >	;-> USR Buffer
	 .WORD	< .USRTO - RELUS4 >	;-> Top of USR Buffer
	 .WORD	< .USRBO - RELUS4 >	;-> First directory entry in seg
	 .WORD	< .FNAME - RELUS4 >	;-> Temp area for RENAME and DSTATS
	 .WORD	< .FNAM6 - RELUS4 >	;-> End of temp for FETCH
	 .WORD	< .D.USR - RELUS4 >	;-> Block number for files in seg
	 .WORD	< .M.USR - RELUS4 >	;-> Approx middle of a dir seg in bufr
	 .WORD	< .USRIO - RELUS4 >	;-> $SYS block for USR Buffer
	 .WORD	< .FILDE - RELUS4 >	;-> Area for file desc for CSI
	 .WORD	< .HANSP - RELUS4 >	;-> User arguments for CSI
	 .WORD	< .DVSTS - RELUS4 >	;-> Device Status block
.IF EQ MMG$T
	 .WORD	< .STKSV - RELUS4 >	;-> Stack save area for CSI
	 .WORD	< .SVSTK - RELUS4 >	;-> End of stack save area
.ENDC ;EQ MMG$T
.IF NE LK4$DV
	 .WORD	< .LK4DV - RELUS4 >	;-> LK4DEV routine
.ENDC ;NE LK4$DV
KURELT	==: < . - 60$ >	;Length of table (for crosscheck with USR)
	 .WORD	0		;FLag end of USR relocation list
	............

70$:	ADD	R0,@R3		;Relocate word in RMON
80$:	MOV	(R2)+,R3	;Get pointer to word in RMON
	BNE	70$		;Loop until done
;+
; Relocate some pointers in USR (assumes USR is contiguous with KMON)
;-
90$:	MOV	(R2)+,R3	;Get offset of location to adjust in USR
	BEQ	100$		;Done
	ADD	PC,R3		;Point at location in USR to change
RELUS4:	ADD	R0,@R3		;Update absolute address in USR
	BR	90$		;Loop thru USR list
	............

100$:	ADD	R0,SYSIOB	;Fix pointer to USRBUF
	MOV	(SP)+,R2	;Restore regs
	MOV	(SP)+,R3
	ADD	R0,(PC)+	;Accumulate KMON moves for DCL
ACCUM:	 .WORD	0		;Accumulated size of KMON moves for DCL
	.UNLOCK			;Let someone else have USR
	ADD	R0,@SP		;Relocate return address
	RETURN
	............

	.DSABL	LSB
;+
; This routine is moved to the top of the USR
; it is used to help move the KMON/USR downward in memory
;-
	.ENABL	LSB

MOVEDN:	MOV	SP,R3		;Save SP to find it in loop
	CLR	-(SP)		;And make us stop at stack top
10$:	MOV	(R1)+,(R4)+	;Copy a word
	BNE	10$		;Loop when non-0
	CMP	R1,PC		;Are we done (past ourselves)?
	BHI	20$		;Yes
	CMP	R1,R3		;Did we get the stack topper?
	BNE	10$		;Keep moving
	MOV	R4,SP		;Switch to new stack (& pop!)
	BR	10$		;And continue
	............

20$:	ADD	R0,@SP		;Relocate return address
	RETURN
	............

	 .WORD	0		;This stops the move!
MOVEDE:

.ASSUME	<MOVEDE-MOVEDN>	EQ 26.	;Required size!

	.DSABL	LSB

MEMERR:	CALLR	OVERC
	............
.IF NE <AI$COD&RESE$$>		;If Auto-install AND RESET command support
RESET::	BIS	#<IFCTC$!IFABT$>,@.STATWD ;Treat as ^C^C exit
	CLR	R3		;Use R3 as pointer to location 5
	MOV	(PC)+,(R3)+	;Re-initializelocation 0
	 BIC	R0,R0		;Contents of location 0
	MOV	(PC)+,(R3)+	;Re-initialize location 2
 .IF EQ MMG$T
	 .EXIT
 .IFF ;EQ MMG$T
	 .ASTX
 .ENDC ;EQ MMG$T
	MOV	@#$SYPTR,R3	;Point to RMON
	BR	BCLEAN		;Initialize buffers
	............

.ENDC ;NE <AI$COD&RESE$$>
.SBTTL	MEXIT 	- KMON Cleanup After EXIT; Collect Command Line

;+
; The following code cleans up after an EXIT has been done.  MEXIT is used
; when the USR has been freshly read and has pointers which must be relocated.
; MEXIT2 is used when a good USR copy is in the standard place in memory.
;-
	.ENABL	LSB

MEXIT:	CALL	LOCATE			;Set pointers into RMON
MEXIT2::CLR	ENBFPT			;Reset in case new copy not brought in
	MOV	@.$KMLO,@.KMLOC		;KMON is now in control
	BIC	#<TTSPC$+TTLC$>,@#$JSW	;Clear out Special TTY mode
	BIC	#<IFBEX$!IFRVT$!IFGTC$>,@.STATWD ;Clear BATCH force exit & ...
					; ... special GTLIN/CSI bits in STATWD
	CLR	EMTMOD			;Clear for calls to GETNAM (USR)
	CLR	GETCNT			;No GETs yet
	MOV	@#$SYPTR,R3		;Point to RMON (NOT contiguous w/ USR)
BCLEAN:	MOV	#<-1>,KMONIN-$RMON(R3)	;KMON is in control
	CLR	BLKEY-$RMON(R3) 	;No directory is in memory
.IF EQ MTT$Y
	MOV	CNTXT-$RMON(R3),R0	;Another ^C will not abort us
	CLR	I.PTTI(R0)		;Clear the previous character
.IFF ;EQ MTT$Y
	MOV	BKCNSL-$RMON(R3),R0	;Another ^C will not abort us
	CLRB	T.PTTI(R0)		;Clear previous character
.ENDC ;EQ MTT$Y
	CLR	@.EXTFLG	;Clear exit in progress flag
	MOV	(SP)+,R0	;Get chain indicator off stack
	.ADDR	#<KMSTAK>,-(SP)	;Setup pointer to KMON stack
	MOV	@SP,SP		;Switch to KMON stack, so .HRESET not done on
				;RMON stack
	TST	R0		;What kind of exit?
	BNE	KCHAIN		;Temporary
.IF NE RESE$$ & ^c<AI$COD>	;If RESET command AND not auto-install monitor
RESET::
.ENDC ;NE RESE$$ & ^c<AI$COD>
RESET1:	BIT	#<SPXIT$>,@#$JSW	;Special chain exit in effect?
	BEQ	10$			;Branch if no
	BIS	#<IFSPC$>,@.STATWD	;Set special chain exit processing bit
	BIC	#<CHAIN$!SPXIT$!CHNIF$>,@#$JSW ;Clear chain bits in $JSW
	MOV	SP,EXPSPC		;<> to expand buffer for special 
	BR	20$			;   chain exit.
	............

10$:	BIT	#<CHNIF$>,@#$JSW	  ;Is this EXIT and CHAIN to @File?
	BEQ	20$			  ;No
	BIS	#<IFABT$!IFCHA$>,@.STATWD ;Yes, abort any current @File, ...
					  ; ... setup for @File CHAIN
20$:	CALL	CLRLOW		;Clear CCB in Monitor
	.HRESET			;System Reset (hardware & software)
	.BR	CTRLCK
	............
CTRLCK:	BIC	#<CHAIN$>,@#$JSW ;Standard KMON loop is no CHAIN
KCHAIN:	MOV	.USRBUF,SYSIOB	;Set up USR Buffer pointer
	.ADDR	#<KMSTAK>,R0	;Set up pointer to KMON stack
	MOV	R0,SP		;Put new SP into reg 6
	.RCTRLO			;Disable CTRL/O
STRT:	MOV	#<-1>,CMDFLG	;Init CMDFLG, ATFLAG for DCL code
				; generation and @File expansion
	.ADDR	#<KMCBUF>,R5	;Point to KMON Command Buffer
	MOV	R5,R3		;Copy pointer
	CLR	(PC)+		;Clear so KMON's dot gets printed
DOTFLG:	 .WORD	0		;<> 0 to suppress KMON dot for prompting
	MOV	#<KMCBFLN>,R1	;Get size of KMON Command Buffer
.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
	BIT	#<IFLIF$>,@.STATWD ;Is this LINK Overlay @File?
	BEQ	STRTP		;No
	MOV	KBFLN,R1	;Yes, get adjusted KMCBF length
.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST
	.BR	STRTP
	............

	.DSABL	LSB
	.ENABL	LSB

STRTP:	.UNLOCK
	BIT	#<CHAIN$>,@#$JSW ;Is this a CHAIN entry?
	BEQ	10$		;No
	.LOCK
	CALLR	RUN		;Yes, simulate a RUN
	............

10$:	MOV	.STATWD,R4	;Since STATWD referenced often
	BIC	#<IFCTC$>,@R4	;Clear CTRL/C typed flag
.EXTIND	==: < . + 4 >
	BISB	@#$USRRB,@#EXTIND-$RMON ;Save all errors
.ERRLEV	==: < . + 2 >
	BITB	@#ERRLEV-$RMON,@#$USRRB ;Any significant errors?
	BNE	KABORT		;Yes, abort any Indirect File
	BIT	#<IFABT$>,@R4	;No, is the abort flag set in @File STATWD?
	BNE	KABORT		;Yes, abort Indirect File
	CLRB	@#$USRRB	;No, clear program error status
20$:	BIT	#<IFSPC$>,@R4	;Special chain exit processing?
	BNE	30$		;Branch if yes
	BIT	#<IFCHA$>,@R4	;Chain to @File?
	BEQ	40$		;No
	BIC	#<IFCHA$>,@R4	;Yes, clear the flag bit
30$:	CALL	CHANIF		;Go handle it
	BR	STRT		;Back to main loop
	............

40$:	TST	DATAFG		;Are we doing @File data expansion?
	BNE	50$		;Yes, don't take data from buffer
	MOV	@.INBFPT,R2	;No, is there data in DCL/@File command bfr?
	BNE	IFDCLN		;Yes, get command line from there
50$:	BIT	#<IFACT$>,@R4	;Is there an active @File?
	BNE	INDFLL		;Yes, go expand data from @File
.INDSTA	==: < . + 2 >
INDXIT:	MOV	#<INDSTA-$RMON>,R2 ;Point to high byte for IND status
	BICB	#<IN$RUN>,@R2	;Reset KMON's RUN_IND flag --
				; Entered KMON from IND?
				.ASSUME IN$IND EQ 200
	BPL	70$		;No, normal process - print dot
	BICB	#<LN$IND!IN$IND>,@R2 ;Clear IND bits
	BISB	#<IN$RUN>,@R2	;Tell IND it was called by KMON (not by user)
.$INDDV	==: < . + 2 >
INDX2:	MOV	@#$INDDV-$RMON,R0 ;Get address of device name and unit
	.ADDR	#<INDCNT>,R2	;Set up to force run of IND
	MOV	R2,R1		;Get pointer to chain block
	ADD	#<INDDVU-INDCNT>,R1 ;Point to area to store ASCII XXn equiv.
	MOV	(R0)+,(R1)+	;Move in first word (device name)
	MOV	(R0)+,(R1)+	;Move in second word (unit number and :)
	MOV	SP,EXPSPC	;Force IND to run before anything else
60$:	MOV	#<CCL.CT>,R1	;Point to chain area for command
	MOV	@R2,(R1)+	;Copy byte count
	CALL	CHANF1		;Move data to low memory area
	BR	30$		;Go do it
	............

70$:
.IF NE CONT$N
	BIC	#<IFDOL$>,@.STATWD ;Init. dollar bit in case it's turned on
	.ADDR	#<KCTNU>,R2	;Get address of continue @File information
	TST	@R2		;Is continuation flag still set?
	BNE	CFATAL		;Yes, fatal error
	MOV	SP,(R2)+	;No, set it
	BR	60$		;Chain
	............

.ENDC ;NE CONT$N
KPMT:	CALL	KDOT		;Get KMON's dot printed
	MOV	R5,R5		;Hook for SL
	BIC	#<IFDOL$>,@.STATWD ;Init. dollar bit before processing line
80$:	MOV	@#$JSW,-(SP)	;Save and set $JSW so a prior get can't
90$:	MOV	#<TTLC$>,@#$JSW	;Enable lowercase input for KMON
	.TTINR			;Get character from TTY
	MOV	R5,R5		;Hook for SL
	BCS	90$		;Branch if no character
	MOV	(SP)+,@#$JSW	;Restore saved $JSW
	CLR	(PC)+		;Set not @ file data expansion
DATAFG:	 .WORD	0		;0 if special characters to be checked and
				; spaces compacted during line collect
	JSR	R2,CHARCK	;Call general character processor
	 BR	80$		;Normal character, loop
	 ......

	JSR	R2,CNTCK	;End of line, check for continuation
	 BR	80$		;Continuation expected, go append new line
	 ......

	BIC	#<IFINP$>,@R4	;No continuation, flag input from TTY
	CALLR	ATSCAN		;Go look for Indirect File (@File)
	............

	.DSABL	LSB
.SBTTL	KABORT	- Abort DCL/@File Processing

	.ENABL	LSB

KABORT:	TST	COROVR		;Is this special case of KMON moving too low?
	BNE	10$		;Yes, there's really data above
				;  KMON, but IFDAT$ isn't set(see DCLSPC)
	BIT	#<IFDAT$>,@R4	;Is there DCL/@File data above KMON/USR?
	BEQ	40$		;No, no memory to reclaim
10$:	CALL	PUTBAK		;Yes, free up the memory and slide KMON/USR
	CLR	COROVR		;Clear over memory flag
	MOV	@.IFSVST,R4	;Should we free @File Context Stack?
	BEQ	40$		;No, just leave
	SUB	#<6>,R4		;Yes, point to nest level byte
20$:	TSTB	@R4		;Level 0?
	BEQ	30$		;Yes
	SUB	#<IFSVSZ>,R4	;No, backup one level
	BR	20$		;See if level 0
	............

30$:	CLR	@.IFSVST	;Set context stack freed up
	CALL	PUTBLK		;Put back the space
40$:	CLR	@.EXTFL		;Re-enable ^C
	BIC	#^c<IFEKO$!IFCHA$!IFIND$>,@.STATWD ;Clear @File status
				; Bits except echo, chain, and IND ON
	CLRB	@#$USRRB	;Clear user program status
	CLR	DATAFG		;Set not @File data expansion
	CALLR	CTRLCK		;Back to main KMON loop
	............

	.DSABL	LSB
;+
; End of data reached in DCL/@FILE buffer
;-

ATEOD:	TST	DOTFLG		;Suppressing dot for prompt?
	BNE	KPMT		;Branch if yes
	BIT	#<IFACT$>,@R4	;Any @File still active?
INDFLL:	BNE	INDFIL		;Yes, go expand some more
	BITB	#<LN$IND!IN$IND>,@.INDSTA ;Entered KMON from IND?
	BNE	INDXIT		;Branch out if yes
	CALL	PUTBAK		;No, free up DCL/@File buffer space
	CLR	@.EXTFL		;Re-enable ^C
	CALLR	STRT		;Go get a line
	............

.IF NE CONT$N
CFATAL:	CALLR	BADCOM		;Give invalid command message
	............

.ENDC ;NE CONT$N
.SBTTL	IFDCLN	- Get Command Line From DCL/@File Buffer

;+
; At this point, there is data in the DCL/@File Buffer above the USR.
; We check for end of data, and also to see if any of the free space
; in the buffer can be reclaimed.
;-

MINFRE	=: < MINMOV * 2 > ;Min. amt of space to FREE=2*MIN. Amt KMON can move

	.ENABL	LSB

IFDCLN:	CMPB	@R2,#<EOFDCL>	;Are we at end of DCL/@File data?
	BEQ	ATEOD		;Yes (only possible after end of line)
	CMPB	@R2,#<EOFIND>	;End of IND type command?
	BNE	20$		;Branch if no
	TST	DOTFLG		;Suppressing dot for prompt?
	BNE	KPMT		;Branch if yes
	BITB	#<LN$IND>,@.INDSTA ;Did command come directly from IND?
	BNE	10$		;Branch if yes
	BIT	#<IFACT$>,@R4	;Any @File still active?
	BEQ	10$		;No, re-run IND
	TST	@(PC)+		;Is the activity from the current level?
.CURLEV:: .WORD	<CURLEV-$RMON>	;Active current level flag word
	BEQ	INDFIL		;Yes, get Indirect File
10$:	INC	@.INBFPT	;Update pointer beyond IND line terminator
	CALLR	INDXIT		;No, re-run IND
	............

20$:	.ADDR	#<KMON+KMSIZE+USRSIZ>,R4 ;Point to end of USR to find the
				; amount of free space in DCL/@File bfr
	MOV	R4,R0		;Copy pointer to DCL/@File data
30$:	ADD	#<MINFRE>,R0	;See if amount of free space > minimum
				; amount we want to free up
	CMP	R0,R2		;Compare ptr with beginning of real data
	BLO	30$		;If low, try to free up more
	SUB	#<MINFRE>,R0	;Too much, allow some free space
	CMP	R4,R0		;Are we freeing anything?
	BHIS	40$		;No, just get out
	MOV	R4,-(R0)	;Yes, calculate size of block of memory
	SUB	R0,@R0		;That will be left after we free some up
	ADD	@R4,@R0		;New Size = Old Addr - New Addr + Old Size
	CMP	@R0,#<MINMOV>	;Is size of block left >= MINMOV ?
	BLOS	40$		;No, don't free or block left ...
				; ... will be too small to reclaim
	MOV	SP,@.EXTFL	;Yes, disable ^C for sensitive stuff
	MOV	R0,@R4		;Store size of block to free up ...
	SUB	R4,@R4		; ... ( = Addr of new blk - Addr of old blk)
	MOV	R1,-(SP)	;Save R1 across PUTBLK
	CALL	PUTBL1		;Free up the block we made
	MOV	(SP)+,R1	;Restore R1
	ADD	R0,R5		;Adjust line buffer pointers ...
	ADD	R0,R3		; ... in case it moved
40$:	BIS	#<IFDAT$>,@.STATWD ;Indicate there is still data above USR
	CLR	@.EXTFL		;Re-enable ^C
	.BR	50$
	............
50$:	CLR	-(SP)		;Init to no echo of line
	TSTB	@R2		;Is hi bit clear to indicate DCL line?
	BPL	60$		;Yes, don't echo DCL line
	BIT	#<IFEKO$>,@.STATWD ;Not DCL line, is echo turned off?
	BNE	60$		;Yes, don't print line
	MOV	R2,@SP		;Store address of line to print later
60$:	BICB	#<FIXCHR>,@R2	;Clear parity as if char was from TTY
70$:	MOVB	(R2)+,R0	;Move char to R0 - end of line?
	BNE	80$		;Not end of line yet
	MOV	#<LF>,R0	;Yes, make it Line Feed for convenience
80$:	CLR	DATAFG		;Clr so special checks are done
	JSR	R2,CHARC1	;Check character and add it to buffer
	 BR	60$		;Normal character, loop for more
	 ......

	MOV	R2,@.INBFPT	;EOL. Update permanent DCL/@File bfr ptr
	MOV	(SP)+,R0	;Anything to echo?
	BEQ	90$		;No
	CALL	KDOT		;Yes, print KMON's dot
	MOV	R4,R4		;Unhook for SL with MOV R4,R4
	.PRINT			;Print the line
90$:	JSR	R2,CNTCK	;Check if line is continued
	 BR	120$		;It is, check for legality
	 ......

	MOV	R5,-(SP)	;No continuation, save line pointer
100$:	TSTB	-(R5)		;End of line?
	BEQ	110$		;Yes, no '@'
	CMPB	@R5,#<'@>	;Is this an '@'?
	BNE	100$		;No, keep looking
	BR	AT1		;Yes, go process it (R5 on stack)
	............

110$:	MOV	R5,R3		;No @ file in line. R3 -> end of line
	MOV	(SP)+,R5	;Restore R5 -> start of line
	BIS	#<IFINP$>,@.STATWD ;Indicate DCL/@File input
	BR	CMDREC		;Go to command recognizer
	............

120$:	CMPB	@R2,#<EOFDCL>	;Continued line, are we at end of data?
	BNE	50$		;No, process continuation
;+
;ERROR
ILCNT:	KMEROR	<Invalid continuation> ;Yes, can't continue that way
;-
	............

	.DSABL	LSB
.SBTTL	INDFIL	- Indirect File Expansion

INDFIL:	MOV	R1,-(SP)	;Save # of bytes left in line buffer
	MOV	R3,-(SP)	;Save ptr. into line buffer
	OVLINK	INDF1		;Link to rest of @File expand
	............

.SBTTL		- Indirect File Stack Format

;+
; The Indirect File Context Stack is stored in a block of memory
; which is allocated the first time an Indirect File is used.
; the block is large enough to hold  IFMXNST  levels of status.
; when the last level is popped up, the block of memory is freed.
;
; Format of block of memory is:
;
;	.WORD	( Block Size )		used by GETBLK/PUTBLK
;	.BYTE	Current Nest Level (0)
;	.BYTE	Max. Nest Level
;	.WORD	Char. Count (Offset Into BLK)
;	.WORD	Curr. Block # of @File
;	.BLKB	SVSTSZ			SAVSTATUS BLK for this @File
;	.BYTE	Current Nest Level (1)	(Prev Nest Level+1)
;	.BYTE	Max. Nest Level
;	   .
;	   .
;-
.SBTTL	ATSCAN	- Scan Line For Indirect File Construct

;+
; At this point there is a full command line in the KMON line buffer.
; Multiple spaces/tabs have been compacted. Continuation lines have been
; combined and comments have been deleted.  Now search the line for an
; Indirect command file specification.
;-

.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
;+
;**NOTE**  ATSCAN is used by the DCL LINK command for expanding an
; overlay descriptor Indirect File.  Routine LINKAT calls ATSCAN as
; a subroutine.  SCN2 in the SCNDUN processor recognizes this
; and does the proper return.
;-
.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST

	.ENABL	LSB

ATSCAN:	MOV	R5,-(SP)	;Save command line pointer (stored backwards)
10$:	TSTB	-(R5)		;Check a character of the command line
	BEQ	SCNDUN		;Null indicates end of command
	CMPB	@R5,#<'@>	;Is it an '@'?
	BNE	10$		;No, keep checking
AT1:	MOV	R1,-(SP)	;Yes, save count of room in line buffer
	OVLINK	AT2		;Link to rest of routine in res. ovlay
	............

	.DSABL	LSB
;+
; Continuation of ATSCAN.  This should be resident, since GETHAR
;  can cause 'LOAD/UNLOAD' overlay to be brought in.
;-

AT3:	CALL	GETHAR		;Get the device handler
				;**CAREFUL, GETHAR can make KMON move**
	MOV	R3,-(SP)	;Save R3 across OVLINK
	OVLINK	AT4		;Link to rest of ATSCAN in @File exp overlay
	............
SCNDUN:	MOV	R5,R4		;R4 -> end of cmd. line
	MOV	(SP)+,R5	;R5 -> begin of cmd. line
	BIT	#<IFACT$>,@.STATWD ;Is Indirect File active?
	BEQ	CMDREC		;No - go to command recognizer
	OVLINK	SCN0		;Link to overlay
	............

SCN3:
.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
 	BIT	#<IFLEF$>,@.STATWD ;EOF while doing LINK overlay @File?
	BNE	SCN2		;Yes, go finish and return do DCL
.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST
	CALLR	STRT		;Back to mainline
	............

.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
;+
; SCN2 is the return for subroutine ATSCAN called from LINKAT
;-

SCN2:	BIC	#<IFLIF$!IFLEF$>,@.STATWD ;Clear LINK overlay status @File
	MOV	ACCUM,R0	;Get accumulated size of KMON moves
	CLR	DATAFG		;Clear so DCL doesn't screw up
	SUB	R0,@SP		;Relocate return address
	RETURN			;Return to DCL hope stack is right!
	............

.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST
.SBTTL	CMDREC	- Command Processor

;+
; We now have a line to be processed as a command.
; First remove any factoring parens, then classify
;  the command and process it
;-
	.ENABL	LSB

CMDREC:	TSTB	-(R5)		;Any data in command line?
	BEQ	CTRLC2		;No, ignore line
	CMPB	(R5)+,#<CTRLC>	;Is it ^C from Indirect File?
	BNE	20$		;No, start processing line
	TST	R0		;Is ECHO turned on?
	BNE	10$		;Branch if yes
	MOV	SP,R0		;This is a temporary exit
10$:	.EXIT			;EXIT
	............

20$:	MOV	R5,-(SP)	;Save ptr to command string
	.ADDR	#<KMCBND>,-(SP)	;Set up pointer to end of KMCBUF
SCNLIN:	TSTB	-(R5)		;At end of line?
	BEQ	CLASIFY		;Yes, no factoring construct to expand
	CMPB	#<'(>,@R5	;An open (left) parenthesis?
	BNE	SCNLIN		;No
	OVLINK	FACTOR		;Yes, go to the factoring code
	............

	.DSABL	LSB

CTRLC2:	CALLR	CTRLCK		;Done
	............
.SBTTL	CLASIFY	- Command Recognizer

;+
; Set up initial values of flags and pointers
;-
	.ENABL	LSB

CLASIFY::
	TST	(SP)+		;Pop off end of KMCBUF address
	MOV	(SP)+,R5	;Restore pointer to command string
	MOV	.CLIFLG,R0	;Point to CLI flags
	TSTB	EXEFLG		;Entered from the middle of EXECUTE expansion?
	BNE	30$		;Branch if yes
.IF NE U$CL
	BITB	#<UCF.KM!UCF.ON>,@R0 ;Test for command to do and UCF to be run
	BMI	10$		;KMON is to do current command
	BEQ	CFYDCL		;UCF not active
 .ASSUME UCF.RN EQ 0
	BIC	#<177400>,@R0	; Clear CLITYP byte
	.PURGE	#<CHOVLY>	;PURGE the overlay channel
;;;	MOV	(PC)+,R0	;Get code for PURGE overlay channel
;;;	 .BYTE	<CHOVLY>,<.PURGE>
;;;	EMT	...PUR		;Do the PURGE
	MOV	R5,R2		;Point to command string
	.ADDR	#<RUN2>,-(SP)	;Provide return addr for GET1
	OVLINK	UCF		;Go run UCF
	............

10$:	BICB	#<UCF.KM>,@R0	;Clear "do command" bit
.ENDC ;NE U$CL
;+
; Try to process the command as DCL
; Match the Entered Command with the Command List (COMLST:)
;-

CFYDCL:
	BITB	#<DCL.ON>,@R0	; Are we doing DCL parsing?
	BNE	30$		; Yes, use standard DCL cmd table
	.ADDR	#<COMLS2>,R2	; No, try 'special' DCL table
	BR	35$
30$:	.ADDR	#<COMLST>,R2	; Set pointer to command list
35$:	CALL	DCLSUP		; Set up for DCL 
	CALL	CTSCAN		; Scan Cmd Tbl, get index in R0
	BCS	60$		; Didn't find cmd in table

; Command found in table; find routine, execute command
	ASL	R0		; Make word index
	.ADDR	#<COMDST-2>,R2	; Point R2 to destination table
	ADD	R0,R2		; Point to entry
	MOV	@R2,R3		; Put relative address in R3
	ADD	PC,R3		; Make it absolute

; Call the command through the PC relative vector. BGT is used even 
; though addresses are unsigned because BGT will branch if the CMP
; is of a positive SRC and a negative DST, which will be the case at 
; least with RESET.
CMDBAS:	.LOCK			; Moved here to fix race
	CMP	#<ENDRES-.>,@R2	; Is command resident?
	BGT	40$		; Yes, skip overlay stuff
	MOV	R5,R1		; Set up for OVREAD
	CALL	OVREAD		; Read in the overlay
40$:	CLR	SAVSWT		; Clear saved indicator if E or D
				; TIME cmd assumes R3 setup this way
	CALL	@R3		; Call the command
CTRLC1:	BR	CTRLC2		; Done
	............

60$:	TST	R0		; What was mismatch ?
	BLT	BADCMD		; Input was invalid command
	BEQ	AMBCMD		; Ambiguous command
;      (BGT	CCLENT)		; Input cmd not in table, try CCL
;+
; Try to process the command as CCL
; Adjust input, try to RUN CMD.SAV
;-
.CLIFLG	==: < . + 4 >
CCLENT:	BITB	#<CCL.ON>,@#CLIFLG-$RMON ;Are we doing CCLs?
.IF NE U$CL
	BEQ	90$		;No, try UCL for command
.IFF ;NE U$CL
	BEQ	BADCMD		;No, then nothing to do
.ENDC ;NE U$CL
.CLITYP	==: < . + 4 >
	MOVB	#<CCL.RN>,@#CLITYP-$RMON ;Yes, indicate that
	.ADDR	#<KMCBUF>,R5	;Point to start of KMON buffer
	MOV	(PC)+,(R5)+	;Move ASCII text in to command string
	 .ASCII	":Y"
	TSTB	(R5)+		;Set pointer to start of command string
	MOV	#<KMCBFLN>,R1	;Get size of KMON command buffer
	.LOCK
	CALLR	RUN		;Treat command as a SAV file
	............

;+
; The command has not been recognized by UCF, DCL, or CCL.
; We have one last chance with UCL (if it is enabled).
;-

.IF NE U$CL
90$:	.PURGE	#<CHOVLY>	;PURGE the overlay channel
;;;	MOV	(PC)+,R0	;Get code for PURGE overlay channel
;;;	 .BYTE	<CHOVLY>,<.PURGE>
;;;	EMT	...PUR		;Do the PURGE
	MOV	R5,R2		;Point to command string
	.ADDR	#<RUN2>,-(SP)	;Provide return addr for GET1
	OVLINK	UCL		;Go run UCL
	............

.ENDC ;NE U$CL
;+
;ERROR
AMBCMD:	KMEROR	<Ambiguous command>
;-
	............
BADCMD:	CALLR	BADCOM		;Give invalid command message
	............
	.DSABL	LSB
.SBTTL	SUBR CHMTCH	Character matching subroutine
; R2 -> Table command string
; R5 -> Input command string
; No registers are affected
; Status from the compare is returned to caller
	.ENABL	LSB

CHMTCH:	MOVB	@R2,-(SP)	;Get a table char
	BIC	#^c<77>,@SP	;Make it sixbit
	MOVB	@R5,-(SP)	;Get input char
	CMPB	#<'a>,@SP	;Less than lowercase a?
	BHI	20$		;Branch if yes - no conversion
	CMPB	#<'z>,@SP	;Greater than lowercase z?
	BLO	20$		;Branch if yes - no conversion
	BICB	#<LOW2UP>,@SP	;Convert lowercase alpha to uppercase
20$:	BIC	#^c<77>,@SP	;Make it sixbit
	CMP	(SP)+,(SP)+	;Do the characters match?
	RETURN			;Return with a decision
	............


.SBTTL	SUBR DCLSUP	Subr to set up flags, etc for DCL processing

DCLSUP:	MOVB	#<DCL.RN>,CLITYP-CLIFLG(R0) ;Indicate DCL parsing
	CLRB	FOTFL2		;Flag to keep track of multiple /OBJ:
	CLRB	SOTFL2		;Flag to keep track of multiple /LIST:
	CLRB	TOTFL2		;Flag to keep track of multiple /SYMBOL
	.ADDR	#<RUNFLG>,R0	;Point at the RUNFLG byte
	CLR	(R0)+		;Reset EXECUTE for /NORUN and DCL COMPILE
				; class command flags
	MOV	(PC)+,(R0)+	;Reset low byte for no CSI flag and
	 .ASCII	<NUL>" "	; initialize EXECUTE delimiter for LINK
	MOV	$DK,(R0)+	;Set default device for DCL commands
	MOV	$DK+2,(R0)+	;Both words
.IF NE EXEC$$
	MOV	#<EXELSZ-1>,(PC)+ ;Set pointer for EXECUTE text for LINK
EXEPTR:	 .WORD	0		;Pointer into LINK string built by EXECUTE
.ENDC ;NE EXEC$$

	RETURN

	.DSABL	LSB

.SBTTL	SUBR	CTSCAN Scan DCL command table for the input command
; Compare table text and input text, char by char, until we have 
; either a match, or we reach the end of the table
; Exit:	'C' clear	Good match	R0 = byte index
;	'C' set		Bad match	R0 < 0	Bad command
;					R0 = 0	Ambiguous command
;					R0 > 0	Command not in table

	.ENABL	LSB
CTSCAN:
	MOV	#-1, R0		; Assume invalid command
	CALL	ALPHT		; Does input string start w/ alpha ?
	BCC	90$		; No, can't be command
	MOV	R5,R3		; Save pointer to start of input line
	CLR	R0		; Init command index

; Compare DCL command table entry to command input string
20$:	INC	R0		; Bump to next command entry
	MOV	R3,R5		; R3 -> Start of Input command

; Compare the chars in this table entry text to the input cmd string
30$:	CALL	CHMTCH		; Do we have a character match?
	BNE	40$		; No, go get to next entry
	CALL	ALPHNT		; Is next input char alpha/num ?
	BCC	60$		; No, probably command
	TSTB	(R2)+		; Bump to next char in table string
	BGT	30$		; Check next table char if there is one
	BR	50$		; End of table string before end of input
	............

; Character mismatch, can't be this one, skip rest of entry
40$:	TSTB	(R2)+		; Examine table entry, bump table pointer
	BGT	40$		; Skip chars to -1 or <NULL>

; Input didn't match table entry, try next entry (if there is one)
50$:	BMI	20$		; <177> = End of entry, try next entry
	BR	90$		; <NULL>=End of table, exit w/R0>0, 'C' set

; Input string matches table string; did user input enough characters ?
60$:	BITB	#<100>,@R2	; Are we into the optional characters ?
	BEQ	70$		; Yes, return with R0 = Entry index
	CLR	R0		; No,  return with R0 = 0
	BR	90$		; Return with 'C' set

; Input matches table, return with 'C' clear, R0 = table entry index
70$:	TST	(PC)+		; Clear carry, skip next instr, we've got it

90$:	SEC			; Set carry, Input Cmd didn't match table
	RETURN

	.DSABL	LSB

.SBTTL	OVREAD	- Read Overlay, Link To Overlay

	.ENABL	LSB

OVREAD:	CLR	-(SP)		;Make room for offset
	MOVB	(R2)+,@SP	; and put it in
	MOVB	(R2)+,R0	;Get relative overlay block
	.ADDR	#<OVLIOB>,R5	;Point to IOB for overlay I/O
	.ADDR	#<OVLY>,R3	; and to memory address
	CMPB	R0,@R5		;Is block already in?
	BEQ	10$		;Yes, don't do I/O
	MOV	R0,-(SP)	;Remember which overlay is in
	CLR	(R5)+		;Point to memory address word
	MOV	R3,@R5		;Set memory address
	MOV	#<-1>,(PC)+	;Set no Indirect File block in memory
IFBN:	 .WORD	-1		;(@File block number currently in memory)
	ADD	@(PC)+,R0	;Make block number absolute
.$MONB:: .WORD	<$MONBL-$RMON>	;$MONBL
	SUB	#<KMONSZ>,R0	; and offset block into overlays
.IF EQ MMG$T
	CALL	@.$SYS		;Do I/O from system device
.IFF ;EQ MMG$T
	CALL	RWSYS		;Do I/O from system device
.ENDC ;EQ MMG$T
	BCS	20$		;Error reading overlay
	MOV	(SP)+,-(R5)	;Store which overlay is in memory
10$:	MOV	R1,R5		;Repoint to command arguments
	ASL	@SP		;Compute word offset
	ADD	(SP)+,R3	;Point it into block
	RETURN
	............

20$:	CLR	-(R5)		;No overlay is in
	CLR	R4		;Message is fatal and
;+
;ERROR
	KMEROR	<Overlay read error>,RES,UNCON$ ;Must be resident
	............

BADCOM:	KMEROR	<Invalid command>
;-
	............

	.DSABL	LSB
;+
; This routine is used to link from one overlay to another.
; Over the link, R0, R1, and R3 are destroyed.
; R2, R4, R5, and the stack are preserved
;-

OVLINK:	MOV	R5,R1		;Preserve R5 over the link
	CALL	OVREAD		;Go read in the overlay
	MOV	(SP)+,R2	;Restore R2
	CALLR	@R3		;Enter the overlay
	............
;+
; The following routines call the KMON Error Message Processor
; Entry:  ERROVR Print error message only
;	  RTERR1 Print error message and run time device info
;	  RTERR2 Print error message and run time file info
;	  RTERR3 Print error message and backwards ASCIZ pointed at by R4
;	  RTERR4 print error message and 2 words of RAD50 to ASCII
;-

ERROVR:	MOV	@(SP)+,R5	;Put relative message address in R5
	OVLINK	ERRCOD		;Load the regular error overlay
	............

RTERR1:	MOV	(PC)+,R4	;Indicate DEV:FILENAME.EXT print
RTERR2:	CLR	R4		;Indicate DEV: print
	MOV	@(SP)+,R5	;Put relative message address in R5
	OVLINK	RTERR		;Load the Run Time Error Overlay
	............

RTERR3:	MOV	@(SP)+,R5	;Put the relative message address in R5
	OVLINK	BRTERR		;Load the Run Time Message Overlay
	............

RTERR4:	MOV	@(SP)+,R5	;Put the relative message address in R%
	OVLINK	RADERR		;Load the run time error overlay
	............

;+
; Note that R3 is destroyed.
;-

COPYFN:	MOV	R0,-(SP)	;Save R0
	.ADDR	#<INPFN>,R3	;Point to filespec area to store
	MOV	(R0)+,(R3)+	;Save the RAD50 device
	MOV	(R0)+,(R3)+	; 1st RAD50 word of filename
	MOV	(R0)+,(R3)+	;  2nd RAD50 word of filename
	MOV	(R0)+,(R3)+	;   and RAD50 filetype
	MOV	(SP)+,R0	;Restore R0
	RETURN
	............

.IF NE ERL$G & ^c<SB>		;If error logging AND not SB/XB
;+
; ERLCHK - Check to see if specified task is error logger
;
;	R4 -> Impure area of task
;
;	CALL	ERLCHK
;
;	Z bit set if task is 'ERRLOG'
;-
	.ENABL	LSB

ERLCHK:
 .IF NE SYT$K
	CMP	I.LNAM(R4),#<"ER>	;First two characters match?
	BNE	10$			;Branch if no
	CMP	I.LNAM+2(R4),#<"RL>	;Still matching the next 2 chars?
	BNE	10$			;Branch if no
	CMP	I.LNAM+4(R4),#<"OG>	;How about the last two?
 .IFF ;NE SYT$K
	CMP	I.NAME+2(R4),#<^rERR> ;Check the first half of name
 	BNE	10$		;Branch if no match
	CMP	I.NAME+4(R4),#<^rLOG> ;Check the second half of name
 .ENDC ;NE SYT$K
10$:	RETURN			;Return indication in Z-bit
	............

	.DSABL	LSB

.ENDC ;NE ERL$G & ^c<SB>
.SBTTL	R50ASC	- RAD50 To ASCII Conversion Routine

;+
; R50ASC
; The RAD50 to ASCII routine converts one RAD50 word contained in R0
; to ASCII and stores it in the area pointed to by R1.
; The unused RAD50 code (35) is converted to '*'.
; The RAD50 code for '.' is converted to '%'.
;
;	R0 =  the word to be converted
;	R1 -> the area to store the ASCII
;
;	CALL	R50ASC
;
;	R0 =  undefined
;	R1 is updated past the end of the ASCII characters
;-
	.ENABL	LSB

	.WORD	0, 1, 50
DIVTAB:	.WORD	< 50 * 50 >

R50ASC:	MOV	R4,-(SP)	;Save R4
	MOV	R3,-(SP)	; and R3
10$:	.ADDR	#<DIVTAB>,R3	;Point to divisor table
20$:	MOV	#<-1>,R4	;Init quotient register
	CMP	#<MAXR50>,R0	;Radix 50 value too large?
	BLO	40$		;Yes, output "???"
30$:	INC	R4		;Divide by power of 50(8)
	SUB	@R3,R0		;
	BCC	30$		;
	ADD	@R3,R0		;Restore dividend
	TST	R4		;Character a blank?
	BEQ	50$		;Yes
	CMP	#<^r  $>,R4	;$ , or digit?
	BLO	60$		;Branch if period or digit
	BEQ	70$		;Branch if $
40$:	ADD	#<40>,R4	;Else alpha or "?"
50$:	ADD	#<16>,R4	;
60$:	ADD	#<11>,R4	;
70$:	ADD	#<11>,R4	;
	MOVB	R4,(R1)+	;Store converted character
	TST	-(R3)		;Backup through table - at end?
	BNE	20$		;No, continue
	MOV	(SP)+,R3	;Restore R3,R4,R5
	MOV	(SP)+,R4	;
	RETURN
	............

	.DSABL	LSB
;+
; Resident Message Printing Utility Routines
;
; NOTE: if the BIS  #<IFABT$>,@.STATWD  is done before the .PRINT
; a problem can arise in F/B when BATCH is forcing a job to
; EXIT, and it has to write the log buffer out.  If the above
; bit is set, and the .PRINT causes log buffer to overflow,
; we can go into NEVER-NEVER LAND....
;
;-
	.ENABL	LSB

MSGKM:	BISB	#<UNCON$>,@#$USRRB ;Resident messages are always UNCONDITIONAL
MSGKM1:	.RCTRLO			;Turn on echo
	.PRINT			;Print the message
.IF EQ CONT$N
	BITB	#<UNCON$>,@#$USRRB ;UNCONDITIONAL error?
	BEQ	20$		;No, let the user decide to abort
;+
; *** NOTE *** change above to a NOP to let this look like 3B system
;-
.IFF ;EQ CONT$N
	BITB	#<WARN$>,@#$USRRB ;Warning?
	BNE	20$		;Yes, keep going
.ENDC ;EQ CONT$N
	BIS	#<IFABT$>,@.STATWD ;Set indirect file abort flag
.IF NE CONT$N
	TST	CTNUFG		;Is this continuation @file?
	BEQ	20$		;No
	CLR	CTNUFG		;Yes, clear flag
;+
;ERROR
;only if continuation file gen'ed
	.ADDR	#<KMHLT>,R0	;Point to fatal msg.
	.PRINT			;Print it
;-
10$:	MOV	@#$SYPTR,R4	;Wait for output ring buffer to empty
	ADD	#<TTOBUF+2-$RMON>,R4
	TSTB	@R4		;Empty ?
	BNE	10$		;Not empty, wait
	HALT			;Fatal KMON Halt (only w/Continuation @File)
	............

.ENDC ;NE CONT$N
20$:	.EXIT
	............

	.DSABL	LSB

.IF NE CONT$N
;+
;ERROR
KMHLT:	.ASCIZ	"?KMON-U-Fatal halt"
;-
	.EVEN
	............

.ENDC ;NE CONT$N

KCRLF:	MOV	PC,R0		;Get a null byte
	MOV	R0,R0		;NO-OP whose bottom byte is 0!!!!!
	.PRINT			;Printing nullstring is a CRLF
	RETURN
	............

LBDCOM:	BR	BADCOM		;Bridge to BADCOM
	............
.SBTTL	R/RUN

	.ENABL	LSB

RUN:	CLR	R3		;Clear flag to indicate DK: default
R:
.IF NE MMG$T
	CLR	VBGFLG		;Clear flag to indicate VBGEXE not required
	BR	10$		;Join common code
	...........

VRUN:	CLR	R3		;Clear flag to indicate DK: default
V:	MOV	#-2,(PC)+
VBGFLG:	 .BYTE	0		; <>0 and even denotes from V[RUN]
				; 0 denotes from R[UN] or .CHAIN
				; 1 denotes load VBGEXE pass
				; 3 denotes fallback pass (VBGEXE not there)
VRNFLG:	 .BYTE	0		; 0 denotes R[UN] or .CHAIN
				; -1 denotes V[RUN]
10$:
.ENDC ;NE MMG$T
	MOV	R3,(PC)+
RFLG:	.WORD	0		;<> denotes from R|V; = denotes from [V]RUN

	CALL	GETCOD		;Get the save image
RUN2:	CLR	R2		;Use the start address
	OVLINK	STRE		;Link to rest of RUN
	............

	.DSABL	LSB

NOTFND::
.IF NE U$CL
	MOV	.CLIFLG,R0		; Point to CLI flags
	BITB	#<UCF.ON>,@R0		; Is UCF enabled ?
	BEQ	90$			; No, error is fatal
	TSTB	CLITYP-CLIFLG(R0) 	; Are we running as UCF ?
	BNE	90$			; No, report fatal error

; We couldn't find UCF.SAV, just warn user, then try other CLIs
; ***********************************************************************
; * This warning message comes out several times if UCF.SAV is missing;	*
; * it really should appear just once. Remove the following lines to 	*
; * disable the message.						*
; ***********************************************************************
;+
;ERROR
	JSR	R0,80$			; Point to text, go to .PRINT
	.ASCIZ	"?KMON-W-File UCF.SAV not found"<CR><LF>
	.EVEN
	............
80$:	.PRINT
;-
	MOV	(SP)+,R0		; Restore R0 saved by JSR
; ***********************************************************************

	BIS	#<UCF.KM>,@R0 		; Set flag to bypass UCF
	BIC	#<CHAIN$!SPXIT$!CHNIF$>,@#$JSW ;Clear chain bits in $JSW
	CALLR	CFYDCL			; Give other CLIs a chance
	............

; Not UCF, display fatal error msg, go back to KMON prompt
90$:
.ENDC ;NE U$CL

; Display fatal error msg, go back to KMON prompt
;+
;ERROR
	KMRTMG	<File not found>,,PFILE
;-
	............

	.ENABL	LSB

;????? Can BEGIN or part of it be moved to an overlay??????

BEGIN:
.IF NE MMG$T
	CLR	SCCATB-$RMON(R5);Make sure there is no old value in SCCA table
	BIT	#<VIRT$>,@#$JSW	;Is job a Windowed (mapped) job
	BEQ	50$		;No
;I&D+
	MOV	<BGMPTR-$RMON>(R5),@#UISAR6 ;Map MCA
	MOV	#<W.NNUM>,-(SP)	;Save number of windows
;I&D-
;+
; Initialize RCB's (pointed to by R0) and WCB's (pointed to by R4)
;-
	MOV	@.$USRLC,R4	;Up to bottom of USR
	SUB	#<V.MAX>,R4	;Less start of Region

	ASH	#<-6.>,R4	;Convert to 32 wd blocks
	BIC	#<BD.32W*2000>,R4 ; by unsigned division by 64
	MOV	#<PAR6+M.RGN>,R0 ;R0 -> U-I RCBs
	MOV	#<V.MAX/PARCKB>,(R0)+ ;Region 0 starts at V.MAX (in chunks)
	MOV	R4,(R0)+

	MOV	(PC)+,@R0	;One Window mapped to Region
	 .BYTE	<0>, <1>	; (# windows mapped is in high byte)
	MOV	#<PAR6+M.WCUI>,R4 ;R4 -> U-I WCBs
	MOV	#<PAR1+M.RGN>,(R4)+ ;Assign Window 0 to Region 0
	CLR	(R4)+		;Window 0 Low Virtual is 0
	MOV	@#$USRTO,@R4	;Hi Virtual is User Hi Address
	MOV	(R4)+,R0	;Size is Hi-Lo/64
	ADD	#<BD.32W+2>,R0	;Round up to nearest 64 bytes

	ASH	#<-6.>,R0	;Convert to 32 wd blocks
	BIC	#<BD.32W*2000>,R0 ; by unsigned division by 64

	MOV	R0,(R4)+	;Move size into W.BSIZ
	CLR	(R4)+		;Offset is 0 into Region 0
	MOVB	#<200>,(R4)+	;First PDR is number 0
	CLRB	@R4		;Initialize # of PDRS
30$:	INCB	@R4		;Bump # of PDRS
	SUB	#<P04KCK>,R0	;Is there another PDR needed?
	BGT	30$		;BR if yes
	SWAB	R0		;Unused size to hi byte
	CLRB	R0		;Clear low bits
	ADD	#<PDRSTD>,R0	;Convert to PDR value
	INC	R4		;Advance ptr
	MOV	R0,(R4)+	;Store last PDR contents
	MOV	(SP)+,R0	;R0 = number of Windows
40$:	DEC	R0		;Decrement # of Windows
	BEQ	45$		;None left
	CLR	W.BSIZ(R4)	;Deactivate the Window
	ADD	#<W.BLGH>,R4	;R4 -> next Window, if one
	BR	40$		;Find out
	............

45$:
;I&D+
	MOV	#<PAR6CK>,@#UISAR6	;Restore mapping
;I&D-
50$:	CALL	$VRAW		;Go check for Virtual Overlays
.ENDC ;NE MMG$T
	MOV	@#$USRTO,R4	;Get highest address of user memory
	TST	@#$USRSP	;Is user stack defined ??
	BNE	60$		;Yes, if its non-zero
	MOV	#<STD.SP>,@#$USRSP ;No stack given, default to 1000
60$:	MOV	@..SYSL,R0	;Highest top if USR can SWAP
	BIT	#<USR$>,CONFIG-$RMON(R5) ;Can the USR SWAP?
	BEQ	70$		;Yes, lucky us
	MOV	@.$USRLC,R0	;No, highest top is the USR
	.BR	70$
	............
70$:
.IF NE MMG$T
	SUB	VBIAS,R0	;Adjust top of memory for job type
.ENDC ;NE MMG$T
	CMP	R0,R4		;Does it overlay top?
	BLOS	OVERC		;File is too big. give error
	.SETTOP	R4		;Set new top of memory
.IF NE CONT$N
	CLR	CTNUFG		;Clear continuation flag for errors
.ENDC ;NE CONT$N
	SUB	R3,R4		;Get Top - Start = Remainder to Read
	BCS	80$		;If negative, no read necessary
	ADD	#<KMBLK+4-$RMON>,R5 ;Point R5 to KMBLK+4 in RMON
	ROR	R4		;Make it a word count
	INC	R4		;Don't forget last word
	MOV	R4,-(R5)	;Put remainder word count into I/O block
	MOV	R1,R0		;Get starting block of file
.IF EQ MMG$T
	MOV	R3,-(R5)	;Put buffer address into I/O block
	MOV	R5,R1		;Setup pointer to RMON stack
	ADD	#<SPTR-KMBLK>,R1 ;Recall where R5 points
	MOV	R1,SP		;Use system temporary stack
	CALLR	RDOVLY-KMBLK(R5) ;Go read in the program
	............

80$:	CALLR	ENTRPG-$RMON(R5) ;Set stack and enter program
	............

.IFF ;EQ MMG$T
	ADD	VBIAS,R3	;Convert User Virtual to Kernel (physical)
	MOV	R3,-(R5)	;KERNEL Physical addr to read
	.ASTX			;Go to RMON in KERNEL mode
	............

80$:	MOV	#<-1>,R0	;Indicate no ovly to read
	.ASTX			;Go to RMON in KERNEL mode
	............

.ENDC ;EQ MMG$T
OVERC:	CLR	@#$USRTO	;File was too big. clear top of
;+
;ERROR
	KMEROR	<Insufficient memory> ;Memory for next KMON cmd.
;-
	............

	.DSABL	LSB
.SBTTL	GET	- (Also Used By RUN)

;+
; First part of GET is resident since it uses GETHAN which can force in the
; 'LOAD' overlay. Once any device handler has been LOADed by GETHAN, we can
; link to the rest of GET in an overlay.
;-
	.ENABL	LSB

.IF NE GET$$
GET:
.ENDC ;NE GET$$
GETCOD:	TST	GETCNT		;See if this is first get
	BNE	10$		;Nth get. Leave 50 alone
	CALL	CLRCCB		;Clear CCB and USRTOP
	BIC	#<RSTRT$>,@#$JSW ;Make it not restartable
	INC	GETCNT		;Mark a get done
10$:	MOV	@#$JSW,-(SP)	;Save $JSW for possible chain bit
	CALL	GETHAN		;Get the device handler
	BIS	(SP)+,@#$JSW	;Restore chain bit incase it was cleared when
				;KMON moved down after loading the handler
	SUB	R0,@SP		;Relocate return address
	MOV	R3,-(SP)	;Save pointer to file descriptor
	OVLINK	GET1		;Link to rest of GET
	............

	.DSABL	LSB

.SBTTL	SAVE  	- (Part 1)

;+
; First part of SAVE is resident since it uses GETHAN which can force in
; the 'LOAD' overlay. Once any dev handler has been LOADed by GETHAN,
; we can link to the rest of SAVE in an overlay.
;-

.IF NE SAVE$$

	.ENABL	LSB

SAVE:
 .IF NE MMG$T
	BIT	#<VIRT$>,@#$JSW	;Is it a Virtual Job image?
	BEQ	10$		;No
	CALLR	BADCOM		;Yes, save is invalid
	............

10$:
 .ENDC ;NE MMG$T
	CALL	GETHAN		;Get file name, handler
	SUB	R0,@SP		;Relocate rtn address
	MOV	R3,-(SP)	;Save pointer to file name
	OVLINK	SAV1
	............

	.DSABL	LSB

.ENDC ;NE SAVE$$
;+
; A linkage from FRUN/SRUN to the KMON root and back is
; necessary to call GETHAR since it can force the 'LOAD'
; overlay to be brought in
;-

.IF NE FRUN$$!SRUN$$		;If FRUN or SRUN commands
FSGHAR:	CALL	GETHAR		;Get handler
	SUB	R0,@SP		;Relocate ret addr
	MOV	R3,-(SP)	;Save fd pointer across overlay
	OVLINK	FSR2		;Link back to FRUN/SRUN overlay
	............

.ENDC ;NE FRUN$$!SRUN$$

.IF NE <MMG$T ! U$CL>
;+
; Load handler for user defined command file.  Then link back to the
; overlay from where we came.
;-
UCLROT:	MOV	@#$JSW,-(SP)	;Save JSW because GETHAR can clear it
	CALL	GETHAR		;Get handler
	BIS	(SP)+,@#$JSW	;Restore JSW
	SUB	R0,@SP		;Relocate pointer to command buffer
	MOV	(SP)+,R5	;Restore pointer to command buffer
				;R5 is preserved in OVLINK
	SUB	R0,@SP		;Relocate return address
	SUB	R0,R3		;Relocate filespec pointer
	MOV	R3,-(SP)	;Save filespec pointer across overlay
	OVLINK	GETUCL		;Try to find UCL and start it
	............

.ENDC ;NE <MMG$T ! U$CL>

ENDRES:				;End of resident commmands
.SBTTL	SYSK  	- Do I/O From/To System Scratch Area

;+
; SYSK  - Do I/O From/To the System Scratch Area
;
;	R0 =  Relative block number within SWAP.SYS
;	R5 -> 3-word IOB: Address, Word Count (<0 for Write), 0
;
;	CALL	SYSK
;-
	.ENABL	LSB

SYSK:	CLR	@.BLKEY		;No directory block in in USRBUF now
	MOV	@(PC)+,-(SP)	;Get start block of SWAP.SYS
.$SWPB:: .WORD	<$SWPBL-$RMON>	;$SWPBL
	ADD	@SP,R0		;Make requested block number absolute
	ADD	#<SWAPSZ>,@SP	;Add size of SWAP.SYS to get top of SWAP file
	MOV	2(R5),-(SP)	;Stack the word count
	BPL	10$		;Positive is read
	NEG	@SP		;Make write count positive
10$:	SWAB	@SP		;Compute number of blocks to do I/O to
	ADD	R0,@SP		; and make that into top block of I/O
	CMP	(SP)+,(SP)+	;Top block of I/O beyond end of SWAP.SYS?
	BHI	OVERC		;Yes, give an error
.IF EQ MMG$T
	CALL	@.$SYS		;Use system handler to do I/O
.IFF ;EQ MMG$T
	CALL	RWSYS		;Use system handler to do I/O
.ENDC ;EQ MMG$T
	BCC	40$		;Ok, return
	TST	2(R5)		;Read or write error?
	BPL	SYRDER		;Read error
;+
;ERROR
SYWTER:	KMEROR	<System output error>,,UNCON$
	............

SYRDER:	KMEROR	<System input error>,,UNCON$
;-
	............

.SBTTL	CLRLOW, CLRCCB

CLRLOW:	MOV	#<$SYCOM>,R1	;Point to parameter area in low memory
20$:	CLRB	(R1)+		;Clear out 40-53
	CMP	R1,#<$USRRB>	;Don't clear $USRRB
	BLO	20$		;Loop until done
.CCB	==: < . + 2 >
CLRCCB:	MOV	#<CCB-$RMON>,R1	;Point to CCB
	MOV	#<10>,-(SP)	;10 words to clear
30$:	CLR	(R1)+		;Clear
	DEC	@SP		; out
	BNE	30$		;  the CCB
	MOV	(SP)+,@#$USRTO	;Pop count, use it to clear $USRTO
40$:	RETURN
	............

	.DSABL	LSB
.SBTTL	FILE  	- Get File Descriptor From Command Line

;+
; FILE - Get File Descriptor from Command Line, With Default Filetype
;
; Null file name is rejected with an error message
; In System Tasking, stores file names in ASCII in BG impure area at I.LNAM
;
;	R3 =  default device name
;	R5 -> input string (backwards)
;
;	CALL	FILE [or IFILE, or SFILE, or RFILE]
;
;	R0 =  R3 -> 'BLOCK' for file-referencing EMT's
;	R2 =  First half of file name in RAD50
;	R3 -> 4-word file descriptor at location 'BLOCK' (I.NAME in FB/XM)
;	R5 -> Delimiting character
;-
	.ENABL	LSB

FILE:
.IF NE SYT$K
	CALL	50$		;Call rest of FILE:
	MOV	R0,-(SP)	;Save R0,R1 because of R50ASC
	MOV	R1,-(SP)	;
	BIT	#<CHAIN$>,@#$JSW ;Chain bit set?
	BEQ	10$		;Branch if no
	MOV	@.$IMPUR,R0	;Get pointer to impure area
	ADD	#<I.NAME>,R0	;Point to name
10$:	MOV	R0,R1		;R1 -> I.NAME in impure area
	ADD	#<I.LNAM-I.NAME>,R1 ;R1 -> Logical Job Name Field
	MOV	R2,R0		;R0 = first half of file name
	CALL	R50ASC		;Convert to ASCII
	MOV	4(R3),R0	;R0 = second half of job name
	CALL	R50ASC		;Convert to ASCII
	CMPB	-(R1),#<' >	;Remove blanks, end it with a 0
	BNE	30$		;Easy if name is 6 chars long
20$:	CLRB	@R1		;Clear next
	CMPB	-(R1),#<' >	;More spaces?
	BEQ	20$		; there has to be at least one
30$:	MOV	(SP)+,R1	;Restore
	MOV	(SP)+,R0	; registers
40$:	RETURN
	............

50$:
.ENDC ;NE SYT$K
	JSR	R1,60$		;Save R1, point to "SAV"
	 .RAD50	/SAV/
	............
60$:	.PURGE	#<CHOVLY>	;PURGE the overlay channel
;;;	MOV	(PC)+,R0	;Get code for PURGE overlay channel
;;;	 .BYTE	<CHOVLY>,<.PURGE>
;;;	EMT	...PUR		;Do the PURGE
	MOV	R3,DEV1		;Put in proper default device name
	MOV	#<CH.PGM>,R0	;Set R0 in case of CHAIN
70$:	BIT	@#$JSW,#<CHAIN$> ;Is CHAIN$ on?
	BNE	80$		;Yes, DEV:FILNAM.EXT is at 500
.IF EQ SB
	MOV	@.$IMPUR,R2	;Point into B/G Impure Area
	ADD	#<I.NAME>,R2	; at name block for job
.IFF ;EQ SB
	MOV	@#$SYPTR,R2	;Point into B/G Impure Area
	ADD	#<BKGND-$RMON+I.NAME>,R2 ; at name block for job
.ENDC ;EQ SB
	CALL	GETFD		;Get the file descriptor (R0 -> BLOCK)
80$:	MOV	(SP)+,R1	;Restore R1
	MOV	R0,R3		;Copy file descriptor pointer
	TST	@R3		;Was it a null file?
	BEQ	NOFILE		;Yes, thats bad
	MOV	2(R3),R2	;File name must be specified
	BNE	RTS7A		;It was
;+
;ERROR
NOFILE:	KMEROR	<No file>
;-
	............

;+
; Entry for Indirect Command File Processor
;-

IFILE:	JSR	R1,60$
..ATFX:: .RAD50	/COM/	;**PATCH** Default Extension for @ Files
	............

.IF EQ SB
;+
; Entry for Foreground File
;-

RFILE:	JSR	R1,60$
..FRUX:: .RAD50	/REL/	;**PATCH** Default Extension for FRUN Command
	............

.ENDC ;EQ SB
.IF NE SYT$K
;+
; Entry for System Job File
;-

SFILE:	JSR	R1,60$
..SRUX:: .RAD50	/REL/	;**PATCH** Default Extension for SRUN Command
	............

.ENDC ;NE SYT$K

	.DSABL	LSB
.SBTTL	CCBB0 	- Read In Block 0 Of Save File

;+
; CCBB0 - Read in Block 0 of a Save File
;
; Block is read into the USR Buffer and then selectively moved to low memory
; the USRTOP location is set to the MAXIMUM of the Top of the Current
; Contents of Memory and the Top of the Save File being loaded.
; Returns:
;	R0 =  undefined
;	R1 =  8.
;	R2 -> local copy of CCB
;	R3 -> CCB copy in RMON
;	R5 =  undefined
;-
	.ENABL	LSB

CCBB0R:	MOV	SYSIOB,R5	;Get pointer to buffer
	CLR	R0		;Read from relative block 0
	CLR	@.BLKEY		;Tell USR that DIR not in memory
	.READW	CHOVLY,R5,#<BK.WD> ;Read one block into buffer
	BCS	FIPERR		;If carry set, error while reading
	RETURN

;+
;ERROR
FIPERR:	KMRTMG	<Input error>,,PFILE ;Input error
;-
	............

CCBB0:	CALL	CCBB0R		;Read CCB into USR buffer
	CMP	#<^RHAN>,@R5	;Is this a runnable handler?
.IF NE	MMG$T
	BEQ	20$		;XM - branch if yes
.IFF ;NE MMG$T
	BEQ	30$		;Non-XM - branch if yes
.IFT ;NE MMG$T
	MOV	66(R5),(PC)+	;Need to Create Region?
$VLY:	 .WORD	0		;Saved pointer to ovly info
	BEQ	20$		;No
	MOV	64(R5),$VLY	;Save pointer to ovly info
20$:	MOV	@#$SYPTR,R3	;Point to B/G VHIGH word
	ADD	#<BGVHI-$RMON>,R3 ;Job impure area
	CLR	@R3		;Clear it (will it be clear already?)
	CMP	#<^rVIR>,@R5	;Is job using /V mapping (check loc 0)
	BNE	30$		;NE -> No, leave word clear
	MOV	2(R5),@R3	;Otherwise save loc 2 as Virtual High Limit
.IFF ;NE MMG$T
	CMP	#<^rVIR>,@R5	;/V mapping?
	BEQ	NEEDXM		;Yes, error
.ENDC ;NE MMG$T
30$:	MOV	#<$JSW>,R0	;R0 -> $JSW
	MOV	@R0,-(SP)	;Save old $JSW
.IF EQ MMG$T
	BIC	#^c<CHAIN$>,@SP	;Save only chain indication
.IFF ;EQ MMG$T
	BIC	#^c<CHAIN$!VBGEX$!VRUNV$>,@SP	;Save only chain and VBGEXE
						; indicators
	CLR	-(SP)		;Allocate a space for a bit map register
	BIT	#<VIRT$>,$JSW(R5) ;Is it a virtual job?
	BNE	140$		;Branch if yes
	CLR	R2		;Privileged job has bias of 0
.ENDC ;EQ MMG$T
.LOWMAP	==: < . + 2 >
	MOV	#<LOWMAP-$RMON>,R3 ;Point to resident low memory map
	CLR	R1		;R1 points to low memory
40$:	MOVB	(R3)+,@SP	;Get next map byte
	SEC			;Set stopper
	ROLB	@SP		;Get first bit
50$:	BCS	60$		;Bit on => skip it
	MOV	@R5,@R1		;Move in a good word
60$:	CMP	(R5)+,(R1)+	;Skip a word in each
	ASLB	@SP		;Get next bit
	BNE	50$		; if any
	CMP	#<V.MAX>,R1	;Is low ptr = 500 yet?
	BNE	40$		;Yes
70$:
.IF NE MMG$T
	TST	(SP)+		;Dump bit mask register
.ENDC ;NE MMG$T
;?????
;	TST	@SP		;Are we in the midst of a CHAIN?
;	BNE	80$		;Branch if yes
;	TST	RFLG		;This routine called by R or RUN?
;	BNE	90$		;R, copy 500-776
;?????
80$:	BIT	@R0,#<CHAIN$>	;Does new $JSW say protect 500-776?
	BEQ	110$		;No
90$:
.IF EQ MMG$T
100$:	MOV	(R5)+,(R1)+	;Now move in the other 96. words
	TSTB	R1		;Is low ptr = 1000 yet ?
	BNE	100$
.IFF ;EQ MMG$T
	MOV	#<1000-V.MAX>/2,R3
100$:	MOV	(R5)+,(R1)+	;Now move in the other 96. words
	SOB	R3,100$
.ENDC ;EQ MMG$T
110$:	BIC	#<CHAIN$!VBGEX$!VRUNV$>,@R0 ;Clear CHAIN indication if on
	BIS	(SP)+,(R0)+	;Set saved chain indication in $JSW
	TST	(R0)+		;R0 = 50 -> $USRTO
	SUB	R1,R5		;Correct R5 for amount moved (500 or 1000)
.IF NE MMG$T
	ADD	R2,R5		;Adjust for bias
	MOV	R2,(PC)+	;Save bias for future use
VBIAS:	 .WORD	0		;0 if privileged; V.MAX if virtual
.ENDC ;NE MMG$T
	ADD	R0,R5		;Add 50, so R5 -> new $USRTO
	CMP	@R5,@R0		;Is new $USRTO bigger than old?
	BLOS	120$		;No
	MOV	@R5,@R0		;Yes, fix it up
120$:	ADD	#<400-$USRTO>,R5 ;R5 -> top of CCB in file
	.ADDR	#<BLOCK+16.>,R2	;R2 -> top of our CCB copy
	MOV	(PC)+,R1	;Move two bytes of value 8. to R1
	 .BYTE	<8.>,<8.>
130$:	MOV	-(R5),-(R2)	;Move in the CCB
	DECB	R1		;Done?
	BNE	130$
	MOV	.CCB,R3		;Point to CCB in RMON
	SWAB	R1		;Get 8 into R1
RTS7A:	RETURN
	............

.IF EQ MMG$T
;+
;ERROR
NEEDXM:	KMRTMG	<Mapped monitor required for>,,PFILE
;-
	............

.IFF ;EQ MMG$T
140$:	MOV	R5,R3
	MOV	#<$SYCOM>,R1	;R1 -> Kernel $SYCOM area
	ADD	R1,R3		;R3 -> loc 40 in block 0
150$:	MOV	(R3)+,(R1)+	;Move 40($USRPC)-50($USRTO) to $SYCOM
	CMP	R1,#<$ERRBY>	;More to move (i.e., < $ERRBY)?
	BLO	150$		;Yes
	MOV	#<V.MAX>,R2	;Virtual job has bias of V.MAX
	MOV	#<1000>,R1	;R1 -> above physical chain area
160$:	MOV	-(R1),V.MAX(R1) ;Copy chain area from physical to virtual
	CMP	R1,R2		;Done yet?
	BHI	160$		;Branch if not
	MOV	#<V.MAX/2>,R3	;Get word count
170$:	MOV	(R5)+,(R1)+	;Copy a word from save image
	SOB	R3,170$		;Loop until done
	BR	70$		;Go merge with common code
	............

.ENDC ;EQ MMG$T

	.DSABL	LSB
.IF NE	MMG$T

.SBTTL	$VRAW 	- /V Create Region And Window Routine

;+
; $VRAW - Do the necessary initialization for a program using Virtual Overlays
;
;	Inputs:	$VLY = 0 if NO Virtual Overlays
;		     = address of first WDB
;	Output:	None	All registers are preserved across the call.
;-
	.ENABL	LSB

$VRAW::	MOV	R5,-(SP)	;Save R5
	MOV	R4,-(SP)	;Save R4
	MOV	R3,-(SP)
	MOV	R1,-(SP)	;And R1
	MOV	R2,-(SP)	;Save R2
	MOV	$VLY,R4		;Get address of WDB(s) for /V overlays
	BEQ	80$		;If zero no /V overlays
	SUB	#<V$END>,R4	;First address we need
	CLRB	R4		;Clr low byte
	SWAB	R4		;Get in low byte
	ROR	R4		;Shift to be a block #
	MOV	R4,-(SP)	;Save block #
	.ADDR	#<SYSIOB>,R5	;-> address of buffer
	MOV	@R5,R5		;Point to buffer
10$:	.READW	CHOVLY,R5,#<BK.WD*2>,R4
	BCS	100$		;Error
	MOV	$VLY,R4		;Get address again
	SUB	#<V$END>,R4	;First address we will need
	BIC	#^c<BK.WD*2-1>,R4 ;Get offset in buffer
	ADD	R5,R4		;R4->start of overlay table
20$:	ADD	#<BK.BYT*2>,R5	;R1 points to end of buffer
	ADD	#<V$END-V$REG>,R4 ;Fix R4 to point at RDB before overlay table
	TST	2(R4)		;/V overlays?
	BEQ	70$		;No
	.ADDR	#<BLOCK>,R2	;EMT area block
	.CRRG	R2,R4		;Create the Region
	BCS	90$		;Error
	MOV	-(R4),R1	;Get address of start of WDB's
	MOV	-(R4),R4	;Get address of end of WDB's
	MOV	@SP,R2		;Get block #
	SWAB	R2		;Get it as a byte count
	ASL	R2		;Ok
	SUB	R2,R4		;-> to end of WDB's
	SUB	R2,R1		;Sub block#
	ADD	#<W.NOFF>,R1	;Point to offset
	.ADDR	#<SYSIOB>,R2	;-> address of buffer
	ADD	@R2,R1		;Add it to WDB offsets
	ADD	@R2,R4		;Add it to end pointer
;I&D+
	MOV	@#$SYPTR,R2	;R2->RMON
	MOV	BKGND+I.MPTR-$RMON(R2),@#UISAR6 ;Map user PAR6 to job's MCA
	MOV	@#<PAR6+M.RGN+R.BLGH>,-(SP) ;Point to start of Created Region
	MOV	#<PAR6CK>,@#UISAR6 ;Map ourselves back
;I&D-
	MOV	2(SP),R2	;R2=block #
	CMP	R1,R5		;Do we need a new block the first time?
	BHI	60$		;Yes
30$:	ADD	@R1,@SP		;Point to offset into Region
	MOV	@SP,@#UISAR6	;Map to PAR 6
	CLR	@#PAR6		;Clear segment #
	MOV	#<PAR6CK>,@#UISAR6 ;Map ourselves back
40$:	SUB	@R1,@SP		;Fix the pointer to start of Region
	ADD	#<W.NLGH>,R1	;Point to next block
	CMP	R1,R4		;Done?
	BHIS	70$		;Yes
50$:	CMP	R1,R5		;Will it overflow?
	BLO	30$		;No
60$:	SUB	R5,R1		;R1=offset to W.NOFF after read
	.ADDR	#<SYSIOB>,R3	;-> buffer address in R5
	CMPB	(R2)+,(R2)+	;Update block #
	.READW	CHOVLY,@R3,#<BK.WD*2>,R2
	BCS	100$		;Error reading
	SUB	#<BK.BYT*2>,R4	;End pointer
	ADD	@R3,R1		;Point to next WDB
	BR	50$		;Merge
	............

70$:	CMP	(SP)+,(SP)+	;Get rid of Region start
80$:	MOV	(SP)+,R2	;Restore
	MOV	(SP)+,R1	;Restore
	MOV	(SP)+,R3	;Restore
	MOV	(SP)+,R4	;And R4
	MOV	(SP)+,R5	;And R5
	RETURN
	............

;+
;ERROR
90$:	KMEROR	<Insufficient memory for region>,,UNCON$
;-
	............

100$:	CALLR	FIPERR		;Error
	............

	.DSABL	LSB

;I&D+
 .IF NE <FRUN$$!SRUN$$>

TEM$P::	MOV	#<PAR6+M.WCUI>,R2	;Point to Window Control Blocks
	MOV	#<PAR1+M.RGN>,(R2)+	;Static window (0) mapped to
					; static region (0)	
	CLR	(R0)+		;Static region starts at virtual 0
	MOV	RHLIM+OVLY-TEM$P1,R1 ;Get Program High Physical Addr (32wd bound)
	ASHC	#<-6>,R1	;Divide by 64 to get region size
	MOV	R1,(R0)+	;Save region size in static region RCB
	MOV	(PC)+,@R0	;One window mapped to start with
	 .BYTE	<0>, <1>	; (# windows is in high byte)
	CLR	(R2)+		;Low virtual address of static window is 0
	MOV	PVSIZ+OVLY-TEM$P1,R1 ;Get high virtual address limit (32wd bound)
	MOV	R1,(R2)+	;Save it in static window WCB
	ASHC	#<-6>,R1	;Divide by 64 to get window size
	MOV	R1,(R2)+	;Set window size in W.BSIZ
	MOV	R1,R0		;Copy window size
	MOV	STOVL+OVLY-TEM$P1,R1 ;Get virtual program load point
	ASHC	#<-6>,R1	;Divide by 64 to get static region offset
	MOV	R1,(R2)+	;Set offset in WCB
	MOV	#<200>,(R2)+	;First PDR is number 0, start with 0 PDR's
	RETURN

 .ENDC ;NE <FRUN$$!SRUN$$>
;I&D-
.ENDC ;NE MMG$T
.SBTTL	GETHAN	- Get File Descriptor And LOAD Specified Device Handler

;+
; GETHAN - Get a File Descriptor and LOAD the Specified Device Handler
;
; It calls 'FILE' with default device DK: to get the file descriptor
;
;	R5 -> Command string (backwards)
;
;	CALL	GETHAN
;
;	R0 =  KMON/USR slide amount (to relocate addresses)
;	R1 =  undefined
;	R2 =  undefined
;	R3 -> File descriptor
;	R4 =  undefined
;	R5 -> Character in command that delimited the file descriptor
;-
	.ENABL	LSB

GETHAN:	MOV	(PC)+,R3	;Use DK: as default device
..DDEV:: .RAD50	/DK /	;**PATCH** Default Device for most CMDs
	TST	RFLG		;Was command R rather than RUN?
	BEQ	5$		;Branch if not -- DK: is correct default
	MOV	#<^RSY >,R3	;Use SY: as default device
5$:	CLR	RFLG		;Set back to RUN/GET/SAVE default of DK:
	CALL	FILE		;Get file descriptor
;+
;	Entry for REL files from FRUN overlay and for @File processor
;-

GETHAR:	MOV	@R0,INPFN	;Save device name incase of error
	.ADDR	#<DEVSTS>,-(SP)	;Point to DEV STATUS block
	EMT	...DST		;Is handler present (V2 .DSTAT EMT)?
	BCS	BADHAN		;Error - no such device
	TST	(R0)+		;Is it a directory device?
	BPL	BADHAN		;No, thats invalid
	CLR	-(SP)		;Init relocation factor
	TST	2(R0)		;Is handler resident?
	BNE	HANIN		;Yes
	MOV	ACCUM,@SP	;Save current value of KMON moves
	.ADDR	#<DEVSTS>,R2	;Point to DEVSTS for handler LOAD
	MOV	@R3,@R2		;So R2 pts to device name
	MOV	R3,-(SP)	;Save R3 across overlay link
	JSR	R5,10$		;Save R5, point to 0 for EOL for LOAD cmd
	 .WORD	0
	............

10$:	CALL	20$		;Call the overlay to do a LOAD
	MOV	(SP)+,R5	;Restore saved R5 ...
	MOV	(SP)+,R3	; ... and R3
	SUB	ACCUM,@SP	;Calculate change in ACCUM
	SUB	@SP,R5		;And ptr to command line
HANIN:	MOV	(SP)+,R0	;Put relocation factor in R0
	SUB	R0,@SP		;Relocate retn address
RTS7:	RETURN
	............

20$:	OVLINK	OL1		;Do a LOAD of the handler, then come back
	............

;+
;ERROR
BADHAN:	KMRTMG	<Invalid device>
	............

BADFET:	KMRTMG	<Bad fetch>
;-
	............

	.DSABL	LSB
.SBTTL	SETBIT	- Set Bit In Core Control Block And Update $USRTO

;+
; SETBIT - Set one bit in the Core Control Block and Update $USRTO
;
;	R0 -> CCB to change
;	R2 =  address corresponding to bit to set
;
; SETBTS - Set a sequence of bits in the Core Control Block and Update $USRTO
;
;	R0 -> CCB to change
;	R2 =  address corresponding to first bit to set
;	R4 =  address corresponding to last bit to set
;
;	CALL	SETB??
;
;	R0,R1,R2,R4 = undefined
;-

SETBIT:	MOV	R2,R4		;Only set one bit (last=first)
SETBTS:	CMP	@#$USRTO,R4	;Is it higher than old top ??
	BHI	NOTHIR		;No
	MOV	R4,@#$USRTO	;Yes, make it the new top
NOTHIR:	BIS	#<BD.BLK>,R4	;Round R4 to top of block
	DEC	R4		;On a word boundary
	SUB	R2,R4		;Get address difference
	CLRB	R4		;Now make this the bit count - 1
	SWAB	R4
	ASR	R4
	SWAB	R2		;Make this a block number
SETBT2:	ASR	R2
	MOV	R2,R1		;Save it
	BIC	#<177407>,R2	;This byte is index into CCB (*20)
	BIC	#<177770>,R1	;This is bit number within byte
	ASR	R2		;Make it a byte index into CCB
	ASR	R2
	ASR	R2
	ADD	R0,R2		;Add address of desired CCB
ONEBIT:	CLR	R0		;Clear mask register
	SEC			;Start with carry bit
SETMSK:	RORB	R0		;Rotate
	DEC	R1		;Count
	BPL	SETMSK		;Mask not ready yet
SETCCB:	BISB	R0,@R2		;Set bit in correct CCB
	DEC	R4		;Any more blocks (bits) to set in use ?
	BMI	RTS7		;No, return
	RORB	R0		;Shift bit again
	BCC	SETCCB		;Set next bit in this word
	INC	R2		;Go to next byte
	BR	ONEBIT		;Go initialize pattern
	............
.SBTTL	PUTBAK	- Return DCL/@File Buffer To Monitor & Slide KMON/USR Back Up

;+
; PUTBAK - Return DCL/@File Buffer to Monitor and Slide KMON/USR Back Up
;
;	CALL	PUTBAK	(Disables ^C)
;	CLR	@.EXTFL	(Re-enable ^C)
;
;	R0,R1,R4 = undefined
;
; Assumes area to return is just above USR
;-

PUTBAK:	MOV	SP,@(PC)+	;Inhibit ^C
.EXTFL:: .WORD	<EXTFLG-$RMON>	;CTRL/C inhibit
	.ADDR	#<KMON+KMSIZE+USRSIZ+2>,R4 ;Point to DCL/@File data blk
	CALL	PUTBLK		;Give space back and slide KMON/USR up
	ADD	R0,@SP		;Relocate return address in case it moved
	CLR	@.INBFPT	;Indicate no more DCL/@File data
	RETURN
	............

.SBTTL	CNTCK 	- Check Line Continuation ("-") And Eliminate Trailing Blanks

;+
; CNTCK - Check for line continuation (line ends with "-") and eliminate
; trailing blanks.
;
;	R1 =  count of space left in cmd line bfr.
;	R3 -> end of cmd line
;	R5 -> beginning of cmd line (stored backwards)
;
;	JSR	R2,CNTCK
;	 Return to Call+2 if line was continued
;	Normal Return to Call+4 if line wasn't continued
;
;	R1 =  corrected count if "-" or trailing blanks deleted
;	R3 -> end of line, without trailing "-" and trailing blanks
;-
	.ENABL	LSB

CNTCK:	TST	DATAFG		;Data expansion?
	BNE	20$		;Yes, don't check anything
	CMP	R5,R3		;No, null line?
	BEQ	20$		;Allow null line, it it meaningful to .GTLIN
10$:	INC	R1		;Not null, fix byte count left in line buffer
	CMPB	(R3)+,#<' >	;Is last character a space?
	BEQ	10$		;Yes, remove trailing blanks
	CMPB	-(R3),#<'->	;No, was it a continuation char?
	BEQ	30$		;Yes, change it to EOL and return to Call+2
	DEC	R1		;No, significant byte, fix the count
20$:	DEC	R3		;Adjust pointer for storing new end of line
	TST	(R2)+		;Return to Call+4 to show no continuation
30$:	CLRB	(R3)+		;Replace "-" or last trailing space with EOL
				; and point to last real character
	CLRB	-2(R3)		;Insurance end of line for some cmds.
	RTS	R2		;Return
	............

	.DSABL	LSB
.SBTTL	SVST	- Save Status Indirect Files For Nesting To Start Executing

;+
; SVST - Save Status Indirect Files for Nesting to Start Executing
;
;	CALL	SVST
;
;	R2 -> SAVESTATUS information in Indirect File status area
;-
	.ENABL	LSB

SVST:	MOV	@(PC)+,R2	;Get addr of SAVESTATUS area
.IFSVST:: .WORD	<IFSVST-$RMON>	;@File save status data
	TST	(PC)+		;Is file still open?
IFOPN:	 .WORD	0		;(Flag not = 0 if Indirect File is open)
	BEQ	10$		;No, just return
	.SAVEST	CHOVLY,R2	;SAVESTATUS the Indirect File
	BCS	CMDDVE		;SAVESTATUS error
	CLR	IFOPN		;Set Indirect File not open
10$:	RETURN
	............

	.DSABL	LSB
;+
; Invalid Device since didn't enter it
; @File on dev we can't SAVESTATUS
;-

;+
;ERROR
CMDDVE:	KMEROR	<Invalid device for command file>
;-
	............

.SBTTL	KDOT	- Print KMON'S Prompting Dot

;+
; KDOT
; Print KMON's prompting dot
;
;If we are doing DCL prompting or if BATCH is active, suppress the dot
;to clean up the terminal output and the log file.
;-
	.ENABL	LSB

KDOT:	MOV	@(SP),SLHOOK	;Move in SL hook dynamically
	TST	DOTFLG		;Are we to suppress dot (prompting?)
	BNE	40$		;Yes, just return
	MOV	R0,-(SP)	;Save R0
	CALL	KCRLF		;Return the carriage
10$:	.RCTRLO

.IF NE	BATC$H
	MOV	@#$SYPTR,R0	;R0 -> $RMON
	MOV	<$ENTRY+BA.NUM-$RMON>(R0),R0	;R0 -> BA.SYS entry
	BEQ	20$		;BATCH not in memory
	TST	BATSW$(R0)	;Is it active?
	BNE	30$		;Yes, suppress dot to pretty up log
.ENDC	;NE BATC$H

;+ 
; NOTE: the .PRINT must be followed by MOV R5,R5 to indicate to the SL.SYS
; that the .PRINT is printing a prompt.  To cause SL.SYS to not print the
; prompt change the MOV R5,R5 to MOV R4,R4.
;-
20$:	MOV	PC,R0		;Point to text to print
	CMP	(PC)+,(R0)+	;
	 .ASCII	"."<200>	;
	.PRINT			;Print the dot
SLHOOK:	MOV	R5,R5		;Hook for SL
30$:	MOV	(SP)+,R0	;Restore R0
40$:	RETURN
	............

	.DSABL	LSB
.SBTTL	GETBLK	- Obtain A Block Of Memory Above KMON/USR

;+
; GETBLK - Obtain a Block of Memory Above KMON/USR
;
; If free memory list has a block big enough, it is given to caller.
; if not, KMON/USR is moved down to create the block.
; Request is increased to MINMOV bytes if otherwise smaller
; KMON/USR can't be moved a smaller distance than MINMOV bytes,
; or the KMON/USR move routines (MOVEUP, and MOVEDN) will fail.
;
;	R0 =  Size of area desired (in bytes) (must be even)
;
;	MOV	SP,@.EXTFL		;Inhibit ^C
;	CALL	GETBLK
;	(PROCESS C BIT)
;	CLR	@.EXTFL			;Re-enable ^C
;
;	R0 =  Size of area actually obtained
;	   =  Max ( Original Request + 2 [for size word] , MINMOV )
;	R1 =  undefined
;	R3 =  undefined
;	R4 -> Start of block+2
;	(R4)-2 = Size of block (1st word of blk)
;
;	C=1 if KMON actually moved (by R0 bytes)
;
; GETBL1 - alternate entry to GETBLK which forces KMON/USR to move so that
; space for DCL/@File data can be just above the USR for swift reclamation.
;-
	.ENABL	LSB

GETBL1:	ADD	#<2+BD.1W>,R0	;Add 2 bytes for size word, 1 for rounding
	BIC	#<BD.1W>,R0	;Round down to a word multiple
	CALL	40$		;Check size of request, move KMON/USR
	SUB	R0,@SP		;Relocate the return
	BIS	#<IFDAT$>,@.STATWD ;Set @File data present above USR
	RETURN			;Return - KMON/USR has moved!
	............

GETBLK:	TST	(R0)+		;Add 2 bytes to request
	MOV	(PC)+,R4	;R4 -> free memory list head
.CORPT:: .WORD	<CORPTR-$RMON>	;Pointer to free memory list
	TST	(R4)+		;Point to next block pointer
10$:	MOV	R4,R3		;Copy pointer to previous block
	MOV	@R3,R4		;R4 -> next free block
	CMP	.CORPT,R4	;End of list?
	BEQ	40$		;Yes, back at list head
	CMP	(R4)+,R0	;This block big enough?
	BLO	10$		;No, try next block
	TST	(R0)+		;Could we get only
	CMP	-(R4),R0	; 2 extra bytes?
	BEQ	20$		;Yes, so we must allocate them.
				; there aren't enough bytes to create
				;  a (size,ptr) linked list entry
	TST	-(R0)		;Request can be satisfied exactly
20$:	SUB	R0,@R4		;Subtract request size from block size
	BNE	30$		;Exactly the same?
	MOV	2(R4),@R3	;Yes, remove from list
30$:	ADD	@R4,R4		;R4 -> start of block
	CLC
	BR	60$		;Go exit
	............
40$:	CMP	R0,#<MINMOV>	;Is the request larger than MINMOV?
	BHIS	50$		;Yes, ok
	MOV	#<MINMOV>,R0	;No, must move at least MINMOV
50$:	SUB	R0,@SP		;Relocate return address
	NEG	R0		;-Size => move KMON down
	ROR	R0		;Halve it, C=1 so it is <0
	CALL	KUMOVE		;Call to move KMON/USR
	NEG	R0		;Fix R0, set Carry
60$:	MOV	R0,(R4)+	;Store size in first word
	RETURN
	............

	.DSABL	LSB
;+
; CHANIF - Chain to @File
;
; User program puts byte count in 510 & KMON lines (ASCIZ w/no CR/LF's) at 512
; Current @File if any is aborted and new @File is executed
;
; CHANF1 is alternate entry for Continuation @File.
;-
	.ENABL	LSB

CHANIF:	MOV	#<CCL.CT>,R2	;Point to info from user
	MOV	@R2,R0		;Pick up the byte count
	CLRB	ATFLAG		;Mark that this is @File
	CALL	DCLSP1		;Go get space for data
	SUB	R0,@SP		;Relocate return address
CHANF1:	MOV	(R2)+,R0	;Get the byte count
10$:	MOVB	(R2)+,(R1)+	;Move the data
	DEC	R0		;Done all?
	BNE	10$		;No
	BITB	#<LN$IND>,@.INDSTA ;Did line come from IND?
	BEQ	20$		;Branch if no
.ASSUME UCF.KM EQ 200
	TSTB	@.CLIFLG	;Command from UCF?
	BMI	20$		;Branch if yes
	MOVB	#<EOFIND>,@R1	;Move in IND line terminator
20$:	BIC	#<IFSPC$>,@.STATWD ;Clean up special chain exit flag
	RETURN
	............

	.DSABL	LSB
;+
; KMON pointers to RMON needed by KMON Overlays
;-

.IFMXNST::.WORD	<IFMXNST-$RMON>	;@File Max. Nest Depth
.IF EQ MMG$T
 .IF NE MTT$Y!<TIME$R-1>	;If multi-terminal OR no timer support
.$MTPS:: .WORD	<$MTPS-$RMON>	;Ptr to $MTPS for SET TT CONSOL or TIME nn
 .ENDC ;NE MTT$Y!<TIME$R-1>
.ENDC ;EQ MMG$T
	............
.SBTTL	DCLSPC	- Get Space For DCL Expansion Or @File Line

;+
; DCLSPC - Get space above KMON/USR for storing Indirect File lines and/
;	   or DCL generated lines
;
;	R0 =  number of bytes needed
;	ATFLAG = 0 if @File expansion
;	CMDFLG used to count DCL calls
;
;	CALL	DCLSPC
;
;	R0 =  number of bytes KMON/USR moved or 0
;	R1 -> area at which to start storing data
;
; To relocate something, when KMON/USR moves, do  'SUB R0,X'
;-
	.ENABL	LSB

DCLSPC:	INCB	CMDFLG		;Keep track of first time DCL uses us
DCLSP1:	MOV	R4,-(SP)	;Save
	MOV	R3,-(SP)	; some
	MOV	R2,-(SP)	;  registers
	CLR	R0RTN		;Assume no KMON/USR sliding
	MOV	SP,@.EXTFL	;Disable ^C
	MOV	.INDSTA,R4	;Point to IND status byte
	BITB	#<LN$IND>,@R4	;Did line come from IND?
	BEQ	10$		;Branch if no
.ASSUME UCF.KM EQ 200
	TSTB	@.CLIFLG	;Command from UCF?
	BMI	10$		;Branch if yes
	INC	R0		;Add one to count for IND line terminator
10$:	BIT	#<IFDAT$>,@.STATWD ;Is there already DCL/@File data above USR?
	BNE	30$		;Yes
	MOV	R0,-(SP)	;No, save this request size
	INC	R0		;Add one byte for EOD flag
	CALL	GETBL1		;Get space by forcing move of KMON/USR
	MOV	R0,(PC)+	;Save move count this call to pass on return
R0RTN:	 .WORD	0		;(Temp storage for R0 during DCLSPC)
	MOV	-(R4),R1	;Get size of block
	ADD	R4,R1		;Add in address of block to get address of end
	MOVB	#<EOFDCL>,-(R1)	;Store end of data flag at end of block
	MOV	R1,(PC)+	;Save end pointer for @File expansion
ENBFPT:	 .WORD	0		;Pointer to end of DCL/@File storage
	MOV	R1,(PC)+	;Save for DCL insertion, too
OLINBF:	 .WORD	0		;-> end of last DCL insert in DCL/@File buffer
	SUB	(SP)+,R1	;Calculate where to start storing data
	MOV	R1,@.INBFPT	;Set up input buffer pointer
20$:	CLR	EXPSPC		;Re-initialize flag (Special Chain exit exp)
	CLR	@.EXTFL		;Re-enable ^C
	MOV	R0RTN,R0	;Setup R0 with size of KMON/USR slide
	MOV	(SP)+,R2	;Restore
	MOV	(SP)+,R3	; some
	MOV	(SP)+,R4	;  registers
	SUB	R0,@SP		;Relocate return address
	RETURN
	............
;+
; DCL/@File data area already exists above USR
;-
30$:	MOV	@.INBFPT,R1	;Get pointer to DCL/@File data
	.ADDR	#<KMON+KMSIZE+USRSIZ+2>,R4 ;Addr of begin of DCL/@File
					   ; space (its just above USR)
	SUB	R4,R1		;Calculate existing free space at front
	SUB	R0,R1		;Compare space in buffer with amount needed
	BLO	50$		;Not enough, go get some more
	MOV	@.INBFPT,R4	;Have enough. Get old start address
	MOV	R4,R1		;Copy addr of data to move = end of new area
	SUB	R0,R1		;Subtract size to get new start address
	MOV	R1,@.INBFPT	;Set up new lower start-of-buffer pointer
	MOV	ENBFPT,R2	;Get top of entire DCL/@File area
	TST	(PC)+		;Expansion for special chain exit?
EXPSPC:	 .WORD	0		;<> expansion from special chain exit
	BNE	40$		;Branch if yes
	TSTB	ATFLAG		;Is this @File expand (insert at end of area)?
	BEQ	60$		;Yes, go move all data in the area
	MOV	OLINBF,R2	;No, DCL expand. Get top of last DCL insertion
	TSTB	CMDFLG		;First time called by DCL?
	BNE	60$		;No, make room at end of last DCL insertion
40$:	MOV	R4,OLINBF	;Yes, remember where DCL insertions end
	BR	20$		;Go clean up
	............

;+
; Need to move KMON/USR to get sufficient space & already some data above USR
;-
50$:	MOV	R0,-(SP)	;Save amount of space asking for
	MOV	R1,R0		;Get amount of additional space required
	NEG	R0		;Make it positive
	MOV	-(R4),-(SP)	;Save length of of current DCL/@File
				; block to append to this new one
	MOV	SP,(PC)+	;Set flag, in case KMON moves too low
COROVR:	 .WORD	0		;  this will let KABORT free up data
				;  since IFDAT$ won't be set in STATWD
	BIC	#<IFDAT$>,@.STATWD ;Set no data above USR, so it won't move
	CALL	GETBL1		;Get space by moving KMON/USR
	CLR	COROVR		;Clear flag, didn't move too low
	ADD	(SP)+,-(R4)	;Merge old DCL/@File block with new one
	MOV	R0,R0RTN	;Save value of R0 for return
	MOV	(SP)+,R0	;Restore amount of space requested
	BR	30$		;Now we have room, go do the insert
	............

;+
; Make room in DCL/@File area by moving data down
;-
60$:	TST	R2
	BEQ	20$
	CMPB	@R4,#<EOFDCL>	;At EOD?
	BEQ	20$		;Yes, end of line, done
	CMPB	@R4,#<EOFIND>	;Check other EOD flag
	BEQ	20$		;Yes, end of line
70$:	MOVB	(R4)+,(R1)+	;No, move data
	CMP	R4,R2		;Are we at top of area to move?
	BLO	70$		;No, loop
	CMPB	-(R4),#<EOFDCL>	;Yes, did we move EOD flag?
	BNE	20$		;No
	DEC	R1		;Yes, adjust pointer to zap it
	BR	20$		;Done, finish up
	............

	.DSABL	LSB
.SBTTL	PUTBLK	- Return A Block Of Memory To The Free List

;+
; PUTBLK - Return a block of memory to the free memory list
;
; Merges contiguous blocks of memory into a single block.
; Reclaims memory from blocks contiguous to KMON/USR by sliding up KMON/USR
; if DCL/@File data exists above USR and the block being freed is contiguous
; to that data, KMON/USR/@File data are all slid up to reclaim space.
; KMON/USR only moved if BLKSIZE>= MINMOV
;
;	R4 -> Start of block+2
;	(R4)-2 = Size of block (in 1st word of blk)
;
;	MOV	SP,@.EXTFL		;Inhibit ^C
;	CALL	PUTBLK
;	(Process C bit)
;	CLR	@.EXTFL			;Re-enable ^C
;
;	R0 =  Amount by which KMON/USR moved (may be 0)
;	R1 =  undefined
;	R4 =  undefined
;
;	C=1 if KMON moved
;-
	.ENABL	LSB

PUTBLK:	TST	-(R4)		;Point to block size in prefix word
PUTBL1:	MOV	.CORPT,R1	;R1 -> free memory list head
10$:	MOV	R1,R0		;Save pointer to previous block
	MOV	2(R0),R1	;R1 -> next free block
	CMP	.CORPT,R1	;Last block in list?
	BEQ	20$		;Yes, insert new block here
	CMP	R1,R4		;No, next block higher in memory?
	BLOS	10$		;No, keep looking
;+
; Upper boundary check for contiguous blocks
;-
	MOV	R4,-(SP)	;Compute address of end of
	ADD	@R4,@SP		; new block of memory
	CMP	(SP)+,R1	;Touches next block?
	BNE	20$		;No, can't merge
	ADD	(R1)+,@R4	;Yes, merge the two sizes into one
	MOV	@R1,R1		;Get next block pointer from merged block
20$:	MOV	R1,2(R4)	;Link new block to next block
;+
; Lower bound check for contiguous blocks
;-
30$:	MOV	R0,-(SP)	;Compute address of end of
	ADD	@R0,@SP		; lower block of memory
	CMP	(SP)+,R4	;Lower block touches this block?
	BNE	40$		;No, just link previous block to this one
	ADD	(R4)+,@R0	;Yes, add size of current block into previous
	MOV	@R4,R4		;Get next block pointer from this one
40$:	MOV	R4,2(R0)	;Link previous block to this one
	.BR	50$
	............
;+
; Memory reclaim check
;-
50$:	MOV	.CORPT,R0	;R0 -> free memory list head
	TST	(R0)+		; at next block pointer
	MOV	@R0,R1		;R1 -> lowest free block
	CMP	@R1,#<MINMOV>	;Is first block's size < MINMOV?
	BLO	60$		;Yes, can't move yet, just exit
	.ADDR	#<KMON+KMSIZE+USRSIZ>,R4 ;Calculate address of top of USR
	CMP	R4,R1		;Is lowest free block contiguous to USR?
	BEQ	70$		;Yes, go move KMON/USR up
	BIT	#<IFDAT$>,@.STATWD ;No, but is there DCL/@File data above USR?
	BEQ	60$		;Nope, simply return
	ADD	@R4,R4		;Add size of DCL/@File area to point to top
	CMP	R4,R1		;Is DCL area contig w/blk being freed?
	BEQ	80$		;Yes, go move KMON/USR/@File data
60$:	CLR	R0		;Indicate no motion and
	;CLC			; Clear Carry, too
	RETURN			;Done, R0=0=amount moved
	............

70$:	BIC	#<IFDAT$>,@.STATWD ;DCL/@File data can't be there now
80$:	MOV	2(R1),@R0	;Remove lowest block from list
	MOV	@R1,R0		;Get its size in R0
	ROR	R0		;Halve it, leave > 0
	CALL	KUMOVE		;Then squish it
	ADD	R0,@SP		;Relocate return address
	SEC			;C=1 to indicate that we moved
	RETURN			;And exit
	............

	.DSABL	LSB
.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
.SBTTL	LINKAT	- Link Overlay Indirect File Support

;+
; LINKAT
;
; Used to process indirect command file which contains overlay commands
; (CSI lines) for the DCL LINK Command.  When this routine is called there
; is a command line in the KMON's commmand buffer (KMCBUF) which cannot be
; destroyed.  This line is slid down to the end of KMCBUF (& KMCBUF's size
; appropriately shortened) so that KMCBUF can be used to expand the command
; file.  If Size of a Line in the Command File + Size of Saved Line exceeds
; Size of KMCBUF, it is just like user typed a line which was too long to
; fit in KMCBUF.  Once the Overlay Command File lines have been expanded
; and stored, the saved command line is moved to the beginning of the
; command buffer and control returns to DCL to finish processing the LINK.
;
; Call:		R0 - > @File spec. from LINK Command.
;		CALL	LINKAT
;
; Return:	R0 = # of bytes KMON has moved
;		     Do "SUB R0,X" to relocate X
;		R5 -> start of KMCBUF
;
; All Regs. USED and NOT SAVED.
;
; The bit IFLIF$ in STATWD indicates that we're processing this type of @File,
; and causes some changes in the normal Indirect File processing; notably,
; these Indirect File lines are not echoed, and they are stored in the
; DCL/@File buffer above the USR as if DCL generated them, rather than as if
; they were @File lines.  This is done in the SCNDUN routine where DCLSP1 is
; called but ATFLG is not set if IFLIF$ is set in STATWD.
;-

LINKAT:	MOV	R0,-(SP)	;Save R0 across OVLINK
	OVLINK	LAT1		;Link to rest of routine in overlay
	............

;+
; This call should be resident, since it could cause another
; overlay to be loaded.
;-

LNKAT1:	CALL	ATSCAN		;Call routine to expand @File
	MOV	R0,-(SP)	;Save R0 across overlay
	OVLINK	LAT2		;Link to end of routine in overlay
	............

.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST
.IF NE MMG$T

;+
; RWSYS - XM Routine to do KMON I/O on the System Device
;
; This routine is necessary, since if KMON did a   "CALL @.$SYS"
; as in SB/FB, it would be doing system device I/O from user mode rather than
; KERNEL mode.  Doing that causes the Monitor stack usage to be incorrect.
;
;	R0 =  absolute blk # on system dev to read/write
;	R5 -> IOB containing:	buffer addr
;				word count (neg. if write)
;
;	CALL	RWSYS
;
;	R0 =  undefined
;	C=1 if I/O error
;
; CAUTION: RWSYS uses hack of incrementing # of Channels in
;	Background impure area by 1.  This effectively makes the
;	System Channel into Channel #20, since it is located
;	right after the Background's Channel 17
;-
	.ENABL	LSB

RWSYS:	JSR	R0,@PC		;Save R0 and point it ...
	ADD	#<XREAD-.>,R0	; ... to the parameter block for .READ/.WRITE
	MOV	(PC)+,(R0)+	;Set up a .READW on Channel 20 ($SYSCH)
	 .BYTE	<CHSYS>,<.READW>
	MOV	(SP)+,(R0)+	;Move in block number ...
	MOV	(R5)+,(R0)+	; ... and buffer address
	MOV	@R5,@R0		;Move in word count
	BPL	10$		;It's a read, go on
				.ASSUME .WRITW EQ <.READW+1>
	INCB	-5(R0)		;A write, change EMT to .WRITW ...
	NEG	@R0		; ... and make the word count positive
10$:	CMP	-(R5),-(R0)	;Backup the pointers
	CMP	-(R0),-(R0)
..I.CNUM==: < . + 2 >
	MOV	#<BKGND+I.CNUM-$RMON>,-(SP) ;Point to number of BG Channels
	MOV	#<CHNUM+1>,@(SP) ;Set to have an extra Channel ($SYSCH)
				.ASSUME ...REA EQ ...WRI
	EMT	...REA		;Do the .READW or .WRITW
	MOV	#<CHNUM>,@(SP)+	;Revert to original number of Channels
	RETURN			;Return, C bit is set for errors
	............

XREAD:	.BLKW	4		;Parameter block for .READW/.WRITW
	.WORD	0		;Wait mode I/O
	............

	.DSABL	LSB

.ENDC ;NE MMG$T
.SBTTL	CHARCx	- Add Characters To KMON Line Buffer, Checking Them

;+
; CHARCK, CHARC1 - Add characters to KMON line buffer, checking them
;
; This routine adds chars to the KMON line buffer.  It compresses
; multiple spaces/tabs to a single space and ignores comments.
; Dollar sign(s) at beginning of a line are ignored (for DCL).
;
; Enter at CHARC1 if characters are from Indirect File and at
; CHARCK if chars. from terminal.  CHARC1 checks for "^C" in Indirect File
; Form feeds are ignored, since they are added to Indirect Files
; by editors, and we don't want them to be treated as null lines.
;
; 	R0 =  input character
;	R1 =  count of room left in KMON buffer
;	R3 -> current position in KMON line buffer
;	R5 -> beginning of KMON buffer
;
;	JSR  R2,CHARC[K,1]
;	 Return to Call+2 if normal character
;	Return here if end of line (LF)
;
;	R0 =  character inserted (same unless TAB => SPACE)
;	R1,R3 updated
;
; If buffer overflow, issue Command Line Too Long message
;
; NOTE: DATAFG<>0 => only EOL, comment deletion, and ^C checks are done.
;	 NO SPACE/TAB compression takes place.
;-
	.ENABL	LSB

CHARC1:	BIC	#<FIXCHR>,R0	;Clear parity bits from Indirect File chars
	CMPB	R0,#<CTRLC>	;Is it CTRL/C (ASCII 3)?
	BEQ	20$		;Yes
	MOVB	@R3,-(SP)	;No, pick up previous character
	MOVB	R0,1(SP)	;Move in current character for "^C" check
	CMPB	#<'c>,R0	;Lowercase C?
	BNE	10$		;Branch if not
	BIC	(PC)+,@SP	;Make it uppercase for possible "^C"
	 .ASCII	<NUL><LOW2UP>
10$:	CMP	#<"^C>,(SP)+	;Is it "uparrow-uppercase C"?
	BNE	CHARCK		;No
20$:	MOV	R5,R3		;Yes, reset line pointer to beginning
	MOV	(PC)+,-(R3)	;Store "CTRL/C ^C exclamation point"
	 .ASCII	"^"<CTRLC>
	MOV	#<"!C>,-(R3)	;So rest of line ignored
	RTS	R2		;Return to CALL+2 - as if normal character
	............

CHARCK:	MOVB	@R3,(PC)+	;Preserve this char in case comment line
CMNTF:	 .WORD	0		;(Low byte='!' to flag line which is all
				;  comment in an @File)
	CMPB	@R3,#<'!>	;Are we pointing at exclamation point?
	BEQ	60$		;Yes, it's a comment - ignore rest of line
	TST	DATAFG		;No, is this data expansion?
	BNE	50$		;Yes, skip special character checks
	CMP	R5,R3		;No, at beginning of line?
	BNE	30$		;Nope
	CMPB	#<'$>,R0	;Dollar sign at beginning of line?
	BNE	30$		;Branch if not equal
	BIS	#<IFDOL$>,@.STATWD ;Set bit to show dollar sign in command
	RTS	R2		;Now ignore the dollar sign
	............
30$:	CMPB	#<TAB>,R0	;Is it a tab?
	BNE	40$		;No
	MOVB	@R5,R0		;Change tab to a space
40$:	CMPB	@R5,R0		;If it is a space
	BNE	50$
	CMPB	@R3,R0		; and we are already pointing to a space
	BEQ	80$		;Then ignore it
50$:	CMPB	#<CR>,R0	;Carriage return?
	BEQ	80$		;Ignore <CR>
	CMPB	#<FF>,R0	;Is it Form Feed?
	BEQ	80$		;Ignore <FF>
	DEC	R1		;Count down room left. Room for it?
	BMI	60$		;No, keep skipping
	MOVB	R0,-(R3)	;Put byte in buffer
60$:	CMPB	#<LF>,R0	;Is it end of line ?
	BNE	80$		;No, give normal character return
70$:	CLRB	(R3)+		;Yes, change <LF> to <NULL>
	TST	R1		;Did buffer overflow?
	BMI	LTL		;Yes, give an error
	TST	(R2)+		;Rtn to call+4 - end of line
80$:	RTS	R2		;Rtn to call+2 - normal character
	............

	.DSABL	LSB
.SBTTL	DCL	- DCL Command And Option Macros

;+
; Global counters used in conjunction with the DCL macros
;-

$QUAL	= 0
$OPTX	= 0


.MACRO	DISPAT	ROUTINE
	.WORD	< ROUTINE - . >
$'ROUTINE = < . - DSPBAS > / 2
.ENDM	DISPAT


.MACRO	SYNTAX	CMD
	.DSABL	CRF
$CONDS	= 1
$QUAL	= < $QUAL + 1 >
$SYN	= .
.ENDM	SYNTAX


.MACRO	FLDBEG	DST
	.BYTE	$FLDBEG
$FLDFLG = 0
  .IF B DST
$FLDFLG = 1
$FLDEND = .
	.BYTE
  .IFF
	.BYTE	< DST - . >
  .ENDC
.ENDM	FLDBEG


.MACRO	SCALL	SUBR,PTRLIST
	.BYTE	$SCALL
	.ENABL	CRF
$TEMP	= < SUBR - SUBREL >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
$TEMP2	= .
	.BYTE
  .IRP Q,<\$QUAL>
    .IRP X,<PTRLIST>
	.BYTE	< $'X'$'Q - . - 1 >
    .ENDR
  .ENDR
$TEMP1	= .
. = $TEMP2
	.BYTE	< $TEMP1 - $TEMP2 - 1 >
. = $TEMP1
.ENDM	SCALL


.MACRO	GOTO	DST
	.BYTE	$GOTO
	.BYTE	< DST - . - 1 >
.ENDM	GOTO


.MACRO	EOLGOT	DST
	.BYTE	$EOLGOT
	.BYTE	< DST - . - 1 >
.ENDM	EOLGOT


.MACRO	ITEREND
	.BYTE	$ITEREND
  .IF NE $FLDFLG
$TEMP1	= .
. = $FLDEND
	.BYTE	< $TEMP1 - $FLDEND >
. = $TEMP1
  .ENDC
.ENDM	ITEREND


.MACRO	OPTEND
	.BYTE	$OPTEND
  .IF NE $FLDFLG
$TEMP1	= .
. = $FLDEND
	.BYTE	< $TEMP1 - $FLDEND >
. = $TEMP1
  .ENDC
.ENDM	OPTEND


;+
; Offsets from PROGDF (default editor) for 'SET'able program defaults
;	(symbols used in EOLSEQ and CEOLSEQ macros)
;-
$$$EDIT	=: 0
$$$FORT	=: 1

.MACRO	EOLSEQ	DEFPRG,FLAG
	.BYTE	$EOLSEQ
  .IF NB FLAG
	.BYTE	$$$'FLAG
  .IFF
	.BYTE	< 200 ! $$'DEFPRG >
  .ENDC
.ENDM	EOLSEQ


.MACRO	APLYDEF	PROG,COND,SWIT
	.BYTE	$APLYDEF
	.BYTE	$$'PROG
  .IF B COND
	.BYTE	0
  .IFF
    .IRP N,<\$QUAL>
	.BYTE	$'COND''N
    .ENDR
  .ENDC
	.BYTE	''SWIT
.ENDM	APLYDEF


.MACRO	WILDEF	PROG,SWIT,CND1,CND2,CND3,CND4,FLAG
	.BYTE	$APLYDEF
	.BYTE	$$'PROG
  .IRP N,<\$QUAL>
	.BYTE	< $'CND1''N ! $'CND2''N ! $'CND3''N ! $'CND4''N ! FLAG >
  .ENDR
	.BYTE	''SWIT
.ENDM	WILDEF


.MACRO	SETDEF	COND
	.BYTE	$SETDEF
  .IRP N,<\$QUAL>
	.BYTE	$'COND''N
  .ENDR
.ENDM	SETDEF


.MACRO	CNDROUT	ROUT,COND
	.BYTE	$CNDROUT
  .IRP N,<\$QUAL>
	.BYTE	$'COND''N
  .ENDR
	ROUTAC	ROUT
.ENDM	CNDROUT


.MACRO	ROUTINE	ROUT
	.BYTE	$ROUTINE
	ROUTAC	ROUT
.ENDM	ROUTINE


.MACRO	ROUTAC TRANS
  .ASSUME N LE 3, MESSAGE=< N Too many chars>
	.ENABL	CRF
  .IF DF ACT'TRANS
$TEMP	= < ACT'TRANS - RACREL >
  .IFF
$TEMP	= < OVA'TRANS - OVLYST + OVLY - RACREL >
  .ENDC	;DF ACT'TRANS
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	ROUTAC


.MACRO	PROMPT	TEXT
	.BYTE	$PROMPT
	.ENABL	CRF
$TEMP	= < TEXT - TXTREL >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	PROMPT


.MACRO	DEFILE	FLAG
	.BYTE	$DEFILE
	.ENABL	CRF
	.BYTE	FLAG
	.DSABL	CRF
.ENDM	DEFILE


.MACRO	SETSWIT	SWIT
	.BYTE	$SETSWIT
	.BYTE	''SWIT
.ENDM	SETSWIT


.MACRO	DEFDV	STR
	.BYTE	$DEFDV
	.ENABL	CRF
$TEMP	= < STR - EXTREL >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	DEFDV


.MACRO	DEFINX	STR
	.BYTE	$DEFINX
	.ENABL	CRF
$TEMP	= < STR - EXTREL >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	DEFINX


.MACRO	SETISPC	STR
	.BYTE	$SETISPC
	.ENABL	CRF
$TEMP	= < STR - DOUSTR >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	SETISPC


.MACRO	DEFOSPC	STR
	.BYTE	$DEFOSPC
	.ENABL	CRF
$TEMP	= < STR - DOUSTR >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	DEFOSPC


.MACRO	CEOLSEQ	DEFPRG,FLAG
	.BYTE	$CEOLSEQ
  .IF NB FLAG
	.BYTE	$$$'FLAG
  .IFF
	.BYTE	< 200 ! $$'DEFPRG >
  .ENDC
.ENDM	CEOLSEQ


.MACRO	FILTYPR	LIST
	.BYTE	$FILTYPR
	.ENABL	CRF
$TEMP	= < LIST - 2 - LSTREL >
	.DSABL	CRF
$TEMP1	= < $TEMP / 400 >
	.BYTE	$TEMP1
	.BYTE	< $TEMP & 377 >
.ENDM	FILTYPR


.MACRO	MAKOFL	TYPE
	.BYTE	$MAKOFL
	.BYTE	< -2 - TYPE > * OFBSIZ
.ENDM	MAKOFL


.MACRO	DEFINE	SIMPLE
	.MACRO	SIMPLE
		.BYTE	$'SIMPLE
	.ENDM	SIMPLE
.ENDM	DEFINE


	DEFINE	OPTBLNK
	DEFINE	SWITLST
	DEFINE	REQBLNK
	DEFINE	REQPLUS
	DEFINE	REQCOMMA
	DEFINE	SRET
	DEFINE	INSPEC
	DEFINE	OUTSPEC
	DEFINE	SPISPEC
	DEFINE	SPOSPEC
	DEFINE	END
	DEFINE	TSTCFLG
	DEFINE	COMPDEF
	DEFINE	FILQUAL
	DEFINE	SAVNAM
	DEFINE	CMDQUAL
.MACRO	SWITS	DUMMY
$TEMP	= 0
$SWTAD	= .
$NONO	= 0
$$$1	= 0
$$$2	= 0
$$$3	= 0
$$$4	= 0
.ENDM	SWITS


.MACRO	ENDNO
$NONUM	= $TEMP
.ENDM	ENDNO


;+
; 3 is Size of Switch Table Entry
;-

.MACRO	NOS
$NOFFST	= < $TEMP * 3 >
$NONO	= 1
.ENDM	NOS


.MACRO	ENDS
  .IRP Q,<\$QUAL>
    .IRPC N,<1234>
      .IIF EQ $$$'N,	.MEXIT
$'N'$'Q:.BLKB	$$$'N
	.BYTE	0
    .ENDR
  .ENDR
	.EVEN
	.ENABL	CRF
.ENDM	ENDS


.MACRO	SWIT	SWITCH,LNUM,IMPLY,FORCE,TRANS,DEFLT,QVAL,X
$TEMP	= < $TEMP + 1 >
$TEMP1	= 0
  .IF DIF IMPLY,-
$TEMP1	= < $TEMP1 ! $$'IMPLY >
  .ENDC
  .IF DIF FORCE,-
$TEMP1	= < $TEMP1 ! 200 ! $$'FORCE >
  .ENDC
  .IF NB QVAL
$TEMP1	= < $TEMP1 + SVALU >
    .IF IDN QVAL,DVAL
$TEMP1	= < $TEMP1 + DECVAL >
    .ENDC
  .ENDC
	.BYTE	$TEMP1
  .IF EQ $NONO
	LETTR
	.BYTE	'OLET'$'SWITCH
	X'.ENDM
  .IFF
	.BYTE	0
  .ENDC
  .IF EQ $NONO
$TEMP1	= .
    .IRP Q,<\$QUAL>
. = < $'LNUM'$'Q + $$$'LNUM >
    .ENDR
	.BYTE	$TEMP
$$$'LNUM = < $$$'LNUM + 1 >
. = $TEMP1
  .ENDC
  .IF DIF TRANS,-
	.NCHR	N,<TRANS>
    .IF EQ < N - 1 >
	.BYTE	''TRANS
    .IFF
	ACTION	TRANS
    .ENDC
  .IFF
	.NCHR	$TEMP1,<DEFLT>
    .IF NE $TEMP1
      .ASSUME $TEMP1 LE 3, MESSAGE=< $TEMP1 Too many chars>
      .IRP N,<\$QUAL>
	.IF NDF $'DEFLT''N
$'DEFLT''N = $CONDS
	  .ASSUME $CONDS LT 100, MESSAGE=< $CONDS Too many conditions>
$CONDS	= < $CONDS + $CONDS >
	.ENDC
	.BYTE	< 200 + $'DEFLT''N >
      .ENDR
    .IFF
	.BYTE	0
    .ENDC
  .ENDC
.ENDM	SWIT


.MACRO	ACTION	TRANS
  .ASSUME N LE 3, MESSAGE=< N Too many chars>
  .IF NDF $A$'TRANS
    .IIF NDF $A$, $A$=0
$A$	= < $A$ + 1 >
    .ASSUME $A$ LE ACTCNT, MESSAGE=< ACTCNT Action dispatch table too small>
$A$'TRANS = $A$
  .ENDC
$TEMP1	= .
	.PSECT	RT11
. = < ACTONS + < 2 * < $A$'TRANS - 1 > > >
	.ENABL	CRF
  .IF DF ACT'TRANS
	.WORD	< ACT'TRANS - ACTREL >
  .IFF
	.WORD	< OVA'TRANS - OVLYST + OVLY - ACTREL >
  .ENDC
	.DSABL	CRF
  .IF GE OVLYN
    .IRP N,<\OVLYN>
	.CSECT	OVLY'N
    .ENDR
  .ENDC
. = $TEMP1
  .ASSUME $A$'TRANS LE ACTCNT, MESSAGE=< $A$'TRANS Action/switch overlap>
	.BYTE	$A$'TRANS
.ENDM	ACTION


.MACRO	SWTDEF	OPTION,DARG
$SCNT	= < $SCNT + 1 >
	LETTR
  .IF DF 'OLET'$'OPTION
   .ASSUME 'OLET'$'OPTION EQ $SCNT, MESSAGE=< $SCNT Duplicate option defined>
  .ENDC
'OLET'$'OPTION = $SCNT
	DARG'.ENDM
.ENDM	SWTDEF


.MACRO	NEXTL
$OPTX	= < $OPTX + 1 >
TEMP	= 0
  .IRPC L,<ABCDEFGHIJKLMNOPQRSTUVWXYZ>
TEMP	= < TEMP + 1 >
    .IF EQ < TEMP - $OPTX >
	.MACRO	LETTR	Z
		Z'.IRPC OLET,<L>
	.ENDM	LETTR
	.MEXIT
    .ENDC
  .ENDR
.ENDM	NEXTL


	NEXTL			;Set up first letter
;+
; The SWIT macro is used to create table entries for the DCL options to
; associate them with the acceptable syntax for the command.  The actual
; option text is collected together by running the big TECO macro on the
; KMON and KMOVLY files (the macro ACTUALLY MODIFIES the files at pages
; begining with ';Option Text' to insert the new table of valid options-
; and therefore NOTHING ELSE IS ALLOWED TO OCCUR ON SUCH PAGES).
;
; The table created by the TECO Macro consists of tightly packed bytes:
; BITS 0-5 Contain the low 6 bits of ASCII of the next valid option char
; BIT 6    Contains a flag indicating that this spelling is unique from all
; 	    other options of this command.
; BIT 7    Flags the end of an option.
;
; The only relationship between this table and the usage of the 'SWIT' macro
; is that the TECO macro scans the SWIT lines to collect the associated
; option text to be placed into the option text lists. Otherwise SWIT
; creates a 3 byte entry for each option:
;Byte 0	Bit 0-4	Program index into CUSPTB associated with option
;	Bit 7	Flags that indicated program is mandatory for option
;	Bit 6	Flags that given option takes a VALUE
;	Bit 5	Flags that if VALUE is a NUMBER- automatically DECIMAL
;Byte 1		Index into option text for associated option, also this 
;		  option is entered into auxilliary table (via LNUM) 
;		  indicating positionality of option
;Byte 2 0	NOP- accept and ignore option
;	1-37	Index into ACTONS table for offset of code to invoke to
;		  handle this option, this entry is automatically filled
;		  in by the SWIT macro if TRANS is a 3 char name, if SWIT
;		  is in an overlay the name is OVA'<3 chars>, if in res
;		  it's ACT'<3 chars>.
;	40-177	ASCII char of RT11 equivalent of option (see bit 6!!)
;	200-377	Bit Mask OR'd in to flag that can be examined later
;
;Usage of SWIT
; If IMPLY or FORCE contains program name, bits 0-4 get set with index
;   as given by CUSPTB, if FORCE also set bit 7
; If TRANS is 1 char- assume RT11 switch, else if 3 chars assume code
;   to be executed on options behalf, else if DEFLT set assume bit flags
; If QVAL set, set bit 6 then if QVAL exactly DVAL also set bit 5
; LNUM encodes positional qualifier indicating where option is legal,
;   always associated with stack frames from SCALL's
;-
.MACRO	PTXT	TEXT
	.ASCII	\TEXT\ \? \ <200>
.ENDM	PTXT

;+
; Comment for what's in next macro
;	JSR	R1,LAB		;Get address of COPY init params
;	.WORD	$NOFFS		;Offset to no entry of current switch
;	.WORD	$SWTAD-SWTBAS	;Offset to switch table for command
;	.WORD	$SYN-STRBAS	;Offset to COPY syntax table
;	.WORD	OPTXN-OPTBAS	;Offset to option text for this command
;	.BYTE	$NONUM		;Highest 'no' legal switch number
;	.BYTE	NUM		;Max number of legal file names for cmd
;-

.MACRO	ITBLE	NUM,?LAB
	JSR	R1,LAB
	.WORD	$NOFFS
	.WORD	< $SWTAD - SWTBAS >
	.WORD	< $SYN - STRBAS >
  .IF EQ $$$1
	.WORD	0
  .IFF
    .IRP N,<\$OPTX>
	.WORD	< OPTX'N - OPTBAS >
    .ENDR
  .ENDC
	.BYTE	$NONUM
	.BYTE	NUM
LAB:
.ENDM	ITBLE


.MACRO	BACKWT	NAME,TEXT
	.BYTE	0
	.NCHR	N,<TEXT>
. = < . + N >
NAME:
  .IRPC N,<TEXT>
. = < . - 1 >
	.BYTE	''N
. = < . - 1 >
  .ENDR
. = NAME
.ENDM	BACKWT


.MACRO	TYPDEF	A,BB,C,D,E,F,G,H,I,J,K,L
  .IF B A
	.WORD	0
	.MEXIT
  .ENDC
	.RAD50	\A\
	.BYTE	< $$'BB ! 200 >
	.BYTE	0
	TYPDEF	C,D,E,F,G,H,I,J,K,L
.ENDM	TYPDEF
.SBTTL	INITIT	- DCL Interpreter

;+
; " Walking on water wasn't built in a day."
;	- Jack Kerouac
;-

;+
; This Interpreter is driven by the syntax table passed via the
; argument list in the initial call.  The syntax table guides
; the parsing of the command line for the generator tables.
; Such things as allowed number of files specs and legal option
; lists are also passed.
;
; Entry:
;	R1 -> data table generated by the ITBLE macro
;
; Register Usage:
;	R0 -> used to pass info between various syntax action routines
;	      and therefore MUST BE VERY CAREFULLY PRESERVED
;	R1,R2,R3 are generally scratch
;	R4 -> syntax table bytes
;	R5 -> backward ASCII text to look at, and is always updated
;	      to be current
;-
	.ENABL	LSB

INITIT:	MOV	(SP)+,@SP	;Pop garbage R1 off stack
	MOV	(R1)+,(PC)+	;Set offset variable
NOFFST:	 .WORD	0		;Offset in bytes to 'NO' entries of switch
	MOV	(R1)+,R0	;Get command's switch table offset
	ADD	PC,R0		;Make absolute
SWTBAS:	MOV	R0,(PC)+	;Save for later
ADSWTB:	 .WORD	0		;Absolute address for current cmd SWIT table
	MOV	(R1)+,R4	;Get offset to command's syntax table
	ADD	PC,R4		;Make interpreter string address absolute
STRBAS:	MOV	(R1)+,(PC)+	;Offset to option text for current command
OPTPTR:	 .WORD	0		;Offset to legal option text for this command
	MOVB	(R1)+,NONUMS	;Get # of switches that take 'NO' prefix
	MOVB	(R1)+,NOSPEC	;Get maximum number of filespecs for command
	.ADDR	#<ISTACK>,R1	;Get address of interpreter stack area
	MOV	R1,STKPTR	;Set interpreter stack pointer
;+
; Example of some variables cleared by following clear loop
;
;	CLRB	NSWITS		;Init number of switches in TRANSW list
;	CLRB	FILNUM		;Init number of file specs processed
;	CLRB	DSWOFF		;Init offset into RT translated SWIT tbl
;	CLRB	DEFMSK		;Clear defaulting mask byte
;	CLRB	DEFILB		;Clear default filename flags
;	CLRB	EXTXT		;Clear special extra text offset
;	CLRB	LNKFLG		;Clear LINK command flag indicator
;	CLRB	QUALFL		;Set flag into command qualifiers
;	CLRB	SCNTFL		;Clear switch count and flags byte
;	CLRB	LIBFLG		;Clear /CREATE flag for LIBRARY command
;	CLR	FORCEP		;Init to no explicit program to run
;	CLR	DEFIEX		;Clear default input extension
;	CLR	DEFOEX		;Clear default output extension
;-
	ADD	#<INTCLR-ISTACK>,R1 ;Set up to init flags for interpreter
	MOV	#<ENDCLR-INTCLR>,R2 ;Size of area in bytes
10$:	CLRB	(R1)+		;Clear out
	DEC	R2		; work areas
	BNE	10$		;Loop till done
	ADD	#<OTBLK-ENDCLR>,R1 ;Point at the output spec block
	MOV	#<3>,R2		;3 spec pointers to init
20$:	CLR	(R1)+		;Clear DV1
	CLR	(R1)+		;Clear DV2
	MOVB	#<-1>,@R1	;Flag byte off
	CMP	(R1)+,(R1)+	;Point at next output spec
	DEC	R2		;Any more to init ?
	BNE	20$		;Yes, continue init
	CLRB	FOTFLG		;First output spec defaulted on
	MOVB	#<$WILD0>,DEFMSK ;Set no wild card seen indicator
INTERP:	MOVB	(R4)+,R1	;Get the next interp byte < 128
	DEC	R1		;Make 0 origin
	ASL	R1		;Make byte offset
	JSR	R1,30$		;Get address of table
DSPBAS:	 DISPAT	OPTBLNK		;Offset to optional blank routine
	 DISPAT	SWITLST		;Offset to switch routine
	 DISPAT	REQBLNK		;Required blank character
	 DISPAT	REQPLUS		;Required '+' character
	 DISPAT	REQCOMMA	;Required ',' character
	 DISPAT	EOLSEQ		;End of line processor
	 DISPAT	FLDBEG		;Optional or iterative field setup
	 DISPAT	ITEREND		;Iteration end routine
	 DISPAT	OPTEND		;Optional field ending
	 DISPAT	SCALL		;Subroutine call
	 DISPAT	SRET		;Subroutine return
	 DISPAT	INSPEC		;Input file spec
	 DISPAT	OUTSPEC		;Output file spec
	 DISPAT	SPISPEC		;Input spec in special mode
	 DISPAT	SPOSPEC		;Output spec in special mode
	 DISPAT	GOTO		;Unconditional interpreter jump
	 DISPAT	PROMPT		;Set up prompt string
	 DISPAT	APLYDEF		;Apply default switch opcode
	 DISPAT	SETDEF		;Syntax driven default switch setting
	 DISPAT	END		;End of command, return to caller
	 DISPAT	DEFILE		;Set default filename flags
	 DISPAT	SETSWIT		;Unconditionally set an RT11 switch
	 DISPAT	DEFINX		;Set a new default extension
	 DISPAT	DEFOSPC		;Set a default output file spec
	 DISPAT	TSTCFLG		;Conditional for Compile class command
	 DISPAT	CEOLSEQ		;End of line Sequence for ',' or EOL
	 DISPAT	MAKOFL		;Generate default output file specs
	 DISPAT	COMPDEF		;Invert the sense of the default mask
	 DISPAT	FILQUAL		;Flag we are processing file qualifiers
	 DISPAT	SAVNAM		;Save default name for output files
	 DISPAT	CMDQUAL		;Force to look like command qualifier
	 DISPAT	FILTYPR		;Routine for Exec to default prog to RUN
	 DISPAT	CNDROUT		;Conditional code execution based on switch
	 DISPAT	ROUTINE		;Force execution of a piece of code
	 DISPAT	DEFDV		;Set a default input device
	 DISPAT	SETISPC		;Set an explicit input file spec
	 DISPAT	EOLGOT		;If end of line goto
	............

30$:	ADD	(SP)+,R1	;Point R1 to entry
	ADD	@R1,R1		;Add in displacement to routine
40$:	MOV	R5,TXTPTR	;Make copy of current text pointer
	CALL	@R1		;Call subroutine
	BR	INTERP		;Go do next one
	............

;+
;ERROR
LTL:	KMEROR	<Line too long>
;-
	............

	.DSABL	LSB
.SBTTL		- DCL Stacking Routines

;+
; The Interpreter stack holds 3-word entries
;
;	1- Stacked Entry ID	 0- Subroutine
;				 1- Optional or iterative field
;				-1- Top of stack
;	2- ID 1  Interp string pointer at start of next field
;	3- ID 0  Return string pointer
;	   ID 1  User text pointer
;-

SCALL:	MOV	STKPTR,R2	;Get free slot pointer
	CLR	(R2)+		;Set subr id
	CLR	(R2)+		;Unused for subr entry
	MOVB	(R4)+,R1	;Get high byte of 2 byte addr
	SWAB	R1		;Put it high, clears low
	BISB	(R4)+,R1	;Put in low byte
	MOV	R4,(R2)+	;Save arg count addr on stack
	MOV	R1,R4		;Set new interp string pointer
	ADD	PC,R4		;Make absolute
;+
; Subroutine pointers are relative to here
;-

SUBREL:	BR	SAVSTK		;Save new stack pointer
	............

SRET:	MOV	STKPTR,R2	;Get stack pointer
	MOV	-(R2),R4	;Reset old interp pointer
				;Don't have to check id because
				; Subroutine calls are always well nested
	CMP	-(R2),-(R2)	;Bump to begining of entry
	MOV	R2,STKPTR	;Reset stack pointer
GOTO:	MOVB	(R4)+,R1	;Get arg count byte
	ADD	R1,R4		;Skip subr arguments
	RETURN			;Continue
	............

FLDBEG:	MOV	STKPTR,R2	;Get stack pointer
	MOV	#<1>,(R2)+	;Set optional or iterative id
	INC	R4		;Skip byte count to end of field
	MOV	R4,(R2)+	;Save interp string pointer
	MOV	R5,(R2)+	;Save user text pointer
SAVSTK:	MOV	R2,STKPTR	;Save new stack pointer
	RETURN			;Continue
	............

ITEREND:MOV	STKPTR,R2	;Last entry on stack must be field begin
	MOV	R5,-(R2)	;On iterative success save new text ptr
	MOV	-(R2),R4	;Reset interp string ptr back to fld beg
	RETURN			;Continue
	............

OPTEND:	SUB	#<6>,STKPTR	;Pop field entry from stack
	RETURN			;Continue
	............
	.ENABL	LSB

EOLGOT:	TSTB	@R5		;End of line?
	BEQ	GOTO		;Yes, get destination argument to branch to
	TSTB	(R4)+		;Skip agrument
	RETURN
	............

CEOLSEQ:CMPB	#<',>,@R5	;Are we at a comma?
	BEQ	10$		;Yes, this is o.k.
EOLSEQ:	TSTB	@R5		;Are we at the end of the line?
	BNE	SCFAIL		;No, scan failure
10$:	MOVB	(R4)+,R0	;Get default prog to run
	BMI	20$		;Branch if really prog byte
				;This code allows SET EDIT and FORTRAN
	ADD	@#$SYPTR,R0	;Point into RMON to get default program
	MOVB	PROGDF-$RMON(R0),R0 ;Now R0 contains program id
20$:	BIC	#<340>,R0	;Clear out other flag bits leaving
				;Sign extension indicating force program
	TST	FORCEP		;Is anything already forced?
	BMI	40$		;Yes
	BEQ	30$		;Nothing even implied, set forced
	CMPB	R0,FORCEP	;Make sure implied matches default
	BNE	ILLOPT		;Branch if default and implied are not same
30$:	MOV	R0,FORCEP	;Set the cusp number and force indicator
40$:	RETURN			;Continue
	............

;+
;ERROR
ILLOPT:	KMEROR	<Invalid option for program>
;-
	............

APLYDEF:CMPB	FORCEP,(R4)+	;Is this the right program for switch?
	BNE	SYNPB2		;No
	BITB	(R4)+,DEFMSK	;Should switch be applied?
	BNE	SYNPB1		;No
SETSWIT:MOVB	(R4)+,R2	;Get ASCII of switch
SETSW1:	CLR	R1		;Set no associated filenumber for switch
	CLR	R3		;Set switch takes no value
	CALLR	ESWIT		;Enter the switch, ESWIT will return
	............

BRLTL:	BR	LTL		;Line too long
	............

FILTYPR:MOVB	(R4)+,R3	;Get addr of filetype and program list
	SWAB	R3		;Put in high, clears low
	BISB	(R4)+,R3	;Get low part
	ADD	PC,R3		;Make pointer absolute
LSTREL:	TST	FORCEP		;Is program to invoke explicit?
	BMI	40$		;Yes, skip filetype search
	.ADDR	#<TMPAREA>,R5,PUSH ;Preserve command line text pointer
	MOV	R5,R0		;Make copy of pointer
	.ADDR	#<SAVNM>,R1	;Set up pic pointer to filespec
	MOV	#<SAVNEN-SAVNM>,R2 ;Set up count of filespec bytes
50$:	MOVB	(R1)+,-(R0)	;Make copy of spec backwards for GETFD
	BNE	60$		;Skip nulls
	INC	R0		;Fix R0
60$:	DEC	R2		;Go through whole spec
	BNE	50$		;Loop thru spec, leaves R1 -> .WORD 0
	CLRB	-(R0)		;Put in cheap terminator
	.ADDR	#<BLOCK>,R2	;Point R2 to output area
				;DK: is always assumed device by DCL
	CALL	GETFD		;Do the RAD50 on it
	MOV	(SP)+,R5	;Restore actual text pointer
	MOV	-2(R2),R1	;Was there an explicit filetype?
	BNE	90$		;Yes, no auto lookups1
	MOV	R0,R1		;Save copy of RAD50 filespec
	MOV	R3,-(SP)	;Save R3
	CALL	COPYFN		;Move it in block to display error
	MOV	(SP)+,R3	;Restore R3
	.DSTATU	R2,R0		;Find if device handler loaded
	BCS	40$		;Not there, error
	TST	4(R2)		;Is handler in memory?
				;LOADing handler would cause us to move
				; and furthermore wouldn't be released!!
	BNE	70$		;Handler is loaded
;+
;ERROR
	KMRTMG	<Handler must be loaded>,,DEV
;-
	............

70$:	TST	(R3)+		;Bump past program field
	MOV	(R3)+,6(R1)	;Set first default filetype
	BEQ	40$		;Branch if no more
	.PURGE	#<CHOVLY>	;PURGE the overlay channel
;;;	MOV	(PC)+,R0	;Get code for PURGE overlay channel
;;;	 .BYTE	<CHOVLY>,<.PURGE>
;;;	EMT	...PUR		;Do the PURGE
	.LOOKUP	CHOVLY,R1	;See if file there
	BCS	70$		;Try the next filetype
	BR	100$		;Got the right filetype
	............

;>>> Remove next line and reorder LSB?????
;;;80$:	CALLR	NOTFND		;Go tell that file was not found
	............

90$:	TST	(R3)+		;Bump past program field
	MOV	(R3)+,R0	;Get RAD50 of default filetype
	BEQ	40$		;Branch if at end of list
	CMP	R0,R1		;Is this the explicit filetype?
	BNE	90$		;No, look at next
100$:	MOVB	@R3,R0		;Get program to run info
	BR	20$		;Go set the program to invoke
	............

CNDROUT:BITB	(R4)+,DEFMSK	;Has option occurred?
	BNE	ROUTINE		;If ne, dispatch to requested code
SYNPB2:	TSTB	(R4)+		;Bump the syntax pointer a byte
SYNPB1:	TSTB	(R4)+		;Bump the syntax pointer a byte
	RETURN
	............

ROUTINE:MOVB	(R4)+,R2	;Get the high byte
	SWAB	R2		;Put it to the high byte
	BISB	(R4)+,R2	;Now the low byte
110$:	ADD	R2,PC		;Do as you are told
RACREL:	.BR	TSTCFLG		;See if we're assembled where we want to be
	............

TSTCFLG:TSTB	COMPFL		;Are we in middle of COMP class command?
	BEQ	SCFAIL		;No, indicated by scan fail
	MOV	(PC)+,R5	;Point R5 to where we last stopped scan
CSTPTR:	 .WORD	0		;Ptr into KMCBUF to ',' or EOL for LANG a,b
	RETURN
	............

	.DSABL	LSB
;+
; Scan Fail Routine
;  This routine uses the stack to allow the interpreter to
;  continue past optional fields and check for prompting on required fields
;-
	.ENABL	LSB

SCFAIL:	MOV	STKPTR,R2	;Get the stack pointer
10$:	MOV	-(R2),R5	;Assume fld entry and restore text ptr
	MOV	-(R2),R4	;Restore string pointer
	TST	-(R2)		;What kind of entry?
	BEQ	10$		;Branch if subr entry, remove it
	BMI	30$		;Branch on hard failure, top of stack
	MOV	R2,STKPTR	;Remove all the entries (this one also)
	MOVB	-(R4),R2	;Get optional fld end byte count (<128)
	ADD	R2,R4		;Adjust interp string pointer
20$:	RETURN			;SP stack must be adjusted properly ...
	............		; ... from INTERP JSR

30$:	TSTB	@TXTPTR		;Are we at the end of line?
	BEQ	40$		;Yes, maybe we can prompt
	CALLR	BADCOM		;Issue error, bad syntax
	............

40$:	MOV	(PC)+,R0	;Get the address of the prompt text
PRMPTR:	 .WORD	0		;Contains relative addr of string for prompt
	ADD	PC,R0		;Make pointer absolute
TXTREL:	.BR	BCPRMPT		;And fall on thru to prompting support
	............

	.DSABL	LSB
.SBTTL	BCPRMPT	- DCL Prompting Support 

;+
; BCPRMPT
; When DCL needs more input to understand a command, it jumps
; to this routine .  In R0 is the addr. of a prompt string to be
; printed on the console to solicit further input from the user.
; in the KMON line buffer is the last line typed by the user
; (which had insufficient information for DCL to execute).  This
; routine sets up the buffer and pointers to accept further information
; from the user (or the @File), and then prints the prompt string
; and goes to get that information.
;-
	.ENABL	LSB

BCPRMPT:.ADDR	#<KMCBUF>,R5	;Point to KMON line buffer
	MOV	R5,R3		;Copy pointer
	MOV	#<KMCBFLN>,R1	;Count of space left in buffer
10$:	DEC	R1		;Decr. count of space in buffer
	TSTB	-(R3)		;Is this end of line?
	BNE	10$		;No, keep looking
	MOVB	#<' >,@R3	;Change EOL to space
	CMPB	(R3)+,@R3	;Line already end w/space?
	BEQ	20$		;Yes, don't need another
	DEC	R1		;Make new space official, decrease space left
	BMI	BRLTL		;Oops, line too long-error
	DEC	R3		;Move pointer back over new space
20$:	MOV	R0,-(SP)	;Save address of prompt string
	.RCTRLO			;Insure echo is on
	MOV	(SP)+,R0	;Back to R0
	.PRINT			;Print prompt string
	MOV	R5,R5		;Hook for SL
	MOV	SP,DOTFLG	;Don't print KMON's dot
	.ADDR	#<KMSTAK>,R2	;Reset KMON stack to clear off subr rtns ...
	MOV	R2,SP		; ...from DCL, or they build up across prompts
	CALLR	STRTP		;Proceed as if nothing happened
	............

	.DSABL	LSB
OPTCOL:	MOVB	#<':>,-(SP)	;Get a colon as optional char
	BR	OPTCHR		;Check for it
	............

	.ENABL	LSB

OPTBLNK:MOVB	#<' >,-(SP)	;Get a blank as optional char
OPTCHR:	CMPB	(SP)+,@R5	;Is it the desired char ?
	BNE	10$		;No
	DEC	R5		;Swallow it
10$:	RETURN
	............

	.DSABL	LSB

REQPLUS:CMPB	#<'+>,@R5	;Is this a plus char?
	BR	REQBL1		;(combine code)
	............

REQCOMMA:CMPB	#<',>,@R5	;Is this a comma?
	BR	REQBL1		;(combine code)
	............

REQBLNK:CMPB	#<' >,@R5	;Is this a blank?
REQBL1:	BNE	SCFAIL		;Required char missing
	RETURN			;Continue, R5 unchanged!
	............

	.ENABL	LSB

DEFILE:	MOVB	(R4)+,DEFILB	;Set default filename byte
	MOV	@#$SYPTR,R1	;Point to RMON
	TSTB	WILDEF-$RMON(R1) ;Should wild card defaults be used?
	BNE	10$		;Yes, wild card defaulting o.k.
	BICB	#<ESTARF+FSTARF>,DEFILB ;Disallow * defaults
10$:	RETURN
	............

	.DSABL	LSB

COMPDEF:COMB	DEFMSK		;Complement all the conditions
	RETURN
	............

FILQUAL:INCB	QUALFL		;Flag we are now in file qualifiers
	RETURN
	............

CMDQUAL:CLRB	QUALFL		;Flag to force command qualifiers
	RETURN
	............

PROMPT:	MOVB	(R4)+,PRMPTR+1	;Put in the high byte relative addr
	MOVB	(R4)+,PRMPTR	;Put in the low byte relative addr
	RETURN
	............

END:	TST	(SP)+		;Pop off interp return word
	RETURN
	............
.SBTTL	SWITLST	- DCL Switch Scanner

;+
; SWITLST - DCL Switch Scanner
;
; This routine does a lot
;	1- Check for switch
;	2- Verify against legal list which is subroutined
;	3- Check for 'NO' and adjust SWIT number approp
;	4- Check number against mutual exclusion list (NOT IMPLEMENTED)
;	5- Add new items to mutual exclusion list     (NOT IMPLEMENTED)
;	6- Execute action routine if one exists
;	7- Invoke the extra syntax scan for switch values
;	8- Handle implied and explicit cusp setting
;	9- Set appropriate RT switch if any
;	10-Handle default mask byte for defaulting conditions
;-

SWITNO	=: 1		;Offset to switch number of ASCII
;+
; MUTEX	=: 2		;Offset to index for mutual excl list
;-
DTRANS	=: 2		;Byte with RT-11 translation of switch
			; or action routine address offset
			; or default mask byte
DECVAL	=: 40		;Bit indicating number should be decimal
SVALU	=: 100		;Flag indicating switch takes value

	.ENABL	LSB

SWITLST:CMPB	#<'/>,@R5	;Is this a switch?
	BNE	SCFAIL		;No, treat as syntax error
	INCB	SCNTFL		;Keep count of number of switches
	CLR	-(SP)		;Set default of 'NO' not given
	MOV	R5,R1		;Copy the start of the switch
	CLR	-(SP)		;Clear a word
	BISB	-(R1),@SP	;Put first char on stack
	SWAB	@SP		;Swap it to high byte
	BISB	-(R1),@SP	;Put second char on stack
	BIC	#<UPASC2>,@SP	;Make them both uppercase
	CMP	#<"ON>,(SP)+	;Check for 'NO' and remove it from stack
	BNE	10$		;Not 'NO'
	INC	@SP		;Set NO found, in low bit
	MOV	R1,R5		;Bump past 'NO'
10$:	CALL	ALPHT		;Make sure first char is alpha
	BCC	ILSWIT		;This is a real syntax error, no backup
	MOV	R5,(PC)+	;Save the text pointer here for rescans
TXTPSV:	 .WORD	0		;Temporary to hold text pointer in switch scan
	MOV	STKPTR,R1	;Scan stack to find last subr arg list
20$:	MOV	-(R1),R2	;Get to top of previous entry(R1-6)
				;R2 = invoking interp string pointer
	TST	-(R1)		;R1-4
	TST	-(R1)		;(R1-6) is this a subr id code?
	BNE	20$		;No, assume one must exist!
	MOVB	(R2)+,SUBCNT	;Get number of switch list pointer strings
	BEQ	20$		;None, ignore subr calls with no args
	BR	40$		;Set up first string list
	............
30$:	DECB	SUBCNT		;Are we at end of legal pointers?
	BLE	ILSWIT		;Yes, unrecognized switch error
	MOV	(PC)+,R2	;Get intermediate pointer for arg list
SUBPTR:	 .WORD	0		;Address to find next relative switch id list
40$:	CLR	R1		;Set up to get switch offsets up to 256
	BISB	(R2)+,R1	;Get offset to list
	ADD	R2,R1		;Pointer is relative to 'INTERPRETER PC'
	MOV	R2,SUBPTR	;Save arg ptr for later
50$:	MOVB	(R1)+,R3	;Get switch table index for command
	BEQ	30$		;Branch if no more to get next args list
	DEC	R3		;Make index relative to 0
	MOV	R3,-(SP)
	ASL	R3		;Mul by 3, 3 bytes per switch entry
	ADD	(SP)+,R3
	ADD	ADSWTB,R3	;Make absolute pointer to table entry
	MOV	OPTPTR,R2	;Set pointer to option text list
	ADD	PC,R2		;Make absolute
OPTBAS:	CLR	R0		;To be index to identify command
60$:	TSTB	(R2)+		;At end of this entry?
	BPL	60$		;No
	INC	R0		;Bump to indicate at next switch
	CMPB	R0,SWITNO(R3)	;Is this a switch to check?
	BNE	60$		;Not there yet
	MOV	TXTPSV,R5	;Reset start of item pointer
70$:	CALL	CHMTCH		;Do the characters match ?
	BNE	50$		;No, go get to next entry
	CALL	ALPHNT		;Is next char alpha?
	BCC	80$		;No, probably command
	TSTB	(R2)+		;Bump to next char
	BPL	70$		;Branch if there is one
;+
;ERROR
ILSWIT: KMEROR	<Invalid option>
	............

AMBSWT:	KMEROR	<Ambiguous option>
	............

ILLNOS:	KMEROR	<Invalid NO on option>
;-
	............

80$:	BITB	#<100>,@R2	;Is recognized command unique?
	BNE	AMBSWT		;No, an error
	MOVB	-(R1),R1	;R1 now contains logical switch number
	TST	(SP)+		;Was NO specified?
	BEQ	90$		;No, no problem
	CMPB	R1,NONUMS	;Is NO legal for this switch?
	BHI	ILLNOS		;No, 'NO' is a no no
	ADD	NOFFST,R3	;Get disp of NO switches and adjust R3
;;;>>>	ADD	'NOFFST/3',R1	;Adjust logical switch number
90$:	MOVB	@R3,R0		;Does this switch cause a specific prog?
	BIC	#<340>,R0	;Clear other flag bits leaving program
				; number and force this program indicator
	BEQ	110$		;Branch if switch doesnt set prog to run
	TST	FORCEP		;Is anything already forced?
	BEQ	100$		;No
	CMPB	R0,FORCEP	;Yes, are they the same?
	BNE	CNFSWT		;Error if program not same as forced
100$:	BIS	R0,FORCEP	;Set the cusp number and must run flag
110$:
.IF NE MUT$EX
	MOVB	MECLPT,R0	;Get number of items to look at
	.ADDR	#<MECLST>,R2	;Get address of exclusion list
120$:	DEC	R0		;At end of list?
	BLT	SWPRT2		;Yes
	CMPB	R1,(R2)+	;Is switch in list?
	BNE	120$		;No, look at next
.ENDC ;NE MUT$EX

	.DSABL	LSB

	.ENABL	LSB

SWPRT2:
.IF NE MUT$EX
	CLR	R0		;Init to get mutual exclusion list
	BISB	MUTEX(R3),R0	; offset to check for invalid switches
	.ADDR	#<MEXLST>,R0,ADD ;Make absolute addr into MEXLST
10$:	MOVB	MECLPT,R1	;Get count of items already in list
	.ADDR	#<MECLST>,R2	;Get pic address of list
20$:	DEC	R1		;At end of list?
	BLT	30$		;Yes
	CMPB	@R0,(R2)+	;Is item already in list?
	BNE	20$		;No
	DECB	MECLPT		;Set up to fall through
30$:	MOVB	(R0)+,@R2	;Put the new exclusion item in
	BEQ	40$		;Done
	INCB	MECLPT		;Indicate another item in list
	BR	10$		;Loop
	............

.ENDC ;NE MUT$EX
40$:	MOVB	FILNUM,R1	;Assoc file for enter switch routine
	MOVB	DTRANS(R3),R2	;Is there a translation for switch?
	BEQ	60$		;Branch if switch is nop
	BMI	50$		;Branch if mask byte
	CMPB	#<ACTCNT+1>,R2	;Is this a translation or action routine
	BLE	ESWIT		;Branch if real RT switch
GOROUT:	ASL	R2		;Make word offset
	.ADDR	#<ACTONS-2>,R2,ADD ;Get offset into table (origin 0)
	ADD	@R2,PC		;Go to appropriate action routine
ACTREL:
ILSWT1:	BR	ILSWIT		;Issue error message
	............

SETDEF:	MOVB	(R4)+,R2	;Get the new defaulting conditions
50$:	BISB	R2,DEFMSK	;Or in the default mask byte
60$:	RETURN
	............

	.DSABL	LSB
	.ENABL	LSB

ESWIT:	MOVB	NSWITS,R0	;Get offset number
	CMPB	#<MAXSWT>,R0	;Make sure we don't fall off list
	BLT	TCERR		;Error, too many switches
	INCB	NSWITS		;Add new switch to table
	ASL	R0		;2 byte entries
	.ADDR	#<TRANSW>,R0,ADD ;Form a pic address
	MOVB	DSWOFF,(R0)+	;Save offset of text
	MOVB	R1,(R0)+	;Save the file number
	CALL	PCDT		;Put the ASCII of switch in table
	TST	R3		;Can switch have a value?
	BEQ	EPCDTR		;No
	BITB	#<SVALU>,@R3	;Can switch have a value?
	BEQ	EPCDTR		;No
10$:	MOVB	#<':>,R2	;Check for value
	CMPB	R2,@R5		;Does switch have a value?
	BNE	EPCDTR		;No
	MOVB	#<2>,R0		;Init for later (to get alpha values)
	CALL	PCDT		;Initially insert the :, then the chars
	CALL	ALPHT		;Check for an alpha
	BCS	40$		;If it is, go pick up value
	INC	R5		;Point back to char
	CALL	NUMBT		;Is it a number?
	BCS	20$		;Yes
	CMPB	#<'->,@R5	;It may still be a number if minus
	BNE	ILVALU		;No, not a legal value
20$:	MOVB	@R5,R2		;Get ASCII of number
	CALL	PCDT		;Move the digit
	CALL	NUMBT		;More digits?
	BCS	20$		;Yes, loop
	MOVB	#<'.>,R2	;Does number end with a decimal point?
	CMPB	R2,@R5		;Check for a decimal point
	BEQ	30$		;Decimal point, use decimal number
	BITB	#<DECVAL>,@R3	;Should number always default to decimal?
	BEQ	10$		;No
	INC	R5		;Adjust because user did not type '.'
30$:	DEC	R5		;Bump past '.'
	CALL	PCDT		;Copy a decimal point at end of number
	BR	10$		;At end of field,check for another value
	............

40$:	MOVB	@R5,R2		;Get ASCII of character
	CALL	PCDT		;Move the character
50$:	CALL	ALPHT		;Check for alphabetic
	BCC	10$		;If not alpha, try for another
	DEC	R0		;Only pass first 3 to program
	BLT	50$		;If we already have 3, just swallow
	BR	40$		;Move the next charcter
	............

	.DSABL	LSB

EPCDTR:	MOV	#<-1>,R2	;Put in the end of switch flag
PCDT:	MOVB	DSWOFF,R1	;Offset of next ASCII switch
	CMPB	#<MAXDSC>,R1	;Don't go to far
	BLE	TCERR		;It won't fit, error
	.ADDR	#<STRANT>,R1,ADD ;Form absolute pointer into table
	MOVB	R2,@R1		;Put in the byte
	INCB	DSWOFF		;Bump the offset
	RETURN
	............

;+
;ERROR
TCERR:	KMEROR	<Command string too complicated>
	............

ILVALU:	KMEROR	<Invalid value specified with option>
	............

CNFSWT:	KMEROR	<Conflicting options>
;-
	............
.SBTTL	ACTxxx	- DCL Switch Action Routines

;+
; Action Routine for /ALLOCATION:nn
;-
	.ENABL	LSB

ACTALL:	CMPB	#<':>,@R5	;Is there a value?
	BNE	ILVALU		;No, error
	CALL	NUMBT		;Does value start with a numeric?
	BCS	10$		;Yes, it is a number
	CMPB	#<'->,@R5	;Check for ALLOC:-n
	BNE	ILVALU		;No, error
10$:	CALL	MULSZ		;Access last given filespec
	ADD	#<STFLG>,R0	;Point at the file type byte
	CMPB	#<DTYP>,@R0	;Is first output file spec > it ?
	BGT	ILSWT1		;Yes, illegal
	CMPB	#<TOTYP>,@R0	;Is third output file spec < it ?
	BLT	ILSWT1		;No, /ALLOC must occur after
				;This also guarantees field was 0 filled
20$:	MOVB	#<']>,-(R0)	;Insert the ] at the end of the field
	SUB	#<STFLG-FSZFLD-1>,R0 ;Point to optional file size field
	MOVB	#<'[>,(R0)+	;Insert the [ at the start of the field
	MOV	#<5>,R1		;Make sure not too many chars
30$:	DEC	R1		;Update char counter
	BLT	ILVALU		;Too many chars in switch value
	MOVB	@R5,(R0)+	;Put in the digit
	CALL	NUMBT		;Any more numbers?
	BCS	30$		;Yes, loop
40$:	TST	R1		;Are we at the end of the field?
	BEQ	50$		;BR if yes
	CLRB	(R0)+		;Clear the rest 
	SOB	R1,40$		; of the field
50$:	MOVB	#<'.>,-(SP)	;Is a decimal point at end of size?
	CALLR	OPTCHR		;Discard it if it's there
	............

	.DSABL	LSB
;+
; Action Routine for Output Spec Generation
; FOT: /OBJECT switch to compilers  and /EXECUTE switch to LINK
; SOT: /LIST switch to compilers and /MAP for LINKS
; TOT: /SYMBOLTABLE to LINK
;-
	.ENABL	LSB

ACTFOT:	.ADDR	#<FOTDV1>,R0	;First output spec block
	BR	20$		;And merge with common code
	............

ACTSOT:	.ADDR	#<SOTDV1>,R0	;Second output spec block
	BR	10$		;And merge with common
	............

ACTTOT:	.ADDR	#<TOTDV1>,R0	;Third output spec block
10$:	CLRB	OFBFLG(R0)	;Force third or second spec to be generated
20$:	TSTB	OFBFL2(R0)	;Was a previous explicit spec given?
	BNE	CNFSWT		;Yes, give error
	MOV	R4,-(SP)	;Save syntax pointer
	MOV	R0,R4		;R4's ok to use
	CMPB	#<':>,@R5	;Is there a value?
	BNE	60$		;No, use a default
	CALL	OUTSPEC		;Get the output filespec
	CMP	SAVORG,R0	;Was any outspec specified?
	BEQ	ILVALU		;No, error
	TSTB	FNMFLD-FSIZ(R0)	;Is there a filename?
	BNE	30$		;Branch if yes
	BR	70$		;A device name was specified
	............

30$:	INCB	OFBFL2(R4)	;Disallow any more explicit files of this type
40$:	MOVB	OFBTYP(R4),-(R0) ;Set the outspec position in CSI line
				;Note R0 comes all the way from outspec!
	INCB	OFBFLG(R4)	;Indicate don't want file type anymore
50$:	MOV	(SP)+,R4	;Restore syntax pointer
	RETURN
	............

60$:	CMP	#<SOTYP>,OFBTYP(R4) ;Is it second spec (default printer)
	BNE	80$		;No, don't default LP:
	TSTB	QUALFL		;Is option on command or filename?
	BNE	90$		;Branch if on file name
	CALL	ACTPRI		;Default listings to LP:
70$:	TST	@R4		;Was a device previously given for this spec?
				.ASSUME OFBDV1 EQ 0
	BNE	CNFSWT		;Yes, give error
	MOV	-FSIZ(R0),@R4	;Save first word of device name
				.ASSUME OFBDV1 EQ 0
	MOV	-FSIZ+2(R0),OFBDV2(R4) ;Save second word of device name
	DECB	FILNUM		;Deallocate the file spec slot
				;Now handle naming the output file
80$:	TSTB	QUALFL		;Is option on command or filename?
	BEQ	50$		;Branch if on command
90$:	MOV	R4,R3		;Set up pointer to default device
				.ASSUME	OFBDV1 EQ 0
	CALL	SUBNAM		;Create a default output name
	BR	40$		;Flag as 2nd in CSI line
	............

MAKOFL:	MOV	R4,-(SP)	;Save the syntax pointer
	INC	@SP		;Bump the syntax pointer
	MOVB	(R4)+,R4	;Get index to OTBLK
	.ADDR	#<OTBLK>,R4,ADD	;PIC pointer for this output spec
	TSTB	OFBFLG(R4)	;Should we generate a file of this type ?
	BNE	50$		;No, because of either the
				;Default or we did it already
	.ADDR	#<SAVNM>,R0	;Point to the default name
	MOV	R4,R3		;Set up pointer to default device
				.ASSUME	OFBDV1 EQ 0
	CALL	SUBNM1		;Generate the listing file name
	BR	40$		;Flag position in CSI line
	............

ACTNOO:	INCB	FOTFLG		;Indicate don't want first file anymore
	RETURN
	............

	.DSABL	LSB
;+
;Action routine to force default output file name 
;
;Used by PRINT/OUTPUT: 
;-

.ENABL	LSB

ACTPRO:	BISB	#<ESTARF>,DEFILB	;Set * in ext for /OUTPUT
	CALL	ACTSOU			;Process as for SQUEEZE/OUT
	BICB	#<ESTARF>,DEFILB	;Clear * in ext for /OUTPUT
	RETURN

;+
; Action routine to force default output file name 
;
; Used by PRINT/OUTPUT: and SQUEEZE/OUTPUT:
;-

ACTSOU:	CMPB	#<':>,@R5	;Is /OUTPUT terminated with a ':'
	BNE	10$		;No, ignore it
	CALL	SPOSPEC		;Process a special mode filespec to
				; force on a default filename
	MOVB	#<FOTYP>,-(R0)	;R0 from call! Flag as primary output file
10$:	RETURN
	............

	.DSABL	LSB
;+
; Action routine to get input spec from option parameter.
;
; Used by library and initialize.
;-
	.ENABL	LSB

ACTFIN:	CMPB	#<':>,@R5	;Is there a ':'?
	BNE	10$		;If not, then branch to ignore option
	CALLR	INSPEC		;Get the input file spec and return
	............

10$:	RETURN
	............

	.DSABL	LSB
;+
; Action Routine for EXECUTE and COMPILE to distinguish FORTRAN
; compilers for the /FORTRAN switch.  Here we implement the /FORTRAN
; default by skipping the interpreter routine FILTYPR.
;-
	.ENABL	LSB

CUSP$M	=:	37		;Mask for CUSP number

ACTFRT:	MOV	FORCEP,R3	;Look to see if any program is forced/implied
	BIC	#^c<CUSP$M>,R3	;Mask off all but cusp number for comparison
	BEQ	10$		;No - go use the FORTRA default
	CMPB	#<$$FORT>,R3	;Yes- Make sure it's a FORTRAN compiler
	BEQ	10$		;It is - good
	CMPB	#<$$F77>,R3	;FORTRAN 77?
	BEQ	10$		;It is - good
	CALLR	CNFSWT		;It isn't - switch conflict, report error
	............

10$:	ADD	#<3>,R4		;Skip FILTYPR interpreter routine		
	RETURN
	............

	.DSABL	LSB
;+
; FDSWIT - Find the indicated switch (stolen from DELETE,PRINT overlay FNDSWT)
;
; INPUT: R3 = ASCII switch to be searched for
;
; OUTPUT: R1 -> 1 byte beyond offset into switch table where switch was found
;	  R2 -> next byte after found switch in switch table
;
;	  C=1 => Switch not found
;	  C=0 => Switch found
;		R1 is pointer to the filespec switch occurred on
;
; R0 destroyed
;-
	.ENABL	LSB

FDSWIT:	CLR	R0		;Keep track of the switches
	.ADDR	#<TRANSW-1>,R1	;Point at the switch table
10$:	TSTB	(R1)+		;Point at 1st byte of the next entry
	INC	R0		;Keep track of the switches in table
 	CMPB	R0,NSWITS	;Have we exhausted the table
	BGT	20$		;Yep, go exit
	MOVB	(R1)+,R2	;Get offset into the ASCII table
	.ADDR	#<STRANT>,R2,ADD ;Make that an absolute address
	CMPB	(R2)+,R3	;Is this the switch?
	BNE	10$		;Keep looking
	TST	(PC)+		;Clear carry and skip next instr, we've got it
20$:	SEC			;Set carry, we didn't find it
	RETURN
	............

	.DSABL	LSB
;+
; This routine removes switches by decrementing the switch count and shifting
; the remaining text pointers over by one entry.
;
; Input: R0 = # of switches parsed (incl. one to remove) before switch found.
;	 R1 -> one byte beyond offset to switch text (of switch found)
;	 R2 -> one byte beyond ASCII switch in switch text table
;
; Call:	 OCALL	REMSWT		;Remove switch from table (called from DELSWT)
;
; Output: R0, R1, R3, R4 may be destroyed.
;-
	.ENABL	LSB

REMSWT:	CLR	R4		;Set up count register
	MOVB	NSWITS,R4	;Get number of switches left
	DECB	NSWITS		;Decrease number of switches to process by one
	SUB	R0,R4		;Get number of switches left to shift
	BLOS	30$		;BR if last switch (if last in table or list)
	TSTB	-(R1)		;-> offset to switch table of swit to remove
10$:	MOV	R1,R3		;Save start
	CMPB	(R1)+,(R1)+	;Point to next offset
20$:	MOVB	(R1)+,(R3)+	;Move switch offset
	MOVB	(R1)+,(R3)+	;and associated file number
	DECB	R4		;One less to shift
	BNE	20$		;Loop until done
30$:	RETURN
	............

	.DSABL	LSB
;+
; This gets executed directly after an INSPEC or OUTSPEC call and R0
; remains set!  This saves the 1st file name for later (see MAKOBJ).
;-
	.ENABL	LSB

SAVNAM:	.ADDR	#<SAVNM>,R1	;Get pointer to save area for filespec
	MOV	R0,R2		;Make copy of table pointer for file
	SUB	#<FSIZ>,R0	;Point to the start of it
	MOV	#<SAVNEN-SAVNM>/2,R3 ;Set up count of words to move
10$:	MOV	(R0)+,(R1)+	;Copy the name over
	DEC	R3		;
	BNE	10$		;
	RETURN
	............

	.DSABL	LSB

	.ENABL	LSB

SUBNAM:	CALL	MULSZ		;Get pointer to last input spec name
10$:	CMPB	#<ITYP>,STFLG(R0) ;Is it an input spec?
	BEQ	SUBNM1		;Yes
	SUB	#<FSIZ>,R0	;Point back to previous one
	BR	10$		;Loop till we find an input spec
	............

	.DSABL	LSB

	.ENABL	LSB

SUBNM1:	MOV	R5,-(SP)	;Save text pointer
	MOV	R0,-(SP)	;Save for later
	MOV	R3,-(SP)	;Save for later
	.ADDR	#<DUMYNM>,R5	;Point to a dummy file name
	CALL	OUTSPEC		;Create a correctly defaulted out spec
	MOV	(SP)+,R5	;Get pointer to default device back
	TST	@R5		;Is there a default device?
	BEQ	10$		;No
	MOV	(R5)+,-FSIZ(R0)	;Override the device
	MOV	(R5)+,-FSIZ+2(R0) ;Both words
10$:	MOV	(SP)+,R5	;Get pointer back to last input spec
	CMP	(R5)+,(R5)+	;Point to filename field
	MOV	(R5)+,FNMFLD-FSIZ(R0) ;Take default output
	MOV	(R5)+,FNMFLD+2-FSIZ(R0) ;File name same as this
	MOV	(R5)+,FNMFLD+4-FSIZ(R0) ;Input file spec name
RSTTPT:	MOV	(SP)+,R5	;Restore text pointer
	RETURN
	............

	.DSABL	LSB
;+
; Action routines for /PRINTER, /TERMINAL, /OUTPUT:
;-
	.ENABL	LSB

ACTOUT:	CMPB	#<':>,@R5	;Is /OUTPUT terminated with a colon?
	BEQ	OUTSPEC		;Yes, go process file spec
	RETURN			;Parse an output spec, R5 will end
	............		;Up correctly and outspec will return

ACTTER:	MOV	R5,-(SP)	;Preserve scan pointer
	.ADDR	#<$TTSPC>,R5	;Set up pointer to TT: (backwards)
	BR	10$		;Go through common output code
	............

ACTPRI:	MOV	R5,-(SP)	;Preserve scan pointer
	.ADDR	#<$LPSPC>,R5	;Set up pointer to LP: (backwards)
10$:	CALL	OUTSPEC		;Parse it as an output file spec
	BR	RSTTPT		;Restore text pointer
	............

	.DSABL	LSB
;+
; Action routine to handle non-default RUN option on LINK and EXECUTE.
; The defaults are opposite making this seem inconsistent.
;-
				;Flag /RUN on a LINK command
ACTNOR:	INCB	RUNFLG		;Flag /NORUN on an EXECUTE command
	RETURN
	............
.SBTTL	xxSPEC	- DCL File Spec Processor

FSTARF	=: 1		;Bit in DEFILB, * default for filename
ESTARF	=: 2		;Bit in DEFILB, * default for ext
DSTARF	=: 4		;Bit in DEFILB, special flag for DELETE

SPISPEC:MOV	(PC)+,R1	;Indicate special mode flag
INSPEC:	CLR	R1		;0 indicates no special mode
	CALL	MULSZI		;Generate offset into filspec tbl in R0
INSPC1:	MOV	#<DEFIEX-DOSREL>,R3 ;Set up rel ptr to default input .ext
	CALL	DOSPC1		;Use common code with output spec
	MOVB	#<ITYP>,(R0)+	;Put in end of in spec indicator
	RETURN
	............

	.ENABL	LSB

SPOSPEC:MOV	(PC)+,R1	;Indicate special mode flag
OUTSPEC:CLR	R1		;0 indicates no special mode
	CALL	MULSZI		;Generate offset into filspec table
	MOV	#<DEFOEX-DOSREL>,R3 ;Set up rel ptr to default output .ext
	CALL	DOSPC1		;Use common code with output spec
	CMPB	#<'[>,@R5	;Is a file size given?
	BNE	40$		;No
	MOVB	@R5,(R2)+	;Copy the left bracket
	CALL	NUMBT		;Is next char a number?
	BCS	10$		;Yes, ok
	CMPB	#<'->,@R5	;Allow negative numbers also
	BNE	FERR		;Positive number is an error
10$:	MOV	#<5>,R1		;Set up to get some digits
20$:	DEC	R1		;Make sure not too many
	BLT	FERR		;Too many chars, error
	MOVB	@R5,(R2)+	;Copy the digit
	CALL	NUMBT		;See if next a number
	BCS	20$		;Yes
30$:	CMPB	#<']>,@R5	;Make sure syntax ok
	BNE	FERR		;Bad output filesize syntax
	MOVB	@R5,(R2)+	;Copy this over also
	DEC	R5		;Point to char after ']'
40$:	MOVB	#<FOTYP>,(R0)+	;Put in end of out spec indicator
	RETURN
	............

	.DSABL	LSB

	.ENABL	LSB

MULSZI:	INCB	FILNUM		;Bump to get to next entry
MULSZ:	MOVB	FILNUM,R2	;Cheapest to add in loop
	CMPB	R2,NOSPEC	;Check for a legal access
	BGT	FNERR		;Error, too many file specs in cmd
MULSZS:	CLR	R0		;Multiply filnum by fsiz to get offset
10$:	ADD	#<FSIZ>,R0
	DEC	R2
	BNE	10$
	.ADDR	#<FILST-FSIZ>,R0,ADD ;Make PIC address, origin 1
	MOV	R0,(PC)+	;Save for later check
SAVORG:	 .WORD	0		;Saved table pointer
	RETURN
	............

	.DSABL	LSB
;+
; R0 -> start of field for broken up spec
; R1<>0 indicates special mode filespec ok
; R2 -> default device name ('xxx:' or 0's)
; R3 -> default extension ('.xxx' or 0's)
; R5 -> text input to be checked
; DOSPC1 alternate entry point that sets up R3 relative to DOSREL and
;	R2 = DEFDEV
;-
	.ENABL	LSB

DOSPC1:	ADD	PC,R3		;Relativize the default extension
DOSREL:	.ADDR	#<DEFDEV>,R2	;Point at the default device
DOSPEC:	MOV	R5,TXTPSV	;Save text pointer for possible backup
	MOV	R1,(PC)+	;Set request type
SPECTP:	 .WORD	0		;Wild carding in file spec allowed flag
	CALL	GETAS3		;Try and get device 3 bytes
	MOVB	#<':>,(R0)+	;Assume device name
	BCS	10$		;Branch if can't be device name
	CMPB	#<':>,@R5	;Did it end with a colon?
	BEQ	30$		;Yes, assumptions right
10$:	CMP	-(R0),-(R0)	;Reset R0 to set default device name
	TST	@R0		;Was there a filespec at all?
	BNE	20$		;Yes
	CMPB	#<'.>,@R5	;If no filename, see if filetype
	BEQ	20$		;Filetype present, allows .FOO->*.FOO
	DECB	FILNUM		;Readjust file spec count
	TST	(SP)+		;Pop off extra word on stack
	CALLR	SCFAIL		;Signal possible error
	............

20$:	MOV	(R2)+,(R0)+	;Move first 2 chars, 0's if no default
	MOV	(R2)+,(R0)+	;Put in last char and colon
	MOV	TXTPSV,R5	;Start rescan at begining
30$:	MOV	R0,R2		;Make copy of filename pointer
	MOV	#<L.FNAM>,R1	;Number of chars in filename
	CALL	GETASC		;Try and get it
	BCS	FERR		;Error if filename too long
	TST	@R2		;Was there an explicit filename?
	BNE	40$		;Yes
	TST	SPECTP		;In special mode?
	BEQ	40$		;No, don't default to asterisk
	BITB	#<FSTARF>,DEFILB ;Should it become an asterisk?
	BEQ	40$		;No, leave it null
	BICB	#<$WILD0>,DEFMSK ;Indicate wildcard occurred
	MOVB	#<'*>,@R2	;Default it to an asterisk
40$:	MOV	R0,R2		;Make copy of extension pointer
	CLR	(R2)+		;Clear out extension field
	CLR	(R2)+		;Both words
	TST	-6(R0)		;Is there a file spec?
	BEQ	70$		;No, don't take a filetype
	MOV	(R3)+,@R0	;Put in default ext, '.x' or null
	MOV	(R3)+,2(R0)	;Put in rest, 'xx' or null
	CMPB	#<'.>,@R5	;Is a filetype given?
	BNE	50$		;No, use default
	MOVB	@R5,(R0)+	;Put in '.'
	CALL	GETAS3		;Get extension 3 bytes
	BCC	70$		;Go to fill in file size
;+
;ERROR
FERR:	KMEROR	<Error in file spec>
	............

FNERR:	KMEROR	<Too many files>
;-
	............
50$:	TST	@R0		;Is there a filetype?
	BNE	70$		;Yes
	TST	SPECTP		;In special mode?
	BEQ	70$		;No
	BITB	#<DSTARF>,DEFILB ;Is this special case of DELETE?
	BEQ	60$		;No
	CMP	#<'*>,-6(R0)	;Yes, is file name '*'?
	BEQ	70$		;Yes, don't default file type to '*'
60$:	BITB	#<ESTARF>,DEFILB ;Should extension become an asterisk?
	BEQ	70$		;No
	BICB	#<$WILD0>,DEFMSK ;Indicate wildcard occurred
	MOV	#<".*>,@R0	;Put in asterisk for file name extension
70$:	MOV	R2,R0		;Set R0 to length pointer
ZFALLF:	CLR	(R0)+		;Assume
	CLR	(R0)+		; no
	CLR	(R0)+		;  file size
	CLRB	(R0)+		;Leave R0 pointing at end flag addr
	RETURN
	............

	.DSABL	LSB

$WILD0	=: 100		;Flag bit in DEFILB for wildcards

	.ENABL	LSB

GETAS3:	MOV	#<L.FTYP>,R1	;3 char entry
	BR	GETASC		;Go get 'em
	............

10$:	BICB	#<$WILD0>,DEFMSK ;Flag a wild card has occurred
20$:	SUB	#<1>,R1		;Decrement count, set C appropriately
	BCS	50$		;Too many chars in field, return C=1
	MOVB	@R5,(R0)+	;Add the good char to the field
GETASC:	CALL	ALPHNT		;Check for a letter or digit
	BCS	20$		;Branch if it is, part of this field
	TST	SPECTP		;Is this a special mode request?
	BEQ	30$		;No, we are at delimiter
	CMPB	#<'*>,@R5	;Is this an asterisk?
	BEQ	10$		;Yes, valid char
	CMPB	#<'%>,@R5	;Is this a percent sign?
	BEQ	10$		;Yes, valid char
30$:	TST	(PC)+		;Clear carry, skip next instruction
40$:	CLRB	(R0)+		;Zero rest of field
	DEC	R1		;At end of field?
	BGE	40$		;Not yet
50$:	RETURN
	............

	.DSABL	LSB
	.ENABL	LSB

DEFDV:	MOV	#<DEFDEV-20$>,R1 ;Set up to stuff default device
	BR	10$		;Use common code
	............

DEFINX:	MOV	#<DEFIEX-20$>,R1 ;Set up to stuff default file type
10$:	ADD	PC,R1		;Relative to 20$
20$:	MOVB	(R4)+,R0	;Get high byte of relocatable addr
	SWAB	R0		; of new extension
	BISB	(R4)+,R0	;Get low byte
	ADD	PC,R0		;Make absolute
EXTREL:	MOV	(R0)+,(R1)+	;Put in first new word
	MOV	(R0)+,(R1)+	;Put in second
	RETURN
	............

	.DSABL	LSB

SETISPC:CALL	DEFOSPC		;Use output spec code
	MOVB	#<ITYP>,@R0	;Change to input spec
	RETURN
	............

	.ENABL	LSB

DEFOSPC:MOVB	(R4)+,R1	;Set up default outspec string addr
	SWAB	R1		;This must occur within a FLDBEG!!!
	BISB	(R4)+,R1	;Set low byte
	ADD	PC,R1		;Make absolute
DOUSTR:	CALL	MULSZI		;Get a slot for a spec
	MOV	#<FSIZ>,R2	;Set up to insert FSIZ bytes
10$:	MOVB	-(R1),(R0)+	;Move a byte of default spec
	BNE	20$		;Still moving text
	INC	R1		;Point back to null for 0 fill
20$:	DEC	R2		;At end of entry?
	BNE	10$		;No
	MOVB	#<DTYP>,-(R0)	;Flag as default output spec
	RETURN
	............

	.DSABL	LSB
.SBTTL	CMDEXE	- DCL Command Generator

.MACRO	EMIT	TEXT
	.NCHR	$TEMP1,<TEXT>
  .IF NE $TEMP1
	JSR	R1,EMITIN
    .IF DIF TEXT,ENDLIN
      .IF DIF TEXT,ENDCMD
	.ASCII	\TEXT\
        .IF EQ < EMITIN - . > & 1
	  .BYTE	0
	.ENDC
	.BYTE	-1
      .IFF
	.BYTE	3, 0, 200, -1
      .ENDC
    .IFF
	.BYTE	200, -1
    .ENDC
  .IFF
	CALL	EMITCH
  .ENDC
.ENDM	EMIT

	.ENABL	LSB

CMDEXE:	CALL	CMDMAK		;Generate the command text
.IF DF HJDB
	CALLR	BADCOM		;Just for debugging, cleans up stack
	............

.IFF ;DF HJDB
	CALLR	STRT		;Jump into KMON startup to do command
	............

.ENDC ;DF HJDB

CMDMAK:	CLRB	GENFLG		;Set to just count space needed
	CLR	(PC)+		;Count accumulated in MEMNED
MEMNED:	 .WORD	0		;Byte count of needed memory for command
	CALL	DOGEN		;Fake generating the command string
;+
; Ask for the space,  we may move!!!!
;-
	MOV	MEMNED,R0	;DCLSPC expects #bytes needed in R0
	CALL	DCLSPC
	SUB	R0,@SP		;Adjust return addr by how much we moved
	SUB	R0,CSTPTR	;Adjust pointer into KMCBUF for COMP A,B
	SUB	R0,(PC)+	;Adjust pointer into KMCBUF for switches
CNMPTR:	 .WORD	0		;Pointer into KMCBUF after <LANG> for switches
	MOV	R1,R5		;Addr to store data returned in R1
	DECB	GENFLG		;Now indicate we really generate text
;+
; Generate the command string again, 'R' line first
;-

DOGEN:	EMIT	<R >		;Emit the string 'R '
	MOVB	FORCEP,R0	;Get program to run index
	.ADDR	#<CUSPTB>,R1	;Get addr of ASCII table of names
10$:	DEC	R0		;Is this the entry?
	BEQ	30$		;Yes
20$:	TSTB	(R1)+		;Get to end of current entry
	BPL	20$		;Loop
	BR	10$		;Try this one
	............

30$:	EMIT			;And the cusp name
	EMIT	ENDLIN		;And end of line
;+
; Now for the CSI line
;-
	TSTB	NOCLNF		;Do we need the CSI line?
	BNE	RETPC		;No
	MOVB	EXTXT,R1	;Do we need to insert any special text?
	BEQ	40$		;No
	.ADDR	#<STRANT>,R1,ADD ;Form absolute pointer to text
	EMIT			;Output special prefix text
40$:	MOVB	#<FOTYP>,R4	;Set up to do the output ones first
	CALL	DOENT		;Find all output ones and do them in order!!??
	MOVB	LNKFLG,R0	;Are we processing a LINK type command?
	BISB	COMPFL,R0	;Or a COMPILE type command ?
	BNE	50$		;Yes,three out specs in order
	TSTB	TFLAG		;Was spec done
	BMI	50$		;Yes skip the default
	DECB	R4		;Setup default output spec flag
	CALL	DOENT		;Do the default spec
	INCB	R4		;Upto the first spec
50$:	INCB	R4		;Point at the next spec now
60$:	INCB	TFLAG		;A nice way to set up commas
	BEQ	60$		;More commas
	CALL	DOENT1		;Enter the second then third out specs
	CMPB	R4,#<TOTYP>	;Third outspec done yet ?
	BNE	50$		;No keep going
	EMIT	<=>		;Output the input output separator
	INCB	R4		;Set up input spec flag, (1+output flag)
	CALL	DOENT		;Do all the input specs (in order)
	CLR	R2		;Now output the command level switches
	CALL	DOSWIT		;Output them
	EMIT	ENDLIN		;Output the CRLF
	EMIT	ENDCMD		;Force a "^C"
RETPC:	RETURN
	............

	.DSABL	LSB
;+
; R4 = file type to be searched for
; TFLAG = number of commas to output prior to the spec
;-
	.ENABL	LSB

DOENT:	CLRB	TFLAG		;Suppress initial comma
DOENT1:	.ADDR	#<FILST-FSIZ>,R1 ;Address of file entry table to R1
	CLR	R2		;Keep track of file spec # for switch matching
10$:	ADD	#<FSIZ>,R1	;Point to next entry
20$:	INC	R2		;Indicate new switch position
	CMPB	R2,FILNUM	;Check for end of spec table
	BGT	RETPC		;Hit end of table
	CMPB	R4,STFLG(R1)	;Is this the right kind of spec?
	BNE	10$		;No, try again
;+
; The following code is a special hook for EXECUTE so it can have access to
; the object file from COMPILEs
;-
	TSTB	GENFLG		;Only do EXECUTE escapes once
				;Must be on count pass before KMON moves
	BNE	30$		;Branch if second pass to skip them
	MOV	EXEESC,R0	;Is this EXECUTE? (or LINK/RUN)
	BEQ	30$		;No
	CMPB	#<FOTYP>,R4	;Is this object or save file?
	BNE	30$		;No
	CALL	@R0		;Let EXECUTE pick up the object file
30$:	DECB	TFLAG		;Do we need a comma?
	BMI	40$		;No, skip outing the comma
	EMIT	<,>		;Output the comma
	BR	30$		;Check for more commas
	............

40$:	EMIT			;Output the file spec
	CMPB	#<ITYP>,R4	;Input spec
	BNE	50$		;No,only one of each input type
	NEGB	TFLAG		;A comma please
50$:	MOV	R1,-(SP)	;Save R1 for loop continuation
	MOV	R4,-(SP)	;Save file type
	CALL	DOSWIT		;Output the associated switches
	MOV	(SP)+,R4	;Restore the file type
	MOV	(SP)+,R1	;Restore R1
	BR	20$		;Loop
	............

	.DSABL	LSB

	.ENABL	LSB

DOSWIT:	MOVB	NSWITS,R3	;Get number of entries in table
	.ADDR	#<TRANSW>,R4	;Get address of switch list
10$:	DEC	R3		;Any more to check?
	BMI	RETPC		;No, done
	MOVB	(R4)+,R1	;Get offset to switch text
	CMPB	R2,(R4)+	;Does switch go on this spec?
	BNE	10$		;No, try the next
	.ADDR	#<STRANT>,R1,ADD ;Get offset to ASCII of switch
	EMIT	</>		;Output a /
	EMIT			;Output the switch text
	BR	10$		;R1 already points to next one, do more
	............

	.DSABL	LSB

	.ENABL	LSB

EMITIN:	CALL	EMITCH		;Output the in-line string
	RTS	R1		;R1 must be word aligned by padding
	............

10$:	INC	MEMNED		;Count how many bytes moved
	TSTB	GENFLG		;Just count or really move the stuff?
	BEQ	EMITCH		;Branch if just counting
.IF DF HJDB
	.TTYOUT			;For debugging
.ENDC ;DF HJDB
	MOVB	R0,(R5)+	;Put in the new byte
EMITCH:	MOVB	(R1)+,R0	;Get the char
	BEQ	EMITCH		;Ignore nulls
	BPL	10$		;Branch for next char
	ASLB	R0		;Set end of line?
	BEQ	10$		;Branch if at end to output a null
	RETURN
	............

	.DSABL	LSB
;+
; Define CUSPTB table (program names table) and CUSP numbers for programs
;-

.MACRO	PROG	NAME,ARG
  .IF B ARG
	.ASCII	\NAME\<-1>
  .IFF
	.ASCII	<-1>
  .ENDC
$TEMP	= < $TEMP + 1 >
$$'NAME	==: $TEMP
.ENDM	PROG

$TEMP	= 0			;Init counter for Macro

CUSPTB:	PROG	RESORC
	PROG	PIP
	PROG	DIR
	PROG	DUP
	PROG	LINK
	PROG	FORTRA
	PROG	MACRO
	PROG	DUMP
	PROG	LIBR
	PROG	SRCCOM
	PROG	FILEX
	PROG	DICOMP
	PROG	FORMAT
	PROG	BINCOM
	PROG	ERROUT
	PROG	QUEMAN
	PROG	BUP
	PROG	KED
	PROG	K52
	PROG	KEX
	PROG	UCL
	PROG	EDIT,NOTEXT
	PROG	TECO,NOTEXT
.IF EQ MMG$T
	PROG	F77
.IFF ;EQ MMG$T
	PROG	F77XM
.ENDC ;EQ MMG$T
	.EVEN
	............

;+
; Note: The CUSP numbers for EDIT and TECO are hard coded in RESORC.  If
;	they change, RESORC must be updated also!!!
;
; Define $$F77 as common symbol for both XB/XM and non-XB/XM to cut
; down on the use of conditional symbols
;+
.IIF NE MMG$T, $$F77 == $$F77XM
;+
; Syntax Subroutines
;-

CSPISPC:REQCOMMA		;Scan off a comma
SPISPC:	SPISPEC			;And a wild card input file spec
	GOTO	GSWIT		;Process optional switches
	............

RINSPC:	INSPEC			;Pick-up a normal file spec
	GOTO	GSWIT		;Accept switches
	............

ROUSPC:	OUTSPEC			;Pick-up a regular output file spec
	GOTO	GSWIT		;Accept switches
	............

SPOSPC:	REQBLNK			;Check for necessary blank
	SPOSPEC			;Get a special output spec and fall into GSWIT
GSWIT:	FLDBEG			;Start optional iterative switch field
	OPTBLNK
	SWITLST			;Arguments have legal switch list
	ITEREND			;Transfer back to FLDBEG
	SRET			;Return to previous syntax string
	............

GSWIT1:	OPTBLNK			;Optional blank
	SWITLST			;Only one switch
	SRET			;Return to previous syntax string
	............

	.EVEN
.SBTTL		- DCL Storage Areas

	.ENABL	CRF
;+
; The interpreter stack are 3 word entries
;	1- Stacked Entry ID	 0- Subroutine
;				 1- Optional or Iterative Field
;				-1- Top of Stack
;	2- ID 1  Interp string pointer at start of next field
;	3- ID 0  Return string pointer
;	   ID 1  User text pointer
;-

IDEPTH	=: 10
STKPTR:	.WORD	0	;Pointer into following interpreter stack
	.WORD	-1	;Top of stack indicator
	.WORD	0	;Entries are all three words
	.WORD	0	;1 more

ISTACK:	
	.REPT	< 3 * IDEPTH > ;Allocate IDEPTH entries
	 .WORD	55555	;Recognizable bit pattern
	.ENDR

TXTPTR:	.WORD	0	;Save address of user text pointer at start
			; any interpreter call

INTCLR:			;Start of area to be 0'ed on interp initialize
DEFIEX:	.WORD	0, 0	;Default input extension to null
DEFOEX:	.WORD	0, 0	;Default output extension to null
EXEESC:	.WORD	0	;Pointer/flag to special EXECUTE code for LINK
FORCEP:	.WORD	0	;Index for prog to RUN(low), Must Run Flag(high)
			; If the prog is implied, high bit is clear
			; If the prog is to be forced, high bit is set
.IF NE MUT$EX
MECLPT:	.BYTE	0	;Current count of items in MEXLST
.ENDC ;NE MUT$EX
NSWITS:	.BYTE	0	;Current number of switches in TRANSW list
LNKFLG:	.BYTE	0	;Flag to indicate in LINK portion of command
QUALFL:	.BYTE	0	;Flag 0 Command Qualifier, else File Qualifier
EXTXT:	.BYTE	0	;Offset and flag to special extra text on CSI
SCNTFL:	.BYTE	0	;Count of switches in command and 1 flag bit
FILNUM:	.BYTE	0	;File spec number we are up to
DSWOFF:	.BYTE	0	;Current offset into STRANT table
DEFMSK:	.BYTE	0	;Default condition masking byte
DEFILB:	.BYTE	0	;Contains defaulting flags for filename
EXEPT2:	.BYTE	0	;Pointer used by EXEC for positional option text
ENDCLR:			;End of area to be 0'ed on interp initialize
TFLAG:	.BYTE	0	;Flag for need of punctuation between specs
GENFLG:	.BYTE	0	;Flag=0, just count chars in generated text
NONUMS:	.BYTE	0	;Highest id for which 'NO' is legal on switch
NOSPEC:	.BYTE	0	;Maximum # of filespecs allowed
SUBCNT:	.BYTE	0	;Count of arguments passed in SCALL
EXEFLG:	.BYTE	0	;Denotes if in middle of EXECUTE expansion
	.EVEN

ACTCNT	=: 37		;Maximum number of action routines
ACTONS:	.BLKW	ACTCNT	;Reserve space for action routine offsets
;+
; *** The following must remain IN ORDER for initialization at classify ***
;-

RUNFLG:	.BYTE	0	;Flag for /RUN or /NORUN on LINK and EXECUTE
COMPFL:	.BYTE	0	;Flag 0, indicates not COMPILE class command
NOCLNF:	.BYTE	0	;Flag to stop CSI line generation (NOT USED ANYMORE)
EXEDEL:	.BYTE	0	;Delimiter used in building LINK string
DEFDEV:	.ASCIZ	"DK:"	;Default device, (must be 4 bytes), modifiable

;+
; *** End Order ***
;-

..CDEV	==: < . > ;**PATCH** .ASCIZ "DK:" Default Dev. for most cmd expansions
$DK:	.ASCIZ	"DK:"	;Initial default device
$SY:	.ASCIZ	"SY:"	;Default device for BOOT command
$.SYS:	.ASCII	".SYS"	;Default extension of SYS
$.LST:	.ASCII	".LST"	;Default extension of LST
$.BOT:	.ASCII	".BOT"	;Default filetype of BOT

;+
; NOTE: The 'FOR' extension has been removed from the following list
;	in order to allow the CEOLSEQ to determine the default FORTRAN
;	compiler to use if a 'MAC' or 'DBL' file isn't found.
;-
$COMPSTR:TYPDEF	MAC,MACRO,DBL,DICOMP

SAVNM:			;Pointer to start of dummy file spec slot
SAVDV1:	.WORD	0	;Slot for device name in ASCII
SAVDV2:	.WORD	0	;Both words
SAVNM1:	.WORD	0	;Dummy filespec save area for 1st in list
SAVNM2:	.WORD	0	;(e.g. LINK A,B,C gets the A saved) for
SAVNM3:	.WORD	0	;Default file generation
SAVEX1:	.WORD	0	;Space for ASCII extension
SAVEX2:	.WORD	0	;(Used for filetype lookups)
SAVNEN:	.WORD	0	;End pointer, must be contiguous and 0
;+
; File Spec Table
;	Entries are same for input and output
;	.BLKB 4		;ASCII device name and ':'
;	.BLKB 6		;ASCII filename
;	.BLKB 4		;ASCII extension preceded by '.'
;	.BLKB 7		;For output optional [nnnnn] or 0's
;			;For input 0's
;	.BYTE -1 OR -2	;End of IN spec or OUT spec indicator
;-

FSIZ	=: 22.		;Total entry size
FNMFLD	=: 4.		;Offset to filename field
FTPFLD	=: 10.		;Offset to filetype field
FSZFLD	=: 14.		;Offset to optional size field
STFLG	=: 21.		;Spec type flag

FILST:	.BLKB	< 9. * FSIZ >	;Allow for 9 regular type entries

DTYP	=: -5		;Default spec for output
FOTYP	=: -4		;First output spec in CSI line
SOTYP	=: -3		;Second output spec in CSI line
TOTYP	=: -2		;Third output spec in CSI line
ITYP	=: -1		;Input file spec indicator

OTBLK:			;Output type block used for ordering
			;And processing of output specs for CSI lines
TOTDV1:	.WORD	0	;Third spec device for /SYMBOLTABLE:DEV:
TOTDV2:	.WORD	0	;On LINK command
TOTFLG:	.BYTE	0	;Third spec default file generation
TOTFL2:	.BYTE	0	;Used to error check multiple /SYMBOLTABLE
	.WORD	TOTYP	;Indicate third output type
SOTDV1:	.WORD	0	;Second spec device for default device on
SOTDV2:	.WORD	0	;/LIST:DEV: or /MAP:DEV:
SOTFLG:	.BYTE	0	;Second spec default file generation
SOTFL2:	.BYTE	0	;Used to error check multiple /LIST's or /MAP's
	.WORD	SOTYP	;Indicate second output spec type
FOTDV1:	.WORD	0	;First spec device for /OBJ:DEV: or
FOTDV2:	.WORD	0	;/EXE:DEV:
FOTFLG:	.BYTE	0	;First spec default file generation
FOTFL2:	.BYTE	0	;Used to error check multiple /OBJ's or /EXE's
	.WORD	FOTYP

;+
; Following are offsets to the above data structure used by the action
; routines : ACTFOT,ACTSOT,ACTTOT,MAKOFL
;-

OFBDV1	=: 0		;First default device word
OFBDV2	=: 2		;Second default device word
OFBFLG	=: 4		;Default file generation flag
OFBFL2	=: 5		;Multiple spec flag
OFBTYP	=: 6		;File positional indicator
OFBSIZ	=: 10		;Size of the block

INPFN:	.BLKW	4	;DEV:FILENAME.EXT block (RAD50)
;+
; CMDREC factoring needs KMCBUF size temporary area here
; FILST+TRANSW+STRANT is enough if contiguous.
;-

;+
; Translated Switch Table
;	.BYTE	;Offset into switch translation table for ASCII
;	.BYTE	;File spec switch occurred on, 0 means command level
;-

TRANSW:	.BLKW	12.		;Area for translated switches
MAXSWT	=: < . - TRANSW > / 2	;Number of switches room for in table

.IF NE MUT$EX
MECLST:	.BLKB	60		;List area for mutual exclusion checking
.ENDC ;NE MUT$EX
TMPAREA:.BLKB	16.		;Temporary area for FILETYP routine (on sp??)

STRANT:	.BLKB	50.		;Room for the translated switch text
MAXDSC	=: < . - STRANT >	;Maximum offset into table allowed

.IF NE MUT$EX
MEXLST:	.BYTE	XX,YY,ZZ,...	;Coded values indicating exclusions
.ENDC ;NE MUT$EX
	BACKWT	$TTSPC,<TT:>
	BACKWT	$LPSPC,<LP:>
	BACKWT	$DKSPC,<DK:>
	BACKWT	$LPWLD,<LP:*.*>
	BACKWT	DUMYNM,<ODT>

$FROM:	PTXT	<From>
$TO:	PTXT	<To  >
$JOB:	PTXT	<Jobname>
$FILEE:	PTXT	<File>
$FILE:	PTXT	<Files>
$DEVICE:PTXT	<Device>
$DVOFL:	PTXT	<Device or file>
$FILE1:	PTXT	<File 1>
$FILE2:	PTXT	<File 2>
$LIBR:	PTXT	<Library>
$PHYSIC:PTXT	<Device  name>
$LOGICA:PTXT	<Logical name>
	.EVEN
.SBTTL	ALP/NUM	- DCL Support Routines

;+
; ALPHT - Test to see if CHAR is ALPHABETIC
;
;	R5-> last char
;
;	CALL	ALPHT
;
;	R5-> at character
;	C=0 if NOT alphabetic
;	C=1 if alphabetic
;-

;+
; ALPHNT - Test to see if CHAR is ALPHANUMERIC
;
;	R5-> Last char
;
;	CALL	ALPHNT
;
;	R5-> at character
;	C=0 if NOT alphanumeric
;	C=1 if alphanumeric
;-

;+
; NUMBT - Test to see if CHAR is DIGIT
;
;	R5-> last char
;
;	CALL	NUMBT
;
;	R5-> at character
;	C=0 if NOT numeric
;	C=1 if numeric
;-
	.ENABL	LSB

ALPHT:	CMPB	#<'A>,-(R5)	;Is it < A?
	BHI	10$		;Branch if so with C=0
	CMPB	@R5,#<<'Z>+1>	;Is it <= Z?
	BLO	10$		;Branch if so with C=1
	CMPB	#<'a>,@R5	;Is it < a?
	BHI	10$		;Branch if so with C=0
	CMPB	@R5,#<<'z>+1>	;Is it <= z?  If so, C=1
10$:	RETURN			;Return with C set correctly
	............

ALPHNT:	CALL	ALPHT		;Is it alphabetic?
	BCS	10$		;Yes
	INC	R5		;Reset R5 for NUMBT, fall in
NUMBT:	CMPB	#<'0>,-(R5)	;Check next char against '0'
	BHI	20$		;No digit, return C=0
	CMPB	@R5,#<'9+1>	;Check against 9, set C if in range
20$:	RETURN			;Return with C set correctly
	............

	.DSABL	LSB
.SBTTL	COMDST	- DCL Command List

;+
; This Macro generates the encoded text table for KMON commands
;-

.MACRO	FLGTXT	TXTARG
	.DSABL	CRF
$TEMP	= 100
$TEMP2	= 1
  .IRPC CHAR,<TXTARG>
    .IF IDN CHAR,_
$TEMP	= 0
    .IFF
      .IF EQ $TEMP2
	.BYTE	< $TEMP1 + $TEMP >
      .ENDC
$TEMP1	= < ''CHAR & 77 >
$TEMP2	= 0
    .ENDC
  .ENDR
$TEMP	= 0
	.BYTE	< $TEMP1 + 200 >
	.ENABL	CRF
.ENDM	FLGTXT


COMDST:
	CMDTBL	R
	CMDTBL	RUN
.IF NE MMG$T
	CMDTBL	V
	CMDTBL	VRUN
.ENDC ;NE MMG$T
	CMDTBL	E
	CMDTBL	D
	CMDTBL	B
	CMDTBL	COPY
	CMDTBL	DATE
	CMDTBL	EDIT
	CMDTBL	DIRECTORY
	CMDTBL	TYPE
	CMDTBL	DELETE
	CMDTBL	PROTECT
	CMDTBL	UNPROTECT
	CMDTBL	TIME
	CMDTBL	GT
	CMDTBL	LINK
	CMDTBL	PRINT
	CMDTBL	EXECUTE
	CMDTBL	REENTER
	CMDTBL	COMPILE
	CMDTBL	RESET
	CMDTBL	LOAD
	CMDTBL	CLOSE
	CMDTBL	BOOT
	CMDTBL	START
	CMDTBL	ASSIGN
	CMDTBL	RENAME
	CMDTBL	SET
	CMDTBL	SQUEEZE
	CMDTBL	UNLOAD
	CMDTBL	GET
	CMDTBL	DEASSIGN
	CMDTBL	FORTRAN
	CMDTBL	MACRO
	CMDTBL	HELP
	CMDTBL	DIBOL
	CMDTBL	FRUN
	CMDTBL	RESUME
	CMDTBL	SUSPEND
	CMDTBL	SAVE
	CMDTBL	SHOW
	CMDTBL	INITIALIZE
	CMDTBL	DIFFERENCES
	CMDTBL	DUMP
	CMDTBL	INSTALL
	CMDTBL	REMOVE
	CMDTBL	LIBRARY
	CMDTBL	SRUN
	CMDTBL	ABORT
	CMDTBL	CREATE
	CMDTBL	FORMAT
	CMDTBL	BACKUP
	CMDTBL	MOUNT
	CMDTBL	DISMOUNT
	CMDTBL	TECO
	CMDTBL	MAKE
	CMDTBL	MUNG
.IF NE SUBM$$
	CMDTBL	SUBMIT
.ENDC ;NE SUBM$$
	............
;+
; Text Table for Keyboard Commands
;-
; COMLS2 is a hack to allow R and RUN to be executed when DCL is 
; disabled. The commands in COMLS2 must be in the same order as 
; in COMLST, since the index in both tables must lead to the correct 
; routine in COMDST.

COMLS2:				; Table of commands executed if DCL.ON=0
	FLGTXT	<R>
	FLGTXT	<RU_N>
	.BYTE	0		; End of Command List
	.EVEN
	............

COMLST:
	FLGTXT	<R>
	FLGTXT	<RU_N>
.IF NE MMG$T
	FLGTXT	<V>
	FLGTXT	<VRU_N>
.ENDC ;NE MMG$T
	FLGTXT	<E>
	FLGTXT	<D>
	FLGTXT	<B>
	FLGTXT	<COP_Y>
	FLGTXT	<DA_TE>
	FLGTXT	<ED_IT>
	FLGTXT	<DIR_ECTORY>
	FLGTXT	<TY_PE>
	FLGTXT	<DEL_ETE>
	FLGTXT	<PRO_TECT>
	FLGTXT	<UNP_ROTECT>
	FLGTXT	<TI_ME>
	FLGTXT	<GT_>
	FLGTXT	<LIN_K>
	FLGTXT	<PRI_NT>
	FLGTXT	<EX_ECUTE>
	FLGTXT	<REE_NTER>
	FLGTXT	<COM_PILE>
	FLGTXT	<RESE_T>
	FLGTXT	<LO_AD>
	FLGTXT	<CL_OSE>
	FLGTXT	<BO_OT>
	FLGTXT	<ST_ART>
	FLGTXT	<AS_SIGN>
	FLGTXT	<REN_AME>
	FLGTXT	<SE_T>
	FLGTXT	<SQ_UEEZE>
	FLGTXT	<UNL_OAD>
	FLGTXT	<GE_T>
	FLGTXT	<DEA_SSIGN>
	FLGTXT	<FORT_RAN>
	FLGTXT	<MAC_RO>
	FLGTXT	<H_ELP>
	FLGTXT	<DIB_OL>
	FLGTXT	<FR_UN>
	FLGTXT	<RESU_ME>
	FLGTXT	<SUS_PEND>
	FLGTXT	<SA_VE>
	FLGTXT	<SH_OW>
	FLGTXT	<INI_TIALIZE>
	FLGTXT	<DIF_FERENCES>
	FLGTXT	<DU_MP>
	FLGTXT	<INS_TALL>
	FLGTXT	<REM_OVE>
	FLGTXT	<LIB_RARY>
	FLGTXT	<SR_UN>
	FLGTXT	<AB_ORT>
	FLGTXT	<CR_EATE>
	FLGTXT	<FORM_AT>
	FLGTXT	<BAC_KUP>
	FLGTXT	<MO_UNT>
	FLGTXT	<DIS_MOUNT>
	FLGTXT	<TE_CO>
	FLGTXT	<MAK_E>
	FLGTXT	<MU_NG>
.IF NE SUBM$$
	FLGTXT	<SUB_MIT>
.ENDC ;NE SUBM$$
	.BYTE	0			;End of Command List
	.EVEN
	............
.SBTTL		- KMON Stack, Storage, And Space For Resident Overlay

;+
; *** Keep Next Two Together ***
;-

CMDFLG:	.BYTE	0		;Flag=-1 if DCL not called yet
ATFLAG:	.BYTE	0		;Flag =0 if doing @File expand call to DCLSPC
.IIF EQ LNK$IF,	.NLIST
.IF NE LNK$IF
OLDLIN:	.WORD	0		;Ptr to cmd line saved in KMCBUF in LINK
				;  Overlay @File processing
KBFLN:	.WORD	0		;Adjusted length of KMCBUF during LINK
				;  Overlay @File processing
.ENDC ;NE LNK$IF
.IIF EQ LNK$IF,	.LIST

.IIF NDF IFBFSZ, IFBFSZ =: 1	;# of blocks in @File buffer
SVSTSZ	=:	10.		;# of bytes for SAVSTATUS
IFSVSZ	=:	< 6 + SVSTSZ >	;# of bytes to store @File status

.IIF NDF KMCBFLN, KMCBFLN =: 200. ;KMON Command Buffer Length
	.WORD	0		  ;Protection for line overflow
KMCBND:	.BLKB	KMCBFLN		  ;(Chars go BACKWARDS)
KMCBUF:	......			  ;KMON Command Buffer
	.WORD	<' >		  ;Used as stopper by factoring
	.ASCII	"S"
	.EVEN

OVLIOB:	.WORD	< OVLY - KMON > / BK.BYT ;Rel block number now in mem
	.WORD	0			 ;Area to read into
	.WORD	< BK.WD * OVLYSZ >	 ;Read one or two blocks
	.WORD	0			 ;Wait I/O

BASE:	.WORD	0
GETCNT:	.WORD	0
SAVSWT:	.WORD	0
BLOKWG:	.WORD	-1		;# of current SWAP block in USR Buffer
SYSIOB:	BSS	3		;Block for system I/O
OLDHAN:	.BLKW	1		;Old handler name (used by GET)
BLOCK:	.BLKW	8.		;Used for SAVE STATUS and F.D. block

..INDN	==: < . >	;**PATCH** .RAD50 "SY " SET KMON IND
NMIND:	.RAD50	/SY /		;Force RUN of IND

;+
; Following is the ASCIZ command string to pass when running IND from KMON.
; The three bytes (BLKB 3) contain the device and unit number of where IND
; must be run from.  This is filled in at STRTP when it has been determined
; that KMON is executing a command within a control file.  The name and unit
; are taken from INDDEV (RMON fixed offset) stored there (in RAD50) by IND
; during initialization.
;-
	.ENABL	LSB

INDCNT::.WORD	< 20$ - 10$ >	;String count for IND chain
10$:	.ASCII	"RUN "		;String to pass to chain
INDDVU:	.BLKB	3		;Device name and unit number
	.ASCIZ	":IND"		;
20$:	.EVEN			;End of string

	.DSABL	LSB

	.ENABL	LSB

.IF NE CONT$N		;***********KEEP TOGETHER*******
KCTNU:
CTNUFG:	.WORD	0		;Flag: non 0 if doing continue @File
CTNUIF:	.WORD	< 20$ - 10$ >	;Byte count for KMON line
10$:	.ASCII	"@CONT"
	.BYTE	SUFX$S		;Suffix of the file name
	.BYTE	SUFX$T
20$:	.EVEN
.ENDC ;NE CONT$N	;***********KEEP TOGETHER*********

	.DSABL	LSB

KMSTK::	.BLKW	60.		;Minimum size of KMON stack
KMSTKE::			;For use in error msg
				;Round KMON to a block for overlay area
. = KMON + < < < . - KMON + BD.BLK > / BK.BYT > * BK.BYT >
KMSTAK::			;KMSTAK includes block rounding
. = KMSTK			;Origin over stack to put in pattern
	.REPT	< KMSTAK - KMSTK > / 2
	 .WORD	52525
	.ENDR
				;***********KEEP TOGETHER*********
OVLY:	.BLKW	< BK.WD * OVLYSZ > ;Area for overlays
IFBUFR	=: < OVLY + BK.BYT >	;Block buffer for Indirect Files

KMONSZ	==: < . - KMON > / BK.BYT ;Size of KMON in Blocks
KMSIZE	==: < KMONSZ * BK.BYT >	;Size of KMON in Bytes
KMLEN	==: < KMONSZ * BK.WD >	;Size of KMON in Words

.IF EQ <MMG$T!SYT$K>		;If not XB/XM AND no System Jobs
 .IF GT <KMONSZ-21>
 KMSZER	=: < < BK.BYT * OVLYSZ > + KMSTKE - KMON - < 21 * BK.BYT > > / 2
	.ERROR	KMSZER	;KMON > 21 Blocks by this many octal words
 .ENDC ;GT <KMONSZ-21>
;>>> Remove the following????
;;; .IF GT <KMONSZ-20>
;;; KMSZER	=: < < BK.BYT * OVLYSZ > + KMSTKE - KMON - 20000 > / 2
;;;	.ERROR	KMSZER	;KMON > 20000 by this many octal words
;;; .ENDC ;GT <KMONSZ-20>
.ENDC ;EQ <MMG$T!SYT$K>
. = OVLY			;Put the following code into the overlay
OVLYST	= .

.MACRO	OVCMD	CMD
N.'CMD	= 1
O.'CMD	= < . - OVLYST >
CMD:
.ENDM	OVCMD

.IF NE DIRE$$

	OVCMD	DIRECTORY

	CALLR	DIR1
	............

.ENDC ;NE DIRE$$

.IF NE COPY$$

.SBTTL	COPY Command

	SYNTAX	COPY

	PROMPT	$FROM
	SCALL	GSWIT,<1>
	REQBLNK
	DEFILE	FSTARF+ESTARF
	SCALL	SPISPC,<1,2,4>
	FLDBEG	OFLD1
	SCALL	CSPISPC,<1,2,4>
	OPTEND
	FLDBEG
	SCALL	CSPISPC,<1,2,4>
	ITEREND
	GOTO	OFLD2
	............

OFLD1:	FLDBEG
	REQPLUS
	SCALL	SPISPC,<1,2,4>
	SETDEF	CON
	ITEREND
OFLD2:	PROMPT	$TO
	SCALL	SPOSPC,<1,2,3>
	EOLSEQ	PIP
	WILDEF	PIP,W,ASK,NLG,AYS,AYS,$WILD0
	COMPDEF
;	APLYDEF	PIP,LOG,W	Take out unnecessary conditional.  Max is 6. JMP
	APLYDEF	PIP,ASK,Q
	APLYDEF	PIP,CON,U
	APLYDEF	DUP,AYS,Y
	APLYDEF	FILEX,ASK,Q
	APLYDEF	DUP,IGN,J
	APLYDEF	PIP,IGN,G
	APLYDEF	FILEX,IGN,G
	APLYDEF	DUP,WAI,W
	APLYDEF	PIP,WAI,E
	APLYDEF	FILEX,WAI,W
	END
	............
	

 SWITS	COPY
	SWIT	QUERY		1	-	-	- ASK
	SWIT	LOG		1	PIP	-	W
	SWIT	REPLACE		1	-	-	-
	SWIT	PROTECTION	1	-	-	F
 ENDNO
	SWIT	CONCATENATE	1	PIP	-	- CON
	SWIT	PREDELETE	1	PIP	-	O
	SWIT	DELETED		1	PIP	-	D
	SWIT	IGNORE		1	-	-	- IGN
	SWIT	ASCII		1	-	-	A
	SWIT	BINARY		1	-	-	B
	SWIT	IMAGE		1	-	-	IMA
	SWIT	PACKED		1	FILEX	-	P
	SWIT	POSITION	2	PIP	-	M,,DVAL
	SWIT	EXCLUDE		1	PIP	-	P
	SWIT	SLOWLY		1	PIP	-	S
	SWIT	NEWFILES	1	PIP	-	C
	SWIT	BEFORE		1	PIP	-	J,,DVAL
	SWIT	DATE		1	PIP	-	C,,DVAL
	SWIT	SINCE		1	PIP	-	I,,DVAL
	SWIT	SETDATE		1	PIP	-	T,,DVAL
	SWIT	SYSTEM		1	PIP	-	Y
	SWIT	INFORMATION	1	PIP	-	X
	SWIT	MULTIVOLUME	1	PIP	-	V
	SWIT	BOOT		1	-	DUP	U,,VAL
	SWIT	DEVICE		1	-	DUP	I
	SWIT	VERIFY		1	-	-	H
	SWIT	OWNER		2	FILEX	-	OWN
	SWIT	FILES		1	DUP	-	F
	SWIT	WAIT		1	-	-	- WAI
	SWIT	DOS		2	-	FILEX	S
	SWIT	TOPS		2	-	FILEX	T
	SWIT	INTERCHANGE	2	-	FILEX	U,,DVAL
	SWIT	START		2	DUP	-	G,,DVAL
	SWIT	ALLOCATE	3	-	-	ALL
	SWIT	END		4	DUP	-	E,,DVAL
 NOS
	SWIT	NOQUERY		1	-	-	- AYS
	SWIT	NOLOG		1	-	-	- NLG
	SWIT	NOREPLACE	1	PIP	-	N
	SWIT	NOPROTECTION	1	PIP	-	Z
 ENDS				;Switch ID lists for COPY
............


	.ENABL	LSB

	OVCMD	COPY

	CLR	(PC)+		;Initialize IMAGE flag
IMAFLG:	 .WORD	0		;= denotes no /IMAGE switch processed
				;<> DENOTES /IMAGE option processed (will be
				;the count in which it was stored in table
	ITBLE	7		;Set maximum number of file specs
	CALL	INITIT		;Do the parse
	MOV	FORCEP,R0	;Get program to run
	BIC	#^c<CUSP$M>,R0	;Isolate cusp number
	CMP	#<$$PIP>,R0	;PIP operation?
	BNE	10$		;Branch if no
	MOV	IMAFLG,R0	;Get flag value (<> denotes switch number)
	BEQ	10$		;Branch if NO
	.ADDR	#<TRANSW-1>,R1	;Point at the switch table
	ADD	R0,R1		;Point to the /Image switch
	MOVB	(R1)+,R2	;Get offset into the ASCII table
	.ADDR	#<STRANT>,R2,ADD ;Make that an absolute address
	TSTB	(R2)+		;Point one beyond
	CALL	REMSWT		;Remove switch from list
10$:	CALLR	CMDEXE		;Generate the command text and execute it
	............

	.DSABL	LSB

.ENDC ;NE COPY$$
.IF NE DIRE$$

.SBTTL	DIRECTORY Command

	SYNTAX	DIRECTORY

	DEFILE	ESTARF+FSTARF
	SCALL	GSWIT,<1>
	FLDBEG	OFLD3
	REQBLNK
	SCALL	SPISPC,<1,2>
	OPTEND
	FLDBEG	OFLD4
	SCALL	CSPISPC,<1,2>
	ITEREND
OFLD3:	SETISPC	$DKSPC
OFLD4:	DEFOSPC	$TTSPC
	EOLSEQ	DIR
	APLYDEF	FILEX,FST,L
	COMPDEF
	APLYDEF	DIR,FST,F
	APLYDEF	FILEX,FST,F
	END
	............


 SWITS	DIRECTORY
	SWIT	PROTECTION	1	DIR	-	T
 ENDNO
	SWIT	BLOCKS		1	DIR	-	B
	SWIT	POSITION	1	DIR	-	B
	SWIT	BRIEF		1	-	-	- FST
	SWIT	FAST		1	-	-	- FST
	SWIT	FULL		1	DIR	-	E
	SWIT	PRINTER		1	-	-	PRI
	SWIT	TERMINAL	1	-	-	TER
	SWIT	OUTPUT		1	-	-	OUT
	SWIT	SUMMARY		1	DIR	-	N
	SWIT	COLUMNS		1	DIR	-	C,,DVAL
	SWIT	ORDER		1	DIR	-	S,,VAL
	SWIT	SORT		1	DIR	-	S,,VAL
	SWIT	EXCLUDE		1	DIR	-	P
	SWIT	ALPHABETIZE	1	DIR	-	A
	SWIT	OCTAL		1	DIR	-	O
	SWIT	NEWFILES	1	DIR	-	D
	SWIT	DATE		1	DIR	-	D,,DVAL
	SWIT	SINCE		1	DIR	-	J,,DVAL
	SWIT	BEFORE		1	DIR	-	K,,DVAL
	SWIT	FREE		1	DIR	-	M
	SWIT	INTERCHANGE	1	-	FILEX	U
	SWIT	DOS		1	-	FILEX	S
	SWIT	TOPS		1	-	FILEX	T
	SWIT	OWNER		2	FILEX	-	OWN
	SWIT	BADBLOCKS	1	-	DUP	K
	SWIT	FILES		1	DUP	-	F
	SWIT	WAIT		1	-	-	W
	SWIT	START		1	DUP	-	G,,DVAL
	SWIT	END		1	DUP	-	E,,DVAL
	SWIT	VOLUMEID	1	-	-	V,,VAL
	SWIT	DELETED		1	DIR	-	Q
	SWIT	REVERSE		1	DIR	-	R
	SWIT	BEGIN		1	DIR	-	G
	SWIT	ALLOCATE	1	-	-	ALL
;>>> Remove the following?????
;;;	SWIT	BACKUP		1	-	BUP	L
 NOS
	SWIT	NOPROTECTION	1	DIR	-	U
 ENDS
............


	.ENABL	LSB

DIR1:	ITBLE	8.		;Set maximum number of file specs
	CALL	INITIT		;Do the parse
	MOV	FORCEP,R0	;Get program to run
	BIC	#^c<CUSP$M>,R0	;Isolate cusp number
	CMP	#<$$DIR>,R0	;Directory operation
	BNE	20$		;Branch if no
	MOV	#<'W>,R3	;Look for /WAIT switch
	CLR	R0		;Keep track of the switches
	.ADDR	#<TRANSW-1>,R1	;Point at the switch table
10$:	TSTB	(R1)+		;Point at 1st byte of the next entry
	INC	R0		;Keep track of the switches in table
	CMPB	R0,NSWITS	;Have we exhausted the table
	BGT	20$		;Yes, go process command
	MOVB	(R1)+,R2	;Get offset into the ASCII table
	.ADDR	#<STRANT>,R2,ADD ;Make that an absolute address
	CMPB	@R2,R3		;Is this the switch?
	BNE	10$		;Keep looking
	CALLR	ILLOPT		;Invalid option for program
	............

20$:	CALLR	CMDEXE		;Generate the command text and do it
	............

	.DSABL	LSB

.ENDC ;NE DIRE$$
.IF NE DIRE$$!COPY$$
;+
; Action routine for FILEX /OWNER switch
;-
	.ENABL	LSB

OVAOWN:	CMPB	#<':>,@R5	;Is there a value?
	BNE	20$		;No, error, value is required
	CMPB	#<'[>,-(R5)	;Does it look like a UIC?
	BNE	20$		;No, error
	MOVB	DSWOFF,EXTXT	;Save relative pointer to add text
10$:	MOVB	@R5,R2		;Get char to be moved
	BEQ	20$		;Invalid if hit end of line before ']'
	CALL	PCDT		;Save the char for later
	DEC	R5		;Point R5 to next char
	CMPB	#<']>,R2	;Was this end of UIC code?
	BNE	10$		;Loop until ']' found
	CALLR	EPCDTR		;Return flagging end of insert text
	............

20$:	CALLR	ILVALU		;Issue invalid value error
	............

	.DSABL	LSB

OVAIMA:	MOVB	NSWITS,IMAFLG	;Get number of switches currently processed
	INC	IMAFLG		;Update by one to be like NSWIT after /I store
	MOVB	#<'I>,R2	;Set up to force RT-11 /I switch
	CLR	R1		;Some flag setting for routine to call
	CLR	R3		;Some more
	CALLR	ESWIT		;Call routine to insert switch
	............

.ENDC ;NE DIRE$$!COPY$$
.IF NE DIRE$$!COPY$$
;+
; Option Text for Resident Overlay (COPY,DIRECTORY)
;-
	.IRP	NUM,<\$OPTX>
OPTX'NUM::
	.ENDR
	.BYTE	-1
	.DSABL	CRF
	$SCNT=0
	SWTDEF	<LOG>
	FLGTXT		<L_OG>
	SWTDEF	<QUERY>
	FLGTXT		<Q_UERY>
	SWTDEF	<REPLACE>
	FLGTXT		<REP_LACE>
	SWTDEF	<PROTECTION>
	FLGTXT		<PRO_TECTION>
	SWTDEF	<CONCATENATE>
	FLGTXT		<C_ONCATENATE>
	SWTDEF	<PREDELETE>
	FLGTXT		<PRE_DELETE>
	SWTDEF	<DELETED>
	FLGTXT		<DEL_ETED>
	SWTDEF	<IGNORE>
	FLGTXT		<IG_NORE>
	SWTDEF	<ASCII>
	FLGTXT		<AS_CII>
	SWTDEF	<BINARY>
	FLGTXT		<BI_NARY>
	SWTDEF	<IMAGE>
	FLGTXT		<IM_AGE>
	SWTDEF	<PACKED>
	FLGTXT		<PA_CKED>
	SWTDEF	<POSITION>
	FLGTXT		<PO_SITION>
	SWTDEF	<EXCLUDE>
	FLGTXT		<EX_CLUDE>
	SWTDEF	<SLOWLY>
	FLGTXT		<SL_OWLY>
	SWTDEF	<NEWFILES>
	FLGTXT		<NE_WFILES>
	SWTDEF	<BEFORE>
	FLGTXT		<BEF_ORE>
	SWTDEF	<DATE>
	FLGTXT		<DA_TE>
	SWTDEF	<SINCE>
	FLGTXT		<SI_NCE>
	SWTDEF	<SETDATE>
	FLGTXT		<SET_DATE>
	SWTDEF	<SYSTEM>
	FLGTXT		<SY_STEM>
	SWTDEF	<INFORMATION>
	FLGTXT		<INF_ORMATION>
	SWTDEF	<MULTIVOLUME>
	FLGTXT		<M_ULTIVOLUME>
	SWTDEF	<BOOT>
	FLGTXT		<BO_OT>
	SWTDEF	<DEVICE>
	FLGTXT		<DEV_ICE>
	SWTDEF	<VERIFY>
	FLGTXT		<VE_RIFY>
	SWTDEF	<OWNER>
	FLGTXT		<OW_NER>
	SWTDEF	<FILES>
	FLGTXT		<FI_LES>
	SWTDEF	<WAIT>
	FLGTXT		<W_AIT>
	SWTDEF	<DOS>
	FLGTXT		<DO_S>
	SWTDEF	<TOPS>
	FLGTXT		<TO_PS>
	SWTDEF	<INTERCHANGE>
	FLGTXT		<INT_ERCHANGE>
	SWTDEF	<START>
	FLGTXT		<ST_ART>
	SWTDEF	<ALLOCATE>
	FLGTXT		<ALL_OCATE>
	SWTDEF	<END>
	FLGTXT		<EN_D>
	SWTDEF	<BLOCKS>
	FLGTXT		<BL_OCKS>
	SWTDEF	<BRIEF>
	FLGTXT		<BR_IEF>
	SWTDEF	<FAST>
	FLGTXT		<FA_ST>
	SWTDEF	<FULL>
	FLGTXT		<FU_LL>
	SWTDEF	<PRINTER>
	FLGTXT		<PRI_NTER>
	SWTDEF	<TERMINAL>
	FLGTXT		<TE_RMINAL>
	SWTDEF	<OUTPUT>
	FLGTXT		<OU_TPUT>
	SWTDEF	<SUMMARY>
	FLGTXT		<SU_MMARY>
	SWTDEF	<COLUMNS>
	FLGTXT		<C_OLUMNS>
	SWTDEF	<ORDER>
	FLGTXT		<OR_DER>
	SWTDEF	<SORT>
	FLGTXT		<SO_RT>
	SWTDEF	<ALPHABETIZE>
	FLGTXT		<ALP_HABETIZE>
	SWTDEF	<OCTAL>
	FLGTXT		<OC_TAL>
	SWTDEF	<FREE>
	FLGTXT		<FR_EE>
	SWTDEF	<BADBLOCKS>
	FLGTXT		<BAD_BLOCKS>
	SWTDEF	<VOLUMEID>
	FLGTXT		<VO_LUMEID>
	SWTDEF	<REVERSE>
	FLGTXT		<REV_ERSE>
	SWTDEF	<BEGIN>
	FLGTXT		<BEG_IN>
;>>> Remove the following?????
;;;	SWTDEF	<BACKUP>
;;;	FLGTXT		<BAC_KUP>
	.EVEN
	.ENABL	CRF
	NEXTL
	............
.ENDC ;NE DIRE$$!COPY$$

.ASSUME < . - KMON > LE KMSIZE, MESSAGE=<Resident Overlay Too Big>

OVSZRS	==: < . - OVLYST >	;Global=Size of res. overlay

. = < KMON + KMSIZE >		;Put us at the block boundary for USR

.IIF DF	NLKMON,	.LIST