Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SUBTTL	Introduction

; Copyright (c) 1980 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.

; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
;	TECO Project
;	Computer Center
;	Stevens Institute of Technology
;	Castle Point Station
;	Hoboken, New Jersey    07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.

  ; Search needed universals

	SEARCH	JOBDAT		; Get the job data definitions
	SEARCH	TECUNV		; TECO universal file

  ; Generate the prologue


	TECVER==200		; Major version number
	TECMIN==1		; Minor version number
	TECEDT==1126		; Edit level
	TECWHO==0		; Last editor


	PROLOGUE(ONC,<TECO Once only>)	; Generate the TITLE and other stuff

	SUBTTL	Table of Contents

;+
;.pag.lit

;		Table of Contents for TECONC - Once only code
;
;
;			   Section			      Page
;   1. Introduction . . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Prebuilt data items. . . . . . . . . . . . . . . . . .    4
;   5. Impure storage . . . . . . . . . . . . . . . . . . . .    5
;   6. Once only start up . . . . . . . . . . . . . . . . . .    6
;   7. FIXSYM - Fix a symbol table entry. . . . . . . . . . .   10
;   8. ONCCHR - Input a character . . . . . . . . . . . . . .   11
;   9. WRTMSG - Write out an error message and move the index   12
;  10. WRTSTR - Write a string. . . . . . . . . . . . . . . .   13
;  11. WRTERR - Write a character into the text area. . . . .   14
;  12. MSGOUT - Write a character to the error file.. . . . .   15
;  13. DOC file
;       13.1.   O$T.0 - End with a null . . . . . . . . . . .   16
;       13.2.   O$T.A - Type a left angle bracket . . . . . .   17
;       13.3.   O$T.BEG - Illegal . . . . . . . . . . . . . .   18
;       13.4.   O$T.EOS - End of string . . . . . . . . . . .   19
;       13.5.   O$T.I - Set left margin . . . . . . . . . . .   20
;       13.6.   O$T.INS - Type another string . . . . . . . .   21
;       13.7.   O$T.J - Type a line feed. . . . . . . . . . .   22
;       13.8.   O$T.K - Type a vertical tab . . . . . . . . .   23
;       13.9.   O$T.L - Type a form feed. . . . . . . . . . .   24
;       13.10.  O$T.M - Carriage return . . . . . . . . . . .   25
;       13.11.  O$T.N - Flag no CRLF. . . . . . . . . . . . .   26
;       13.12.  O$T.Q - Output a double quote . . . . . . . .   27
;       13.13.  O$T.R - Output a right angle bracket. . . . .   28
;       13.14.  O$T.X - Set the type out routine. . . . . . .   29
;       13.15.  O$T.Z - Output an error table . . . . . . . .   30
;       13.16.  Output a byte . . . . . . . . . . . . . . . .   31
;       13.17.  Text strings. . . . . . . . . . . . . . . . .   32
;       13.18.  Routine dispatch table. . . . . . . . . . . .   33
;  14. PSECT ends . . . . . . . . . . . . . . . . . . . . . .   34
;  15. End of TECONC. . . . . . . . . . . . . . . . . . . . .   35

;.end lit.pag
;-

	SUBTTL	Revision History
COMMENT	|

1000	Start of this version

1002	By: Robert McQueen		On: 16-July-1980
	- Start some work on a -20 interface and making KAs work with TECONC
	- Fix a core management problem/symbol table problem defining the first
	  symbol
	Modules: TECUNV,TECSYM,TECONC

1034	By: Nick Bush		On: 24-August-1980
	If an error occurs during the execution of TECONC, error processing
	blows up. Set up a flag to indicate whether TECONC has finished yet.
	If it is still set, error processing will skip writing the message
	into the Q-reg.
	Modules: TECUNV,TECUUO,TECONC

1074	By: Nick Bush		On: 23-January-1981
	Make TECONC ask for an initial command string for TECINI. This can be
	any set of TECO commands terminated by two altmodes.
	Also make TECECM do a physical-only GETSEG during an EE file restart if
	the original run-from info was gotten from the GETTAB's.
	Modules: TECINI,TECONC,TECECM

Start of Version 200A(1126)
|

	SUBTTL	Prebuilt data items

	$ONCE			; Once only data

MSGFDB:				; FDB for error message file
$BUILD	FDB,.FDLEN		; Full length
TOPS10,<
	$SET	DEV,<SIXBIT |DSK|>    ; Write on DSK:
	$SET	NAM,<SIXBIT |TECO|>   ; TECO
	$SET	EXT,'ERR'	; .ERR
>; End of TOPS10
TOPS20,<
	$SET	FIL,<[ASCIZ |DSK:TECO.ERR|]>
>; End of TOPS20
	$SET	MOD,$FMASC	; ASCII mode
$EOB

DOCFDB:				; FDB for the DOC file
$BUILD	FDB,.FDLEN		; Full length
TOPS10,<
	$SET	DEV,<SIXBIT |DSK|> ; Write on DSK:
	$SET	NAM,<SIXBIT |TECMSG|> ; TECMSG
	$SET	EXT,'RNO'	; .RNO
>; End of TOPS10
TOPS20,<
	$SET	FIL,<[ASCIZ |DSK:TECO-MESSAGES.RNO|]>
>; End of TOPS20
	$SET	MOD,$FMASC	; ASCII mode
