File: TECOVF.MA of Disk: V50/Source/Source-Listing-MAC-2

(Source file text) 

---

/3 F-OVERLAY TO TECO V50

/ 08-APR-79	FIXED READ WITH NO WAIT BUG WITH ECHO OFF
/		ADDED ELSE PROCESSING

	.ENABLE 7BIT

	.MACRO	.ERROR	ERNUM
	.GLOBAL ERR'ERNUM
ERR'ERNUM:	ERR
	.ENDM

	.MACRO	.SORT	ARG1,ARG2
	SORT;	ARG1;	ARG2-ARG1
	.ENDM

	MTHREE=CLL STA RTL

	.EXTERNAL IOVRLC,QOVRLC,EOVRLC,XOVRLC
	.EXTERNAL EDFLAG,ETFLAG
	.EXTERNAL NCHK,POPJ,NNEW13,NMRBAS,POPJ,ERR,CRLF
	.ZTERNAL N,Z40,NP,Z4,RADIX,NLINK,DVT1,LASTC
	.ZTERNAL CLNF,ZZ,P,Z12,Z377,M,CFLG,SCHAR
	.EXTERNAL EU1,EU2,KTYPE,PUTT,TYPE,ET1,ET8,SCHU,YSKP,EH4,TQMK,T0
	.EXTERNAL MQLDVI,NCHK,POKE,SCAN,TPUT,UPOC
	.EXTERNAL NMBR2,PUSHJ,CMIN,VBAR

	.GLOBAL FOVRLY
	.GLOBAL CTL.D,CTL.O,CBSL,CEQL
	.GLOBAL DRAD
	.GLOBAL CHR.ED,CHR.EH,CHR.EO,CHR.ES,CHR.ET,CHR.EU

	.ASECT TECOVF

	*7200

	RELOC 3200

	IOVRLC
	QOVRLC
	EOVRLC
	XOVRLC
FOVRLY,	0

	.SBTTL	Cmd EU
	.SBTTL	Cmd ET
	.SBTTL	Cmd ES
	.SBTTL	Cmd EO
	.SBTTL	Cmd EH
	.SBTTL	Cmd ED

