File: CCLSUB.MA of Disk: V50/Source/Source-Listing-MAC-1
(Source file text) 

/CCL SUBROUTINES 1 FOR KBM V40
/
/
/
/
/
/
/	CCL SIMPLE COMMAND SUBROUTINES
/	VERSION=4B

	.ENTRY CCSUB

	.EXTERNAL REMD,REGO,FLAG,FOREVER,EXSUB
	.EXTERNAL LISPRT,ERROR,VMES,MMES,MSGLST
	.EXTERNAL RDMON,BATCH,ARLOC,MOVE
	.EXTERNAL ASSIGN,FUDG,DVICE,LOOK
	.EXTERNAL GETSPC,ZEROCD,LBEGIN

	.GLOBAL USRSUB,BASUB,DEASSIGN
	.GLOBAL CRSUB,EDSUB,FOSUB,ZERSUB
	.GLOBAL TECSUB,MAKSUB,MNGSUB,TTSUB
	.GLOBAL SQSUB,KILRT,RENRT,MOVRT

	.NOLIST
	.INCLUDE OUT:CCLDEF
	.LIST
	.SBTTL UA,UB,UC COMMANDS
	.RSECT CCLSUB
	FIELD 1

CCSUB,	0		/USED TO FORCE THIS OVERLAY IN
	JMP I	CCSUB

/TEST END OF TABLE