$EOB
				; End the block

	SUBTTL	Impure storage

ONCZER:!

OUTRTN:	BLOCK	1		; Output routine for WRTSTR
CODEFF:	BLOCK	1		; First free loc in code
CODLPG:	BLOCK	1		; Last addressable page in code
CODPTR:	BLOCK	1		; Byte pointer into code for storing error text
FSTLVL:	BLOCK	1		; Level to keep in core of first lines
CONLVL:	BLOCK	1		; Level of continuations to keep in core
CHRCNT:	BLOCK	1		; Character counter for writing into error file
HGHPAT:	BLOCK	1		; Length of high segment patching space to allocate
LOWPAT::BLOCK	1		; Length of low segment patching space to allocate
$JBSYM:	BLOCK	2		; Room for copy of .JBSYM/.JBUSY
$JBUSY==$JBSYM+1

ONCEZR==.-1
WRDCNT:	BLOCK	1		; Word counter for writing into error file
LMARGN:	BLOCK	1		; Left margin for output

	SUBTTL	Macro definitions -- OCTIN.

; Macro to input an octal number. Under TOPS-10 it will call the .IOCTW
;routine in TECCOM.  Under TOPS-20 it will just do the NIN JSYS.


	DEFINE OCTIN.(PROMPT,ADDR,%1)
<%1:!	MOVEI	T1,[$STRING(<PROMPT>)]
	PUSHJ	P,T$TYPE	;; Type the string
TOPS20,<
	MOVX	T1,.PRIIN	;; Get the input designator
	MOVX	T3,^D8		;; Get the radix
	NIN%			;; Input the number
	 ERJMP	%1		;; Couldn't, go ask again
	MOVEM	T2,ADDR		;; Save it
> ;; End of TOPS20
TOPS10,<
	PUSHJ	P,.IOCTW	;; Input a number
	JUMPN	CH,[PUSHJ P,BADNUM	;; Bad number
		JRST	%1]		;; go try again
	MOVEM	T1,ADDR		;; Save the value
> ;; End of TOPS10
> ; End of OCTIN. defintion

	DEFINE YONIN.(PROMPT,%1,%2,%3)
<%3:!	MOVEI	T1,[$STRING(<PROMPT>)]
	PUSHJ	P,T$TYPE	;; Type the string
TOPS20,<
	PBIN%			;; Get a character
	 ERJMP	%1		;; Couldn't?
> ;; End of TOPS20
TOPS10,<
	PUSHJ	P,ONCCHR	;; Get a character
	JUMPE	CH,%1		;; If end of line, try again
	MOVE	T2,CH		;; Otherwise get a copy
	PUSHJ	P,ONCCHR	;; Get the next character
	JUMPN	CH,.-1		;; And eat the rest of the line
> ;; End of TOPS10
	CAIE	T2,"N"		;; An N?
	 CAIN	T2,"n"		;; or an n?
	  JRST	%2		;; Yes, all is fine
	CAIE	T2,"Y"		;; Or was it a Y?
	 CAIN	T2,"y"		;; Or a y?
	  JRST	%2+1		;; Yes, give the skip
%1:!	MOVEI	T1,[$STRING(?Please type Y or N)]
	PUSHJ	P,T$TYPE	;; Type the error message
	JRST	%3		;; Try again
%2:!>

	SUBTTL	Once only start up

;+
;.HL1 ONCE
; This routine is the initial starting address of TECO.  It will ask the
;person that is running TECO several questions and then determine what to
;write into TECO.ERR from the answers that are given by the user.  This
;routine may not write a TECO.ERR if the person is foolish enough to want
;all the error messages for TECO left in core.
;-

	DEFLVR			; Define the low segment version symbols

	HIGH=:CODBEG-.JBHDA-1	; Start of future high segment

; Here to exit to the operating system

MONRET:	$HALT			; Exit to the operating system
	JRST	.-1		; Don't allow continues

ONCE:	RESET			; Reset the world
	STORE	T1,ONCZER,ONCEZR,0 ; Clear our private impure storage
	STORE	T1,IMPBEG,IMPEND,0 ; And the global storage
	MOVEI	T1,PTRBEG	; Get the beginning of the error messages
	MOVEM	T1,ERRIDX	; Store it for now
	MOVEI	T1,CODEND	; Get the end address of code
	MOVEM	T1,CODEFF	; Save it
	MOVEI	T1,<CODEND-1>_-^D9 ; Get the page number for the last page
	MOVEM	T1,CODLPG	; Save it
	MOVE	P,[IOWD D.PDLL,PDL] ; Set up the stack
	PUSH	P,[EXP MONRET]	; Store the address
	MOVEM	P,SAVEP		; Incase of an error save this
	DMOVE	T1,.JBSYM	; Get the symbol table addresses
	DMOVEM	T1,$JBSYM	; Save them for later
	MOVEI	T1,IMPEND	; Get the end of the impure segment
	MOVEM	T1,.JBFF	; And use that for allocating core
	SETZB	S,F		; Clear the flags
	PUSHJ	P,M$INIT	; Initalize memory management for file routines
	PUSHJ	P,F$INIT	; Initialze the file system stuff
	PUSHJ	P,I$JOB		; Get job info
	PUSHJ	P,T$INIT	; Initialize the terminal stuff