CHR.EU,	IAC
CHR.ET,	IAC
CHR.ES,	IAC
CHR.EO,	IAC
CHR.EH,	IAC
CHR.ED,	TAD	(EDFLAG	/*K* FLAGS MUST BE CONSECUTIVE FOR MORE REASONS THAN 1
	DCA	XXFLAG
	TAD	N
	MQL		/*WM SORRY
	NCHK		/ANY ARGUMENT?
	JMP	9$	/NO, RETURN VALUE
	ISZ	CFLG	/WERE 2 ARGUMENTS SPECIFIED?
	JMP	8$	/NO
	TAD	M	/YES
	CMA
	AND I	XXFLAG	/TURN OFF BITS SPECIFIED BY M
8$:	MQA		/OR IN N VALUE
	DCA I	XXFLAG	/SET NEW VALUE
	DCA	CFLG
	TAD	XXFLAG
	TAD	XX$
	DCA	PTR$
	TAD I	PTR$
	DCA	PTR$
L$:	TAD I	PTR$
	SNA
	JMP	E$	/DONE, RETURN TO SET MULTI8 ECHO
	DCA	MASK$	/SAVE MASK
	ISZ	PTR$
	TAD I	PTR$
	DCA	1$	/SAVE SKIP CONDITION
	ISZ	PTR$
	TAD I	PTR$
	DCA	LOC$	/SAVE LOC TO CHANGE
	ISZ	PTR$
	TAD I	XXFLAG	/LOOK AT FLAG
	AND	MASK$	/'AND' WITH MASK
1$:	HLT		/SKIP INSTRUCTION
	JMP	3$
	TAD I	PTR$
	DCA I	LOC$
	ISZ	PTR$
2$:	ISZ	PTR$
	JMP	L$
3$:	ISZ	PTR$
	TAD I	PTR$
	DCA I	LOC$
	JMP	2$

9$:	TAD I	XXFLAG	/GET VALUE
	JMP I	(NNEW13	/MAKE NEW 13-BIT VALUE
E$:	TAD I	(ETFLAG
	AND	MSK10	/WAS NO ECHO SET ?
	CLL RTR		/IF ET CHANGED, ALWAYS AFFECT MULTI8
	SNA
	CLA STL IAC RAL	/NO, GIOT 3: ENABLE ECHO
	6770		/YES, GIOT 2: DISABLE ECHO
	POPJ

XX$:	-EDFLAG+XXSUBS
PTR$:	0
LOC$:	0
MASK$:	0

XXFLAG,	0		/POINTS TO FLAG IN MEMORY ABOVE 4000

	.NOLIST BE

/	MASK;	SKIP;		LOC;	VALUE IF SKIPS;	VALUE IF NO SKIP

EUSUB,	7777;	SMA CLA;	EU1;	CLA;		SNA CLA
	7777;	SPA SNA CLA;	EU2;	TAD Z40;	NOP
	0

ETSUB,	1;	SNA CLA;	KTYPE;	PUTT;		TYPE
	1;	SNA CLA;	ET1;	PUTT;		TYPE
MSK10,	10;	SNA CLA;	ET8;	DCA SCHAR;	TYPE
	0

EDSUB,	1;	SNA CLA;	SCHU;	-1;		"^
	2;	SNA CLA;	YSKP;	SKP CLA;	SZA CLA
	0

EHSUB,	4;	SNA CLA;	EH4;	TQMK;		T0
CXSUB,
EVSUB,
ESSUB,
EOSUB,	0

	.LIST BE

/RADIX TABLES:
/MUST BE IN SAME OVERLAY AS = AND ^O AND ^D

ORAD,	NOP
	1000
	100
	10
DRAD,	NP&177+1200	/TAD NP
	1000.
	100.
	10.

XXSUBS,	EDSUB
	EHSUB
	EOSUB
	ESSUB
	ETSUB
	EUSUB
/	EVSUB
/	CXSUB
/MUST ALL BE TOGETHER IN SAME OVERLAY

	PAGE

/NUMERICAL OUTPUT ROUTINE

ZEROD,	0
	DCA	ZER$	/INITIALIZE "LEADING ZEROS" FLAG
	TAD I	ZEROD
	ISZ	ZEROD
	DCA	DEV$	/SAVE OUTPUT ROUTINE ADDRESS
	TAD	NLINK	/POS OR NEGATIVE?
	SNA CLA
	JMP	2$	/POSITIVE
	TAD	(ORAD
	CIA
	TAD	RADIX
	SNA CLA
	JMP	1$	/OCTAL
	TAD	N	/DECIMAL
	CIA
	DCA	N	/NEGATE
	SKP
1$:	TAD	Z4	/CONVERT - TO 1
	TAD	("-
	JMS I	DEV$	/OUTPUT MINUS SIGN
2$:	MTHREE
	DCA	CNT$	/ITERATION COUNT
	TAD	RADIX
	DCA	R$
3$:	ISZ	R$
	TAD I	R$
	DCA	4$	/GET DIVISOR
	TAD	N
	MQLDVI		/DIVIDE BY A POWER OF THE BASE
4$:	0
	TAD	ZER$
	SNA
	JMP	5$	/IGNORE LEADING ZEROS
	TAD	("0
	JMS I	DEV$
	STL RAR
	DCA	ZER$	/SET LEADING ZEROS FLAG
5$:	TAD	DVT1	/GET REMAINDER
	DCA	N
	ISZ	CNT$	/GO AROUND AGAIN?
	JMP	3$	/WHY NOT?
	TAD	N
	TAD	("0
	JMS I	DEV$	/OUTPUT LAST DIGIT NO MATTER WHAT
	JMP I	ZEROD

DEV$:	0		/WHERE WE'RE SENDING THE DIGITS
ZER$:	0
CNT$:	0
R$:	0

	.SBTTL	Cmd =

CEQL,	NCHK		/COMMAND =
	.ERROR	21	/NO NUMBER
	TAD	RADIX
	DCA	TMP$
	JMS I	(POKE	/LOOK AHEAD ONE CHARACTER
	TAD	(-"=	/CHECK FOR = SIGN
	SZA CLA
	JMP 	1$	/SINGLE =
	SCAN		/DOUBLE = (PASS UP SECOND ONE)
	SKP CLA		/CLEAR AC
1$:	TAD	Z4
	TAD	(ORAD
	DCA	RADIX	/SET OCTAL RADIX TEMPORARILY
	JMS	ZEROD
	TPUT
	TAD	TMP$
	DCA	RADIX	/RESTORE ORIGINAL RADIX
	ISZ	CLNF	/: SEEN?
	CRLF		/NO, END WITH CRLF
	DCA	CLNF
	POPJ
TMP$:	0

	.SBTTL	Cmd \
	.SBTTL	Cmd |

CBSL,	TAD	LASTC	/GET CHARACTER BEFORE IT WAS TRANSLATED TO UPPER CASE
	AND	Z40	/SEE IF IT WAS \ OR | (VERICAL BAR)
	SZA CLA
	JMP I	(VBAR	/COMMAND | (VERTICAL BAR)
	NCHK		/COMMAND \ (BACKSLASH)
	JMP	CBSN
	JMS	ZEROD
	UPOC
	POPJ

CBSN,	PUSHJ
		NMBR2	/INITIALIZE RESULT TO 0
	JMS	PTCH
	TAD	(-"-	/CHECK FOR MINUS SIGN
	SZA
	JMP	.+3	/NOT MINUS
	PUSHJ
		CMIN	/RECORD MINUS SIGN
	CIA
	CLL RTR
	SNA CLA		/CHECK FOR PLUS SIGN
L$:	ISZ	P	/BUMP POINTER PAST SIGN
	JMS	PTCH
	TAD	(-72
	CLL
	TAD	Z12
	SNL		/IS IT A DIGIT?
	POPJ		/NO
	PUSHJ
		NMBR2	/YES - ACCUMULATE IT
	JMP	L$	/AND LOOP

PTCH,	0
	TAD P		/V3C
	STL CIA		/CHECK FOR END OF BUFFER
	TAD ZZ
	SZL SNA CLA
	POPJ
	CDF 10
	TAD I	P	/GET A CHAR
	AND	Z377
	CDF	0
	JMP I PTCH

	.SBTTL	Cmd ^D

	.SBTTL	Cmd ^O

CTL.D,	TAD	Z4	/SET RADIX DECIMAL
CTL.O,	TAD	(ORAD	/SET RADIX OCTAL
	DCA	RADIX
	TAD I	RADIX
	DCA I	(NMRBAS	/EITHER "NOP"(8) OR "TAD NP"(10)
	POPJ

	PAGE
	RELOC


---