A large commit.

[pdp8.git] / sw / os8 / v3d / sources / devext / dectapes / dectape1 / cclsub.ma

/
/
/
/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.
/
/
/

\f
/VERSION=V3A (D.H.)
\f/3	CCL SIMPLE COMMAND SUBROUTINES

	.EXTERNAL REMD,REGO,FLAG,FOREVER,REMEM,PRMESG
	.EXTERNAL RDMON,BATCH
	.GLOBAL USRSUB,BASUB,DEASSIGN
	.EXTERNAL ASSIGN,FUDG,DVICE,LOOK,PRINT
	.ENTRY VERTN	/CALLED INDEPENDENTLY BY CCL
	.GLOBAL CRSUB,EDSUB,ZERSUB
	.GLOBAL TECSUB,MAKSUB,MNGSUB
	.GLOBAL SQSUB,KILRT,RENRT,MOVRT
	.EXTERNAL CDER2,GETSPC,GCH,ZEROCD,LBEGIN
	.ENTRY CMDERR
	.ENTRY CCSUB
	.GLOBAL ARLOC	/****
	MOFILE=7600
	MPARAM=7643

	XR2=15
	XR=16
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	DELIM=32
	LXR=34
	OS78BIT=7771
	CCLNUM="3
	CCLVER="A
\f	.SBTTL UA,UB,UC COMMANDS
	.RSECT CCLSUB
	FIELD 1

/TEST END OF TABLE

USRSUB,	0
	TAD I (REMD
	SMA CLA
	JMP I (REGO	/REMEMBERED A NEW LINE
	TAD I (FLAG	/WANT TO
	AND (70
	CLL RTR
	RAR
	TAD (-1		/IN THIS REM-LINE
	DCA U$
	JMS I (FOREVER	/NO DATE
	JMS I (REMEM
U$:	0
	JMP I USRSUB
\f	.SBTTL BASIC COMMAND

BASUB,	0
	TAD (200	/SET /Q SWITCH
	DCA I (MPARAM+1
	JMP I BASUB
\f	.SBTTL VERSION COMMAND

VERTN,	0
	JMS I (RDMON	/READ MONITOR
	CDF 0
	TAD I (2031	/GET PATCH LEVEL
	SNA
	TAD ("!
	AND (77
	DCA TEM$
	TAD I (2000	/GET VERSION #
	CDF 10
	SPA
KK7600:	7600		/"0" MEANS OLD
	TAD (60
	CLL RTL
	RTL
	RTL
	TAD TEM$
	DCA I (VLOC
	CDF 0
	TAD I (OS78BIT
	AND (200	/	78
	SZA CLA		/	OR
	TAD (1000	/	/8
	TAD (5770
	CDF 10
	DCA I (LOC78
	JMS I (PRMESG
	VMES
TEM$:	0
\f	.SBTTL DEASSIGN COMMAND

/ALLOW DEASSIGN FOO ?

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

T$:	0
\fCHKSUP,	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)
	JMS I (PRINT
	SUP
	JMP I CHKSUP
\f	.SBTTL ZERO COMMAND
ZERSUB,	0
	TAD I (7601
	SNA CLA		/WAS FILENAME SPECIFIED ON ZERO CMD?
	TAD I KK7600	/OR WAS NO OUT DEVICE SPECIFIED?
	SNA CLA
	JMP I (CDER2	/YES... ERROR
	JMP I ZERSUB	/NO, OKAY.

CMDERR,	JMS I (PRMESG	/NOT A LEGAL KEYWORD
	ERRCMD

RENMES,	TEXT	/FILES RENAMED:/
	PAGE
\f	.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
\f	.SBTTL MAKE COMMAND

	ALTMODE=233

SETPA,	0
	JMS I (SETX
	"P;"A		/KEEP HERE TO MAKE EASY TO PATCH
	JMP I SETPA

MAKSUB,	0
	TAD DELIM
	SNA CLA
	JMP I (CMDERR	/DON'T ALLOW MAKE <CR>
	JMS SETLXR
	JMS I (GETSPC
	JMS I (LOVE
	PUT "EW"
	JMS TECMOV
	JMS SETPA
	PUT "$"
	JMS I (CHKSUP
	JMS I (REMEM
	0
	JMP I MAKSUB

SETLXR,	0
	TAD I (LBEGIN
	DCA LXR
	TAD (MOFILE-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 NAME1
/	SNA CLA
/	JMP I (CDER2
	TAD I TECPUT
	ISZ TECPUT
	SNA
	JMP I TECPUT
	JMS I (TPUT
	JMP TECPUT+1
\f/MOVE CHARS FROM FIELD 0 LINE BUFFER
/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
/INTO TECO LINE BUFFER AT 17600

TECMOV,	0
	TAD SAVLXR
	DCA XR2
	TAD SAVLXR
	CMA
	TAD LXR
	SNA CLA
	JMP I (CDER2	/NO FILE SPEC
L$:	CDF 0
	TAD I XR2
	CDF 10
	JMS I (TPUT
	TAD XR2
	CMA
	TAD LXR
	SNA CLA
	JMP I TECMOV
	JMP L$
\f	.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
	JMP I (CDER2
1$:	CDF 0
	DCA I LXR	/CHANGE < TO 0
	CDF 10
	PUT "EW"
	JMS TECMOV
	JMS SETPA
	TAD LXR
	DCA SAVLXR
	JMS I (CHKSUP
	JMS I (GETSPC
	PUT "$ER"
	JMS TECMOV
	JMS SETPA
	PUT "$Y"
	JMP TECLV
\fTECNORM,PUT "EB"
	JMS TECMOV
	JMS SETPA
	PUT "$Y"
TECLV,	JMS I (REMEM
	0
	JMP I TECSUB
SAVLXR,	0
	PAGE
\f	.SBTTL MUNG COMMAND

TPUT,	0
	AND (177	/TECO LIKES 7-BIT
	ISZ TYR
	DCA I TYR
	TAD TYR
	TAD (-7646	/CHECK FOR OVERFLOW OF CD AREA
	SZA CLA
	JMP I TPUT
	JMS I (PRMESG
	TOOLNG

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
	JMP I (CDER2
L$:	STL CLA RAR	/PREVENT 'GCH' FROM HANDLING SPACE AND /
	JMS I (GCH
	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
	JMP I MNGSUB
TYR,	0
\f/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
	CLL RTL
	RTL
	RTL
	DCA 1$
	TAD 2$
	AND (77
	TAD 1$
	DCA NAME4
	JMP I SETX
\fLOVE,	0
	TAD NAME1
	TAD (-'LO
	SZA CLA
	JMP I LOVE
	TAD NAME2
	TAD (-'VE
	SZA CLA
	JMP I LOVE
	TAD NAME3
	TAD NAME4
	SZA CLA
	JMP I LOVE
	JMS I (PRINT
	LOVMES
	JMP I LOVE

TOOLNG,	TEXT	/#COMMAND TOO LONG/
\fCCSUB,	0		/USED TO FORCE THIS OVERLAY IN
	JMP I CCSUB
	PAGE
\f	.SBTTL CREATE COMMAND

CRSUB,	0
	TAD I (7617
	SNA CLA		/BETTER BE NO INPUT
	TAD I K7600	/ANYTHING THERE?
	SNA CLA
	JMP I (CDER2	/NO OUTPUT OR YES INPUT
	JMS EDSUB	/REMOVE BACK-ARROW AND REMEMBER CREATE LINE
	JMP I CRSUB
\f	.SBTTL EDIT COMMAND

EDSUB,	0
	CDF 0
	DCA I ARLOC	/REPLACE ARROW BY NULL
	CDF 10
	JMS I (REMEM	/REMEMBER NEW COMMAND LINE
	1
	JMP I EDSUB

ARLOC,	.		/LOCATION OF BACK-ARROW IN COMMAND LINE
			/'.' IS HARMLESS POINTER IN CASE NO ARROW
\f	.SBTTL SQUISH COMMAND

SQSUB,	0
	TAD I K7600
	SZA CLA
	JMP I SQSUB
	TAD I (7617
	DCA I K7600
	JMS I (BATCH	/IS BATCH RUNNING?
	JMP I SQSUB	/NO
K7600,	7600		/YES (CLEAR AC)
	TAD I K7600
	TAD (7647-1	/POINT INTO DEVICE HANDLER RESIDENCY TABLE
	DCA T$
	TAD I T$	/GET HANDLER STARTING ADDRESS
	TAD (-7607
	SZA CLA		/IS SQUISHED DEVICE SYS:?
	JMP I SQSUB	/NO
	JMS I (PRINT
	SQWARN		/YES, WARN USER
	JMP I SQSUB
T$:	0
\f	.SBTTL COPY, MOVE, AND DELETE COMMANDS

KILRT,	0
	STL CLA RAR	/4000 MEANS NOT PACKED
	JMS I (PRINT
	KILMES
	JMP I KILRT

RENRT,	0
	JMS I (PRINT
	RENMES
	JMP I RENRT

MOVRT,	0
	JMS I (PRINT
	MOVMES
	JMP I MOVRT
\fVMES,	TEXT	\OS/8 - KBM V3A - CCL V1A\
	LOC78=VMES+1
	VLOC=VMES+6
	*.-2
	CCLNUM&77^100+<CCLVER&77>
	*.+2
LOVMES,	TEXT	/NOT WAR?/
SUP,	TEXT	/%SUPERSEDING/
ERRCMD,	TEXT	/#ERROR IN COMMAND/
SQWARN,	TEXT	/%BATCH SQUISHING SYS:!/
MOVMES,	TEXT	/FILES COPIED:/
	.ENABLE ASCII
KILMES,	TEXT	/Files deleted:/
	.ENABLE SIXBIT
	PAGE