; Now set the terminal channel to not be full character set. This lets
;at least the minimal monitor editing to be done on the input.

	LOAD.	T1,FDBCHN,+TTYFDB ; Get the channel number
	MOVX	T2,<INSVL.(.FOSET,FO.FNC)> ; Get the function
	MOVX	T3,.IOASL	; Just ASCII line mode
	STOR	T1,T2,FO.CHN	; Store the channel number in
	MOVX	T1,<XWD 2,T2>	; Get the pointer
	FILOP.	T1,		; And set the status
	 JFCL			; Ignore any error


	SKIPE	[EXP HIGH&<.SUAKL-1>] ; Code psect in correct place?
	 JRST	[MOVEI	T1,[$STRING(<? PSECT CODE must be loaded starting at a page boundary plus 10 (octal) words>)]
		PUSHJ	P,T$TYPE	; Output the message
		JRST	MONRET]		; Exit to the operating system

; Type out the psect layout

DEFINE $TYPPS(NAME,COD,NXT),<
	MOVEI	T1,[$STRING(<^I/0/NAME^I/8/^O/[COD'BEG]/^I/^D16/^O/[COD'END-1]/^I/^D24/^O/[COD'END-COD'BEG]/^I/^D32/=^I/^D35/^D/[COD'END-COD'BEG]/.^I/^D44/^O/[NXT'BEG-COD'END]/^I/^D52/=^I/^D55/^D/[NXT'BEG-COD'END]/.>)]
	PUSHJ	P,T$TYPE	; Type the string
> ; End of DEFINE $TYPPS
	ENDBEG==1000000		; Highest address plus one

	MOVEI	T1,[$STRING(<^I/0/
PSECT layout:
PSECT^I/8/Start^I/^D16/End^I/^D24/Length^I/^D44/Free to next
^I/0/-----^I/8/-----^I/^D16/---^I/^D24/------^I/^D44/------------>)]
	PUSHJ	P,T$TYPE	; Type the string
	$TYPPS(IMPURE,IMP,ONC)	; Type the info for impure
	$TYPPS(.ONCE,ONC,PTR)	; Type the info for once
	$TYPPS(.TXTPT,PTR,TXT)	; and for the error index
	$TYPPS(.TEXT.,TXT,COD)	; and the text
	$TYPPS(CODE,COD,END)	; And lastly the code section

; Now open the output file DSK:TECO.ERR[-]

	MOVE	T1,.JBVER	; Get the version number
	STOR.	T1,FDBVER,+MSGFDB ; Store it in the FDB
	MOVX	T1,$IOWRI	; Open this for writing
	MOVEI	T2,MSGFDB	; Get the address of the FDB
	PUSHJ	P,F$OPEN	; Open it
	  JRST	F$ERR		; Failed
	MOVEI	T1,ONCCHR	; Get the input routine
	MOVEM	T1,RTN		; Store in the routine address
ONCE.0:	OCTIN.(<^M^JHighest first line message level to keep in core: ^N>,FSTLVL)
	OCTIN.(<^M^JHighest continuation line message level to keep in core: ^N>,CONLVL)

; Here to move the error messages to the correct place

ONCE.1:	MOVE	P1,[XWD -<<PTREND-PTRBEG>/$ERLEN>,PTRBEG] ; Get the loop counter
TOPS10,<
	MOVX	T4,%CNDTM	; Get the current time
	GETTAB	T4,		;  .  .  .
	 MOVEI	T4,E.MAX	; Couldn't use the max index entry instead
>
TOPS20,<
	GTAD%			; Get the current date/time
	MOVE	T4,T1		; Get it into the correct place
>
	LSH	T4,1		; Make the word so we can store it in ASCII
	MOVEM	T4,ERRDTM	; Save so we can tell if the error file is correct
	MOVEI	T2,5		; Write 5 bytes
	MOVE	T3,[POINT 7,T4]	; Get the byte pointer
ONCDTM:	ILDB	CH,T3		;  .  .  .
	MOVEI	T1,MSGFDB	; Get the FDB address
	PUSHJ	P,F$WRIT	; Write the byte
	 PJRST	F$ERR		; Couldn't
	SOJG	T2,ONCDTM	; Loop for all the digits

	MOVEI	T1,E.MAX##	; Get the maximum error index
	PUSHJ	P,GETCOD	; And get the space for the index
	MOVE	P2,T1		; Get the address
	MOVEM	P2,ERRIDX	; Save the address of the index
	MOVEI	T3,E.MAX##(T1)	; And the address afterwards
	HRLI	T3,(POINT 7,)	; Get the byte pointer
	MOVEM	T3,CODPTR	; Save the address

ONCE.3:	PUSHJ	P,WRTMSG	; Write out this message and copy index entry
	ADDX	P2,$ERLEN	; Bump the pointer
	ADDX	P1,$ERLEN-1	; This one also
	AOBJN	P1,ONCE.3	; Loop for all of the messages
	MOVEI	T1,MSGFDB	; Get the FDB
	SKIPN	WRDCNT		; Write anything?
	 JRST	[PUSHJ	P,F$RSET	; No, forget about the file
		JRST	ONCE.4]		; And continue on
	PUSHJ	P,F$CLOS	; Close the file
	  JRST	F$ERR		; Failed - Process the error

