/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/4	CCL'S COMMAND DECODER
	.EXTERNAL TABLES,FNAME1
	.EXTERNAL SWTCHS
	.ENTRY GETSPC
/THE FOLLOWING DON'T HAVE TO BE ENTRY'S BECAUSE THEY ARE LINKED TO
/FROM THE EXTENSION MODULE (CCLCDX) THAT KNOWS CCLCD IS IN MEMORY
	.GLOBAL LV
	.EXTERNAL EQLPRM,POUND,DNUMB
	MULTI=1		/SET TO 0 TO GET RID OF MULTIPLE CHARACTER SWITCHES
	PTR=36
	.GLOBAL BADEV,CDER2,DVICE	/******
	.GLOBAL ASADR,LNAME		/*****
	.ENTRY CCER1
	.RSECT CCLCD
	.GLOBAL UNKN
	.EXTERNAL FLAG,MOVE,PRMESG
	.EXTERNAL PRNAME,PRWD
	.EXTERNAL LBEGIN,DECODE
	.EXTERNAL ARLOC
	.EXTERNAL DEFILE
	.ENTRY CD,ASSIGN,LOOKUP,ZEROCD,GLXR
	.EXTERNAL OUTSW,OUTLIM
	.ENTRY GCH,SETDEV,SETEXT
	.ENTRY NMOVE
	.EXTERNAL DONB
	.EXTERNAL NAMPTR
	FIELD 1
	MOFILE=7600
	MIFILE=7617
	MPARAM=7643

	XR2=15
	XR=16
	T=20
	TT=21
	DEF=22
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	NAME5=27
	NMBASE=37
	DEV1=30
	DEV2=31
	DELIM=32
	DEFALT=33	/POINTS TO DEFAULT EXTENSION LIST
	LXR=34
	CLXR=35
	BEGLN=1000
	HNDLR=4400
CD,	0
	JMS I (CDINIT
BEGGRP,	TAD I (OUTSW
	SNA CLA
	TAD I (BEGDIF	/DIFF BETWEEN INPUT & OUTPUT AREAS
	TAD (MOFILE-1
	DCA CLXR
	JMS I (GETSPC	/FAKE-OUT TO GETSPC CAN CAUSE EFFECTIVE BRANCH HERE
	JMS I (ASSIGN
	TAD I (OUTSW
	SNA CLA
	TAD I (LIMDIF	/DIFF BETWEEN END OF OUTPUT & INPUT AREAS
	TAD I (OUTLIM	/END OF OUTPUT AREA
	TAD CLXR
	SMA CLA
	JMP I (CDER1
	TAD I (OUTSW
	SNA CLA
LKUPSW,	JMP IN$		/ZEROED IF IN "SPECIAL DECODE" MODE
	TAD I (DVICE
	JMS PCLXR
	TAD NAME1
	JMS PCLXR
	TAD NAME2
	JMS PCLXR
	TAD NAME3
	JMS PCLXR
	TAD NAME4
	JMP 2$
IN$:	JMS I (LOOKUP
	JMS PCLXR	/STORE LENGTH AND DEV NUMBER
	TAD I (LNAME	/GET BLOCK
2$:	JMS PCLXR
	JMS I (CCLSWT
	TAD I (OUTSW
	SNA CLA
	TAD I (FLAG
	CLL RTL
	SPA CLA		/FEATURE ENABLED?
	TAD LKUPSW
	SNA CLA
	JMP DLOOK	/IN SPECIAL MODE OR ON OUTPUT SIDE
	TAD DELIM
	TAD (-"+
	SNA CLA
	JMP NBS
	TAD DONB
	SZA CLA
	JMP NBS
	TAD (7600	/V1A NOW TAKES ARG IN AC
	JMS I (NMOVE	/MOVE NAME TO OUTPUT FILE NAMES
	JMP DLOOK
NBS,	JMS I (ZERR
DLOOK,	STA
	DCA I (DVFLAG
	TAD DELIM
	SNA
	JMP I CD
	TAD (-"[
	SNA
	JMP I (OLENGT
	TAD ("[-"+
	SZA
	TAD ("+-",
	SNA
	JMP I (FILLP	/**** JUMPING INTO ROUTINE (IS THIS A BUG?)
	TAD (",-"<
	SZA
	TAD ("<-"_
	SNA
	JMP 5$		/BACK-ARROW (UNDERSCORE) MEANS SAME AS "<"
	TAD ("_-"=
	SZA CLA		/SKIP ON AN EQUAL SIGN (=)
	JMP I (CDER2	/BAD CHAR
	JMS I (GLXR
	JMS I (DECODE
	CLL
	STA		/LINK=0 MEANS LETTER
	TAD LXR		/NOW LINK=1 MEANS LETTER
	DCA LXR
	SZL
	JMP 5$		/= MEANS "<"
	JMS I (EQLPRM	/= MEANS = (NUMERIC PARAMETER)
DL2:	JMS I (CCLSWT
	JMP DLOOK
5$:	ISZ I (OUTSW	/FOUND BACK-ARROW (<)
	JMP I (CDER2	/TWO BACK-ARROWS
	TAD LXR		/GET PTR TO ARROW
	DCA I (ARLOC	/SAVE IT ('EDIT' MIGHT NEED IT)
	JMP BEGGRP

PCLXR,	0
	ISZ CLXR
	DCA I CLXR
	JMP I PCLXR
	PAGE
ZERR,	0
	DCA I (DONB	/ZERO 1ST OUTPUT FILE
	TAD (7577
	DCA XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	JMP I ZERR
ASSIGN,	0
	TAD CLXR
	AND I (DVFLAG
	TAD I (OUTLIM
	SMA SZA CLA	/CHECK FOR OUTPUT OR FIRST INPUT
	JMP ASNORM	/IF DEVICE WAS SPECIFIC,
			/OR IF WE ARE ON THE INPUT SIDE,
			/PROCEED NORMALLY
	TAD NAME1
	SNA CLA
	JMP ASGNST
	TAD DFLTNM+1
	DCA DEV2
	TAD DFLTNM
	DCA DEV1
ASNORM,	TAD DEV1
	DCA AS+1
	TAD DEV2
	DCA AS+2
	TAD I (OUTSW
	SNA CLA		/DON'T LOAD HANDLER
			/IF WE ARE ON OUTPUT SIDE OF "_"
	TAD NAME1
SPKLG1,	SNA CLA		/OR THERE IS NO FILE NAME TO LOOK UP
	TAD GETHND	/GETHND=11 NORMALLY,
			/0 IF IN "SPECIAL DECODE" MODE
	IAC
	DCA AS
	TAD (HNDLR+1	/ALLOW TWO PAGE HANDLERS
	DCA ASADR
	CIF 10
	JMS I (200
AS,	0
	0
	0
ASADR,	HNDLR+1
	JMP I (CDER0
	TAD AS+2
ASGNST,	DCA I (DVICE
	JMP I ASSIGN
DFLTNM,	DEVICE DSK
GETHND,	11		/1+11=12 (1=FETCH, 12=INQUIRE)
GETL,	0
	JMS I (GCH
	DCA DELIM
	TAD DELIM
	JMS I (DECODE
	JMP I GETL	/NON-ALPHANUM IN CCL SWITCH
	CLA
	TAD DELIM
	AND (77
	ISZ GETL
	JMP I GETL
CCLSWT,	0
	TAD DELIM
	TAD (-"/
	SNA
	JMP I (SLASH
	TAD ("/-"-
	SZA CLA
	JMP I CCLSWT
	TAD I (OUTSW
	SZA CLA
	JMP I (CDER4	/CCL EXT ON OUTPUT FILE
	TAD (SWTCHS
	DCA DEF
	JMS GETL
	JMP I (CDER44	/NON-ALPHANUMERIC CCL SWITCH
	JMS I (ROTL
	DCA TN$
	JMS GETL
	JMP 1$		/ONE CHAR CCL SWITCH
	TAD TN$
	DCA TN$
	JMS GETL
1$:	SKP CLA		/2 CHAR CCL SWITCH
	JMP I (CDER44	/3 CHAR CCL-SWITCH
	TAD TN$
	JMS I (EXTLUK
	CLA
	ISZ DEF
	CDF 0
	TAD I DEF
	DCA G$		/GET PTR TO ARGUMENT PAIR
	TAD I G$	/GET SUBROUTINE
	DCA H$
	ISZ G$
	TAD I G$	/GET ARGUMENT
	CDF 10
	JMS I H$	/CALL SUBR, ARG IN AC
	JMP CCLSWT+1
G$:	0
H$:	0
TN$:	0
	PAGE
/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
/RETURNS WITH DELIMETER IN AC
/GIVES ERROR MESSAGE IF NAME IS BAD

GNAME,	0
	DCA NAME1
	DCA NAME2
	DCA NAME3
	DCA NAME4
	DCA NAME5
	TAD (NAME1
	DCA NMBASE
	CLA CMA
	DCA PERDSW
	DCA NAMECT
	JMS I (GCH
	TAD (-"#
	SNA
	JMS I (NUMC	/BUG IF MAKE COMMAND USES A # (OVERLAYS LOOP)
	TAD ("#
	SKP
GTNMLP,	JMS I (GCH
P2,	DCA DELIM
	TAD DELIM
	TAD (-"%
	SNA
	JMP PER
	TAD ("%-"?
	SZA
	TAD ("?-"*
	SNA
STARSW,	JMP I (CDER6	/"JMP STARNM"
			/IF "SPECIAL DECODE" MODE
	TAD ("*-".
	SNA CLA
	JMP PERIOD
	TAD DELIM
	JMS I (DECODE
	JMP LV
STARNM,	CLA		/THIS CODE HANDLES *'S AND ?'S CORRECTLY
	TAD DELIM
	AND (77
	DCA DELIM
	TAD NAMECT
	TAD (-6
	SMA CLA
	JMP GTNMLP
	TAD NAMECT
	CLL RAR
	TAD NMBASE
	DCA TT
	TAD DELIM
	SNL
	JMS I (ROTL
	TAD I TT
	DCA I TT
	ISZ NAMECT
	JMP GTNMLP
PERIOD,	TAD NAME1
	SZA CLA
	ISZ PERDSW
	JMP I (CDER7	/NULL NAME OR DOUBLE EXTENSION
	ISZ NMBASE
	ISZ NMBASE
	STL CLA RTL	/2 (ALLOW 4 CHARACTER EXTENSION)
	DCA NAMECT
	JMP GTNMLP
LV,	CLA
	TAD DELIM
	JMP I GNAME

PER,	TAD ("?
	JMP P2
PERDSW,	0
NAMECT,	0
	SOFSET=7747

CDER6,	CDF 0
	TAD I (7777
	CDF 10
	RAL
	SPA CLA
	JMP CD6E	/ERROR IF BATCH IS RUNNING
	TAD I (FLAG
	RTL
	SMA CLA
	JMP CD6E	/ONLY IF -LS WORKS
	TAD (-12
	JMS I (MOVE
	CDF 10
	MUNGC
	CDF 10
	7600
	TAD (-34
	JMS I (MOVE
	CDF 0
	1000
	CDF 10
	7612
	DCA I (7646	/SAFETY
	CDF 0
	TAD I (SOFSET
	CDF 10
	DCA BLK
	JMS I (200
	6		/CHAIN TO CCL.SV
BLK,	0


CD6E,	JMS I (PRMESG
	BADSTR

	PAGE
LOOKUP,	0
	DCA LNAME
	TAD NAME1
	SNA CLA
	JMP LKUPST
	TAD I (PERDSW
	TAD NAME4
	SNA CLA
	CLA IAC		/FORCE NAMERM NON-0 IF . AND NO EXT
	TAD NAME4
	DCA NAMERM	/REMEMBER TYPED EXTENSION
	TAD DEFALT
	DCA DEF
	TAD I (SETEXT
	SNA		/HAS AN EXTENSION BEEN SET?
	TAD NAMERM	/NO
	SNA		/DOES FILE HAVE EXTENSION?
	JMP EXT2	/NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
	JMS EXTLUK	/LOOK FOR EXTENSION
	SNA CLA		/DID WE FIND IT?
	JMP EXT3	/NO, FORCE NULL EXTENSION TO MATCH
EXT2,	CDF 0
	TAD I DEF
	IAC
	SNA CLA
	JMP NEXTEXT	/IGNORE -1'S
	TAD NAMERM
	SZA CLA
	JMP EXT3
	TAD I DEF
	DCA NAME4	/SET NEW EXTENSION
EXT3,	CDF 10
	TAD (NAME1
	DCA LNAME
	TAD I (AS+2
	JMS I (200
	2
LNAME,	0		/NAME1
LENGTH,	0
	JMP LFAILD
	TAD NAME4
	DCA I (SETEXT
	ISZ DEF		/POINT TO ASSOCIATED CUSP NAME
	CDF 0
	TAD I DEF
	CDF 10
	DCA I (DEFILE	/SAVE IT AWAY
	TAD LENGTH
	CLL
	TAD (400
	SNL
CLACON,	7600		/CLA
	CLL RTL
	RTL
	AND (7760
LKUPST,	TAD DVICE
	JMP I LOOKUP
LFAILD,	TAD NAMERM
	CDF 0
	SNA CLA		/WAS THERE AN EXPLICIT EXTENSION?
	TAD I DEF	/NO - WAS THERE A DEFAULT EXTENSION?
	SNA CLA
	JMP XYZ
NEXTEXT,CDF 10
	ISZ DEF		/NO EXPLICIT EXT AND YES DEFAULT EXT
	ISZ DEF		/POINT TO NEXT POSSIBLE DEFAULT EXTENSION
	JMP EXT2	/AND TRY FOR IT

NAMERM,	0
DVICE,	0

EXTLUK,	0
	CIA
	DCA T
1$:	CDF 0
	TAD I DEF
	CDF 10
	SNA		/AT NULL?
	JMP I EXTLUK	/YES
	TAD T		/NO
	SNA CLA		/MATCH?
	JMP 2$		/YES
	ISZ DEF		/NO
	ISZ DEF		/POINT TO NEXT ENTRY
	JMP 1$		/TRY AGAIN
2$:	TAD T		/RETURN WITH IT IN AC
	CIA
	JMP I EXTLUK
XYZ,	CDF 10
	JMP I (CDER3	/NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
BADSYN,	TEXT	/#ILLEGAL SYNTAX/
TOOMAN,	TEXT	/#TOO MANY FILES/
/AMBIGY,	TEXT	/#AMBIGUOUS SWITCH/
CDER1,	JMS I (PRMESG
	TOOMAN
NFOU,	TAD NAME1
	AND (77
	SNA CLA
	JMP I (ONE		/ONE-CHARACTER SWITCH
	JMS I (PRNAME
	JMS I (PRMESG
	SWNF
	PAGE
/TAKES A LETTER OR A DIGIT IN AC
/AND TURNS ON APPROPRIATE BIT IN OPTION TABLE

SLSHCH,	0
	DCA DELIM
	TAD (MPARAM-1
	DCA T
	TAD DELIM
	JMS I (DECODE
	JMP CDER8
	SZL
	TAD (32
	CMA STL		/THE FOLLOWING TURNS
			/ON THE CORRECT OPTION BIT
	DCA TT
L$:	SZL
	ISZ T
	RAR
	SNL
	ISZ TT
	JMP L$
	DCA TT
	TAD TT
	CMA
	AND I T
	TAD TT
	DCA I T
	JMP I SLSHCH

CDER8,	CLA
	JMS I (PRMESG
	BADOPT
ZEROCD,	0
	TAD (-42	/AC MAY BE NON-0
	DCA T
	TAD (MOFILE-1
	DCA XR
	DCA I XR	/ZERO THE COMMAND DECODER OUTPUT AREA
	ISZ T
	JMP .-2
	JMP I ZEROCD

GCH,	0
	JMS GLXR
	TAD (-240
	SNA
	JMP GCH+1	/IGNORE SPACES
	TAD (240-"(
	SNA
	JMP OPENP$
	TAD ("(
	JMP I GCH
	JMP GCH+1
OPENP$:	JMS GLXR
	TAD (-")
	SNA
	JMP GCH+1
	TAD (")
	JMS SLSHCH
	JMP OPENP$

GLXR,	0
	CDF 0
	ISZ LXR
	TAD I LXR
	CDF 10
	JMP I GLXR

	IFZERO MULTI <
SLASH,	JMS GLXR
	JMS SLSHCH
	JMS GLXR
	DCA DELIM
	JMP I (CCLSWT+1
	>

	IFNZRO MULTI <
SLASH,	CDF TABLES	/POINT TO SWITCH TABLE POINTER
	TAD I PTR	/GET PTR TO SWITCH TABLE
	CDF 10
	JMS I (TRANSL
	JMP I (CCLSWT+1
	>
OLENGT,	TAD I (OUTSW
	AND NAME1	/[N] IS ONLY LEGAL
			/ON THE OUTPUT SIDE OF THE "_"
	SNA CLA		/AND ONLY AFTER A FILE NAME
	JMP I (CDER2
	TAD (-4
	TAD CLXR
	DCA NMBASE
	JMS I (DNUMB
	CLL RTL
	RTL
	AND (7760
	TAD I NMBASE
	DCA I NMBASE
	CDF 0
	TAD DELIM
	TAD (-"]	/IS THERE A CLOSING BRACKET?
	SNA		/IF NOT,
			/"DLOOK" ROUTINE WILL DETECT IT
	JMS GCH
	DCA DELIM
	JMP I (DL2
SETDSK,	0
	TAD DSKDEV
	SZA
	JMP I SETDSK
	JMS I (200
	12		/INQUIRE
	5723		/PACKED ENCODING FOR 'DSK:'
DSKDEV,	0		/SET TO DEVICE NUMBER
	0
	HLT		/NO 'DSK' !
	TAD DSKDEV
	JMP I SETDSK
	.ENABLE ASCII
	.DISABLE FILL
MUNGC,	TEXT	/MUNG WILD,/
	.ENABLE SIXBIT
	.ENABLE FILL
	PAGE
CCER1,	TAD I (NAMPTR
	DCA X$
	TAD (-5
	JMS I (MOVE
	CDF 10
X$:	0
	CDF 10
	NAME1
CDER3,	TAD (4300
	JMS I (PRWD	/#
	JMS I (PRNAME
	JMS I (PRMESG
	NF

CCER2,	TAD I (DVNM1
	DCA DEV1
	TAD I (DVNM2
	DCA DEV2
CDER0,	TAD DEV1
	SNA CLA
	JMP I (CDER2	/B DOES NOT EXIST
	TAD (4300	/#
	JMS I (PRWD
	TAD DEV1
	JMS I (PRWD
	TAD DEV2
	JMS I (PRWD
	JMS I (PRMESG
	DNE
NF,	TEXT	/ NOT FOUND/
DNE,	TEXT	/ DOES NOT EXIST/
BADSW,	TEXT	/#SWITCH NOT ALLOWED HERE/
BADSW2,	TEXT	/#BAD CCL SWITCH/
CONTRA,	TEXT	/#CONTRADICTORY SWITCHES/
BKA,	0
	TAD I (LBEGIN
	DCA CLXR
1$:	CDF 0
	ISZ CLXR
	TAD I CLXR
	CDF 10
	SNA
	JMP NOBKR$
	TAD (-"<
	SNA
	JMP I BKA
	TAD ("<-"_
	SNA
	JMP I BKA
	TAD ("_-"=
	SZA CLA
	JMP 1$
	ISZ CLXR	/= MEANS _ IF NOT FOLLOWED BY A DIGIT
	CDF 0
	TAD I CLXR
	CDF 10
	JMS I (DECODE
	SKP CLA		/NOT A DIGIT
	SNL CLA		/MAYBE A DIGIT
	JMP I BKA	/= FOLLOWED BY A NON-DIGIT MEANS _
	JMP 1$		/IT'S AN =NNNN

NOBKR$:	ISZ BKA
	JMP I BKA
BADEV,	TEXT	/#BAD DEVICE/
	PAGE
CDINIT,	0
	ISZ PTR		/POINT TO SWITCH TABLE
	JMS I (200
	13		/RESET ALL HANDLERS
	CDF 0
	TAD I DEFALT
	CDF 10
	TAD (-5200
	SZA CLA		/IS THIS A REQUEST FOR A
			/"SPECIAL DECODE"?
	JMP CDCONT	/NO
	TAD ALTLIM
	DCA I (OUTLIM	/YES, SET UP THE PROPER LOCATIONS
	TAD ALTDF1
	DCA LIMDIF	/TO GET 1 OUTPUT AND 5 INPUT FILES
	TAD ALTDF2
	DCA BEGDIF	/ALL OF WHICH ARE
			/5-WORD <DEVICE,NAME> ENTRIES
	DCA I PLKUPS
	TAD STARJM
	DCA I PSTARS	/AND ALLOW *
			/AS A FILE OR EXTENSION NAME
	TAD L7600	/STOPS FETCHES IN SPECIAL MODE
	DCA I PSPKG1	/NO HANDLER FETCHES NECESSARY EITHER
			/SINCE NO LOOKUPS
CDCONT,	JMS I (BKA	/SCAN AHEAD FOR <
	STA		/SKIP RETURN IF NOT FOUND
	DCA I (OUTSW
	JMS I (ZEROCD
	TAD I (LBEGIN
	DCA LXR
	JMP I CDINIT
/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
ALTLIM,	1-MOFILE-5
ALTDF1,	MOFILE+5-MPARAM+5
ALTDF2,	5
PLKUPS,	LKUPSW
PSTARS,	STARSW
PSPKG1,	SPKLG1

BEGDIF,	MIFILE-MOFILE
LIMDIF,	MIFILE-MPARAM+2
/STARJM,	RELOC STARNM	/DUMP LITERALS AT LAST POSSIBLE MOMENT
/	JMP STARNM
/	RELOC
STARJM,	5200+<STARNM&177>
SETDEV,	0		/V1A ARG NOW IN AC
	DCA 1$
	CLL STA RAL	/-2
	JMS I (MOVE
	CDF 0
1$:	0		/PTS TO DEVICE NAME
	CDF 10
	DVNM1
	JMS I (SETOUT
	JMP I SETDEV

UNKN,	0
	TAD SETEXT
	SZA
	TAD T		/NEG OF SWITCH REQUEST
	SZA CLA
	JMP CCERA	/CAN'T HAVE 2ND DEFAULT EXTENSION
	TAD T
	CIA
	DCA SETEXT	/SET DEFAULT EXTENSION
	TAD DEFALT	/SEE IF IT'S IN COMMAND'S SEARCH LIST
	DCA DEF
	TAD SETEXT
	JMS I (EXTLUK
	SNA CLA		/DID WE FIND IT?
	JMP CDER4	/NO
	ISZ DEF		/YES
/	TAD I (JMSUB	/ALLOW RECURSIVE CALL
/	DCA HOLD
	CDF 0
	TAD I DEF
	CDF 10
	JMS I (JMSUB	/CALL ITS SUBR
/	TAD HOLD
/V1A RECURSIVE CALL NO LONGER THREATENS
/	DCA I (JMSUB
	JMP I UNKN

SETEXT,	0		/EXT WHICH HAS BEEN SET BY A CCL SWITCH
CCERA,	JMS I (PRMESG
	CONTRA
CDER2,	JMS PRMESG
	BADSYN

L7600,
CCERB,
CDER4,	7600		/CLA
	JMS I (PRMESG
	BADSW
CDER44,	CLA
	JMS I (PRMESG
	BADSW2
CDER7,	JMS I (PRMESG
	BADX
BADSTR,	TEXT	/#ILLEGAL * OR ?/
SWNF,	TEXT	/ OPTION UNKNOWN/
BADOPT,	TEXT	/#BAD SWITCH OPTION/
	PAGE
BADX,	TEXT	/#BAD EXTENSION/

/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
/IT GIVES A FATAL ERROR MESSAGE IF BAD.
GETSPC,	0
	STA
	DCA DVFLAG
	DCA DEV1
FILLP1,	DCA DEV2
FILLP,	JMS I (GNAME
	TAD (-":	/AC CONTAINED DELIM
	SNA CLA
	JMP 3$		/IT'S A DEVICE NAME
	DCA NUMC
	TAD (-4
	JMS I (MOVE
	CDF 10
	NAME1
	CDF 0
	FNAME1		/SAVE AWAY FILE NAME
	JMP I GETSPC
3$:	CLA IAC		/PARSE FILENAME AFTER DEV:
	TAD I (PERDSW
	TAD NUMC
	SZA CLA
	JMP CDERA	/. OR # IN DEVICE NAME
	TAD NAME1
	DCA DEV1
	ISZ DVFLAG
	JMP CDERA	/CATCHES A:B:
	TAD NAME2
	JMP FILLP1

DVFLAG,	0
CDERA,	JMS I (PRMESG
	BADEV

NUMC,	0		/USED AS FLAG INDICATING SAW #
	JMS I (POUND
	JMP I NUMC
NMOVE,	0
	DCA 2$		/V1A ARG IN AC
	TAD I (FLAG
	RTL
	SMA CLA		/FEATURE ENABLED?
	JMP I (CCERB	/NO
	TAD I (OUTSW
	SZA CLA
	JMP I (CCERB	/ON OUTPUT SIDE
	TAD I (MOFILE	/V3C
	SNA CLA		/DON'T CHANGE OUT DEV IF SPECIFIED
	TAD I (FLAG	/LOOK AT 'COPY EXT' BIT
	AND (200
	SNA CLA
	JMP 1$		/IT WASN'T SET
	TAD I (MIFILE	/GET FIRST INPUT DEVICE
	AND (17		/ISOLATE DEVICE BITS
	DCA I (MOFILE	/FORCE THIS TO BE FIRST OUTPUT DEVICE
1$:	TAD I 2$
	SNA
	JMS I (SETDSK	/CHANGE TO 'IAC' TO ALWAYS USE SYS:
	DCA I 2$	/SET DEVICE TO SYS IF NONE
	ISZ 2$
	TAD I 2$	/WAS THERE A SPECIFICATION THERE?
	SZA CLA
	JMP I NMOVE	/YES, DO NOTHING
	TAD I (FLAG
	AND (200	/GET 'COPY EXTENSION' BIT
	SMA SZA CLA	/'SMA' IS UNNECESSARY
	STA		/COPY 4 WORDS IF BIT 4 WAS ON
	TAD (-3		/OTHERWISE ONLY COPY 3 WORDS
	JMS I (MOVE
	CDF 0
	FNAME1
	CDF 10
2$:	0
	JMP I NMOVE
ROTL,	0
	CLL RTL
	RTL
	RTL
	JMP I ROTL

JMSUB,	0
	SNA
	JMP I JMSUB
	DCA T$
	JMS I T$
	JMP I JMSUB
T$:	0
AMBIG,	TAD NAME1
	AND (77
	SNA CLA
	JMP I (ONE
	JMS I (PRNAME
	JMS I (PRMESG
	AMBIGY
AMBIGY,	TEXT	/ OPTION AMBIGUOUS/
	PAGE
SETOUT,	0
	TAD I (FLAG
	RTR
	SZL CLA
	TAD (5
	TAD (7600
	DCA OLOC
	TAD I OLOC
	SZA CLA
	JMP I SETOUT	/HE'S SPECIFIED SOMETHING
	JMS I (200
	12		/INQUIRE
DVNM1,	0
DVNM2,	0
	0
	JMP I (CCER2	/NO SUCH DEVICE
	TAD DVNM2
	DCA I OLOC
	TAD OLOC
	AND (5
	SNA CLA		/USING 2ND OUT DEV?
	JMP I SETOUT	/NO
	ISZ OLOC	/YES
	TAD (-4
	JMS I (MOVE
	CDF 0
	FNAME1
	CDF 10
OLOC,	7600		/INITIALLY 7600 OR 7605
	JMP I SETOUT
/	TAD (PTR TO SWITCH TABLE ENTRY (IN FIELD 0)
/	JMS TRANSL
/	IT PARSES SWITCH, SETS BIT
/	PARSES :VALUE, SETS = OPTION
/	LEAVES DELIMETER IN DELIM

TRANSL,	0
	DCA SPTR	/POINT INTO A SWITCH TABLE
	JMS I (GNAME	/GET A NAME
	DCA DEL
/	TAD NAME4
/	SZA CLA
/	HLT		/EXTENSION ON A SWITCH
	JMS SRCH
	JMP I (NFOU	/SWITCH NOT FOUND
	STA
	TAD SRPTR
	DCA SSPTR	/SAVE PTR INTO LONG NAME
	JMS SRCH	/SEARCH SOME MORE
	SKP		/SHOULDN'T FIND ANYTHING
	JMP I (AMBIG	/AMBIGUOUS SWITCH
	CDF 0
L$:	TAD I SSPTR	/SCAN PAST END OF LONG NAME
	ISZ SSPTR
	AND (77
X240:	SZA CLA
	JMP L$
	TAD I SSPTR
	CDF 10
SL,	AND (377	/ISOLATE CORRESPONDING ONE-CHARACTER SWITCH
	SZA
	JMS I (SLSHCH	/SET APPROPRIATE BIT
	TAD DEL
	DCA DELIM
	TAD DELIM
	TAD (-":
	SNA CLA
	JMS I (EQLPRM
	JMP I TRANSL

ONE,	TAD NAME1
	CLL RTR
	RTR
	RTR
	TAD X240
	AND (77
	TAD X240
	JMP SL

SPTR,	0
SSPTR,	0
DEL,	0
/RETURN 1 IF NAME NOT FOUND
/RETURN 2 IF NAME FOUND

SRCH,	0
1$:	TAD (NAME1
	DCA NPTR
	CLL STA RTL	/-3
	DCA NCNT
	CDF 0
	TAD I SPTR
	CDF 10
	ISZ SPTR
	SNA
	JMP I SRCH	/NOT FOUND
	DCA SRPTR
2$:	TAD I NPTR
	SNA
	JMP 3$
	AND (77
	SZA CLA
	TAD (77		/MUST MATCH BOTH BYTES
	TAD (7700	/NEED ONLY MATCH LEFT BYTE
	CDF 0
	AND I SRPTR
	CDF 10
	CIA
	TAD I NPTR
	SZA CLA
	JMP 1$		/THIS SWITCH AIN'T IT
	ISZ SRPTR
	ISZ NPTR
	ISZ NCNT
	JMP 2$
3$:	ISZ SRCH
	JMP I SRCH

SRPTR,	0		/POINTS INTO LONG NAME TABLE
NCNT,	0
NPTR,	0		/POINTS INTO NAME1-3
	PAGE

