[pdp8.git] / sw / adventure / SPEAK.RA

/	SPEAK - Types out messages from the database\r
/	Also includes TTY output routines that unpack\r
/	packed sixbit into mixed case ASCII.\r
/\r
	FIELD1	ADVTTY\r
\r
TTY,	0			/ TTY Output routine, dupe of FRTS\r
	IOF			/ Protect from race conditions\r
	SNA			/ Input or output?\r
	JMP	KBD		/ Input - read character\r
	DCA	HANGPT		/ Output - save char\r
	RDF\r
	TAD	CDIF00\r
	DCA	CDFX\r
	CDF	0\r
	TAD%	TOCHR		/ Output character status in FRTS\r
	SMA SZA CLA		/ If gt 0, char backed up\r
	JMP	BUSY		/ Else must wait\r
LOOP,	TAD%	TOCHR		/ Get the status\r
	CLL RAL			/Busy flag in link\r
	CLA CML RAR		/Complement of busy in sign\r
	TAD	HANGPT\r
	SPA			/If tty not busy, \r
	TLS			/Send it\r
	DCA%	TOCHR		/Store pos or neg, backed up or busy\r
TTYRET,	ION			/Interrupts back on\r
CDFX,	HLT			/Caller's field\r
	JMP%	TTY		/Return\r
\r
CDIF00,	CIF CDF\r
\r
BUSY,	CDF	10		/Busy, must wait. Call Field 0 HANG routine\r
	CIF	0\r
	JMS%	HANGPT+1\r
	0451			/ TTUHNG\r
	CDF	0\r
	JMP	LOOP		/ Try output again\r
\r
KBD,	RDF\r
	TAD	CDIF00\r
	DCA	CDFX\r
	CDF	0\r
	TAD%	TICHR		/ Any input?\r
	SNA CLA\r
	JMP	WAIT		/ No, wait\r
GETIN,	TAD%	TICHR		/ Get character\r
	DCA	HANGPT		/ Save\r
	DCA%	TICHR		/ Clear buffer\r
	TAD	HANGPT\r
	JMP	TTYRET		/ Return\r
\r
WAIT,	CDF	10\r
	CIF	0\r
	JMS%	HANGPT+1	/Hang\r
	465			/KBUHNG\r
	CDF	0\r
	JMP	GETIN	/Get input\r
TOCHR,	4\r
TICHR,	5\r
HANGPT,	ADDR	#HANG\r
/\r
/ Terminal line input routine. Used because the FRTS input is quite limited.\r
/ This one handles scope rubouts and allows lower case input.\r
/ Inputs: Array	Returned characters, stored one sixbit per array word\r
/		(The FORTRAN input routine is set up this way to unpack)\r
/	Size	Number of characters to allow\r
/	Prompt Prompt string\r
	FIELD1	RDLIN\r
/\r
	ENTRY	RDLINE\r
RDLINE,	JA	#RLST\r
#RLXR,	ORG	.+10\r
	TEXT	+RDLINE+\r
#RLRET,	SETX	#RLXR\r
	SETB	#RLBAS\r
	JA	.+3\r
#RLBAS,	ORG	.+6\r
BUFPT,	ORG	.+3\r
BUFLEN,	ORG	.+3\r
\r
	ORG	#RLBAS+30\r
	FNOP\r
	JA	#RLRET\r
	FNOP\r
#RGOBK,	0;0\r
#RLRTN,	BASE	#RLBAS\r
	JA	#RGOBK\r
#RLST,	STARTD\r
	0210\r
	FSTA	#RGOBK,0\r
	0200\r
	SETX	#RLXR\r
	SETB	#RLBAS\r
	LDX	0,1\r
	FSTA	#RLBAS\r
	FLDA%	#RLBAS,1+\r
	FSTA	BUFPT\r
	FLDA%	#RLBAS,1+\r
	FSTA	BUFLEN\r
	STARTF\r
/\r
/	Pass down size to '8' code\r
/\r
	SETX	BUFSIZ	\r
	FLDA%	BUFLEN\r
	FNEG			/ Make it negative\r
	ATX	0		/ Pass buffer len\r
	SETX	#RLXR\r
	TRAP4	GETLIN		/ Get input line\r
	JA	#RLRTN		/ And return\r
/ Input reader\r
\r
	FIELD1	GETLN\r
\r
GETLIN,	0\r
	CLA\r
	DCA	OFFSET		/ Start at offset zero\r
	TAD%	SCOPT\r
	AND	K200\r
	DCA	SCOPE\r
	TAD%	BUFFLD+1	/ Get CDF for buffer\r
	AND	FLDMSK\r
	CLL RTL\r
	RAL\r
	TAD	CDFG\r
	DCA	BUFCDF\r
/\r
/ Go get an input character\r
/\r
GETNXT,	JMS%	PTTY+1		/ Called with zero to get char\r
	DCA	INCH		/ Save input\r