ONCE.4:	MOVEI	T1,[$STRING(<^M^JInitial command string (to read TECO.INI, etc.): ^N>)]
	PUSHJ	P,T$TYPE	; Type it
	SETZ	P1,		; Clear the count
	MOVE	T1,CODEFF	; Get the free address
	HRLI	T1,(POINT 7,)	; Make it a byte pointer
	MOVEM	T1,FSTCMD	; Store the address where we are storing the text
	MOVEM	T1,CODPTR	; Save it
	MOVX	CH,"*"		; Start with a star (from the "prompt")
	PUSHJ	P,WRTERR	; Write it

	TXZE	F,F.TYOF	; Anything need to by typed?
	 PUSHJ	P,TTYOUT	; Yes, force it out
ICMD.0:	INCHWL	CH		; Get a character
ICMD.1:	AOJ	P1,		; Count the character
	PUSHJ	P,WRTERR	; No, write the character
	CAXE	CH,.CHESC	; Escape?
	 JRST	ICMD.0		; No, get next character
	INCHWL	CH		; Get next character
	CAXE	CH,.CHESC	; Escape?
	 JRST	ICMD.1		; No, go store it
	MOVEM	P1,FSTCMD+1	; Store the number of characters in the command

	OCTIN.(<^M^JLength of patching space to allocate in high segment (octal): ^N>,HGHPAT)
	OCTIN.(<^M^JLength of patching space to allocate in low segment (octal): ^N>,LOWPAT)
	SKIPN	T1,HGHPAT	; Need high segment patching?
	 JRST	ONCE.E		; No, skip it
	PUSHJ	P,GETCOD	; Get the space in code
	MOVE	T3,T1		; Get a copy
	MOVEI	T1,[$STRING(<^M^JHigh segment patching space starts at PAT.. = ^O/T3/, length = ^O/HGHPAT/ (= ^D/HGHPAT/.)>)]
	PUSHJ	P,T$TYPE	; Type the string
	MOVEM	T3,HGHPAT	; Save the address of the space
ONCE.E:	SKIPN	LOWPAT		; Want low seg space?
	 JRST	ONCE.F		; No, skip this
	MOVEI	T1,[$STRING(<
Low segment patching space starts at LOWPAT = ^O/[IMPEND+1]/, length = ^O/LOWPAT/ (= ^D/LOWPAT/.)>)]
	PUSHJ	P,T$TYPE	; Type the string
	MOVE	T1,LOWPAT	; Get the length
	ADDM	T1,XITCOD+XITJFF ; Save for exit code
	MOVEI	T1,IMPEND	; Get the address of LOWPAT
	MOVEM	T1,LOWPAT	; And save it
ONCE.F:	SKIPE	$JBSYM		; Any symbols?
	 YONIN.	(<Keep symbol table (Y or N):^N >) ; Prompt for whether to keep symbols
	  JRST	[SETZM	$JBSYM		; Don't want symbols, clear the pointers
		SETZM	$JBUSY		;  .  .  .
		JRST	ONCE.A]		; And continue on
	MOVX	T1,<SQUOZE 0,PAT..> ; Get the symbol to change
	SKIPN	T2,HGHPAT	; And what to change it to
	 MOVE	T2,LOWPAT	; Use low segment otherwise
	PUSHJ	P,FIXSYM	; Fix the symbol
	MOVX	T1,<SQUOZE 0,LOWPAT> ; Get the other symbol
	MOVE	T2,LOWPAT	; And the value
	PUSHJ	P,FIXSYM	; change it
	HLRE	T1,$JBUSY	; Get the undefined table
	MOVN	T1,T1		;  length
	MOVE	P3,T1		; Get a copy of the size
	PUSHJ	P,GETCOD	; Get the code area
	MOVE	P2,T1		; Get the address
	ADD	P3,T1		; Make P3 the final address
	HLRE	T1,$JBSYM	; Yes, get the length
	MOVN	T1,T1		; Make it positive
	PUSHJ	P,GETCOD	; Allocate the code space for it
	MOVE	P1,T1		; Get the address
	HRL	P1,$JBSYM	; Set up to move the symbol table
	HRRM	P1,$JBSYM	; Remember where we are putting it
	HLRE	T1,$JBSYM	; Get the length again
	MOVN	T1,T1		;  .  .  .
	ADDI	T1,(P1)		; Get the final address+1
	BLT	P1,-1(T1)	; Move the table
	SKIPL	$JBUSY		; Have any undefines?
	 JRST	ONCE.A		; No, all done
	HRL	P2,$JBUSY	; Set up to move the undefined symbols
	HRRM	P2,$JBUSY	; Fix the pointer
	BLT	P2,-1(P3)	; And move the symbols
	JRST	.+2		; Skip into the final code