USRSUB,	0
	TAD I (REMD
	SMA CLA
	JMP I (REGO	/REMEMBERED A NEW LINE
	JMS I (FOREVER	/NO DATE
	TAD I (FLAG	/WANT TO
	AND (70
	CLL RTR
	RAR
	TAD (-1		/IN THIS REM-LINE
	JMS I	(EXSUB
	JMP I USRSUB
	.SBTTL SQUISH COMMAND

SQSUB,	0
	TAD I	(MOFILE+1
	TAD I	(MIFILE+1
	SZA CLA
SQER$:	JMS I	(ERROR	/DON'T ALLOW FILES
	24.		/#Error in command
	TAD I	(MOFILE
	SZA CLA
	JMP I	SQSUB
	TAD I	(MIFILE
	SNA
	JMP	SQER$	/NO DEV: NO GOOD
	DCA I	(MOFILE
	JMS I	(BATCH	/IS BATCH RUNNING?
	JMP I	SQSUB	/NO
	CLA
	TAD I	(MOFILE
	TAD	(DVHNDL-1	/POINT INTO DEVICE HANDLER RESIDENCY TABLE
	DCA	T$
	TAD I	T$	/GET HANDLER STARTING ADDRESS
	TAD	(-SHNDLR
	SZA CLA		/IS SQUISHED DEVICE SYS:?
	JMP I	SQSUB	/NO
	TAD I	(MPARAM
	AND	(20	/HUSH ?
	SZA CLA
	JMP I	SQSUB	/YES, NO MESSAGE
	CLA STL IAC RAL	/3
	JMS I	(LISPRT	/%Batch squishing SYS:!
	MSGLST		/YES, WARN USER
	JMP I	SQSUB
T$:	0
	.SBTTL DEASSIGN COMMAND

/ALLOW DEASSIGN FOO ?

DEASSIGN,0
	TAD	(7740
	DCA	XR
	TAD	(-17
	DCA	D$
	DCA I	XR
	ISZ	D$
	JMP	.-2
	CDF 0
	TAD I	(JSBITS
	AND	(6777
	TAD	(1000
	DCA I	(JSBITS
	CDF 10
	JMP I	DEASSIGN

D$:	0

CHKSUP,	0
	JMS I	(FUDG
	JMS I	(ASSIGN
	TAD	NAME1
	SNA CLA
	JMP I	CHKSUP	/CAN'T SUP IF NO FILENAME
	TAD I	(DVICE
	JMS I	(LOOK	/LOOK UP FILE
	NAME1
	JMP I	CHKSUP	/NOT FOUND (GOOD)
	CLA STL RTL	/MSG #2 %Superseding
	JMS I	(LISPRT
	MSGLST
	JMP I	CHKSUP
	.SBTTL ZERO COMMAND
ZERSUB,	0
	TAD I	(MOFILE+1
	SNA CLA		/WAS FILENAME SPECIFIED ON ZERO CMD?
	TAD I	(MOFILE	/OR WAS NO OUT DEVICE SPECIFIED?
	SNA CLA
	JMS I	(ERROR	/YES... ERROR
	9.		/#Illegal syntax
	JMP I	ZERSUB	/NO, OKAY.

TECEND,	0		/TRANSFER TECO COMMAND TO 17400
	JMS I	(TPUT	/TERMINATE COMMAND
	TAD	(-200
	JMS I	(MOVE
	CDF 0
	BFR
	CDF 10
	7400
	TAD	.-1
	DCA I	(MOFILE	/SET CONTINUATION POINTER
	JMP I	TECEND
	PAGE
	.SBTTL PUT MACRO
	.NOLIST ME

	.MACRO PUT TXT
	JMS TECPUT

	.IF IDN TXT[1],$<
	.ENABLE ASCII
	;TEXT	<ALTMODE>"TXT[2:0]"
	.ENABLE SIXBIT
	>

	.IF DIF TXT[1],$<
	.ENABLE ASCII
	;TEXT	/TXT/
	.ENABLE SIXBIT
	>

	.ENDM
	.SBTTL MAKE COMMAND

	ALTMODE=233

MAKSUB,	0
	TAD	DELIM
	SNA CLA
	JMS I	(ERROR	/DON'T ALLOW MAKE <CR>
	24.		/#Error in command
	JMS	SETLXR
	JMS I	(GETSPC
	PUT "EW"
	JMS	TECMOV
	PUT "$"
	JMS I	(CHKSUP
	JMS I	(LOVE
	CLA CLL IAC RAL	/REMEMBER IN CHANNEL #2
	JMS I	(EXSUB
	JMS I	(TECEND
	JMP I	MAKSUB

SETLXR,	0
	TAD I	(LBEGIN
	DCA	LXR
	TAD	(BFR-1
	DCA I	(TYR
	TAD	(-5	/ZERO OPTION TABLE TOO
	JMS I	(ZEROCD
	TAD	LXR
	DCA	SAVLXR
	JMP I	SETLXR

/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR

TECPUT,	0
	TAD I	TECPUT
	ISZ	TECPUT
	SNA
	JMP I	TECPUT
	JMS I	(TPUT
	JMP	TECPUT+1
/MOVE CHARS FROM FIELD 0 LINE BUFFER
/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
/INTO TECO LINE BUFFER AT 'BFR'

TECMOV,	0
	TAD	SAVLXR
	DCA	XR2
	TAD	SAVLXR
	CMA
	TAD	LXR
	SNA CLA
	JMS I	(ERROR	/NO FILE SPEC
	9.		/#Illegal syntax
L$:	CDF 0
	TAD I	XR2
	CDF 10
	JMS I	(TPUT
	TAD	XR2
	CMA
	TAD	LXR
	SNA CLA
	JMP I	TECMOV
	JMP	L$
	.SBTTL TECO COMMAND

TECSUB,	0
	JMS	SETLXR
	JMS I	(GETSPC
	TAD	DELIM
	SNA
	JMP	TECNORM
	TAD	(-"<	/ALLOW "_" AS WELL AS "<"
	SZA
	TAD	("<-"=
	SZA
	TAD	("=-"_
	SZA CLA
	JMS I	(ERROR
	9.		/#Illegal syntax
1$:	CDF 0
	DCA I	LXR	/CHANGE < TO 0
	CDF 10
	PUT "EW"
	JMS	TECMOV
	TAD	LXR
	DCA	SAVLXR
	JMS I	(CHKSUP
	JMS I	(GETSPC
	PUT "$ER"
	JMP	TECLV
TECNORM,PUT "EB"
TECLV,	JMS	TECMOV
	PUT "$Y"
	CLA CLL IAC RAL	/CHANNEL #2
	JMS I	(EXSUB
	JMS I	(TECEND
	JMP I	TECSUB
SAVLXR,	0
	PAGE
	.SBTTL MUNG COMMAND

TPUT,	0
	AND	(177	/TECO LIKES 7-BIT
	ISZ	TYR
	CDF 0
	DCA I	TYR
	CDF 10
	TAD	TYR
	TAD	(-<BFR+200-1>	/CHECK FOR OVERFLOW OF 'BFR' AREA
	SZA CLA
	JMP I	TPUT
	JMS I	(ERROR
	25.		/#Command is too long
TYR,	0

MNGSUB,	0
	JMS I	(SETLXR
	JMS I	(GETSPC
	PUT "ER"
	JMS I	(TECMOV
	JMS	SETX
	"T;"E
	PUT "$YHXYHKI"
	TAD	DELIM
	SNA
	JMP	F$
	TAD	(-",
	SZA CLA
	JMS I	(ERROR
	9.		/#Illegal syntax
L$:	CDF 0
	ISZ	LXR
	TAD I	LXR
	CDF 10
	AND	(177	/GET RID OF HIGH ORDER BIT
	SNA
	JMP	F$
	JMS	TPUT
	JMP	L$
F$:	PUT "$MY"	/MACRO GETS CALLED WITH POINTER PAST CHARS
	JMS I	(TECEND
	JMP I	MNGSUB
/SET DEFAULT EXTENSION

SETX,	0
	TAD I	SETX
	DCA	1$
	ISZ	SETX
	TAD I	SETX
	DCA	2$	/FALL THRU 2ND EXT
	TAD	NAME4
	SNA CLA
	TAD	NAME1
	SNA CLA
	JMP I	SETX
	TAD I	TYR	/GET LAST CHAR (NO EXT)
	TAD	(-56	/WAS IT A DOT?
	SNA CLA
	JMP I	SETX	/YES
	JMS I	(TECPUT	/NO, USE DEFAULT EXTENSION
	".
1$:	0
2$:	0
	0
	TAD	1$
	AND	(77
	BSW
	DCA	1$
	TAD	2$
	AND	(77
	TAD	1$
	DCA	NAME4
	JMP I	SETX
	.SBTTL BASIC COMMAND

BASUB,	0
	TAD (200	/SET /Q SWITCH
	DCA I (MPARAM+1
	JMP I BASUB

LOVE,	0
	TAD	NAME1
	TAD	(-'LO
	SZA CLA
	JMP I	LOVE
	TAD	NAME2
	TAD	(-'VE
	SZA CLA
	JMP I	LOVE
	TAD	NAME3
	SZA CLA
	JMP I	LOVE
	CLA IAC		/not WAR?
	JMS I	(LISPRT
	MSGLST
	JMP I	LOVE

	PAGE
	.SBTTL CREATE COMMAND

CRSUB,	0
	TAD I	(MIFILE
	SNA CLA		/BETTER BE NO INPUT
	TAD I	(MOFILE	/ANYTHING THERE?
	SNA CLA
	JMS I	(ERROR	/NO OUTPUT OR YES INPUT
	9.		/#Illegal syntax
	JMS	EDSUB	/REMOVE BACK-ARROW AND REMEMBER CREATE LINE
	JMP I	CRSUB


	.SBTTL EDIT COMMAND

EDSUB,	0
	TAD I	(ARLOC
	DCA	AR$
	TAD	AR$
	CDF 0
	SZA CLA		/WE COULD KILL SOMETHING IN F0
	DCA I	AR$	/REPLACE ARROW BY NULL
	CDF 10
	CLA IAC CLL RAL	/REMEMBER NEW COMMAND LINE
	JMS I	(EXSUB	/REMEMBER IN CHANNEL #2
	JMP I	EDSUB

AR$:	0		/LOCATION OF BACK-ARROW IN COMMAND LINE
			/0 IS NOW HARMLESS IN CASE NO ARROW

	.SBTTL FOCAL COMMAND

FOSUB,	0
	CLA STL IAC RTL	/REMEMBER IN CHANNEL #6
	JMS I	(EXSUB
	JMP I	FOSUB
	.SBTTL COPY, RENAME, AND DELETE COMMANDS

KILRT,	0
	CLA STL IAC RTL	/MESSAGE #6
	JMS	KRMHSH
	JMP I	KILRT

RENRT,	0
	CLA CLL IAC RTL	/MESSAGE #4
	JMS	KRMHSH
	JMP I	RENRT

MOVRT,	0
	TAD	(5	/MESSAGE #5
	JMS	KRMHSH
	JMP I	MOVRT

KRMHSH,	0
	DCA	KRMNM$
	TAD I	(MPARAM
	AND	(20	/PICK OUT /H FOR HUSH
	SNA CLA
	JMP	KRMND$	/NO HUSH
	CLA CLL CMA RAL	/7776
	AND I	(MPARAM
	DCA I	(MPARAM	/TAKE OUT /L
	JMP I	KRMHSH
KRMNM$:	0
KRMND$:	TAD	KRMNM$
	JMS I	(LISPRT
	MSGLST
	JMP I	KRMHSH
	.SBTTL TTL TECO.TEC LOAD

TTSUB,	0			/MOVE TT COMMAND STRING
	TAD	(-200		/TO TECO INPUT BUFFER
	DCA	T		/128 CHARS
	TAD	(BEGLN-1
	DCA	XR2
	TAD	(7400-1
	DCA	XR
TL$:	CDF 0
	TAD I	XR2
	CDF 10
	AND	(177
	DCA I	XR
	ISZ	T
	JMP	TL$
	DCA I	(MOFILE		/SET FLAG FOR TECO.TEC
	TAD	(7400		/AND CONTINUATION POINTER
	DCA I	(MOFILE+1
	JMP I	TTSUB		/THAT WAS EASY