/\r
/ Specials?\r
/\r
	TAD	INCH\r
	TAD	MDEL		/ Delete?\r
	SNA CLA\r
	JMP	DELETE		/ Handle that\r
	TAD	INCH\r
	TAD	MCR		/ CR?\r
	SNA CLA\r
	JMP	ENTER		/ End of line, let's go.\r
	TAD	INCH\r
	TAD	MSPC		/ Less than space?\r
	SPA CLA\r
	JMP	BELL		/ Nope, ignore\r
	TAD	OFFSET\r
	TAD	BUFSIZ		/ Room left?\r
	SMA CLA\r
	JMP	BELL		/ Bell if not\r
	TAD	INCH\r
	JMS%	PTTY+1		/ Echo it\r
	TAD	INCH\r
	TAD	LWRA		/ Is it lowercase?\r
	SPA CLA\r
	JMP	UPPER		/ No, store it\r
	TAD	INCH\r
	TAD	LWRZ\r
	SMA CLA\r
	JMP	UPPER		/ More than lowercase z\r
	TAD	INCH\r
	TAD	AMINA		/ Adjust to uppercase\r
	DCA	INCH\r
UPPER,	JMS	STORE		/ Store this character\r
	JMP	GETNXT		/ Get more\r
/ Store a character in the output buffer\r
/ using the current offset\r
/\r
\r
STORE,	0\r
	TAD	OFFSET\r
	TAD	OFFSET\r
	TAD	OFFSET		/ Count FPP words\r
	TAD%	BUFPTR+1	/ Pointer to exponent word\r
	DCA	BPT\r
	TAD	K27		/ Exponent 27 for integer\r
	JMS	STO\r
	JMS	STO		/ Zero high word\r
	TAD	INCH		/ Char value\r
	AND	SIXMSK		/ Convert to sixbit\r
	JMS	STO		/ Store in buffer\r
	CDF	10		/ Back to my field\r
	ISZ	OFFSET		/ One more in the buffer\r
SPC,    240			/ Really shouldn't overflow; harmless AND\r
	JMP%	STORE		/ Return\r
STO,	0\r
BUFCDF,	HLT			/ Gets CDF for buffer field\r
	DCA%	BPT\r
	ISZ	BPT		/ Next word\r
	JMP%	STO		/ Return if no skip\r
	TAD	BUFCDF\r
	TAD	BS		/ Next field\r
	DCA	BUFCDF\r
	JMP%	STO\r
\r
BELL,	TAD	BEL		/ Warn the user\r
	JMS%	PTTY+1\r
	JMP	GETNXT\r
\r
DELETE,	TAD	OFFSET		/ How far into the buffer are we?\r
	SNA CLA\r
	JMP	BELL		/ Ignore extra deletes\r
	TAD	SCOPE\r
	SNA CLA\r
	JMP	DUMBDL		/ Simple fortran-format delete\r
	TAD	BS\r
	JMS%	PTTY+1\r
	TAD	SPC\r
	JMS%	PTTY+1\r
	TAD	BS\r
	JMS%	PTTY+1\r
	JMP	FIXOFF		/ Fix the offset\r
DUMBDL,	TAD	K334		/ Backslash\r
	JMS%	PTTY+1\r
FIXOFF,	CLA CMA\r
	TAD	OFFSET\r
	DCA	OFFSET\r
	JMP	GETNXT\r
\r
ENTER,	TAD	CR		/ Send a RETURN\r
	JMS%	PTTY+1\r
CLRLP,	TAD	OFFSET		/ Is there space available?\r
	TAD	BUFSIZ\r
	SMA CLA\r
	JMP	CLRDN\r
	TAD	SPC\r
	DCA	INCH\r
	JMS	STORE\r
	JMP	CLRLP\r
CLRDN,	CIF CDF 0\r
	JMP%	GETLIN\r
\r
BUFSIZ,	0\r
SCOPT,	7726			/ Scope flag in OS/8\r
K200,	200\r
MDEL,	-377			/ Delete \r
MCR,	-215\r
CR,	215\r
MSPC,	-240\r
BEL,	207\r
LWRA,	-341\r
LWRZ,	-373\r
AMINA,	-40			/ Add to "a" to make "A"\r
BPT,\r
BUFFLD,	ADDR BUFPT+1\r
SCOPE,\r
BUFPTR,	ADDR	BUFPT+2\r
OFFSET,\r
PTTY,	ADDR	TTY\r
BS,	10\r
K334,	334\r
CDFG,	CDF 0\r
K27,	27\r
SIXMSK,	77\r
FLDMSK,	7\r
INCH,	0\r
\r
/\r
/ Fortran-callable message printer\r
/ Put here to avoid wasting the rest of the page.\r
/ Arguments:\r
/	BUF		Buffer pointer\r
/	COUNT		Number of characters to write, zero to look for end\r
/	CRFLAG		Carriage return flags.\r
/			Bit 11 (1) = no lead LF\r
/			Bit 10 (2) = no trail CR\r
/			Bit 9  (4) = start lowercase\r
/\r
	ENTRY	SIXOUT\r
SIXOUT,	JA	#STRT\r
#SXR,	ORG	.+10\r
	TEXT	+SIXOUT+\r
#SRET,	SETX	#SXR\r
	SETB	#SBASE\r
	JA	.+3\r
#SBASE,	ORG	.+6\r
CNT,	ORG	.+3\r
SFLAG,	ORG	.+3\r
\r
	ORG	#SBASE+30\r
	FNOP\r
	JA	#SRET\r
	FNOP\r