ONCE.A:	 SETZM	$JBUSY		; No undefined table
	DMOVE	T1,$JBSYM	; Get the new pointers
	DMOVEM	T1,.JBSYM	; Save them
	MOVE	T1,[PORTAL RST]	; Get the restart instruction for EE commands
	MOVEM	T1,HIGH+.JBHDA	; Save it
	MOVE	T1,.JBVER	; Fix up high-seg job data
	MOVEM	T1,HIGH+.JBHVR	; Store te version number
	MOVE	T1,[SIXBIT |TECO|] ; Get our name
	MOVEM	T1,HIGH+.JBHNM	; Save it
	SETNAM	T1,		; And change to that
	MOVE	T1,.JBSYM	; And the smbol
	MOVEM	T1,HIGH+.JBHSM	; table pointer
	MOVE	T1,.JBCOR	; Get the JBCOR
	MOVEM	T1,HIGH+.JBHCR	; And store it
	MOVE	T1,.JB41	; Get the LUUO instruction
	MOVEM	T1,HIGH+.JBH41	; Save it
	MOVEI	T1,TECO		; Get the start address
	HRL	T1,XITCOD+XITJFF ; And get the end of the low seg
	MOVEM	T1,.JBSA	; Save it
	HLRM	T1,.JBFF	; Save here also
	MOVEI	T1,.JBVER	; Get highest non-zero loc
	SKIPE	.JBDDT		; Have DDT ?
	 JRST	[HLRZ	T1,.JBDDT	; Yes - Not a zero low segment
		CAMGE	T1,XITCOD+XITJFF ; Is it VMDDT?
		 JRST	.+1		; No, keep it
		SETZ	T1,		; Yes, it won't really be there
		SETDDT	T1,		; So clear the DDT start address
		MOVEI	T1,.JBVER	; And flag we have a null low segment
		JRST	.+1]		; Continue
	MOVSM	T1,.JBCOR	; Save it
	MOVEM	T1,HIGH+.JBHSA	; Here also
	MOVSI	T1,HIGH		; Get the high segment start
	MOVEM	T1,HIGH+.JBHGA	; Save it
	MOVE	T1,CODEFF	; Get the first free high-segment address
	SUBI	T1,HIGH		; Minus the base
	HRLM	T1,.JBHRL	; Store the length
	HRLM	T1,HIGH+.JBHRN	; Here also
	HRRZ	T1,.JBREN	; Get the re-enter address
	HRRM	T1,HIGH+.JBHRN	; Save it
	SETZM	ONCFLG		; Flag no longer in TECONC
TOPS10,<
	MOVE	P2,CODEFF	; Get the vlue again
	TXO	P2,.SUAKL-1	; Round up to nearest page
	HRRM	P2,.JBHRL	; Store it
	AOJ	P2,		; Bump to next page
	ADR2PG	P2		; Shift to a page number
	SUBI	P2,HIGH_-^D9	; And get the number of pages in the high segment
	MOVEI	P1,3		; Three arguments
	MOVEI	P3,HIGH_-^D9	; Source page
	MOVEI	P4,HIGH_-^D9	; Destination page
	MOVX	T1,<XWD .PAGCH,P1> ; Get the argument pointer
	PAGE.	T1,		; Create the high segment
	 STOPCD	CCH,<Can't create high-segment, PAGE. UUO failed>
	MOVE	T1,CODEFF	; Get the first free high-segment address
	SUBI	T1,HIGH		; Minus the base
	HRLM	T1,.JBHRL	; Store the length
> ; End of TOPS10
	RESET			; Clear the world again
	STORE	T1,IMPBEG,IMPEND,0 ; And clear the low segment
	DMOVE	T1,[BLT 17,17		; Get the .JBBLT things
		EXIT]			;  .  .  .
	DMOVEM	T1,.JBBLT	; And save them
	SETZM	IMPBEG		; Clear first loc of low segment
	MOVSI	17,XITCOD	; Set up the exit code
	BLT	17,XITEND	; And move it
	MOVEI	17,1		; Set up for BLT
	JRST	XITSTA		; And go finish up


XITCOD:	PHASE	0		; Code to do the exit
XITJFF:!EXP	IMPEND		; Last loc to leave in low segment
XITBLP:!XWD	IMPBEG,IMPBEG+1	; Pointer to clear low seg
XITSTA:!CORE	XITJFF,		; Get rid of random rot
	 HALT	.		; Couldn't?
	BLT	XITBLP,@.JBREL	; Clear the low segment out to avoid rot in .EXE file.
	SETZ	0,		; Clear 0 for the BLT
	JRST	.JBBLT		; And go exit
XITEND==.-1

	DEPHASE			; Real addresses again

	SUBTTL	GETCOD - Allocate space in the CODE section

;+
;.hl1 GETCOD
; This routine will allocate space in the CODE section for the error index,
;messages, and symbol table.
;.b.literal
; Usage:
;	MOVEI	T1,Size
;	PUSHJ	P,GETCOD
;	 (return, T1=address)
;
;.end literal
;-

GETCOD:	$SAVE	<P1>		; Save this register
	MOVE	P1,CODEFF	; Get the first free loc in the section
	ADDB	T1,CODEFF	; Get the final address we need
	SOS	T2,T1		; Minus one
	ADR2PG	T2		; Make this the ending page number
TOPS10,<
	CAMG	T2,CODLPG	; Need to expand to see this?
	 JRST	GETC.1		; No, skip this
>; End of TOPS10
	MOVE	T1,CODLPG	; Get the starting page number minus one
	AOJ	T1,		; Plus one to put to first non-existent page
	MOVEM	T2,CODLPG	; Save the new last page
	SUB	T2,T1		; Determine the number of pages
	AOJ	T2,		; Plus one
	PUSHJ	P,M$CPGS	; Acquire N pages
	  JRST	GETC.2		; Failed

GETC.1:	MOVE	T1,P1		; Get the address
	POPJ	P,		; And return

GETC.2:
TOPS10<
	OUTSTR	ICBTXT		; Output the error message
>; End of TOPS10
TOPS20<
	HRROI	T1,ICBTXT	; Get the text to output
	PSOUT%			; Output it
