software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape5 / CCL.PA

/56	CCL  FOR  OS/8 V3D
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977 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	MOFILE=7600
	MIFILE=7617
	MPARAM=7643

	XR2=15
	XR=16
	TXR=17
	AMFLAG=17
	T=20
	TT=21
	DEF=22
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	NMBASE=27
	DEV1=30
	DEV2=31
	DELIM=32
	DEFALT=33	/POINTS TO DEFAULT EXTENSION LIST
	LXR=34
	CLXR=35
	PTR=36
	DATWD=7666
	BATERR=7000	/JMP HERE TO ABORT BATCH
	BATOUT=7400	/JMS HERE TO PRINT ON BATCH LOG
	BATSPL=7200	/JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC
	OS78BIT=7771

	BEGLN=1000

/CCL STARTING ADDRESS:	12000
/STARTING ADDRESS:	12001
/CHAIN STARTING ADDRESS:12002

/	JOB STATUS WORD = 2003

/**************************************************
/
/		SAVING CCL
/
/		.LOAD CCL
/		.SAVE SYS CCL;12001=2103
/		.R CCL
/
/**************************************************

	CCLSW=435
	DEASADR=427
	PRQMRK=1357
	GETCCL=1362
	OV=1375
	MSOVL2=55

	CCLBLK=67	/BLOCK ON SYS: USED BY CCL
	CCLTAB="G	/MUST BE UPDATED IF TABLES CHANGE
	CCLNUM="1
	CCLVER="F	/CCL VERSION #

/*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY.
/USE OF SEMICOLONS WITH CCL VERSION I OR LATER
/REQUIRES BATCH VERSION 7 OR LATER.
/USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER

	HNDLR=4400
	BFR=5000

/MEMORY ALLOCATION:

/0 4400-4777	INPUT HANDLER FOR CD
/		ALSO, SEMICOLON BUFFER
/0 5000-5177	PRE-EXTENSION @ BUFFER
/0 5200-5577	@ BUFFER
/0 1000-1777	/COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK]
/0 2000-2777	/LINE BUFFER EXTENSION
\f/	CHANGES SINCE FIELD RELEASE VERSION:

/1.	RECURSIVE 'U' BUG FIXED
/2.	INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED
/3.	BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED
/4.	.SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE
/5.	COMPARE PASSES ALTMODE
/6.	TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP
/7.	BUG RE PASSING DEFAULT * FIXED
/8.	.LS FORM OF .CREF COMMAND REMOVED
/9.	BUG CONCERNING PROCESSOR SWITCHES FIXED
/10.	CCL SWITCH ALLOWED AFTER =N OPTION
/11.	BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED
/12.	EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT
/13.	'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY
/14.	'BAD CCL SWITCH' MESSAGE ADDED
/15.	CCL EDIT # CHANGED TO CCL VERSION #
/16.	.EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES
/17.	MUNG PTR: NOW WORKS
/18.	FIXED BUG RE MUNG <CR>
/19.	FIXED BUG RE CD FOR FILE > 2047 BLKS
/20.	FIXED BUG RE MAKE PTR:

/VERSION B FIXES:

/21.	ALLOWED 'EDIT' TO COPY FILE EXTENSION
/22.	FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE
/23.	FIXED DATE PROBLEM
/24.	ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED

/VERSION C FIXES:

/25.	FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT
/26.	ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE
/	 AS IN DEVICE (IF NONE SPECIFIED)
/27.	ADDED MORE SYNTAX CHECKING TO ZERO COMMAND

/VERSION D CHANGES:

/28.	ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' .

/VERSION E CHANGES: (IN-HOUSE ONLY VERSION)

/29.	WARNING MSG IF SQUISH SYS: UNDER BATCH
/30.	ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS <
/31.	ADDED HOOKS FOR ; TO BE READY FOR V4
/32.	FIX BUG RE CMD STARTING WITH SPACES

/CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C):

/33.	FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC
/34.	INCORPORATED ALL PREVIOUS EDITS
/35.	ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED)
/36.	FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1:
/37.	CORRECTED SPELLING OF SUPERSEDING
/38.	ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS]

/VERSION G CHANGES:

/39.	FIXED BUG WITH HELP COMMAND
/40.	FIXED BUG CONCERNING EDIT DEV:_FILE

/VERSION H CHANGES:

/41.	ADDED MAC AND LINK COMMANDS
/42.	ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS
/43.	ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS
/44.	ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING
/45.	ALLOWED @ AT BEGINNING OF LINE
/46.	MOVED MOST OF 'DETCOR' TO FIELD 0
/47.	WAIT ROUTINE  NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC
/48.	ALLOWED EXEC .BI TO USE BATCH
/49.	TENTATIVELY ADDED SEMICOLON STUFF
/50.	PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH

/VERSION I CHANGES:

/51.	FIRMED UP SEMICOLON STUFF

/VERSION J CHANGES:

/52.	DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS:
/53.	-L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME

/VERSION K CHANGES:

/54.	DATE NOW HANDLES DATE/78 ALGORITHM
/55.	TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG

/VERSION 1A CHANGES:

/56.	FIXED BUG RE NULL INDIRECT CMD FILE
/57.	FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM
/58.	PRINT "OS78" FOR VERSION NAME IF APPLICABLE
/59.	ADDED -N AND -D AND REWROTE LOGIC A BIT
/60.	HELP COMMAND NOW USES HELP.SV
/61.	SET COMMAND NOW USES SET.SV
/62.	'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD
/63.	ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH)
/64.	ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE)
/65.	ADDED DUPLICATE COMMAND (USES RXCOPY)

/V1B CHANGES:

/66.	MODIFIED FORMAT OF MAIN TABLE
/67.	GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT
/	FILE (EVEN IF NON-FS)
/68.	PRINT KBM VERSION #
/69.	ADDED TERMINATE COMMAND

/V1F CHANGE:

/70.	DUPL CALLS RXCOPY IN SPECIAL MODE
\f/	FORMAT OF CCL TABLE

/ENTRY	PURPOSE

/	TABLE WIDTH=7 (BUT VARIES)

/0	FLAG WORD

	/BIT	MEANING IF ON

	/0	PERFORM CD (IF 0, OMIT ENTRIES 1-6)
	/1	DON'T PERMIT SPOOLING
	/2	ALLOW .LS, .NB, .MP SWITCHES
	/3	ADD _ TO END OF COMMAND STRING
	/4	SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON)
	/6-8	SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1)
	/	0 MEANS NONE.  7 RESERVED FOR SPECIAL USE.
	/10	CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME
	/11	WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1)

/1	PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES.
/	IF PTS TO 0, NONE.   IF PTS TO 5200, USE SPECIAL MODE.

/2-4	DEFAULT SWITCHES TO BE OR'ED INTO THOSE
/	EXPLICITLY GIVEN.

/5	ADDRESS OF SUBROUTINE TO BE CALLED
/	AFTER C.D. HAS BEEN DONE.  0 IF NONE.

/6	PTR TO FILENAME OF PROGRAM
/	TO BE CHAINED TO.  0 IF NONE.

/	FIELD 0

/1000-1777	LINE BUFFER
/2000-2777	LINE BUFFER EXTENSION
/4000-4377	REM-LINES
/4400-4777	HANDLER
/5000-5577	BUFFER
/6000-7577	MORE CCL (7 PAGES)

	REST=6000
\f	FIELD 1

	*2000

	FAKBM=404	/PLACE TO FAKE OUT KBM

START,	JMP .+3		/START FROM MONITOR
	JMP (CCLBLC	/START FROM .RUN COMMAND
			/THIS LITERAL IS AT END OF PAGE
	JMP MONCHN	/START WHEN CHAINED TO
	CLA
	CDF 0		/READ IN REST OF CCL
	TAD I (CCLBLC	/GET BLOCK OF START
	CDF 10
	TAD CCLREM
	DCA CCLREM	/GET BLOCK OF REST
	CIF 0
	JMS I (7607
	700		/READ 7 MORE PAGES
	REST
CCLREM,	1+14+1		/SKIP CCB AND *400 STUFF
	JMP ERR2
	JMS TWAIT
	CDF 0
	TAD I LVNO
	CDF 10
	TAD (-CCLTAB	/DO VERSION #'S AGREE?
	SZA CLA
	JMP BADVNO
PREGO,	JMS I (AT
	STA
	DCA I (REMD	/ALLOW RECURSIVE U'S
	CDF 0
	TAD I KENTRY	/GET ENTRY #
KCIDF,	CIF CDF 10
	TAD (PTBL	/GET ADDRESS OF PTR TO START OF ENTRY
	DCA PTR
	TAD I PTR	/GET PTR TO START OF ENTRY
	DCA PTR
	JMP I (GOO
MONCHN,
KCIF,	CIF 0
	JMS I (7607	/READ IN KBM
	1000		/4 BLOCKS
	0		/0-1777
	7		/BLOCK 7 ON SYS:
	HLT		/NO WAY TO RECOVER (EVEN 7605 DOES THIS)
	TAD (-44
	JMS I (MOVE	/ASSUME COMMAND LINE IS IN
	CDF 10		/17600-17643
	7600
	CDF 0
	1000		/MOVE TO OS/8 LINE BUFFER
	CIF CDF 0
YAT,	JMP I KFAKBM	/@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO')
	TAD I (ASSIGN	/'YAT' IS JMS'ED TO
	SNA CLA		/BY INITIAL @ COMMAND
	JMP I (LEAVE	/DO NOTHING IF NO @ GOT EXPANDED (NULL LINE)
REGO,	CIF 0
	JMS I (7607
	200		/READ ONE BLOCK
	400		/400-777
	10		/RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY
	HLT
	JMP I (FAKE

/REGO,	TAD KCIDF
/	CDF 0
/	DCA I (RETCIF	/ALLOW 'FINDIT' TO RETURN TO FIELD 1
/	CIF CDF 0
/	STA
/	DCA I (HALF
/	DCA I (ENTRY
/	TAD (KEYWRD
/	DCA I (KPTR
/	JMS I (FINDIT	/LOOK UP KEYWORD
/	SMA CLA
/	JMP PREGO	/FOUND IT
/CMDERR,	JMS I (PRMESG	/NOT A LEGAL KEYWORD
/	ERRCMD
\fERR2,	CIF CDF 0
	JMP I (NOCCL

BADVNO,	JMS I (PRINT
	BADVMS
	JMS I (VERTN
	JMP I (LEAVE	/GO AWAY
\f/TEST END OF TABLE

USRSUB,	0
	TAD I (REMD
	SMA CLA
	JMP REGO	/REMEMBERED A NEW LINE
	TAD I (FLAG	/WANT TO
	AND (70
	CLL RTR
	RAR
	TAD (-1		/IN THIS REM-LINE
	DCA UREM
	JMS I (FOREVER	/NO DATE
	JMS I (REMEM
UREM,	0
	JMP I USRSUB
\fTWAIT,	0
	DCA WFL
	JMS BATCH
	JMP TW		/BATCH NOT RUNNING
	CLA		/WE'RE RUNNING UNDER BATCH
	JMP I TWAIT
TW,	TSF
	SKP		/WAIT FOR THINGS TO QUIET DOWN
	JMP I TWAIT
LVNO,	AND I 0		/WASTE SOME TIME
KFAKBM,	AND I 4
KENTRY,	600
	ISZ WFL
	JMP TW
	JMP I TWAIT	/CAN'T WAIT TOO LONG
WFL,	0

/SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC

BATCH,	0
	CDF 0
	TAD I (7777
	CDF 10
	DCA BWORD
	TAD BWORD
	RTL
	SNL CLA		/IS BATCH RUNNING?
	JMP I BATCH	/NO
	TAD BWORD	/YES
	AND (70		/ISOLATE FIELD OF BATCH
	TAD KCIF	/FORM CIF TO THE HIGHEST FIELD
	ISZ BATCH	/AND TAKE SKIP RETURN WITH IT IN AC
	JMP I BATCH
\fBWORD,	0
	PAGE
\f/WE FALL INTO THIS FROM LITERAL ON PREVIOUS PAGE
MONFIX,	JMS I (RDMON
	CDF 0
	TAD I ZERO
	TAD (-7607
	SNA CLA
	JMP I PCCER3	/ALWAYS WRITE OUT CCL BLOCK
	CDF 10
	CIF 0
	JMS I L7607
	4200		/WRITE 1 RECORD FROM FIELD 0
	400		/LOCATIONS 400-777
	CCLBLK		/INTO THE SYSTEM'S CCL BLOCK
	JMP I (IOERR
	CDF 0
	TAD I (2000+CCLSW
	TAD (-PRQMRK
	SNA
	JMP MONOK
	TAD (PRQMRK-GETCCL
	SZA CLA
	JMP I PCCER3
/	CIF CDF 0
/	JMP I L7605
MONOK,	TAD (GETCCL
	DCA I (2000+CCLSW
	STA
	DCA I (2000+DEASADR	/DELETE DEASSIGN
	JMS WRMON
	JMS I (LOOK
	YFORT		/LOOK FOR FORT.SV
	TAD (YF4-YFORT	/NOT FOUND, USE F4
	TAD (YFORT	/FOUND USE IT
	DCA I (FORTE
	TAD I (FORTE
	TAD (-YFORT
	SZA CLA
	TAD (YLOAD-YLOADER	/F4
	TAD (YLOADER
	DCA I (LOADE
	JMP I (WRITFT	/UNKLUTZ
\fL200,
WRMON,	200
	CDF 10
	CIF 0
	JMS I L7607
	4200
L2400,	2400
	10
	JMP I (IOERR
	JMP I WRMON
\fMONRES,	0
	JMS I (RDMON
	CDF 0
	TAD (PRQMRK
	DCA I (2000+CCLSW
	TAD (-405
	DCA I (2000+DEASADR
	JMS WRMON
	JMP I MONRES

L7605,
SETLPT,	7605		/COULD BE ONCE ONLY
	TAD KLPTDEV
	JMS SETDEV
	JMP I SETLPT

L7607,	7607

M7607,
SETTTY,	-7607
	TAD KTTYDEV
	JMS SETDEV
	JMP I SETTTY

PCCER3,
SETPTP,	CCER3
	TAD (PTPDEV
	JMS SETDEV
	JMP I SETPTP

ZERO,			/STAYS 0 FOR A WHILE
SETDEV,	0		/V1A ARG NOW IN AC
	DCA DEVPTR
	CLL STA RAL	/-2
	JMS I (MOVE
	CDF 0
DEVPTR,	LOC78
	CDF 10
	DVNM1
	JMS I (SETOUT
	JMP I SETDEV

P4,	SETDEV
KLPTDEV,LPTDEV

P5,	SETDEV
KTTYDEV,TTYDEV
\fFAKE,	CIF CDF 0
	TAD (MSOVL2
	DCA I (OV	/RESTORE LOC SO DATE CMD W ARGS WILL WORK
	JMP I (FAKBM

PTCH,	CDF 0
	DCA I (VLOC
	TAD I (OS78BIT
	AND (200	/	78
	SZA CLA		/	OR
	TAD (1000	/	/8
	TAD (5770
	DCA I DEVPTR
	CDF 10
	JMS I (PRMESG
	VMES
	PAGE
\f	COLWRD		/NEEDED BY SET
GO,	JMS I (SCAN	/ADVANCE SCAN UNTIL AFTER SPACES
GO2,	TAD I PTR	/GET FLAG
	DCA FLAG	/SAVE IT
	TAD DELIM
	SNA CLA		/IS TYPED LINE EMPTY AFTER KEYWORD?
	TAD FLAG	/AND IS SPECIAL REMEMBERING BITS ON?
	CLL RTR
	RAR		/AND HAS GOD WILLED US TO REMEMBER?
	AND (7		/AND ARE THE ZODIAK SIGNS FAVORABLE?
	SNA
	JMP NORM	/NO
	TAD REMD	/YES, GET REM-LINE (SUBTRACT 1)
	DCA REMD
	CDF 0
	TAD I (BEGLN
	CDF 10
	DCA NMPTR
	JMS I (RECALL	/RECALL LINE
REMD,	-1		/-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE
	DCA DEPN	/SAVE DEPENDENT INFO
	TAD NMPTR
	SZA CLA		/EG COMMAND?
	JMP NORM	/NO
	ISZ DELIM	/YES
	TAD DEPN
	DCA PTR		/RESET PTR FROM CMD DEPENDENT WORD
	JMP GO2
\fNORM,	TAD FLAG
L7700,	SMA CLA
	JMP CHAINN	/SKIP ENTRIES IF NO CD
	ISZ PTR		/POINT TO DEFAULT INPUT EXTENSION
	TAD I PTR	/GET DEFAULT INPUT EXTENSION PTR
	DCA DEFALT	/SAVE IT
	TAD (7641
	DCA XR
	TAD FLAG
	JMS I (GAMFLG
	DCA I XR	/STORE AWAY IN C.D. OPTION TABLE
	DCA I XR	/V3D ZERO OPTION WORDS
	DCA I XR
	DCA I XR
	DCA I XR	/ZERO L.O. =
STOLUP,	ISZ PTR
	TAD I PTR
	SNA
	JMP STODON
	DCA NTEMP
	ISZ PTR
	TAD I PTR	/GET VALUE
	DCA I NTEMP	/STORE IN SPECIFIED LOCATION
	JMP STOLUP
STODON,	TAD FLAG
	AND (400
	SZA CLA
	JMS I (INSARR	/INSERT BACK ARROW IF FLAG BIT SET
	JMS I (CD	/PERFORM COMMAND DECODE IF FLAG BIT
			/0 SET
CHAI,	TAD FLAG
	RAL
	SMA CLA		/IS SPOOLING PROHIBITED?
	JMS I (SPOOLIT	/NO
CHAINN,	ISZ PTR		/POINT TO AFTER CD SUBR
	TAD I PTR	/GET SUBR ADDRESS
	JMS I (JMSUB
	TAD I (DEFILE
	SZA		/IS THERE A FILENAME SET TO CHAIN TO?
	JMP ZOW		/YES
	ISZ PTR		/NO, POINT TO FILENAME
	TAD I PTR
	SNA
	JMP I (LEAVE	/NO FILE TO CHAIN TO
ZOW,	DCA NMPTR
	JMS LOOK	/LOOKUP FILE
NMPTR,	0
	JMP I (CCER1	/NOT FOUND
CHAIN,	JMS I (200	/CHAIN TO IT
	6		/CHAIN
DEPN,			/REM LINE DEPENDENT INFO
BLK,	0
/	-----
\f/LOOK, LOOKS UP FILE ON DEVICE .  POINTER IS IN ARG1
/	ARG2 IS ERROR RETURN IF NOT FOUND
/DEVICE NUMBER IS IN AC.  IF 0, USE SYS:

LOOK,	0
	SNA
	IAC
	DCA DEV
	TAD I LOOK	/GET PTR TO FILE NAME IN FIELD 0
	DCA HISFIL
	TAD HISFIL
	AND L7700
	SNA CLA
	JMP FLD1	/PTR LT 100 MEANS IN FIELD 1
	TAD (-3
	JMS I (MOVE	/MOVE IT UP
	CDF 0
HISFIL,	0
	CDF 10
PFILDMY,FILDMY
	TAD PFILDMY
SETN,	DCA NAMPTR	/STORE AWAY PTR TO FILENAME
	ISZ LOOK	/POINT TO ERROR RETURN
	TAD DEV		/GET DEVICE NUMBER
	JMS I (200
	2		/LOOKUP
NTEMP,
NAMPTR,	0
	0
	JMP I LOOK	/TAKE ERROR RETURN IF NOT FOUND
	TAD NAMPTR	/STORE STARTING BLOCK # IN 'BLK'
	DCA BLK
	ISZ LOOK	/POINT TO NORMAL RETURN
	JMP I LOOK	/RETURN
\fFLAG,	0
DEV,	0

FLD1,	TAD HISFIL
	JMP SETN
	PAGE
\fXEXE,	5033;	EXTEXE;	7643;40;0;	EXSUB;	YPAL8	/EXECUTE MUST BE FIRST FOR TECO EG
XBAC,	0;				TRMSUB;	YCAMP	/BACKSPACE (OR TERMINATE)
							/MUST BE 2ND FOR OS78
XBAS,	0;				BASUB;	YBASIC	/BASIC
XDUPL,	4001;	STAR;	0;		0;	YRXCOP	/DUPLIC
XBOO,	0;				0;	YBOOT	/BOOT
XCCL,	0;				MONRES;	0	/CCL
XCOMPA,	4001;	EXTNUL;	0;		SETTTY;	YSRCCOM	/COMPARE
XCOMPI,	5033;	EXTCOM;	0;		EXSUB;	YPAL8	/COM
XCOP,	4001;	STAR;	7643;1;0;	MOVRT;	YFOTP	/COPY
XCOR,	0;				DETCOR;	0	/MEMORY
XCREA,	4400;	EXTNUL;	0;		CRSUB;	YEDIT	/CREATE
XCREF,	4002;	EXTCF;	7643;1000;0;	0;	YPAL8	/CREF
XDAT,	0;				DATE;	0	/DATE
XDEL,	4001;	STAR;	7643;401;0;	KILRT;	YFOTP	/DELETE
XDEA,	0;				DEASSIG;0	/DEASSIGN
XDIR,	4001;	STAR;	7646;COLWRD,0;0;SETTTY;	YDIRECT	/DIRECT
XEDI,	5220;	EXTNUL;	0;		EDSUB;	YEDIT	/EDIT
XEOF,	0;				0;	YCAMP	/EOF
XHEL,	4001;	STAR;	7644;20;0;	SETTTY;	YHELP	/HELP
XLINK,	5033;	EXTLI;	0;		EXSUB;	YLINK	/LINK
XMAC,	5033;	EXTMA;	0;		EXSUB;	YMACREL	/MAC
XLIS,	4001;	STAR;	7644;10;0;	SETLPT;	YFOTP	/LIST
XLOA,	5031;	EXTLO;	0;		EXSUB;	YABSLDR	/LOAD
XMAK,	0;				MAKSUB;	YTECO	/MAKE
XMAP,	4001;	EXTBN;	0;		SETTTY;	YBITMAP	/MAP
XMUN,	0;				MNGSUB;	YTECO	/MUNG
XPAL,	5033;	EXTPA;	0;		EXSUB;	YPAL8	/PAL
XPRI,	4000;	STAR;	0;		SETLPT;	YLPTSPL	/PRINT
XPUN,	4001;	EXTNUL;	0;		SETPTP;	YPIP	/PUNCH
XREN,	4001;	STAR;	7643;1;7644;100;0;RENRT;YFOTP	/RENAME
XRES,	4001;	EXTSY;	0;		SETTTY;	YRESORC	/RESOURCES
XREW,	0;				0;	YCAMP	/REWIND
XSET,	0;				0;	YSET	/SET
XSKI,	0;				0;	YCAMP	/SKIP
XSQU,	4001;	EXTNUL;	7644;40;0;	SQSUB;	YPIP	/SQUISH
XSUB,	4000;	EXTBI;	0;		0;	YBATCH	/SUBMIT
XTEC,	10;				TECSUB;	YTECO	/TECO
XTYP,	4001;	STAR;	7644;10;0;	SETTTY;	YFOTP	/TYPE
XUNL,	0;				0;	YCAMP	/UNLOAD
XUA,	40;				USRSUB;	0	/UA
XUB,	50;				USRSUB;	0	/UB
XUC,	60;				USRSUB;	0	/UC
XVER,	0;				VERTN;	0	/VERSION
XZER,	4401;	EXTNUL;	7645;2000;0;	ZERSUB;	YPIP	/ZERO
XAT,	0;				YAT;	0	/@
	ZBLOCK 13

GAMFLG,	0
	CDF 0
	TAD I PAMFLAG	/COMBINE ALTMODE BITS
	CDF 10
	RAR		/IN POSITION 11
	CLA RAR		/PUT NEW ALTMODE BIT ALONE IN BIT 0
	JMP I GAMFLG
PAMFLAG,AMFLAG
\fTRMSUB,	0
	CDF 0
	TAD I POS78
	CDF 10
	AND R200
	SNA CLA
	JMP I TRMSUB	/BACKSPACE, NOT TERMINATE
	6073
	6002
	CLA		/JUST IN CASE WE'RE NOT ON A VT-78
	JMS I PPRM
	BADEV
POS78,	OS78BIT
R200,	200
PPRM,	PRMESG
\fPTBL,	XEXE
	XBAC
	XBAS
	XDUPL
	XBOO
	XCCL
	XCOMPA
	XCOMPI
	XCOP
	XCOR
	XCREA
	XCREF
	XDAT
	XDEL
	XDEA
	XDIR
	XEDI
	XEOF
	XHEL
	XLINK
	XMAC
	XLIS
	XLOA
	XMAK
	XMAP
	XMUN
	XPAL
	XPRI
	XPUN
	XREN
	XRES
	XREW
	XSET
	XSKI
	XSQU
	XSUB
	XTEC
	XTYP
	XUNL
	XUA
	XUB
	XUC
	XVER
	XZER
	XAT
	ZBLOCK 4
\fSTAR,	5200;	0
	0;	0


EXTSY,	2331;	0
	0;	0
EXTBI,	0211;	0
	0;	0
EXTCF,	2001;	COMPA
/EXTLS,	1423;	COMLS
	0;	COMPA
EXTMA,	1501;	COMMA
	0;	COMMA
EXTPA,	2001;	COMPA
	0;	COMPA
EXTBN,	0216;	0
	0;	COMBN
/EXTHL,	1014;	0
/	0;	0
EXTNUL,	0;	0
EXTLO,	0216;	COMBN	/BN
	2214;	COMRL	/RL
EXTLI,	2202;	COMRB	/RB
	0;	0
EXTCM,	0315;	0
	0;	0
\fEXTEXE,	2001;	COMPA	/PA
	0624;	COMFT	/FT
	0201;	COMBA	/BA
	1501;	COMMA	/MA
	0216;	COMBN	/BN
	2214;	COMRL	/RL
	2201;	COMRA	/RA
	2302;	COMSB	/SB
	2202;	COMRB	/RB
	1404;	COMLD	/LD V3C
	0211;	COMBI	/BI
	0;	0
	ZBLOCK 4
EXTCOM,	2001;	COMPA	/PA
	0624;	COMFT	/FT
	1501;	COMMA	/MA
	0201;	COMBA	/BA
	2201;	COMRA	/RA
	2302;	COMSB	/SB
	0;	0
	ZBLOCK 4
	IFZERO .&7600-3200 <PAGE>
\fCOMBN,	0
	JMS USUAL
	0216
	YABSLDR
	JMP I COMBN

COMRL,	0
	JMS USUAL
	2214
LOADE,	YLOAD		/MAY BECOME YLOADER
	JMP I COMRL

COMPA,	0
	JMS USUAL
	2001
	YPAL8
	JMP I COMPA

COMFT,	0
	JMS USUAL
	0624
FORTE,	YF4		/COULD BE CHANGED TO YFORT BY .R CCL
	JMP I COMFT

COMBA,	0
	JMS USUAL
	0201
	YBCOMP
	JMP I COMBA

COMRA,	0
	JMS USUAL
	2201
	YRALF
	JMP I COMRA
\fCOMSB,	0
	JMS USUAL
	2302
	YSABR
	JMP I COMSB

COMRB,	0
	JMS USUAL
	2202
	YLINK
	JMP I COMRB

COMMA,	0
	JMS USUAL
	1501
	YMACREL
	JMP I COMMA

COMBI,	0
	JMS USUAL
	0211
	YBATCH
	JMP I COMBI

COMLD,	0
	JMS USUAL
	1404
	YFRTS
	JMP I COMLD
\fDEFILE,	0		/PTR TO FILENAME TO CHAIN TO

/COMLS,	0
/	TAD I (EXTLS
/	DCA SETEXT
/	TAD (YCREF
/	DCA DEFILE
/	ISZ I (DONB	/CREF FOO.LS MAKES NO BINARY
/	JMP I COMLS

RDMON,	0
	CDF 10
	CIF 0
	CLA
	JMS I (7607
	0400		/READ 2 RECORD
	2000		/LOCATION 2000 FIELD 0
	7		/BLOCK 7,10
	JMP I (IOERR
	JMP I RDMON

USUAL,	0
	TAD I USUAL
	DCA SETEXT
	ISZ USUAL
	TAD I USUAL
	DCA DEFILE
	ISZ USUAL
	JMP I USUAL
\fUNKN,	0
	TAD SETEXT
	SZA
	TAD T		/NEG OF SWITCH REQUEST
	SZA CLA
	JMP I (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 I (CDER4	/NO
	ISZ DEF		/YES
/	TAD I (JMSUB	/ALLOW RECURSIVE CALL
/	DCA HOLD
	TAD I DEF
	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

SEMERR,	TAD (SEMSG-1
	DCA UNKN
	TAD I UNKN
	DCA .+2
	JMS I (PRMESG
	SEMSG1
\fWRITFT,	JMS I (LOOK
	YCCL
	JMP I (IOERR	/CCL.SV NOT FOUND
	TAD I (BLK
	TAD (4		/*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB
	DCA FBLK
	CDF 10
	CIF 0
	JMS I (7607
	4210		/WRITE 1 RECORD FROM FIELD 1
	3400		/LOCS 3400-3777
FBLK,	0
	JMP I (IOERR
	CIF CDF 0
	JMP I (7605
	PAGE
\fCD,	0
	JMS I (200
	13		/RESET ALL HANDLERS
	JMS I (CDINIT
BEGGRP,	TAD OUTSW
	SNA CLA
	TAD I (BEGDIF	/DIFF BETWEEN INPUT & OUTPUT AREAS
	TAD (MOFILE-1
	DCA CLXR
	JMS I (GETSPC
	JMS I (ASSIGN
	TAD OUTSW
	SNA CLA
	TAD I (LIMDIF	/DIFF BETWWEN END OF OUTPUT & INPUT AREAS
	TAD I (OUTLIM	/END OF OUTPUT AREA
	TAD CLXR
	SMA CLA
	JMP I (CDER1
	JMS I (CCLSWT
	TAD OUTSW
	SNA CLA
LKUPSW,	JMP INFILE	/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 LSTPUT
INFILE,	JMS I (LOOKUP
	JMS PCLXR	/STORE LENGTH AND DEV NUMBER
	TAD I (LNAME	/GET BLOCK
LSTPUT,	JMS PCLXR
	TAD 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 DONB
	SZA CLA
	JMP NBS
	TAD (7600	/V1A NOW TAKES ARG IN AC
	JMS I (NMOVE	/MOVE NAME TO OUTPUT FILE NAMES
	JMP DLOOK
\fNBS,	DCA DONB	/ZERO 1ST OUTPUT FILE
	TAD (7577
	DCA XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
DLOOK,	STA
	DCA I (DVFLAG
	TAD DELIM
	SNA
	JMP I CD
	TAD (-"[
	SNA
	JMP I (OLENGT
	TAD ("[-",
	SNA
	JMP I (FILLP	/**** JUMPING INTO ROUTINE (IS THIS A BUG?)
	TAD (",-"<
	SNA
	JMP BKAROW
	TAD ("<-"=
	SZA CLA
	JMP I (CDER2	/BAD CHAR
/ THIS STUFF WOULD ALLOW = AS WELL AS < AND _
/*** HAVE TO FIX 'BKA' ROUTINE
/	JMS I (GLXR
/	JMS I (DECODE
/	STL
/	STA		/LINK=0 MEANS LETTER
/	TAD LXR		/NOW LINK=1 MEANS LETTER
/	DCA LXR
/	SZL
/	JMP BKAROW
	DCA I (NUMFUJ
	JMS I (NUMBER
	DCA I (MPARAM+3
	CLA CLL CML RAR
	AND I (MPARAM-1	/PRESERVE  ALTMODE
	TAD I (HIORD
	DCA I (MPARAM-1
	JMS I (CCLSWT
	JMP DLOOK
BKAROW,	ISZ OUTSW
	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
\fDONB,	0		/ENTRY PT USED AS FLAG
	JMP I DONB

OUTSW,	-1		/-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE

P6,	SETDEV
	TVDEV
	PAGE
\fNUMBER,	0
	SZA CLA
	TAD (NUM&177+1200-SKP
	TAD (SKP
	DCA NUMADD/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
	DCA HIORD
NUMLP,	DCA NUM
	JMS I (GCH
	ISZ NUMKNT
	SKP
	JMP EONUM2
	CMA
	TAD NUMFUJ
	TAD ("8		/TEST INPUT CHARACTER FOR RANGE
	CLL CMA		/0-7 IF NUMFUJ=0
	TAD (10		/0-9 IF NUMFUJ=2
	TAD NUMFUJ
	SNL
	JMP EONUM
	DCA T
	CLA CLL CMA RTL
	DCA DELIM
	TAD NUM
ROTLP,	CLL RAL
	DCA NUMX
	TAD HIORD
	RAL
NUMSKP,	SPA		/MODIFIED BY #
	JMP I (CDER5
	DCA HIORD
	TAD NUMX
	ISZ DELIM
	JMP ROTLP
NUMADD,	TAD NUM		/SKP IF OCTAL
	TAD NUM
	TAD T
	JMP NUMLP
EONUM,	TAD ("0
EONUM2,	DCA DELIM
	TAD NUMKNT
	SPA CLA
	JMP I (CDER5	/FEWER THAN CORRECT NUMBER OF DIGITS
	TAD NUM
	JMP I NUMBER

NUM,	0
NUMFUJ,	0
NUMKNT,	0		/SET TO -N-1 TO FORCE N DIGITS
HIORD,	0
\fASSIGN,	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
NUMX,
AS,	0
	0
	0
ASADR,	HNDLR+1
	JMP I (CDER0
	TAD AS+2
ASGNST,	DCA I (DVICE
	JMP I ASSIGN
\fDFLTNM,	DEVICE DSK
GETHND,	11		/1+11=12 (1=FETCH, 12=INQUIRE)

LOVE,	0
	TAD NAME1
	TAD (-1417
	SZA CLA
	JMP I LOVE
	TAD NAME2
	TAD (-2605
	SZA CLA
	JMP I LOVE
	TAD NAME3
	TAD NAME4
	SZA CLA
	JMP I LOVE
	JMS I (PRINT
	LOVMES
	JMP I LOVE

FILDMY,	FILENAME DUMMY.SV

SEMSG,	SEMSG1
	SEMSG2
	SEMSG3
	SEMSG4
	PAGE
\f/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
/RETURNS WITH DELIMETER IN AC
/GIVES ERROR MESSAGE IF NAME IS BAD

TN,			/DON'T CALL CCLSWT FROM GNAME UNLESS THIS IS MOVED
GNAME,	0
	DCA NAME1
	DCA NAME2
	DCA NAME3
	DCA NAME4
	TAD (NAME1
	DCA NMBASE
	CLA CMA
	DCA PERDSW
	DCA NAMECT
	JMS I (GCH
	TAD (-"#
	SNA
	JMP NUMCON
	TAD ("#
	SKP
GTNMLP,	JMS I (GCH
	DCA DELIM
	TAD DELIM
	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
	TAD (4
	DCA NAMECT
	JMP GTNMLP
\fCCLSWT,	0
	TAD DELIM
	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 XLK2	/ONE CHAR CCL SWITCH
	TAD TN
	DCA TN
	JMS GETL
XLK2,	SKP CLA		/2 CHAR CCL SWITCH
	JMP I (CDER44	/3 CHAR CCL-SWITCH
	TAD TN
	JMS I (EXTLUK
	CLA
	ISZ DEF
	TAD I DEF
	DCA GETL	/GET PTR TO ARGUMENT PAIR
	TAD I GETL	/GET SUBROUTINE
	DCA PERDSW
	ISZ GETL
	TAD I GETL	/GET ARGUMENT
	JMS I PERDSW	/CALL SUBR, ARG IN AC
	JMP CCLSWT+1
\fGETL,	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

NUMCON,	JMS I (NUMC
LV,	CLA
	TAD DELIM
	JMP I GNAME

PERDSW,	0
NAMECT,	0
	PAGE
\fLOOKUP,	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,	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,	TAD (NAME1
	DCA LNAME
	TAD I (AS+2
	JMS I (200
	2
LNAME,	0		/NAME1
LENGTH,	0
	JMP LFAILD
	ISZ DEF		/POINT TO FOLLOW-UP SUBROUTINE
	TAD I DEF
	JMS JMSUB	/CALL IT
	TAD LENGTH
	CLL
	TAD (400
	SNL
CLACON,	7600		/CLA
	CLL RTL
	RTL
	AND (7760
LKUPST,	TAD DVICE
	JMP I LOOKUP
\fLFAILD,	TAD NAMERM
	SNA CLA		/WAS THERE AN EXPLICIT EXTENSION?
	TAD I DEF	/NO - WAS THERE A DEFAULT EXTENSION?
	SNA CLA
	JMP I (CDER3	/NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
NEXTEXT,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
XLUK,	TAD I DEF
	SNA		/AT NULL?
	JMP I EXTLUK	/YES
	TAD T		/NO
	SNA CLA		/MATCH?
	JMP MAT		/YES
	ISZ DEF		/NO
	ISZ DEF		/POINT TO NEXT ENTRY
	JMP XLUK	/TRY AGAIN
MAT,	TAD I DEF	/RETURN WITH IT IN AC
	JMP I EXTLUK

TS,
ZERSUB,	0
	TAD I (7601
	SNA CLA		/WAS FILENAME SPECIFIED ON ZERO CMD?
	TAD I CLACON	/OR WAS NO OUT DEVICE SPECIFIED?
	SNA CLA
	JMP I (CDER2	/YES... ERROR
	JMP I ZERSUB	/NO, OKAY.
\fIOERR,	JMS I (PRMESG
	SYSER

EXSUB,	0
	TAD BASPTR	/PUSH PTR BACK TO BEGIN OF ENTRIES
	JMS I (REMEM	/REMEMBER THIS IN DEPENDENT WORD
	2
	JMP I EXSUB

JMSUB,	0
	SNA
	JMP I JMSUB
	DCA TS
	JMS I TS
	JMP I JMSUB
\fSPOOLIT,0
	JMS I (BATCH	/IS BATCH RUNNING?
	JMP I SPOOLIT	/NO
	DCA CB		/YES
	TAD I DEFALT
	TAD (-5200
	SNA CLA
	TAD I DEFALT	/LEAVE 5200 IN AC IF SPECIAL MODE
CB,	HLT		/CIF TO FIELD OF BATCH
	JMS I (BATSPL	/ALLOW BATCH TO SPOOL STUFF
	JMP I SPOOLIT

GOO,	TAD PTR
BASPTR,	DCA BASPTR
	JMP I (GO
	PAGE
\fSLSHCH,	0
	DCA DELIM
	TAD (MPARAM-1
	DCA T
	TAD DELIM
	JMS DECODE
	JMP CDER8
	SZL
	TAD (32
	CMA STL		/THE FOLLOWING TURNS
			/ON THE CORRECT OPTION BIT
	DCA TT
SLSHLP,	SZL
	ISZ T
	RAR
	SNL
	ISZ TT
	JMP SLSHLP
	DCA TT
	TAD TT
	CMA
	AND I T
	TAD TT
	DCA I T
	JMP I SLSHCH

/THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT
/IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0
/IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1
/IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC.
DECODE,	0
	TAD (-"9-1	/MIGHT BE CALLED WITH ANY DF
	CLL
	TAD ("9+1-"0
	SZL
	JMP DCDYES
	TAD ("0-"Z-1
	CLL CML
	TAD ("Z-"A+1
	SNL
DCDYES,	ISZ DECODE
	JMP I DECODE

CDER8,	CLA
	JMS I (PRMESG
	BADOPT
\fZEROCD,	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
	TAD (240-"/
	SNA
	JMP SLASH
	TAD ("/-"(
	SNA
	JMP OPENP
	TAD ("(
	JMP I GCH
SLASH,	JMS GLXR
	JMS SLSHCH
/*** CAN'T PUT /A:VAL HERE BECAUSE GCH AINT RECURSIVE
	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
\fOLENGT,	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
	CLA CLL CML RTL
	DCA I (NUMFUJ	/SET "NUMBER" TO ACCEPT
			/DIGITS 8 AND 9
	STA		/ALLOW DECIMAL
	JMS I (NUMBER
	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 (DLOOK
\fBASUB,	0
	TAD (200	/SET /Q SWITCH
	DCA I (MPARAM+1
	JMP I BASUB
	PAGE
\fPRMESG,	0
	CLA
	TAD I PRMESG
	DCA .+2
	JMS PRINT
	HLT
LEAVE,	JMS I (TWAIT
/V3D	TCF
	CIF CDF 0
	TAD FATALFLG
	SNA CLA
	JMP I (7605
FATALFLG,0		/CIF CDF BATCH FIELD IF WANT TO ABORT
	JMP I (BATERR

PRWD,	0
	DCA T
	TAD T
TTY212,	RTR
	RTR
	RTR
	JMS PCHAR
	TAD T
	JMS PCHAR
	JMP I PRWD

PCHAR,	0
	AND (77
	SNA
	JMP I PCHAR	/IGNORE NULLS
	TAD (240
	AND (77
	TAD (240	/CAN'T USE 'TTY240'
	JMS TYPE
	JMP I PCHAR

PRNAME,	0
	TAD NAME1
	JMS PRWD
	TAD NAME2
	JMS PRWD
	TAD NAME3
	JMS PRWD
	TAD NAME4
	SNA CLA
	JMP I PRNAME
	TAD (256
	JMS PCHAR
	TAD NAME4
	JMS PRWD
	JMP I PRNAME
\fTYPE,	0
	DCA TE2
	JMS I (BATCH
	JMP TTYOUT
	DCA CIFB
CIFB,	HLT		/REPLACED BY CIF BATCH FIELD
	TAD TE2
	JMS I (BATOUT
	TAD TE2
	TAD (-"#
TTY240,	SZA CLA
	JMP I TYPE
	TAD CIFB
	IAC		/CONVERT CIF TO CIF CDF
	DCA FATALFLG
	JMP I TYPE

TTYOUT,	TAD TE2
	TAD (-"#	/DON'T TYPE #'S
	SNA CLA
	JMP I TYPE
	TAD T7600
	KRS
	TAD (-7603
	SNA
	JMP LEAVE
	TAD (203-217
	SNA CLA
	JMP I TYPE
	TAD TE2
TJUMP,	JMP .+3
	TSF
	JMP .-1
	TLS
T7600,	7600
	TAD (7000
	DCA TJUMP
	JMP I TYPE
\fPRINT,	0
	DCA CRLF	/AC NON-0 MEANS DON'T CRLF
	TAD I PRINT
	ISZ PRINT
	DCA TE
PRINTP,	CDF 0
	TAD I TE
	CDF 10
	JMS PRWD
	CDF 0
	TAD I TE
	CDF 10
	ISZ TE
	AND (77
	SZA CLA
	JMP PRINTP
	TAD CRLF
	SNA CLA
	JMS CRLF
	JMP I PRINT
TE,	0
TE2,	0
\fCRLF,	0
	TAD (215
	JMS TYPE
	TAD TTY212
	JMS TYPE
	JMP I CRLF

CDER2,	JMS PRMESG
	BADSYN

P1,	NMOVE
	7605
	PAGE
\fCCERB,	JMS I (PRMESG
	BADSW
CDER1,	JMS I (PRMESG
	TOOMAN
CDER5,	JMS I (PRMESG
	BADNUM
CCER1,	TAD I (NAMPTR
	DCA NMX
	TAD (-4
	JMS I (MOVE
	CDF 10
NMX,	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
\fKILRT,	0
	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

SWTCHS,	1423;	P1	/LS
	1602;	P2	/NB
	1520;	P3	/MP
	1400;	P4	/L
	2400;	P5	/T
	2300;	P6	/S
	2000;	P7	/P
	0400;	P8	/D
	1600;	P9	/N
	0000;	P10	/UNKNOWN
	ZBLOCK 2	/PATCH ROOM FOR USER

P2,	DONB
	0

P3,	NMOVE
	7612

P7,	SETDEV
	PTPDEV

P9,	SETDEV
	NULDEV

P10,	UNKN
	0
\fSCAN,	0
	TAD (BEGLN
	DCA T
	CDF 0
	JMS BLSCAN	/IGNORE INITIAL SPACES
	JMP CHK
NOBLUP,	CLA
	ISZ T
	TAD I T
CHK,	SNA
	JMP ENDOFB
	JMS I (DECODE
	SKP CLA
	JMP NOBLUP
	JMS BLSCAN
ENDOFB,	DCA DELIM
	STA
	TAD T
	CDF 10
	DCA I (LBEGIN
	JMP I SCAN

BLSCAN,	0
	TAD I T
	TAD (-240
	SZA
	JMP BL2
	ISZ T
	JMP BLSCAN+1
BL2,	TAD (240
	JMP I BLSCAN	/LEAVE CHAR IN AC
	PAGE
\f	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 CMDERR	/DON'T ALLOW MAKE <CR>
	JMS SETLXR
	JMS I (GETSPC
	JMS I (LOVE
	JMS TECPUT
	"E;"W;0
	JMS TECMOV
	JMS SETPA
	JMS TECPUT
	ALTMODE;0
	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
TECL,	CDF 0
	TAD I XR2
	CDF 10
	JMS I (TPUT
	TAD XR2
	CMA
	TAD LXR
	SNA CLA
	JMP I TECMOV
	JMP TECL
\fTECSUB,	0
	JMS SETLXR
	JMS I (GETSPC
	TAD DELIM
	SNA
	JMP TECNORM
	TAD (-"<	/ALLOW "_" AS WELL AS "<"
	SNA
	JMP EXTEN
	TAD ("<-"_
	SZA CLA
	JMP I (CDER2
EXTEN,	CDF 0
	DCA I LXR	/CHANGE < TO 0
	CDF 10
	JMS TECPUT
	"E;"W;0
	JMS TECMOV
	JMS SETPA
	TAD LXR
	DCA SAVLXR
	JMS I (CHKSUP
	JMS I (GETSPC
	JMS TECPUT
	ALTMODE;"E;"R;0
	JMS TECMOV
	JMS SETPA
	JMS TECPUT
	ALTMODE;"Y;0
	JMP TECLV
\fTECNORM,JMS TECPUT
	"E;"B;0
	JMS TECMOV
	JMS SETPA
	JMS TECPUT
	ALTMODE;"Y;0
TECLV,	JMS I (REMEM
	0
	JMP I TECSUB
SAVLXR,	0

CMDERR,	JMS I (PRMESG	/NOT A LEGAL KEYWORD
	ERRCMD
	PAGE
\fTPUT,	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
CDER9,	JMS I (PRMESG
	TOOLNG

MNGSUB,	0
	JMS I (SETLXR
	JMS I (GETSPC
	JMS I (TECPUT
	"E;"R;0
	JMS I (TECMOV
	JMS SETX
	"T;"E
EXTOK,	JMS I (TECPUT
	ALTMODE;"Y;"H;"X;"Y;"H;"K;"I;0
	TAD DELIM
	SNA
	JMP IFIN
	TAD (-",
	SZA CLA
	JMP I (CDER2
G,	STL CLA RAR	/PREVENT 'GCH' FROM HANDLING SPACE AND /
	JMS I (GCH
	AND (177	/GET RID OF HIGH ORDER BIT
	SNA
	JMP IFIN
	JMS TPUT
	JMP G
IFIN,	JMS I (TECPUT
	ALTMODE;"M;"Y;0		/MACRO GETS CALLED WITH POINTER PAST CHARS
	JMP I MNGSUB
TYR,	0
\f/SET DEFAULT EXTENSION

SETX,	0
	TAD I SETX
	DCA C1
	ISZ SETX
	TAD I SETX
	DCA C2		/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
	".
C1,	0
C2,	0
	0
	TAD C1
	AND (77
	JMS I (ROTL
	DCA C1
	TAD C2
	AND (77
	TAD C1
	DCA NAME4
	JMP I SETX

CCERA,	JMS I (PRMESG
	CONTRA
\fCRSUB,	0
	TAD I (7617
	SNA CLA		/BETTER BE NO INPUT
	TAD I (7600	/ANYTHING THERE?
	SNA CLA
	JMP I (CDER2	/NO OUTPUT OR YES INPUT
	JMS EDSUB	/REMOVE BACK-ARROW AND REMEMBER CREATE LINE
	JMP I CRSUB

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 PTR IN CASE NO ARROW

CCER3,	CDF 10
	JMS I (PRMESG
	BADMON

CDER4,	CLA
	JMS I (PRMESG
	BADSW
CDER44,	CLA
	JMS I (PRMESG
	BADSW2
CDER7,	JMS I (PRMESG
	BADX
CDER6,	JMS I (PRMESG
	BADSTR
	PAGE
\fINSARR,	0
	TAD (BEGLN
	DCA XR
	CDF 0
	TAD I XR
	SZA CLA
	JMP .-2
	STA
	TAD XR
	DCA XR
	TAD ("<
	DCA I XR
	DCA I XR
	CDF 10
	STA
	TAD XR
	DCA I (ARLOC	/REMEMBER WHERE WE INSERTED A "_"
	JMP I INSARR

BKA,	0
	TAD I (LBEGIN
	DCA CLXR
GG,	CDF 0
	ISZ CLXR
	TAD I CLXR
	CDF 10
	SNA
	JMP NOBKAR
	TAD (-"<
	SNA
	JMP I BKA
	TAD ("<-"_
	SZA CLA
	JMP GG
	TAD ("<
	CDF 0
	DCA I CLXR
	CDF 10
	JMP I BKA
NOBKAR,	ISZ BKA
	JMP I BKA
\fAT,	0
	CIF CDF 0
	JMS I (SEMI
ATMORE,	TAD (BEGLN-1
	DCA LXR
ATLOOP,	JMS I (GLXR
	SNA
	JMP I AT
	TAD (-300
	SZA CLA
	JMP ATLOOP
	TAD LXR
	DCA I (SAVL
	JMS I (FUDG
	JMS I (GETSPC
	JMS I (ASSIGN
	DCA I (SETEXT
	TAD (EXTCM
	DCA DEFALT
	JMS I (LOOKUP
	SZA CLA		/V3C
	TAD I (ASADR
	SNA
	JMP I (ATERR	/IF NO FILESPEC AFTER @, ERROR
	DCA T
	TAD I (LNAME	/GET BLOCK NUMBER
	DCA BLN
	CIF 0
	JMS I T
	200		/READ 2 PAGES
NWB,	BFR+200		/INTO BUFFER
COUNT,
BLN,	0		/FROM THIS BLOCK
	JMP I (ATERR	/ I/O ERROR
	TAD (-200
	DCA COUNT
	TAD (BFR-1
	DCA XR
	TAD NWB
	DCA T
	CDF 0
ALP,	TAD I T
	JMS I (P
	CLL RTR
	RTR
	DCA BKA
	ISZ T
	TAD I T
	JMS I (P
	CLL RTL
	RTL
	RAL
	TAD BKA
	JMS I (P
	CLA
	ISZ T
	ISZ COUNT
	JMP ALP
	JMP I (ATOVER

/ATFIN,	TAD LXR
/	TAD (-BEGLN
/	SZA CLA
/	JMP I AT	/LEAVE
/	JMP I (LEAVE	/LEAVE BECAUSE LINE NOW EMPTY
	PAGE
\fP,	0
	AND (177
	SNA
	JMP CTZ		/END AT 0 OR ^Z
	TAD (-32
	SNA
	JMP CTZ
	TAD (32-16	/IGNORE CR,LF,FF,VT
	CLL
	TAD (16-12
	SZL
	JMP POGO
	TAD (212	/FORCE 8-BIT
	DCA I XR
POGO,	CLA
	TAD I T
	AND (7400
	JMP I P
\fCTZ,	CDF 10
	TAD LXR
	DCA ATEND
	STA
	TAD LXR
	DCA LXR		/INCASE @ GOES TO EOL
	JMS I (GLXR	/SEARCH FOR EOL
	SZA CLA
	JMP .-2
	TAD LXR
	CMA
	TAD ATEND
	DCA ENDLEN
	TAD XR
	CMA
	TAD (BFR	/GET LENGTH OF INSERTED STUFF
	DCA NEWLEN
	CDF 0
	TAD I ATEND	/GET NEXT CHAR AFTER FILESPEC
	CDF 10		/V3C
	TAD (-"'
	SZA CLA		/IS IT AN APOSTROPHE?
	JMP .+3		/NO
	ISZ ENDLEN	/YES
	ISZ ATEND	/MAKE IT GO AWAY
	TAD ENDLEN
	JMS I (MOVE	/MOVE REST OF LINE UP
	CDF 0
ATEND,	0		/FIRST CHAR POSITION AFTER @ SPEC
	CDF 0
	BEGLN+1000
	TAD NEWLEN	/IF 0, 'MOVE' WILL IGNORE IT
	JMS I (MOVE	/MOVE IN NEW STUFF
	CDF 0
	BFR
	CDF 0
SAVL,	0		/POINTS TO @
	TAD NEWLEN
	CIA
	TAD SAVL
	DCA NEWEND
	CLL
	TAD NEWEND
	TAD (-BEGLN-1000
	SZL CLA
	JMP ATOVER
	TAD ENDLEN
	JMS I (MOVE	/MOVE BACK END
	CDF 0
	BEGLN+1000
	CDF 0
NEWEND,	0		/FIRST POSITION AFTER NEW STUFF
	JMP I (ATMORE	/LOOK FOR MORE
\fATOVER,	JMS I (PRMESG
	OVFLOW
GETMP,
ENDLEN,	0		/- NO. OF CHARS AT END INCLUDING 0

NUMC,	0
	TAD (SKP
	DCA I (NUMSKP
	TAD (-11
	DCA I (NUMKNT
	JMS I (NUMBER
	DCA NAME2
	TAD I (HIORD
	DCA NAME1
	STA
	TAD LXR
	DCA LXR
	TAD (-11
	DCA I (NUMKNT
	JMS I (NUMBER
	DCA NAME4
	TAD I (HIORD
	DCA NAME3
	TAD (SPA
	DCA I (NUMSKP
	JMP I NUMC
\fNEWLEN,			/- NO. OF CHARS BEING INSERTED
GETYR,	0
	AND (7
	DCA GETMP
	CDF 0
	TAD I (7777
	CDF 10
	CLL RTR
	RTR
	AND (30
	TAD GETMP
	JMP I GETYR
	PAGE
\f/	TAD (-# OF LOCS TO MOVE
/	JMS MOVE
/	FROM CDF
/	FROM LOC
/	TO CDF
/	TO LOC

MOVE,	0
	DCA T
	TAD I MOVE	/GET FROM CDF
	DCA FRCDF
	ISZ MOVE
	STA
	TAD I MOVE	/GET FROM LOC-1
	DCA XR
	ISZ MOVE
	TAD I MOVE	/GET TO CDF
	DCA TOCDF
	ISZ MOVE
	STA
	TAD I MOVE	/GET TO LOC-1
	DCA XR2
	ISZ MOVE	/POINT TO RETURN
	TAD T
	SNA CLA
	JMP I MOVE	/V1A IGNORE 0 MOVE
FRCDF,	HLT
	TAD I XR
TMP1,
TOCDF,	HLT
	DCA I XR2
	ISZ T
	JMP FRCDF
	CDF 10
	JMP I MOVE
\fDETCOR,	0
	CIF 0
	JMP I (CORE
	JMP I DETCOR

BADCOR,	JMS I (PRINT
	NOCORE
GOEQ,	CIF CDF 0
	JMP I (COREQ

ABSCOR,	JMS I (PRINT
	CORMES
	JMP I DETCOR

WRSCOR,	JMS I (PRINT
	BATCOR
	JMP GOEQ

SCRM,	JMS I (PRINT
	SCRMES
	JMP I DETCOR
\fSQSUB,	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 TMP1
	TAD I TMP1	/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
\fSETOUT,	0
	TAD I (FLAG
	RTR
	SZL CLA
	TAD (5
	TAD K7600
	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 MOVE
	CDF 10
	NAME1
	CDF 10
OLOC,	7600		/INITIALLY 7600 OR 7605
	JMP I SETOUT
\fENGOA,	TAD (-5
	JMS I (ZEROCD
	CDF 0
	TAD I (BLKNO
	CDF 10
	DCA I (7620
	CLA IAC
	DCA I (7617	/'CCBTCH' IS ON SYS:
	TAD (20		/   /T OPTION
	DCA I (7644
	TAD (20		/  ALSO /H (HUSH) OPTION
	DCA I (7643
	TAD (YBATCH
	JMP I (ZOW	/CHAIN TO BATCH
	PAGE
\fDATE,	0
	TAD I (DATWD
	SNA
	JMP NODATE
	DCA DATEM
	TAD DATEM
	CLL RTL
	RTL
	RAL
	AND (17
	DCA TM1
	TAD TM1
	TAD (MONLST-1
	DCA TM2
	CDF 0
	TAD I TM2
	CDF 10
	DCA MONP
	TAD DATEM
	JMS I (GETYR	/V3D DATE/78 ALGORITHM
	DCA TM2
	TAD TM2
	TAD (106	/70.
	CIF CDF 0
	JMS I (OTODY
	DCA YEAR
	TAD DATEM
	CLL RTR
	RAR
	AND (37
	DCA DATEM
	TAD DATEM
	CIF CDF 0
	JMS I (OTODY
	DCA DAY
	CDF 0
	STL CLA RTL	/2
	TAD TM2
	CLL RTR
	SNL SMA
	JMP LEAP
	ISZ I (JAN
	ISZ I (FEB
LEAP,	AND (37
	TAD TM2
	TAD (3
	TAD DATEM
	DCA DATEM
	TAD TM1
	TAD (JAN-1
	DCA TM1
	TAD I TM1
	CDF 10
	TAD DATEM
DIV7,	CLL
	TAD (-7
	SZL
	JMP DIV7
	TAD (7
	TAD (WEEKLST
	DCA TM2
	CDF 0
	TAD I TM2
	CDF 10
	DCA WKP
	STA		/DON'T CRLF
	JMS I (PRINT
WKP,	0
	STA
	JMS I (PRINT
	DAYDAY
	STA
	JMS I (PRINT
MONP,	0
	STL CLA RAR
	JMS I (PRWD	/SPACE
	TAD DAY
	JMS I (PRWD
	STA
	JMS I (PRINT
	COM19
	TAD YEAR
	JMS I (PRWD
	JMS I (CRLF
	JMS I (LOOK	/LOOKUP SYS:DATE.SV
	YDATE
	JMP I DATE	/DO NOTHING IF IT'S NOT THERE
	JMP I (CHAIN	/CHAIN TO IT, IF IT'S THERE
\fNODATE,	JMS I (PRMESG
	NONE
DT,	0
TM2,	0
DATEM,	0
DAY,	0
YEAR,	0
\fSETDSK,	0
	TAD DSKDEV
	SZA
	JMP I SETDSK
	JMS I (200
	12		/INQUIRE
	5723		/PACKED ENCODING FOR 'DSK:'
DSKDEV,	0		/SET TO DEVICE NUMBER
	0
TM1,	HLT		/NO 'DSK' !
	TAD DSKDEV
	JMP I SETDSK
	PAGE
\f/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL
/SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE.
/THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT:

/4000-4037	REM-LINE 0
/4040-4177	REM-LINE 1
/4100-4137	REM-LINE 2
/4140-4177	REM-LINE 3
/4200-4237	REM-LINE 4
/4240-4277	REM-LINE 5
/4300-4337	REM-LINE 6
/4340-4377	REM-LINE 7

/EACH REM-LINE HAS THE FOLLOWING FORMAT:

/WORD 0:	IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE
/WORD 1:	DATE LINE WAS REMEMBERED
/WORD 2:	COMMAND DEPENDENT INFORMATION
/WORD 3:	RESERVED FOR FUTURE EXPANSION
/WORDS 4-37	COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES
/		PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0.

/ROUTINES:

/	TAD (DEP
/	JMS REMEM
/	N

/REMEMBERS CURRENT LINE IN REM-LINE N.  AC IS LINE DEPENDENT INFORMATION.
/IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK.

/	JMS RECALL
/	N

/RECALLS REM-LINE N INTO BUFFER
/IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8.
/UPON RETURN, LINE-DEPENDENT INFO IS IN AC.
/IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1

/0	USED BY TECO, MAKE COMMANDS
/1	USED BY EDIT, CREATE COMMANDS
/2	USED BY COMPILE, EXECUTE COMMANDS & PAL.
/	DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE

/3	USED BY 'UA' COMMAND
/4	USED BY UB
/5	USED BY UC

/	JMS FOREVER

/CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
\f	REMSPACE=4000
	REMBLOCK=65

REMEM,	0
	DCA DEP
	TAD I (REMD
	SMA CLA
	JMP I REMEM	/DON'T REMEMBER IF JUST RECALLED
	JMS I (RDREM
	JMP I (MEMBIG
	TAD I REMEM
	ISZ REMEM
	CLL RTL
	RTL
	RAL		/MULTIPLY BY 40
	TAD (REMSPACE
	DCA LPTR
	TAD (1234
	CDF 0
	DCA I LPTR
	CDF 10
	ISZ LPTR
FORVR,	TAD I (DATWD	/REPLACED BY CMA IF WANT NO DATE
	JMS LPUT	/STORE DATE
	TAD DEP
	JMS LPUT	/STORE DEPENDENT INFO
	JMS LPUT	/RESERVED
	JMS I (SCAN	/GO PAST KEYWORD AND BLANKS
	TAD I (LBEGIN
	DCA XR
RELUP,	JMS I (GETF
	JMP LZER
	JMS I (ROTL
	DCA TML
	JMS I (GETF
	JMP RZER
	TAD TML
	JMS LPUT
	JMP RELUP
RZER,	TAD TML
LZER,	JMS LPUT
	JMS I (WRREM
	JMP I (MEMBIG
REMGO,	JMP I REMEM
\fDEP,	0
LPTR,	0		/PTS TO REM-LINE
TML,	0		/TEMP

/PUT INTO REM-LINE

LPUT,	0
	DCA TML
	TAD LPTR
	AND (37
	SNA CLA
	JMP I (MEMBIG
	TAD TML
	CDF 0
	DCA I LPTR
	CDF 10
	ISZ LPTR
	JMP I LPUT

FOREVER,0
	TAD LCMA
	DCA FORVR
	JMP I FOREVER	/NON-ZERO MEANS SET DATE TO -1
\fRECALL,	0
	JMS I (RDREM
	JMP I (REMERR
	TAD I RECALL
	ISZ RECALL
	JMS I (ROTL
	RAR
	TAD (REMSPACE
	DCA LPTR
	JMS LGET
	TAD (-1234
	SZA CLA
	JMP I (REMER2
	JMS LGET
	SNA
	JMP I (REMER2
LCMA,	CMA
	SNA
	JMP FOREV
	IAC
	TAD I (DATWD	/SAME DAY?
	SZA CLA
	JMP I (REMER2
FOREV,	JMS LGET
	DCA DEP
	JMS LGET	/IGNORE RESERVED WORD
	CLA
	TAD (BEGLN-1
	DCA XR
	TAD (BEGLN-1
	DCA I (LBEGIN
RECLUP,	JMS LGET
	DCA TML
	TAD TML
	JMS I (ROTL
	RAL
	JMS I (PUTF
	JMP RECLV
	TAD TML
	JMS I (PUTF
	JMP RECLV
	JMP RECLUP

RECLV,	TAD DEP
	JMP I RECALL
\fLGET,	0
	CDF 0
	TAD I LPTR
	CDF 10
	ISZ LPTR
	JMP I LGET
	PAGE
\fPUTF,	0
	AND (77
	SNA
	JMP PUTZ
	ISZ PUTF
	TAD (240
	AND (77
	TAD (240
PUTZ,	CDF 0
	DCA I XR
	CDF 10
	JMP I PUTF

CHKSUP,	0
	JMS 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

REMERR,	JMS I (PRMESG
	REMBAD
REMER2,	JMS I (PRMESG
	BADREM
\fMEMBIG,	CLA
	JMS I (PRINT
	MEMWARN
	JMP I (REMGO

RDREM,	0
	CIF 0
	JMS I (7607
	200		/READ 2 PAGES INTO FIELD 0
	4000		/LOCATION 4000
	REMBLOCK
	SKP CLA
	ISZ RDREM
	JMP I RDREM

WRREM,	0
	CIF 0
	JMS I (7607
	4200		/WRITE 2 PAGES FROM FIELD 0
	4000		/LOCATION 4000
	REMBLOCK
	SKP CLA
	ISZ WRREM
	JMP I WRREM

FUDG,	0
	DCA I (OUTSW	/LOAD HANDLER
	TAD I (OUTLIM
	CIA
	DCA CLXR
	JMP I FUDG
\fK8,	0
	TAD (1716
	JMS I (PRWD
	TAD (1431
	JMS I (PRWD
	CIF CDF 0
	JMP I K8

ROTL,	0
	CLL RTL
	RTL
	RTL
	JMP I ROTL

/GET FROM INPUT LINE VIA XR

GETF,	0
	CDF 0
	TAD I XR
	CDF 10
	SZA
	ISZ GETF
	AND (77
	JMP I GETF
\f/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
/IT GIVES A FATAL ERRORR MESSAGE IF BAD.
GETSPC,	0
	STA
	DCA DVFLAG
	DCA DEV1
FILLP1,	DCA DEV2
FILLP,	JMS I (GNAME
	TAD (-":	/AC CONTAINED DELIM
	SNA CLA
	JMP DEVNAM
	DCA I (NUMC
	JMP I GETSPC
DEVNAM,	CLA IAC
	TAD I (PERDSW
	TAD I (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
\fCDERA,	JMS I (PRMESG
	BADEV

ATERR,	CDF 10
	CLA
	JMS I (PRMESG
	ATIO
	PAGE
\fCDINIT,	0
	TAD I DEFALT
	TAD (-5200
	SZA CLA		/IS THIS A REQUEST FOR A
			/"SPECIAL DECODE"?
	JMP CDCONT	/NO
	TAD ALTLIM
	DCA 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 CCLA	/STOPS FETCHES IN SPECIAL MODE
	DCA I PSPKG1	/NO HANDLER FETCHES NECESSARY EITHER
			/SINCE NO LOOKUPS
CDCONT,	JMS I (BKA
	STA
	DCA I (OUTSW
	JMS I (ZEROCD
	TAD 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
OUTLIM,	1-MIFILE
LBEGIN,	0		/PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT
\fNMOVE,	0
	DCA PT1		/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 CCLA	/V3C
	SNA CLA		/DON'T CHANGE OUT DEV IF SPECIFIED
	TAD I (FLAG	/LOOK AT 'COPY EXT' BIT
	AND (200
	SNA CLA
	JMP NMXXX		/IT WASN'T SET
	TAD I (7617	/GET FIRST INPUT DEVICE
	AND (17		/ISOLATE DEVICE BITS
	DCA I CCLA	/FORCE THIS TO BE FIRST OUTPUT DEVICE
NMXXX,	TAD I PT1
	SNA
	JMS I (SETDSK	/CHANGE TO 'IAC' TO ALWAYS USE SYS:
	DCA I PT1	/SET DEVICE TO SYS IF NONE
	ISZ PT1
	TAD I PT1	/WAS THERE A SPECIFICATION THERE?
	SZA CLA
	JMP I NMOVE	/YES, DO NOTHING
	TAD I (FLAG
	AND (200	/GET 'COPY EXTENSION' BIT
L7740,	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 10
	NAME1
	CDF 10
TEM,
PT1,	0
	JMP I NMOVE

P8,	SETDEV
	DMPDEV
\fVERTN,	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
CCLA,	7600		/"0" MEANS OLD
	TAD (60
	JMS I (ROTL
	TAD TEM
	JMP I (PTCH
\f/ALLOW DEASSIGN FOO ?

DEASSIGN,0
	TAD L7740
	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
\fSTARJM,	RELOC STARNM	/DUMP LITERALS AT LAST POSSIBLE MOMENT
	JMP STARNM
	RELOC
	PAGE
	ZBLOCK 7600-.
\f/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD
/CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT.
/FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE
/OS/8 CORE-IMAGE FORMAT.
/FOR VERSION OF THE MONITOR BEFORE LEVEL A,
/THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS
/OR IT READS OVER 7600.
/BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF
/INTO FIELD 0.  400-777 IS IGNORED BY SKIPPING A BLOCK,
/THEN THER REST OF CCL (7 PAGES) IS READ IN.

	FIELD 0

	*400

/IT LOADS OVER THE SAVE, DATE OVERLAY
/AND STARTS AT LOCATION 600

/KEYWORD TABLE IN 400-

/CONSISTS OF COMMANDS 2 CHARS PER LOCATION
/IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL)
/SEPARATED FROM EACH OTHER BY 6-BIT 00'S.
/EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU
/NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX
/BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED
/BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
\fVNO,	CCLTAB
KEYWRD,
0530	/EX ECUT
4543
6564
0002	/BA CKSP OR TER MIN
0143
5363
6000
0201	/BAS IC
2351
4300
0425	/DU PLICATE
6054
5143
4164
4500
0217	/BO OT
5764
0003	/CCL
0314
0003	/COMPA R
1715
2001
6200
0317	/COM PIL
1560
5154
0003	/COP Y
1720
7100
1505	/MEM ORY
1557
6271
0003	/CREA TE
2205
0164
4500
0322	/CREF
0506
0004	/DA TE
0164
4500
0405	/DEL ETE
1445
6445
0004	/DE A
0541
0004	/DIR ECT
1122
4543
6400
0504	/ED IT
5164
0005	/EO F
1746
0010	/HE LP
0554
6000
1411	/LIN K
1653
0015	/MAC R
0103
6200
1411	/LI ST
6364
0014	/LO AD
1741
4400
1501	/MAK E
1345
0015	/MAP
0120
0015	/MUNG
2516
0700
2001	/PAL
1400
2022	/PRI NT
1156
6400
2025	/PU NCH
5643
5000
2205	/REN AME
1641
5545
0022	/RES
0523
0022	/REW IND
0527
5156
4400
2305	/SET
2400
2313	/SK IP
5160
0023	/SQ UISH
2165
5163
5000
2325	/SU BMIT
4255
5164
0024	/TE CO
0543
5700
2431	/TY PE
6045
0025	/UN LOAD
1654
5741
4400
2501	/UA
0025	/UB
0200
2503	/UC
0026	/VE R
0562
0032	/ZERO
0522
1700
4000	/@
	ZBLOCK 600-.
\f	IFDEF XYZMCR <

THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE:


HKGYJ2S\ 1\eR0,.KHXAHKMA
\ 1TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM
OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL.
**  NO EDITING **
\ 1HKHXYHXN0UO0UB0UN
!CHLP!^TUL\eQL-32"EOBLANK\e'QL-13"EOCR\e'QL-26"EOEND\e'
!CHLP0!QL&63+QBUT\e QT/8UX\eQX+48I\eQT-(8*QX)+48I\e
QL"NZJ.UZGNQLI\eQZJXNK%N\e'
%O&1"NOCHLP\e' QN-3"LZUH'I
\eOCHLP\e
!BLANK! 32UBZJ.UZGNQLI\eQZJXNK%N\eOCHLP\e
!CR! \ 1
\ 1QHJ	/\eGNZJXN0UN0UB0ULOCHLP0\e
!END!I00
\e


	>
\f	*600

	JSBITS=7746
	SYSTEM=22
	PRMES=330
	ERRET=33	/THESE ARE LOCATIONS FROM OS/8 MONITOR

/RUNS IN FIELD 0 ONLY.

ENTRY,	0		/INITIALLY 0 MEANS 'EX' COMMAND
LINPTR,	JMP ENTREE	/OS/8 JUMPS HERE (ACTUALLY TO 600)
TEMM,
TEKLDG,	ISZ CCLNHR	/TECO 'EG' JUMPS HERE
	DCA I (BEGLN	/ZERO COMMAND LINE
	JMP TEGO	/FIRST WE DISABLE CALLS TO MONITOR
ENTREE,	TAD (7605
	DCA ERRET
	TAD SYSTEM
	DCA MYSYS
	JMS FINDIT	
	SPA CLA		/WAS IT A LEGAL COMMAND?
	JMP I (PRQMRK	/NO
TEGO,	TAD (6003	/YES
	DCA I (JSBITS
	CIF 10
	JMS I MYSYS	/CALL USR AND LOCK IN CORE
	10
	CLA IAC
	CIF 10
	JMS I (200
	2
CCLBLC,	CCLSV
CCLEN,	0
CCLNHR,	JMP NOCCL	/ISZ'ED IF KBM NOT IN MEMORY
	CLA IAC
	TAD CCLBLC
	DCA CCLRDB
	JMS I (7607
CCLCCW,	2711		/READ 27 PAGES OF CCL.SV
CCLSTR,	2000
MYSYS,
CCLRDB,	7700		/INITIALLY POINTS TO USR
	JMP NOCCL
	CIF CDF 10
	JMP I CCLSTR
\fCCLSV,	FILENAME CCL.SV

NOCCL,	CLA SKP
	JMP I (7605	/GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND
	JMS I (PRMES	/PRINT ERROR MESSAGE OTHERWISE
	TEXT	/NO CCL!/
	0
\f/FINDS IF INPUT LINE STARTS WITH A COMMAND
/LEAVES ENTRY # IN AC, -1 IF NOT FOUND
/ENTRIES START AT ENTRY 0.
/CALLABLE FROM ANY FIELD

FINDIT,	0
MORE,	TAD (BEGLN-1
	DCA LINPTR
	ISZ LINPTR
	TAD I LINPTR
	TAD (-240
	SNA CLA
	JMP .-4
	JMS GETKAR
	JMP ENDOFT	/NO MATCH
	JMP INTO
FNLUP,	TAD I LINPTR
	TAD (-301
	STL
	TAD (-32
	SNL CLA
	JMP NOLET	/NOT A LETTER
	JMS GETKAR
	JMP MATCH
INTO,	CIA
	TAD I LINPTR
	AND (37		/5-BIT ASCII
	ISZ LINPTR
	SNA CLA		/DO THEY MATCH?
	JMP FNLUP	/YES
NOMT,	JMS GETKAR
	SKP
	JMP .-2		/SCAN TO NEXT ENTRY
	ISZ ENTRY
	JMP MORE

NOLET,	JMS GETKAR
	JMP MATCH
	CLA
	ISZ SIGNIF
	JMP NOMT
MATCH,	TAD ENTRY
	SKP
ENDOFT,	STA
RETCIF,	CDF 0		/RETURN TO CALLING FIELD (MAY BE OVERLAID)
	JMP I FINDIT
KPTR,	KEYWRD
\fHALF,	-1		/0 MEANS LEFT HALF
SIGNIF,	0		/1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT

/GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC
/SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT
/TAKES RETURN 1 IF CHAR IS 0
/TAKES RETURN 2 OTHERWISE

GETKAR,	0
	ISZ HALF
	JMP RTHALF
	TAD I KPTR
	RTR
	RTR
	RTR
	JMP INSIDE
RTHALF,	STA
	DCA HALF
	TAD I KPTR
	ISZ KPTR
INSIDE,	AND (77
	DCA TEMM
	TAD TEMM
	AND X40
X40,	SZA CLA
	STA
	DCA SIGNIF
	TAD TEMM
	SZA
	ISZ GETKAR
	AND (37
	JMP I GETKAR
	PAGE
\f	*REST
CORLOC,	CORX
CORV,	1400
CORSIZ,	1

CORE,	CDF 0
	TAD CORSIZ
	CLL RTL
	RAL
	AND COR70
	TAD COREX
	DCA .+1
COR1,	CDF
	TAD I CORLOC
COR2,	NOP
	DCA COR1
	TAD COR2
	DCA I CORLOC
COR70,	70
	TAD I CORLOC
CORX,	7400
	TAD CORX
	TAD CORV
	SZA CLA
	JMP COREX
	TAD COR1
	DCA I CORLOC
	ISZ CORSIZ
	JMP CORE
COREX,	CDF 0
	TAD CORSIZ
	CLL RTL
	TAD (-10
	JMP I (DETC2	/GO TO NEXT PAGE
\fMONLST,	MON1
	MON2
	MON3
	MON4
	MON5
	MON6
	MON7
	MON8
	MON9
	MON10
	MON11
	MON12
\fMON1,	TEXT	/JANUARY/
MON2,	TEXT	/FEBRUARY/
MON3,	TEXT	/MARCH/
MON4,	TEXT	/APRIL/
MON5,	TEXT	/MAY/
MON6,	TEXT	/JUNE/
MON7,	TEXT	/JULY/
MON8,	TEXT	/AUGUST/
MON9,	TEXT	/SEPTEMBER/
MON10,	TEXT	/OCTOBER/
MON11,	TEXT	/NOVEMBER/
MON12,	TEXT	/DECEMBER/
\fCOM19,	TEXT	/, 19/

WEEKLST,DAY1
	DAY2
	DAY3
	DAY4
	DAY5
	DAY6
	DAY7

DAY1,	TEXT	/SATUR/
DAY2,	TEXT	/SUN/
DAY3,	TEXT	/MON/
DAY4,	TEXT	/TUES/
DAY5,	TEXT	/WEDNES/
DAY6,	TEXT	/THURS/
DAY7,	TEXT	/FRI/
BADMON,	TEXT	/#BAD MONITOR/
	PAGE
\fHISIZ,	0		/HIGHEST MEMORY BANK
NEWCOR,	0		/PROPOSED NEW MEMORY BANK

DETC2,	SNA
	JMS KEIGHT
	TAD (-30
	SNA
	JMS K32
	TAD (40
	JMS OTOD
	DCA I (CORMES
	CDF 10
	TAD I (LBEGIN
	DCA XRL
	CDF 0
	STA
	TAD I (CORSIZ
	DCA HISIZ
	ISZ XRL
	TAD I XRL	/GET NEXT CHAR
	SNA
	JMP COREQ	/NOT SETTING CORE SIZE
	TAD (-260
	DCA NEWCOR
	TAD NEWCOR
	AND (7770
	SZA CLA
	JMP DETER	/TRIED TO SET CORE SIZE GT 7
	TAD NEWCOR
	CIA
	TAD HISIZ
	SPA CLA
	JMP BADKOR	/TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE
	TAD I (7777
	RTL		/BATCH BIT TO LINK
	SZL CLA
	JMP WRSKOR	/CAN'T CHANGE CORE SIZE UNDER BATCH
	TAD NEWCOR
	CLL RTL
	RAL
	DCA NEWCOR
	TAD I (7777
	AND (7707
	TAD NEWCOR
	DCA I (7777
COREQ,	TAD I (7777
	AND (70
	SNA
	JMP ABSKOR
	TAD (10
	CLL RAR
	JMS OTOD
	DCA I (SCRMES
	TAD I (SCRMES
	CIA
	TAD I (CORMES
ABSKOR,	CIF CDF 10
	SNA CLA
	JMP I (ABSCOR	/DON'T PRINT SOFT IF = REAL
	JMP I (SCRM

BADKOR,	CIF CDF 10
	JMP I (BADCOR
WRSKOR,	CIF CDF 10
	JMP I (WRSCOR

DETER,	CIF CDF 10
	JMP I (CMDERR

KEIGHT,	0
	CIF CDF 10
	JMS I (K8
	JMP I KEIGHT

XRL,	0
\fOTOD,	0
	DCA TTX
	DCA TX
	TAD TTX
	TAD (-12
	ISZ TX
	SMA
	JMP .-3
	TAD (72
	DCA CORETM
	STA
	TAD TX
	SNA
	TAD (40-60
	TAD (60
	CLL RTL
	RTL
	RTL
	TAD CORETM
	JMP I OTOD

TX,	0
TTX,	0
CORETM,
K32,	0
	TAD (4100
	DCA I (CORMES+5
	JMP I K32
\fOTODY,	0
	JMS OTOD
	CIF CDF 10
	JMP I OTODY
	PAGE
\fERRCMD,	TEXT	/#ERROR IN COMMAND/
BADVMS,	TEXT	/#CCL 3X OVERLAY AND MONITOR INCOMPATIBLE/
	AAAA=.
	*BADVMS+3
	CCLTAB&77^100+40
	*AAAA
\fLOVMES,	TEXT	/NOT WAR?/
KILMES,	TEXT	/FILES DELETED:/
RENMES,	TEXT	/FILES RENAMED:/
MOVMES,	TEXT	/FILES COPIED:/
SCRMES,	TEXT	\00K/\
	*.-1
CORMES,	TEXT	/00K MEMORY/
DAYDAY,	TEXT	/DAY /
\fNOCORE,	TEXT	/# NOT ENOUGH MEMORY/
BATCOR,	TEXT	/#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/
JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6
\fSUP,	TEXT	/%SUPERSEDING/
MEMWARN,TEXT	/%CAN'T REMEMBER/
SQWARN,	TEXT	/%BATCH SQUISHING SYS:!/
SYSER,	TEXT	\#I/O ERROR ON SYS:\
BADSYN,	TEXT	/#ILLEGAL SYNTAX/
TOOMAN,	TEXT	/#TOO MANY FILES/
NF,	TEXT	/ NOT FOUND/
DNE,	TEXT	/ DOES NOT EXIST/
SEMSG1,	TEXT	/? ENTER ERROR/
SEMSG2,	TEXT	\?I/O ERROR\
SEMSG3,	TEXT	/?DEVICE FULL/
SEMSG4,	TEXT	/?CLOSE ERROR/
\fATIO,	TEXT	/#BAD FILENAME OR ERROR READING INDIRECT FILE/
OVFLOW,	TEXT	/#COMMAND LINE OVERFLOW/
BADNUM,	TEXT	/#BAD NUMBER/
BADSTR,	TEXT	/#ILLEGAL * OR ?/
\fBADX,	TEXT	/#BAD EXTENSION/
BADOPT,	TEXT	/#BAD SWITCH OPTION/
TOOLNG,	TEXT	/#COMMAND TOO LONG/
REMBAD,	TEXT	\#I/O ERROR TRYING TO RECALL\
\fBADSW,	TEXT	/#SWITCH NOT ALLOWED HERE/
BADSW2,	TEXT	/#BAD CCL SWITCH/
NONE,	TEXT	/NONE/
BADREM,	TEXT	/#BAD RECOLLECTION/
BADEV,	TEXT	/#BAD DEVICE/
CONTRA,	TEXT	/#CONTRADICTORY SWITCHES/
\fVMES,	TEXT	\OS/8 - KBM V3A - CCL V1A\
	LOC78=VMES+1
	VLOC=VMES+6
	*.-2
	CV=CCLVER&77
	CCLNUM&77^100+CV
	*.+1
\fYEDIT,	FILENAME EDIT.SV
	*.-1
YBOOT,	FILENAME BOOT.SV
	*.-1
YFORT,	FILENAME FORT.SV
	*.-1
YF4,	FILENAME F4.SV
	*.-1
YBITMAP,FILENAME BITMAP.SV
	*.-1
YSRCCOM,FILENAME SRCCOM.SV
	*.-1
YBCOMP,	FILENAME BCOMP.SV
	*.-1
YPAL8,	FILENAME PAL8.SV
	*.-1
YFOTP,	FILENAME FOTP.SV
	*.-1
/YCREF,	FILENAME CREF.SV
/	*.-1
YDIRECT,FILENAME DIRECT.SV
	*.-1
\fYPIP,	FILENAME PIP.SV
	*.-1
YABSLDR,FILENAME ABSLDR.SV
	*.-1
YLOADER,FILENAME LOADER.SV
	*.-1
YLOAD,	FILENAME LOAD.SV
	*.-1
YTECO,	FILENAME TECO.SV
	*.-1
YLPTSPL,FILENAME LPTSPL.SV
	*.-1
YCAMP,	FILENAME CAMP.SV
	*.-1
YSET,	FILENAME SET.SV
	*.-1
YBASIC,	FILENAME BASIC.SV
	*.-1
YRXCOP,	FILENAME RXCOPY.SV
	*.-1
YRESORC,FILENAME RESORC.SV
	*.-1
YBATCH,	FILENAME BATCH.SV
	*.-1
YRALF,	FILENAME RALF.SV
	*.-1
YSABR,	FILENAME SABR.SV
	*.-1
YFRTS,	FILENAME FRTS.SV
	*.-1
YDATE,	FILENAME DATE.SV
	*.-1
YCCL,	FILENAME CCL.SV
	*.-1
YHELP,	FILENAME HELP.SV
	*.-1
YMACREL,FILENAME MACREL.SV
	*.-1
YLINK,	FILENAME LINK.SV
	*.-1
\fBATHED,	"$;"J;"O;"B;215;212;".;0
BATAIL,	".;"R;240;"F;"O;"T;"P;215;212
	"*;"S;"Y;"S;":;"C;"C;"B;"T;"C;"H;".;"T;"M;"/;"D;"$;215;212
	"$;"E;"N;"D;215;212;32;0
TEMNAM,	FILENAME CCBTCH.TM
\fLPTDEV,	DEVICE LPT
TVDEV,	DEVICE TV
TTYDEV,	DEVICE TTY
PTPDEV,	DEVICE PTP
DMPDEV,	DEVICE DUMP
NULDEV,	DEVICE NULL
\f	BATBUF=4400	/LOCATION OF ONE BLOCK BATCH TEMP BUFFER
	USR=200
	GLINE=1200	/LOCATION FROM KBM
	CTRLCK=1241	/LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C
BATPTR,	BATBUF-1
LCHAR,	0

SEMGO,	CIF CDF 10
	JMP I SEMI

SEMI,	0
	TAD (BEGLN-1
	DCA XR
SEMLUP,	TAD I XR
	SNA
	JMP SEMGO	/NO SEMICOLONS
	TAD (-";
	SZA CLA
	JMP SEMLUP
	CIF 10
	CLA IAC		/SYS
	JMS I (USR
	3		/ENTER
BLKNO,	TEMNAM
BLKLEN,	0		/NEG OF LENGTH
	JMP SEMER1	/ENTER ERROR
	TAD BLKNO
	DCA BATBLK
	TAD (BEGLN-1
	DCA XR
	TAD (7600
	DCA I (CTRLCK	/FORCE ^C TO GLINE TO GO TO 7600
	JMS BATLST
	BATHED
S2,	TAD I XR
	SNA
	JMP LINEND
	DCA LCHAR	/SAVE CHAR
	TAD LCHAR
	TAD (-";
	SNA CLA
	JMP GOTSEM
	TAD LCHAR
S3,	JMS BATPUT
	JMP S2
\fLINEND,	TAD LCHAR
	TAD (-";	/LOOK AT LAST CHAR
	SZA CLA		/WAS IT SEMICOLON?
	JMP BATEND	/NO, END OF TEMP BATCH STREAM
	JMS I (GLINE	/YES, READ NEW LINE FROM KEYBOARD
/**** WHAT IF WE'RE RUNNING UNDER BATCH ****
	TAD (BEGLN-1
	DCA XR
	JMP S2

GOTSEM,	JMS KRLF
	TAD (".
	JMP S3

KRLF,	0
	TAD (215
	JMS BATPUT
	TAD (212
	JMS BATPUT
	JMP I KRLF

BATPUT,	0
	ISZ BATPTR
	DCA I BATPTR
	TAD BATPTR
	TAD (-BATBUF-377
	SNA CLA
	JMS BATWRIT	/WRITE OUT BUFFER IF FULL
	JMP I BATPUT
\fBATWRIT,0
	JMS I (7607
	4200		/WRITE 1 BLOCK
	BATBUF
BATBLK,	0
	JMP SEMER2	/  I/O ERROR
	ISZ BATBLK	/POINT TO NEXT BLOCK
	ISZ BATLEN	/BUMP LENGTH
	ISZ BLKLEN
	SKP
	JMP SEMER3	/DEVICE FULL
	TAD (BATBUF-1
	DCA BATPTR
	JMP I BATWRIT

BATEND,	JMS KRLF
	JMS BATLST
	BATAIL
	JMS BATWRIT
	CIF 10
	CLA IAC		/SYS
	JMS I (USR
	4		/CLOSE
	TEMNAM
BATLEN,	0		/LENGTH OF TEMPORARY FILE
	JMP SEMER4	/CLOSE ERROR
	CIF CDF 10
	JMP I (ENGOA
\fBATLST,	0
	TAD I BATLST
	DCA BTPT
	ISZ BATLST
BTLP,	TAD I BTPT
	SNA
	JMP I BATLST
	JMS BATPUT
	ISZ BTPT
	JMP BTLP

BTPT,	0

SEMER4,	IAC	/CLOSE ERROR
SEMER3,	IAC	/DEVICE FULL
SEMER2,	IAC	/ I/O ERROR
SEMER1,	IAC	/ENTER ERROR
	CIF CDF 10
	JMP I (SEMERR
	PAGE
\f	FIELD 1
	*2001
	$
\f