#SGOBK,	0;0\r
#SRTN,	BASE	#SBASE\r
	JA	#SGOBK\r
#STRT,	STARTD\r
	0210\r
	FSTA	#SGOBK,0\r
	0200\r
	SETX	#SXR\r
	SETB	#SBASE\r
	LDX	0,1\r
	FSTA	#SBASE\r
	FLDA%	#SBASE,1+\r
	FSTA	BUF		/ Buffer pointer\r
	FLDA%	#SBASE,1+	/ Count\r
	FSTA	CNT\r
	FLDA%	#SBASE,1+	/ Carriage control flag\r
	FSTA	SFLAG\r
	STARTF\r
	FLDA%	CNT\r
	SETX	COUNT\r
	ATX	0\r
	FLDA%	SFLAG\r
	ATX	1\r
	SETX	#SXR\r
	TRAP4	SIX8		/Call the 8-mode output routine\r
	JA	#SRTN\r
\r
	FIELD1	SXOUT\r
	ENTRY	SIX8		/ Mixed case output routine\r
\r
SIX8,	0\r
	TAD	CRFLAG		/Suppresss carriage control?\r
	RAR			/Low bit suppresses lead LF\r
	SZL CLA\r
	JMP	.+4		/No leading LF\r
	CDF	10		/ My field\r
	TAD	LF		/Linefeed\r
	JMS%	TTYPTR+1	/Output it\r
	TAD	CRFLAG\r
	AND	K4		/Start in lower case?\r
	SZA CLA\r
	TAD	K40		/Yes\r
	TAD	HUN		/Reset conversion factor\r
	DCA	SHIFT\r
	TAD	BUF		/Buffer field\r
	AND	K7		/Just the field bits\r
	CLL RAL\r
	RTL			/Into place\r
	TAD	CDF0		/Into CDF instruction\r
	DCA	CDF1\r
	TAD	CDF1\r
	DCA	CDF2\r
	TAD	COUNT		/Get buffer length\r
	SNA\r
	JMP	NOTRIM		/Zero means it has a terminating "@"\r
/\r
/ Find the end of the string\r
/\r
	CLA CMA			/End is start + len - 1\r
	TAD	COUNT		/String len in words\r
	TAD	BUF+1		/End of the string\r
	DCA	PTR		/Pointer to end\r
	TAD	COUNT		/Invert count\r
	CMA IAC\r
	DCA	COUNT\r
CDF1,	HLT\r
FNDEND,	TAD%	PTR\r
	TAD	K3740		/ - '  ' (two spaces)\r
	SZA CLA			/ Skip if blank\r
	JMP	NONBLK\r
	ISZ	COUNT		/Count another\r
	SKP\r
	JMP	NONBLK		/If empty, done\r
	CLA CMA			/ -1\r
	TAD	PTR\r
	DCA	PTR		/Back pointer up\r
	JMP	FNDEND		/Keep looking\r
\r
NONBLK,	TAD	COUNT\r
	SNA CLA			/Skip if output left\r
	JMP	DONE		/Nothing if count zero already\r
NOTRIM,	TAD	BUF+1		/Reset pointer to start\r
	DCA	PTR\r
CDF2,	HLT\r
	TAD%	PTR		/Get word\r
	DCA	STEMP		/Save\r
	TAD	STEMP\r
	RTR\r
	RTR\r
	RTR			/First sixbit\r
	JMS	OUTONE		/Convert and output it\r
	TAD	STEMP		/Second sixbit\r
	JMS	OUTONE\r
	ISZ	PTR		/Bump pointer\r
	SKP			/OK if no skip\r
	JMP	NEWFLD		/Next field otherwise\r
INCCNT,	ISZ	COUNT\r
	JMP	CDF2		/Keep outputting\r
DONE,	CLA\r
	TAD	CRFLAG		/Suppress trailing CR?\r
	RTR			/2 bit suppresses trailing CR\r
	SZL CLA			/If zero, write it.\r
	JMP	OUT		/Yes, leave now\r
	CDF	10		/My field\r
	TAD	CRTN\r
	JMS%	TTYPTR+1\r
OUT,	CIF CDF	0\r
	JMP%	SIX8\r
\r
NEWFLD,	TAD	CDF1\r
	TAD	K10		/Next field\r
	DCA	CDF1\r
	TAD	CDF1\r
	DCA	CDF2\r
	JMP	INCCNT\r
\r
OUTONE,	0\r
	AND	K77		/Mask\r
	SNA\r
	JMP	DONE		/ End of string\r
	TAD	K7743		/ minus '['\r
	SNA\r
	JMP	SETLWR		/Set to lowercase shift\r
	TAD	K2		/ ok, ']'?\r
	SNA\r
	JMP	SETUPR		/Set to uppercase\r
	TAD	K7773		/Restore\r
	SPA\r
	TAD	SHIFT		/For positive, shift it\r
	TAD	K40		/Else it's not alphabetic\r
	CDF	10		/My field\r
	JMS%	TTYPTR+1	/Output it\r
	JMP%	OUTONE		/Done\r
\r
SETLWR,	TAD	K40		/Reset shift\r
SETUPR,	TAD	HUN		/For upper/lower\r
	DCA	SHIFT\r
	JMP%	OUTONE\r