>; End of TOPS20

; Error text

ICBTXT:	ASCIZ	|
?Insufficient core to build TECO
|

	SUBTTL	BADNUM - Give error message for bad number input

; Here if the octal message level has junk after it

BADNUM:	MOVEI	T1,[$STRING(?TECILC Illegal character ^7/CH/)]
	PUSHJ	P,T$TYPE	; Output the text
	SKIPE	CH		; If at EOL
	 PUSHJ	P,ONCCHR	; Loop until end of line
	JUMPN	CH,.-1		; . . .
	POPJ	P,		; Return to try again

	SUBTTL	FIXSYM - Fix a symbol table entry


;+
;.hl1 FIXSYM
; This routine will change the value of a symbol in the symbol table.
;.b.literal
; Usage:
;	MOVE	T1,Symbol.name (RADIX-50)
;	MOVE	T2,New.value
;	PUSHJ	P,FIXSYM
;	 (return)
;
;.end literal
;-

FIXSYM:	$SAVE	<P1,P2>		; Save P1/P2
	DMOVE	P1,T1		; And save the args

	MOVE	T2,.JBSYM	; Get the symbol pointer
	JUMPGE	T2,.POPJ	; Return if none

FIXS.0:	MOVE	T1,(T2)		; Get the symbol
	TXZN	T1,74B5		; Program name?
	 JRST	FIXS.1		; Yes, skip it
	CAME	T1,P1		; Correct name?
	 JRST	FIXS.1		; No, try the next
	MOVEM	P2,1(T2)	; Store the value
	POPJ	P,		; And return

FIXS.1:	AOBJN	T2,.+1		; Bump the counter
	AOBJN	T2,FIXS.0	; Loop for all symbols
	POPJ	P,		; Return if not found

	SUBTTL	ONCCHR - Input a character

;+
;.HL1 ONCCHR
; This routine will input a character from the terminal.  It will
;have the monitor do all the echoing of the characters, unlike the
;rest of the terminal processing in TECO.
;.literal
;
; Usage:
;	PUSHJ	P,ONCCHR
;	(Return)
;
; CH - Contains the character (Zero if EOL)
;.end literal
;-

TOPS10,<
BITMSK(EOLCHR,.CH,<LFD,FFD,VTB,CNZ,BEL,CNC,ESC>)

ONCCHR:	$SAVE	<T1>		; Save T1
	TXZE	F,F.TYOF	; Have to force output ?
	 PUSHJ	P,TTYOUT	; Yes, output the buffer
ONCC.0:	INCHWL	CH		; Get a character
	CAXN	CH,.CHCRT	; Is this a carriage return ?
	  JRST	ONCC.0		; Yes - Eat it and try again
	CAXN	CH,.CHESC	; Is this an escape ?
	 OUTSTR	[ASCIZ |
|]				; Yes - Output a CRLF
	MOVX	T1,EOLCHR	; Get the end of line bits
	LSH	T1,(CH)		; Move this
	SKIPGE	T1		; Skip if not an EOL
	 SETZ	CH,		; Clear this
	POPJ	P,
>; End of TOPS10

	SUBTTL	WRTMSG - Write out an error message and move the index

;+
;.hl1 WRTMSG
; This routine will move an error message to the correct place.
;-

WRTMSG:	LOAD.	T1,ERRPFX,(P1)	; Get the prefix
	STOR.	T1,ERRPFX,(P2)	; Store it
	ZERO.	T1,ERRFLG,(P2)	; Clear the flags
	LOAD.	P3,ERRLVL,(P1)	; Get the message level
	STOR.	P3,ERRLVL,(P2)	; Save it
	CAMLE	P3,FSTLVL	; Want to keep the first line?
	 JRST	WRTM.1		; No, go write it out
	MOVEI	T1,WRTERR	; Yes, get the routine
	MOVEM	T1,OUTRTN	; Save it
	HRRZ	T1,CODPTR	; Get the pointer address
	STOR.	T1,ERRFST,(P2)	; Store it
	JRST	WRTM.2		; And go write the message

WRTM.1:	MOVEI	T1,MSGOUT	; Get the routine
	MOVEM	T1,OUTRTN	; Save it
	MOVE	T1,WRDCNT	; Get the word count
	ADDI	T1,1		; Plus 5 for the date/time word
	STOR.	T1,ERRFST,(P2)	; Save the file address
	BITON	T1,ER$DS1,$ERFLG(P2) ; Flag it is one disk
	AOS	ERFCNT		; Bump the count of messages

WRTM.2:	LOAD.	T1,ERRFST,(P1)	; Get the message address
	PUSHJ	P,WRTSTR	; Write the string
	PUSHJ	P,WRTM.E	; Fix the pointers

WRTM.4:	CAMLE	P3,CONLVL	; Continuation kept?
	 JRST	WRTM.5		; No, go set up to write it
	MOVEI	T1,WRTERR	; Get the routine
	MOVEM	T1,OUTRTN	; Save it
	HRRZ	T1,CODPTR	; Get the address
	STOR.	T1,ERRCON,(P2)	; Store it
	JRST	WRTM.6		; And go move the message