\r
TTYPTR,	ADDR TTY\r
SHIFT,	140		/Shift value\r
/ COUNT and CRFLAG must stay together\r
COUNT,	0		/Num words to output. \r
CRFLAG,	0		/1 - no leading LF, 2 no trailing CR\r
PTR,	0\r
CRTN,	15\r
LF,	12\r
K3740,	3740			/minus blank\r
BUF,	0;0;0			/Buffer 15-bit address\r
STEMP,	0\r
K77,	77			/sixbit mask\r
K7,	7\r
K4,	4\r
K40,	40\r
CDF0,	CDF\r
HUN,	100\r
K7743,	7743\r
K7773,	7773\r
K10,	10			/Field increment\r
K2,	2\r
\r
	SECT	SPEAK\r
/C\r
/	SUBROUTINE SPEAK(N)\r
/C\r
/C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.\r
/C\r
/	IMPLICIT INTEGER (A-Z)\r
/	COMMON /TXTCOM/ RTEXT,LINES,ASCVAR\r
/	COMMON /ALPHAS/ BLANK,EOF\r
/	DIMENSION RTEXT(205),LINES(36)\r
/C\r
	EXTERN	IO\r
	EXTERN	#HANG\r
	JA	#ST\r
#XR,	ORG	.+10\r
	TEXT	+SPEAK+\r
#RET,	SETX	#XR\r
	SETB	#BASE\r
	JA	.+3\r
#BASE,	ORG	.+6\r
N,	ORG	.+3\r
#DOTMP,	ORG	.+3\r
BLANK,	TEXT +      +\r
EOF,	TEXT +>$<   +\r
ONE,	F 1.0\r
FOUR,	F 4.0\r
	ORG	#BASE+30\r
	FNOP\r
	JA	#RET\r
	FNOP\r
#GOBAK,	0;0\r
I,	ORG	.+0003\r
L,	ORG	.+0003\r
OLDLOC,	ORG	.+0003\r
	#LBL=.\r
	COMMON	TXTCOM\r
RTEXT,	ORG	.+1147\r
LINES,	ORG	.+0044\r
ASCVAR,	ORG	.+0003\r
TXTLOC,	ORG	.+0003\r
DATA,	ORG	.+0352\r
	ORG	#LBL\r
#RTN,	BASE	#BASE\r
	JA	#GOBAK\r
#ST,	STARTD\r
	0210\r
	FSTA	#GOBAK,0\r
	0200\r
	SETX	#XR\r
	SETB	#BASE\r
	LDX	0,1\r
	FSTA	#BASE\r
	FLDA%	#BASE,1+\r
	FSTA	N\r
	STARTF\r
/	 IF(N.EQ.0)RETURN\r
	FLDA%	N\r
	JEQ	#RTN\r