WRTM.5:	MOVEI	T1,MSGOUT	; Get the routine address
	MOVEM	T1,OUTRTN	; Save it
	MOVE	T1,WRDCNT	; Get the disk addrss
	ADDI	T1,1		; Plus the offset for the date/time word
	STOR.	T1,ERRCON,(P2)	; Save it
	BITON	T1,ER$DSC,$ERFLG(P2) ; Flag it is on disk
	AOS	ERFCNT		; Bump the count

WRTM.6:	LOAD.	T1,ERRCON,(P1)	; Get the address
	PUSHJ	P,WRTSTR	; And write the string
	LOAD	T1,CODPTR,BP.PFL ; Get the position field
WRTM.E:	CAIN	T1,^D36		; Initial pointer?
	 JRST	WRTM.3		; Yes, all is okay
	AOS	T1,CODPTR	; Get the address
	HRLI	T1,(POINT 7,)	; Set up the byte pointer
	MOVEM	T1,CODPTR	; Save the new pointer
WRTM.3:	SKIPN	CHRCNT		; Need to fix character count
	 POPJ	P,		; Return
	MOVEI	T1,5		; Get a 5
	SUB	T1,CHRCNT	; And get the number left
	MOVE	T2,MSGFDB+.FDBRH+.BFCTR ; Get the counter
	SUB	T2,T1		; Adjust it
	MOVEM	T2,MSGFDB+.FDBRH+.BFCTR ; And store it back
	AOS	T1,MSGFDB+.FDBRH+.BFPTR ; Get the pointer
	HRLI	T1,(POINT 7,)	; Set up the pointer
	MOVEM	T1,MSGFDB+.FDBRH+.BFPTR ; Save it
	SETZM	CHRCNT		; Yes, clear the count
	AOS	WRDCNT		; And bump the word count
	POPJ	P,		; Return

	SUBTTL	WRTSTR - Write a string

;+
;.hl1 WRTSTR
; This routine will write out a single $STRING type string. It will call
;the routine whose address is in OUTRTN to write each character.
;.b.literal
; Usage:
;	MOVEI	T1,Address.of.string
;	PUSHJ	P,WRTSTR
;	 (return)
;
;.end literal
;-

WRTSTR:	HRLI	T1,(POINT 7,)	; Set up the byte pointer
WRTS.0:	ILDB	CH,T1		; Get a character
	CAXN	CH,$TFBEG	; A beginning of string
	 JRST	WRTS.1		; Yes, go check if end of string
WRTS.2:	PUSHJ	P,@OUTRTN	; Write the character
	JRST	WRTS.0		; And get the next character

WRTS.1:	PUSHJ	P,@OUTRTN	; Write the character
	ILDB	CH,T1		; And get the next one
	JUMPE	T1,.-1		; Ignore nulls
	CAXE	CH,$TFEOS	; End of string?
	 JRST	WRTS.2		; No, go continue
	PJRST	@OUTRTN		; Yes, go write it and return

	SUBTTL	WRTERR - Write a character into the text area

;+
;.hl1 WRTERR
; This routine will write a character into the text area of what will
;become the high segment. It will make sure that the page being stored into
;is addressable.
;-

WRTERR:	$SAVE	(<T1,T2>)	; Save some room
	IBP	CODPTR		; Bump the pointer
	HRRZ	T2,CODPTR	; Get the new address
	AOJ	T2,		; Point to the next word
	MOVE	T1,T2		; Get the address
	SUB	T1,CODEFF	; Get the amount to increase
	CAML	T2,CODEFF	; Need to expand?
	 PUSHJ	P,GETCOD	; Yes, expand one word

WRTE.1:	DPB	CH,CODPTR	; Store the character
	POPJ	P,		; And return

	SUBTTL	MSGOUT - Write a character to the error file.

;+
;.hl1 MSGOUT
; This routine will write out a character to the error message file.
;-

MSGOUT:	$SAVE	<T1>		; Save some ac's
	MOVEI	T1,MSGFDB	; Get the FDB address
	PUSHJ	P,F$WRIT	; And write the character
	 PJRST	F$ERR		; Couldn't, punt
	AOS	T1,CHRCNT	; Bump the count
	CAIGE	T1,5		; Hit a word boundary?
	 POPJ	P,		; No, return
	SETZM	CHRCNT		; Yes, clear the count
	AOS	WRDCNT		; And bump the word count
	POPJ	P,		; Return

	SUBTTL	DOC file -- O$T.0 - End with a null

;+
;.HL1 O$T.0
;This routine will just return, since no error message should need
;to have the end with a null in it.
;-

O$T.0:	POPJ	P,		; Just ignore this

	SUBTTL	DOC file -- O$T.A - Type a left angle bracket

;+
;.HL1 O$T.A
;This routine will just type a left angle bracket into the error message
;file.
;-

O$T.A:	MOVEI	CH,"<"		; Get the character to type
	PJRST	OUTDOC		; Output the byte

	SUBTTL	DOC file -- O$T.BEG - Illegal

;+
;.HL1 O$T.BEG
;This function is illegal and will be ignored.
;-

O$T.BEG:			; Begin function -- Handled top level
	STOPCD	(BEG,<Begin function in an error message>)

	SUBTTL	DOC file -- O$T.EOS - End of string

;+
;.HL1 O$T.EOS
;This function is encountered at the end of a string.
;-

O$T.EOS:				; End of string

	SUBTTL	DOC file -- O$T.I - Set left margin

;+
;.HL1 O$T.I
;This function will set the left margin for the type out.
;-

O$T.I:	MOVEM	T1,LMARGN	; Store the left margin
	MOVEI	T1,[$STRING(^X/OUTDOC/^M^J.LM ^D/LMARGN/)] ; Get the string to output
	PJRST	T$TYPE		; Output it

	SUBTTL	DOC file -- O$T.INS - Type another string

;+
;.HL1 O$T.INS
;This function should type another string.  It will only STOPCD here.
;-

O$T.INS:
	STOPCD	(INS,<INS function encountered>)

	SUBTTL	DOC file -- O$T.J - Type a line feed

;+
;.hL1 OT$.J
;This routine will simulate a line feed.  It is assumed that a
;carriage return will also be output and the carriage return will
;be ignored.
;-

O$T.J:	MOVEI	T1,[$STRING(^X/OUTDOC/^M^J.BREAK)] ; Get the string
	PJRST	T$TYPE		; Output the string

	SUBTTL	DOC file -- O$T.K - Type a vertical tab

;+
;.HL1 O$T.K
;This routine will type a vertical tab.
;-

O$T.K:	POPJ	P,		; Just return for now

	SUBTTL	DOC file -- O$T.L - Type a form feed

;+
;.HL1 O$T.L
;This routine will cause a page break, or a form feed to be output.
;-

O$T.L:	POPJ	P,		; In an error file ?

	SUBTTL	DOC file -- O$T.M - Carriage return

;+
;.HL1 O$T.M
;This routine will ignore the carriage return, since it is assumed that
;a line feed will follow.  That routine will cause a carriage return and
;line feed to be output.
;-

O$T.M:	POPJ	P,		; Ignore this character

	SUBTTL	DOC file -- O$T.N - Flag no CRLF

;+
;.HL1 O$T.N
;This routine will cause no carriage return to be output at the end of
;the message.  It is assumed that this is not in the error file
;processing.
;-

O$T.N:	STOPCD	(NFE,<N function encountered>)

	SUBTTL	DOC file -- O$T.Q - Output a double quote

;+
;.HL1 O$T.Q
;This routine will cause a double quote to be output to the DOC file.
;-

O$T.Q:	MOVX	CH,""""		; Get the character
	PJRST	OUTDOC		; Output the character

	SUBTTL	DOC file -- O$T.R - Output a right angle bracket

;+
;.HL1 O$T.R
;This routine will cause a right angle bracket to be output.
;-

O$T.R:	MOVEI	CH,">"		; Get the character
	PJRST	OUTDOC		; Output the character

	SUBTTL	DOC file -- O$T.X - Set the type out routine

;+
;.HL1 O$T.X
;This routine will set the type out routine.  Since this is not valid
;a STOPCD will be issued if this is encountered.
;-

O$T.X:	STOPCD	(XFE,<X function encounted in error doc file>)

	SUBTTL	DOC file -- O$T.Z - Output an error table

;+
;.HL1 O$T.Z
;This routine will cause an error table to be output.  This is for the
;switch processing error messages and the EV error processing.
;-

O$T.Z:

	SUBTTL	DOC file -- Output a byte

;+
;.HL1 OUTDOC
;This routine will output a byte to the DOC file.  It will POPJ return
;to the caller.
;.literal
;r
; Usage:
;	MOVX	CH,Character
;	PUSHJ	P,OUTDOC
;	(Return)
;
;.end literal
;-

OUTDOC:	MOVEI	T1,DOCFDB	; Get the FDB address
	PUSHJ	P,F$WRIT	; Output the byte
	  SKIPA			; Failed ?
	POPJ	P,		; Just return

	STOPCD	DOF,<DOC file output failed>

	SUBTTL	DOC file -- Text strings

;+
;.HL1 DOCTXT
;The following table is used to insert text into the DOC file that
;is written by TECONC.  The DOC file will contain all the error messages
;that are currently in TECO with the strings inserted where the
;functions would normally cause items to be typed out.
;-

DEFINE	TT(CHAR,FLAGS,STRING),<
 IFNB <STRING>,< EXP	[ASCIZ |'STRING'|]>
 IFB  <STRING>,< EXP	0>
>; End of TT macro definition

DOCTXT:	TXTTYP			; Expand the text

	SUBTTL	DOC file -- Routine dispatch table

; The following is the dispatch table for the routines that output
; various items to the DOC file.


DEFINE	TT(CHAR,FLAGS,STRING),<
 IFNB <STRING>,<EXP	0>
 IFB  <STRING>,<EXP	O$T.'CHAR>
> ; ENd of TT macro definition

DOCRTN:	TXTTYP			; Expand the text

	SUBTTL	PSECT ends

; This defines the symbols for the end of each PSECT

	DEFINE ENDSYM(XXX),<
	LSTOF.		;; Turn off listing for literals
	LIT		;; Dump the literals just in case
	LSTON.		;; Turn listing back on
XXX'END:!		;; Define the end symbol +1
	> ; End of ENDSYM definition

	$IMPURE			; First do impure data
	ENDSYM(IMP)

	$CODE			; Pure data and code
	ENDSYM(COD)

	$TEXT			; Error message text
	ENDSYM(TXT)

	$TXTPT			; Error message index
	ENDSYM(PTR)

	$ONCE			; Once only code
	ENDSYM(ONC)		; End it

	SUBTTL	End of TECONC

	END	ONCE		; End of TECONC