/	 READ(2'N) LOC,LINES\r
	FLDA	N\r
	STARTD\r
	FSTA	#G0002\r
	STARTF\r
	JSR	IO\r
	JA	.+0004\r
#G0002,	JA	.\r
/	 IF(LINES(1).EQ.EOF)RETURN\r
	FLDA	ONE\r
	ATX	7\r
	FLDA	LINES-0003,7\r
	FSUB	EOF\r
	JEQ	#RTN\r
/1	 OLDLOC = LOC\r
#1,	FLDA	TXTLOC\r
	FSTA	OLDLOC\r
	FLDA	ONE\r
	FSTA	I\r
\r
/	 DO 3 I=36,1,-1\r
/	Set COUNT to the number of words (36 or 44 octal)\r
	SETX	COUNT\r
	LDX	44,0		/44 words\r
	LDX	0,1		/With carriage control\r
	SETX	#XR\r
/	 L=I\r
/3	 CONTINUE\r
/5	 TYPE 2,(LINES(I),I=1,L)\r
#5,	FLDA	LINEPT\r
	FSTA	BUF		/Set buffer pointer\r
	TRAP4	SIX8\r
\r
	FLDA%	N\r
	FADD	ONE\r
	FSTA%	N\r
	FLDA	N\r
/	 READ(2'ASCVAR) LOC,LINES\r
	STARTD\r
	FSTA	#G0006\r
	STARTF\r
	JSR	IO\r
	JA	.+0004\r
#G0006,	JA	.\r
/	 IF(LOC .EQ. OLDLOC) GO TO 1\r
	FLDA	TXTLOC\r
	FSUB	OLDLOC\r
	JEQ	#1\r
	EXTERN	#WRITO\r
	TRAP3	#WRITO\r
	JA	FOUR\r
	JA	#10+2\r
	EXTERN	#RENDO\r
	TRAP3	#RENDO\r
\r
/10	 RETURN\r
#10,	JA	#RTN\r
/	 (1X)\r
	5061\r
	3051\r
/2	 FORMAT(' ',36A2) PDP/8: (' ',12A6)\r
LINEPT,	ADDR	LINES\r
	0\r
	END\r
Commit	Line	Data
84b5715c PH	1	/ SPEAK - Types out messages from the database\r
	2	/ Also includes TTY output routines that unpack\r
	3	/ packed sixbit into mixed case ASCII.\r
	4	/\r
	5	FIELD1 ADVTTY\r
	6	\r
	7	TTY, 0 / TTY Output routine, dupe of FRTS\r
	8	IOF / Protect from race conditions\r
	9	SNA / Input or output?\r
	10	JMP KBD / Input - read character\r
	11	DCA HANGPT / Output - save char\r
	12	RDF\r
	13	TAD CDIF00\r
	14	DCA CDFX\r
	15	CDF 0\r
	16	TAD% TOCHR / Output character status in FRTS\r
	17	SMA SZA CLA / If gt 0, char backed up\r
	18	JMP BUSY / Else must wait\r
	19	LOOP, TAD% TOCHR / Get the status\r
	20	CLL RAL /Busy flag in link\r
	21	CLA CML RAR /Complement of busy in sign\r
	22	TAD HANGPT\r
	23	SPA /If tty not busy, \r
	24	TLS /Send it\r
	25	DCA% TOCHR /Store pos or neg, backed up or busy\r
	26	TTYRET, ION /Interrupts back on\r
	27	CDFX, HLT /Caller's field\r
	28	JMP% TTY /Return\r
	29	\r
	30	CDIF00, CIF CDF\r
	31	\r
	32	BUSY, CDF 10 /Busy, must wait. Call Field 0 HANG routine\r
	33	CIF 0\r
	34	JMS% HANGPT+1\r
	35	0451 / TTUHNG\r
	36	CDF 0\r
	37	JMP LOOP / Try output again\r
	38	\r
	39	KBD, RDF\r
	40	TAD CDIF00\r
	41	DCA CDFX\r
	42	CDF 0\r
	43	TAD% TICHR / Any input?\r
	44	SNA CLA\r
	45	JMP WAIT / No, wait\r
	46	GETIN, TAD% TICHR / Get character\r
	47	DCA HANGPT / Save\r
	48	DCA% TICHR / Clear buffer\r
	49	TAD HANGPT\r
	50	JMP TTYRET / Return\r
	51	\r
	52	WAIT, CDF 10\r
	53	CIF 0\r
	54	JMS% HANGPT+1 /Hang\r
	55	465 /KBUHNG\r
	56	CDF 0\r
	57	JMP GETIN /Get input\r
	58	TOCHR, 4\r
	59	TICHR, 5\r
	60	HANGPT, ADDR #HANG\r
	61	/\r
	62	/ Terminal line input routine. Used because the FRTS input is quite limited.\r
	63	/ This one handles scope rubouts and allows lower case input.\r
	64	/ Inputs: Array Returned characters, stored one sixbit per array word\r
65	/ (The FORTRAN input routine is set up this way to unpack)\r
66	/ Size Number of characters to allow\r
67	/ Prompt Prompt string\r
68	FIELD1 RDLIN\r
69	/\r
70	ENTRY RDLINE\r
71	RDLINE, JA #RLST\r
72	#RLXR, ORG .+10\r
73	TEXT +RDLINE+\r
74	#RLRET, SETX #RLXR\r
75	SETB #RLBAS\r
76	JA .+3\r
77	#RLBAS, ORG .+6\r
78	BUFPT, ORG .+3\r
79	BUFLEN, ORG .+3\r
80	\r
81	ORG #RLBAS+30\r
82	FNOP\r
83	JA #RLRET\r
84	FNOP\r
85	#RGOBK, 0;0\r
86	#RLRTN, BASE #RLBAS\r
87	JA #RGOBK\r
88	#RLST, STARTD\r
89	0210\r
90	FSTA #RGOBK,0\r
91	0200\r
92	SETX #RLXR\r
93	SETB #RLBAS\r
94	LDX 0,1\r
95	FSTA #RLBAS\r
96	FLDA% #RLBAS,1+\r
97	FSTA BUFPT\r
98	FLDA% #RLBAS,1+\r
99	FSTA BUFLEN\r
100	STARTF\r
101	/\r
102	/ Pass down size to '8' code\r
103	/\r
104	SETX BUFSIZ \r
105	FLDA% BUFLEN\r
106	FNEG / Make it negative\r
107	ATX 0 / Pass buffer len\r
108	SETX #RLXR\r
109	TRAP4 GETLIN / Get input line\r
110	JA #RLRTN / And return\r
111	/ Input reader\r
112	\r
113	FIELD1 GETLN\r
114	\r
115	GETLIN, 0\r
116	CLA\r
117	DCA OFFSET / Start at offset zero\r
118	TAD% SCOPT\r
119	AND K200\r
120	DCA SCOPE\r
121	TAD% BUFFLD+1 / Get CDF for buffer\r
122	AND FLDMSK\r
123	CLL RTL\r
124	RAL\r
125	TAD CDFG\r
126	DCA BUFCDF\r
127	/\r
128	/ Go get an input character\r
129	/\r
130	GETNXT, JMS% PTTY+1 / Called with zero to get char\r
131	DCA INCH / Save input\r
132	/\r
133	/ Specials?\r
134	/\r
135	TAD INCH\r
136	TAD MDEL / Delete?\r
137	SNA CLA\r
138	JMP DELETE / Handle that\r
139	TAD INCH\r
140	TAD MCR / CR?\r
141	SNA CLA\r
142	JMP ENTER / End of line, let's go.\r
143	TAD INCH\r
144	TAD MSPC / Less than space?\r
145	SPA CLA\r
146	JMP BELL / Nope, ignore\r
147	TAD OFFSET\r
148	TAD BUFSIZ / Room left?\r
149	SMA CLA\r
150	JMP BELL / Bell if not\r
151	TAD INCH\r
152	JMS% PTTY+1 / Echo it\r
153	TAD INCH\r
154	TAD LWRA / Is it lowercase?\r
155	SPA CLA\r
156	JMP UPPER / No, store it\r
157	TAD INCH\r
158	TAD LWRZ\r
159	SMA CLA\r
160	JMP UPPER / More than lowercase z\r
161	TAD INCH\r
162	TAD AMINA / Adjust to uppercase\r
163	DCA INCH\r
164	UPPER, JMS STORE / Store this character\r
165	JMP GETNXT / Get more\r
166	/ Store a character in the output buffer\r
167	/ using the current offset\r
168	/\r
169	\r
170	STORE, 0\r
171	TAD OFFSET\r
172	TAD OFFSET\r
173	TAD OFFSET / Count FPP words\r
174	TAD% BUFPTR+1 / Pointer to exponent word\r
175	DCA BPT\r
176	TAD K27 / Exponent 27 for integer\r
177	JMS STO\r
178	JMS STO / Zero high word\r
179	TAD INCH / Char value\r
180	AND SIXMSK / Convert to sixbit\r
181	JMS STO / Store in buffer\r
182	CDF 10 / Back to my field\r
183	ISZ OFFSET / One more in the buffer\r
184	SPC, 240 / Really shouldn't overflow; harmless AND\r
185	JMP% STORE / Return\r
186	STO, 0\r
187	BUFCDF, HLT / Gets CDF for buffer field\r
188	DCA% BPT\r
189	ISZ BPT / Next word\r
190	JMP% STO / Return if no skip\r
191	TAD BUFCDF\r
192	TAD BS / Next field\r
193	DCA BUFCDF\r
194	JMP% STO\r
195	\r
196	BELL, TAD BEL / Warn the user\r
197	JMS% PTTY+1\r
198	JMP GETNXT\r
199	\r
200	DELETE, TAD OFFSET / How far into the buffer are we?\r
201	SNA CLA\r
202	JMP BELL / Ignore extra deletes\r
203	TAD SCOPE\r
204	SNA CLA\r
205	JMP DUMBDL / Simple fortran-format delete\r
206	TAD BS\r
207	JMS% PTTY+1\r
208	TAD SPC\r
209	JMS% PTTY+1\r
210	TAD BS\r
211	JMS% PTTY+1\r
212	JMP FIXOFF / Fix the offset\r
213	DUMBDL, TAD K334 / Backslash\r
214	JMS% PTTY+1\r
215	FIXOFF, CLA CMA\r
216	TAD OFFSET\r
217	DCA OFFSET\r
218	JMP GETNXT\r
219	\r
220	ENTER, TAD CR / Send a RETURN\r
221	JMS% PTTY+1\r
222	CLRLP, TAD OFFSET / Is there space available?\r
223	TAD BUFSIZ\r
224	SMA CLA\r
225	JMP CLRDN\r
226	TAD SPC\r
227	DCA INCH\r
228	JMS STORE\r
229	JMP CLRLP\r
230	CLRDN, CIF CDF 0\r
231	JMP% GETLIN\r
232	\r
233	BUFSIZ, 0\r
234	SCOPT, 7726 / Scope flag in OS/8\r
235	K200, 200\r
236	MDEL, -377 / Delete \r
237	MCR, -215\r
238	CR, 215\r
239	MSPC, -240\r
240	BEL, 207\r
241	LWRA, -341\r
242	LWRZ, -373\r
243	AMINA, -40 / Add to "a" to make "A"\r
244	BPT,\r
245	BUFFLD, ADDR BUFPT+1\r
246	SCOPE,\r
247	BUFPTR, ADDR BUFPT+2\r
248	OFFSET,\r
249	PTTY, ADDR TTY\r
250	BS, 10\r
251	K334, 334\r
252	CDFG, CDF 0\r
253	K27, 27\r
254	SIXMSK, 77\r
255	FLDMSK, 7\r
256	INCH, 0\r
257	\r
258	/\r
259	/ Fortran-callable message printer\r
260	/ Put here to avoid wasting the rest of the page.\r
261	/ Arguments:\r
262	/ BUF Buffer pointer\r
263	/ COUNT Number of characters to write, zero to look for end\r
264	/ CRFLAG Carriage return flags.\r
265	/ Bit 11 (1) = no lead LF\r
266	/ Bit 10 (2) = no trail CR\r
267	/ Bit 9 (4) = start lowercase\r
268	/\r
269	ENTRY SIXOUT\r
270	SIXOUT, JA #STRT\r
271	#SXR, ORG .+10\r
272	TEXT +SIXOUT+\r
273	#SRET, SETX #SXR\r
274	SETB #SBASE\r
275	JA .+3\r
276	#SBASE, ORG .+6\r
277	CNT, ORG .+3\r
278	SFLAG, ORG .+3\r
279	\r
280	ORG #SBASE+30\r
281	FNOP\r
282	JA #SRET\r
283	FNOP\r
284	#SGOBK, 0;0\r
285	#SRTN, BASE #SBASE\r
286	JA #SGOBK\r
287	#STRT, STARTD\r
288	0210\r
289	FSTA #SGOBK,0\r
290	0200\r
291	SETX #SXR\r
292	SETB #SBASE\r
293	LDX 0,1\r
294	FSTA #SBASE\r
295	FLDA% #SBASE,1+\r
296	FSTA BUF / Buffer pointer\r
297	FLDA% #SBASE,1+ / Count\r
298	FSTA CNT\r
299	FLDA% #SBASE,1+ / Carriage control flag\r
300	FSTA SFLAG\r
301	STARTF\r
302	FLDA% CNT\r
303	SETX COUNT\r
304	ATX 0\r
305	FLDA% SFLAG\r
306	ATX 1\r
307	SETX #SXR\r
308	TRAP4 SIX8 /Call the 8-mode output routine\r
309	JA #SRTN\r
310	\r
311	FIELD1 SXOUT\r
312	ENTRY SIX8 / Mixed case output routine\r
313	\r
314	SIX8, 0\r
315	TAD CRFLAG /Suppresss carriage control?\r
316	RAR /Low bit suppresses lead LF\r
317	SZL CLA\r
318	JMP .+4 /No leading LF\r
319	CDF 10 / My field\r
320	TAD LF /Linefeed\r
321	JMS% TTYPTR+1 /Output it\r
322	TAD CRFLAG\r
323	AND K4 /Start in lower case?\r
324	SZA CLA\r
325	TAD K40 /Yes\r
326	TAD HUN /Reset conversion factor\r
327	DCA SHIFT\r
328	TAD BUF /Buffer field\r
329	AND K7 /Just the field bits\r
330	CLL RAL\r
331	RTL /Into place\r
332	TAD CDF0 /Into CDF instruction\r
333	DCA CDF1\r
334	TAD CDF1\r
335	DCA CDF2\r
336	TAD COUNT /Get buffer length\r
337	SNA\r
338	JMP NOTRIM /Zero means it has a terminating "@"\r
339	/\r
340	/ Find the end of the string\r
341	/\r
342	CLA CMA /End is start + len - 1\r
343	TAD COUNT /String len in words\r
344	TAD BUF+1 /End of the string\r
345	DCA PTR /Pointer to end\r
346	TAD COUNT /Invert count\r
347	CMA IAC\r
348	DCA COUNT\r
349	CDF1, HLT\r
350	FNDEND, TAD% PTR\r
351	TAD K3740 / - ' ' (two spaces)\r
352	SZA CLA / Skip if blank\r
353	JMP NONBLK\r
354	ISZ COUNT /Count another\r
355	SKP\r
356	JMP NONBLK /If empty, done\r
357	CLA CMA / -1\r
358	TAD PTR\r
359	DCA PTR /Back pointer up\r
360	JMP FNDEND /Keep looking\r
361	\r
362	NONBLK, TAD COUNT\r
363	SNA CLA /Skip if output left\r
364	JMP DONE /Nothing if count zero already\r
365	NOTRIM, TAD BUF+1 /Reset pointer to start\r
366	DCA PTR\r
367	CDF2, HLT\r
368	TAD% PTR /Get word\r
369	DCA STEMP /Save\r
370	TAD STEMP\r
371	RTR\r
372	RTR\r
373	RTR /First sixbit\r
374	JMS OUTONE /Convert and output it\r
375	TAD STEMP /Second sixbit\r
376	JMS OUTONE\r
377	ISZ PTR /Bump pointer\r
378	SKP /OK if no skip\r
379	JMP NEWFLD /Next field otherwise\r
380	INCCNT, ISZ COUNT\r
381	JMP CDF2 /Keep outputting\r
382	DONE, CLA\r
383	TAD CRFLAG /Suppress trailing CR?\r
384	RTR /2 bit suppresses trailing CR\r
385	SZL CLA /If zero, write it.\r
386	JMP OUT /Yes, leave now\r
387	CDF 10 /My field\r
388	TAD CRTN\r
389	JMS% TTYPTR+1\r
390	OUT, CIF CDF 0\r
391	JMP% SIX8\r
392	\r
393	NEWFLD, TAD CDF1\r
394	TAD K10 /Next field\r
395	DCA CDF1\r
396	TAD CDF1\r
397	DCA CDF2\r
398	JMP INCCNT\r
399	\r
400	OUTONE, 0\r
401	AND K77 /Mask\r
402	SNA\r
403	JMP DONE / End of string\r
404	TAD K7743 / minus '['\r
405	SNA\r
406	JMP SETLWR /Set to lowercase shift\r
407	TAD K2 / ok, ']'?\r
408	SNA\r
409	JMP SETUPR /Set to uppercase\r
410	TAD K7773 /Restore\r
411	SPA\r
412	TAD SHIFT /For positive, shift it\r
413	TAD K40 /Else it's not alphabetic\r
414	CDF 10 /My field\r
415	JMS% TTYPTR+1 /Output it\r
416	JMP% OUTONE /Done\r
417	\r
418	SETLWR, TAD K40 /Reset shift\r
419	SETUPR, TAD HUN /For upper/lower\r
420	DCA SHIFT\r
421	JMP% OUTONE\r
422	\r
423	TTYPTR, ADDR TTY\r
424	SHIFT, 140 /Shift value\r
425	/ COUNT and CRFLAG must stay together\r
426	COUNT, 0 /Num words to output. \r
427	CRFLAG, 0 /1 - no leading LF, 2 no trailing CR\r
428	PTR, 0\r
429	CRTN, 15\r
430	LF, 12\r
431	K3740, 3740 /minus blank\r
432	BUF, 0;0;0 /Buffer 15-bit address\r
433	STEMP, 0\r
434	K77, 77 /sixbit mask\r
435	K7, 7\r
436	K4, 4\r
437	K40, 40\r
438	CDF0, CDF\r
439	HUN, 100\r
440	K7743, 7743\r
441	K7773, 7773\r
442	K10, 10 /Field increment\r
443	K2, 2\r
444	\r
445	SECT SPEAK\r
446	/C\r
447	/ SUBROUTINE SPEAK(N)\r
448	/C\r
449	/C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.\r
450	/C\r
451	/ IMPLICIT INTEGER (A-Z)\r
452	/ COMMON /TXTCOM/ RTEXT,LINES,ASCVAR\r
453	/ COMMON /ALPHAS/ BLANK,EOF\r
454	/ DIMENSION RTEXT(205),LINES(36)\r
455	/C\r
456	EXTERN IO\r
457	EXTERN #HANG\r
458	JA #ST\r
459	#XR, ORG .+10\r
460	TEXT +SPEAK+\r
461	#RET, SETX #XR\r
462	SETB #BASE\r
463	JA .+3\r
464	#BASE, ORG .+6\r
465	N, ORG .+3\r
466	#DOTMP, ORG .+3\r
467	BLANK, TEXT + +\r
468	EOF, TEXT +>$< +\r
469	ONE, F 1.0\r
470	FOUR, F 4.0\r
471	ORG #BASE+30\r
472	FNOP\r
473	JA #RET\r
474	FNOP\r
475	#GOBAK, 0;0\r
476	I, ORG .+0003\r
477	L, ORG .+0003\r
478	OLDLOC, ORG .+0003\r
479	#LBL=.\r
480	COMMON TXTCOM\r
481	RTEXT, ORG .+1147\r
482	LINES, ORG .+0044\r
483	ASCVAR, ORG .+0003\r
484	TXTLOC, ORG .+0003\r
485	DATA, ORG .+0352\r
486	ORG #LBL\r
487	#RTN, BASE #BASE\r
488	JA #GOBAK\r
489	#ST, STARTD\r
490	0210\r
491	FSTA #GOBAK,0\r
492	0200\r
493	SETX #XR\r
494	SETB #BASE\r
495	LDX 0,1\r
496	FSTA #BASE\r
497	FLDA% #BASE,1+\r
498	FSTA N\r
499	STARTF\r
500	/ IF(N.EQ.0)RETURN\r
501	FLDA% N\r
502	JEQ #RTN\r
503	/ READ(2'N) LOC,LINES\r
504	FLDA N\r
505	STARTD\r
506	FSTA #G0002\r
507	STARTF\r
508	JSR IO\r
509	JA .+0004\r
510	#G0002, JA .\r
511	/ IF(LINES(1).EQ.EOF)RETURN\r
512	FLDA ONE\r
513	ATX 7\r
514	FLDA LINES-0003,7\r
515	FSUB EOF\r
516	JEQ #RTN\r
517	/1 OLDLOC = LOC\r
518	#1, FLDA TXTLOC\r
519	FSTA OLDLOC\r
520	FLDA ONE\r
521	FSTA I\r
522	\r
523	/ DO 3 I=36,1,-1\r
524	/ Set COUNT to the number of words (36 or 44 octal)\r
525	SETX COUNT\r
526	LDX 44,0 /44 words\r
527	LDX 0,1 /With carriage control\r
528	SETX #XR\r
529	/ L=I\r
530	/3 CONTINUE\r
531	/5 TYPE 2,(LINES(I),I=1,L)\r
532	#5, FLDA LINEPT\r
533	FSTA BUF /Set buffer pointer\r
534	TRAP4 SIX8\r
535	\r
536	FLDA% N\r
537	FADD ONE\r
538	FSTA% N\r
539	FLDA N\r
540	/ READ(2'ASCVAR) LOC,LINES\r
541	STARTD\r
542	FSTA #G0006\r
543	STARTF\r
544	JSR IO\r
545	JA .+0004\r
546	#G0006, JA .\r
547	/ IF(LOC .EQ. OLDLOC) GO TO 1\r
548	FLDA TXTLOC\r
549	FSUB OLDLOC\r
550	JEQ #1\r
551	EXTERN #WRITO\r
552	TRAP3 #WRITO\r
553	JA FOUR\r
554	JA #10+2\r
555	EXTERN #RENDO\r
556	TRAP3 #RENDO\r
557	\r
558	/10 RETURN\r
559	#10, JA #RTN\r
560	/ (1X)\r
561	5061\r
562	3051\r
563	/2 FORMAT(' ',36A2) PDP/8: (' ',12A6)\r
564	LINEPT, ADDR LINES\r
565	0\r
566	END\r