Google
 

Trailing-Edge - PDP-10 Archives - steco_19840320_1er_E35 - 10,5676/teco/newsrc/teccom.mac
There are 3 other files named teccom.mac in the archive. Click here to see a list.
	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	TECUNV		; TECO universal file

  ; Generate the prologue


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


	PROLOGUE(COM,<TECO Common routines>)	; Generate the TITLE and other stuff
	SUBTTL	Table of Contents

;+
;.pag.lit

;		Table of Contents for TECCOM - Common routines
;
;
;			   Section			      Page
;   1. Introduction . . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Save register routines
;        4.1.   .SAVE1, .SAVE2, .SAVE3, .SAVE4. . . . . . . .    4
;        4.2.   .SAVEA. . . . . . . . . . . . . . . . . . . .    5
;        4.3.   .SVCH . . . . . . . . . . . . . . . . . . . .    6
;        4.4.   .SAVT1. . . . . . . . . . . . . . . . . . . .    7
;        4.5.   .SAVT2. . . . . . . . . . . . . . . . . . . .    8
;        4.6.   .SAVT3. . . . . . . . . . . . . . . . . . . .    9
;        4.7.   .SAVET. . . . . . . . . . . . . . . . . . . .   10
;   5. Return routines
;        5.1.   .POPJ, .POPJ1, .T1PJ, .T1PJ1, .T2PJ, .T2PJ1 .   11
;        5.2.   .RET0, .RET1, .RET2 . . . . . . . . . . . . .   12
;   6. .INSRT - Insert text into a QRG block. . . . . . . . .   13
;   7. Miscellaneous character dispatcher
;        7.1.   DISPAT. . . . . . . . . . . . . . . . . . . .   14
;   8. Non-returning character dispatcher . . . . . . . . . .   15
;   9. CKSYM - Check if character is a symbol character . . .   16
;  10. Subroutines
;       10.1.   LOKNAM - Lookup a name in a table . . . . . .   17
;  11. FNDSTR - This routine will find a string . . . . . . .   18
;  12. Impure storage . . . . . . . . . . . . . . . . . . . .   19
;  13. End of TECCOM. . . . . . . . . . . . . . . . . . . . .   20

;.end lit.pag
;-
	SUBTTL	Revision History
COMMENT	|

1000	Start of this version

Start of Version 200A(1126)

1127	By: Nick Bush@SIT, Robert C. McQueen@SIT		On: 15-October-1981
	Add the following new features:
	- String arguments.  {...} is a string argument.
	- Make I take them, = and == return them.
	- Implement the FC command to define immediate command tables
	- Implement the E? command to return various items.
	- Start doing some work so that TECO will work on TOPS-20
	- Start doing some work so that TECO some day may run in a section
	  besides zero.
	Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI
|
	SUBTTL	Save register routines -- .SAVE1, .SAVE2, .SAVE3, .SAVE4

	$CODE			; To the code PSECT

;These routines act as co-routines with the routines which call them,
;	therefore no corresponding "RESTORE" routines are needed. when
;	the calling routine returns to its caller, it actually returns
;	via the restore routines automatically.

.SAVE1:	PUSH	P,P1		; Save P1
	PUSHJ	P,@-1(P)	; Call our caller
	 JRST	.+2		; Skip the AOS
	  AOS	-2(P)		; Pass on the skip return
	MOVE	P1,(P)		; Restore P1
	ADJSP	P,-2		; And remove the old return PC
	POPJ	P,		; And return

.SAVE2:	$ADJSP	P,2		; Make room for 2 items
	DMOVEM	P1,-1(P)	; Save P1/P2
	PUSHJ	P,@-2(P)	; Call our caller
	 JRST	.+2		; Skip the AOS
	  AOS	-3(P)		; Pass on skip return
	DMOVE	P1,-1(P)	; Restore the AC's
	ADJSP	P,-3		; Remove the items
	POPJ	P,		; And return

.SAVE3:	$ADJSP	P,3		; Make room for 3 items
	DMOVEM	P1,-2(P)	; Save P1/P2
	MOVEM	P3,(P)		; And P3
	PUSHJ	P,@-3(P)	; Call our caller
	 JRST	.+2		; Handle non-skip
	  AOS	-4(P)		; And skip returns
	DMOVE	P1,-2(P)	; Restore P1/P2
	MOVE	P3,(P)		; And P3
	ADJSP	P,-4		; Remove the space
	POPJ	P,		; And return

.SAVE4:	$ADJSP	P,4		; Make some room
	DMOVEM	P1,-3(P)	; Save P1/P2
	DMOVEM	P3,-1(P)	; And P3/P4
	PUSHJ	P,@-4(P)	; Call our caller
	 JRST	.+2		; Handle non-skip return
	  AOS	-5(P)		; And skip return
	DMOVE	P1,-3(P)	; Restore P1/P2
	DMOVE	P3,-1(P)	; And P3/P4
	ADJSP	P,-5		; Remove the junk
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SAVEA

;+
;.HL1 _.SAVEA
;This routine will save the two argument registers.
;-

.SAVEA:	$ADJSP	P,2		; Make room
	DMOVEM	A1,-1(P)	; Save A1/A2
	PUSHJ	P,@-2(P)	; Call our caller
	 JRST	.+2		; Pass on non-skip return
	  AOS	-3(P)		; and skip return
	DMOVE	A1,-1(P)	; Get the ac's back
	ADJSP	P,-3		; Remove the junk
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SVCH

;+
;.HL1 _.SVCH
; This routine will save register CH on the stack.  This routine is
;a coroutine.
;-

.SVCH:	PUSH	P,CH		; Save CH
	PUSHJ	P,@-1(P)	; Call our caller
	 JRST	.+2		; Handle non-skip return
	  AOS	-2(P)		; And skip
	MOVE	CH,(P)		; Restore CH
	ADJSP	P,-2		; Remove the junk
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SAVT1

;+
;.HL1 _.SAVT1
; This routine will save the T1 register on the stack.  It is normmally
;called by a $SAVE macro expansion.
;-

.SAVT1:	PUSH	P,T1		; Save T1
	PUSHJ	P,@-1(P)	; Call our caller
	 JRST	.+2		; Skip the AOS
	  AOS	-2(P)		; Pass on the skip return
	MOVE	T1,(P)		; Restore T1
	ADJSP	P,-2		; And remove the old return PC
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SAVT2

;+
;.HL1 _.SAVT2
; This routine will save the T1 and T2 registers on the stack.  It is normmally
;called by a $SAVE macro expansion.
;-

.SAVT2:	$ADJSP	P,2		; Make room for 2 items
	DMOVEM	T1,-1(P)	; Save T1/T2
	PUSHJ	P,@-2(P)	; Call our caller
	 JRST	.+2		; Skip the AOS
	  AOS	-3(P)		; Pass on skip return
	DMOVE	T1,-1(P)	; Restore the AC's
	ADJSP	P,-3		; Remove the items
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SAVT3

;+
;.HL1 _.SAVT3
; This routine will save the T1 to T3 registers on the stack.  It is normally
;called by a $SAVE macro expansion.
;-

.SAVT3:	$ADJSP	P,3		; Make room for 3 items
	DMOVEM	T1,-2(P)	; Save T1/T2
	MOVEM	T3,(P)		; And T3
	PUSHJ	P,@-3(P)	; Call our caller
	 JRST	.+2		; Handle non-skip
	  AOS	-4(P)		; And skip returns
	DMOVE	T1,-2(P)	; Restore T1/T2
	MOVE	T3,(P)		; And T3
	ADJSP	P,-4		; Remove the space
	POPJ	P,		; And return
	SUBTTL	Save register routines -- .SAVET

;+
;.Hl1 _.SAVET
; This routine will save all the Tx registers.  It is normally called by the
;$SAVE macro expansion.
;-


.SAVET:	$ADJSP	P,4		; Make some room
	DMOVEM	T1,-3(P)	; Save T1/T2
	DMOVEM	T3,-1(P)	; And T3/T4
	PUSHJ	P,@-4(P)	; Call our caller
	 JRST	.+2		; Handle non-skip return
	  AOS	-5(P)		; And skip return
	DMOVE	T1,-3(P)	; Restore T1/T2
	DMOVE	T3,-1(P)	; And T3/T4
	ADJSP	P,-5		; Remove the junk
	POPJ	P,		; And return
SUBTTL	Return routines -- .POPJ, .POPJ1, .T1PJ, .T1PJ1, .T2PJ, .T2PJ1

;+
;.HL1 .POPJ, .POPJ1, .T1PJ, .T1PJ1, .T2PJ, .T2PJ1
;These routines are used to restore registers on the stack and to be used
;as a place to jump to to return from a routine.
;-


.POPJ1:	AOS	(P)		; Give a skip return
.POPJ:	POPJ	P,		; Return to the caller

.T1PJ1:	AOS	-1(P)		; Increment the return address
.T1PJ:	POP	P,T1		; Restore T1
	POPJ	P,		; And return

.T2PJ1:	AOS	-1(P)		; Increment the return address
.T2PJ:	POP	P,T2		; Restore T2
	POPJ	P,		; Return
SUBTTL	Return routines -- .RET0, .RET1, .RET2

;+
;.HL1 .RET0, .RET1, .RET2
;These routines will return a value in T1.
;-

.RET0:	TDZA	T1,T1		; Zero T1
.RET1:	MOVEI	T1,1		; Return a one
	POPJ	P,		; Return to the calling routine

.RET2:	MOVEI	T1,2		; Return a two
	POPJ	P,		; . . .
	SUBTTL	Stack variable allocation - .SKTPT

;+
;.hl1 _.SKTPT
; This routine will allocate a TPT on the XS stack that will be returned
;when the caller returns.  This is used by the STKTPT macro.
;.lit
;
; Usage:
;	MOVE	T1,BLK address
;	PUSHJ	P,.SKTPT
;	 (return, top XS stack item pointing to BLK)
;
;.end lit
;-

.SKTPT:	$ADJSP	XS,$XSCLN	; Allocate the space
	PUSH	P,T2		; And T2
	STORI.	$XEMEM,T2,XSBTYP,(XS) ; Save the block type
	SETZM	$XSBUF(XS)	; Clear the pointer
	XMOVEI	T2,$XSBUF(XS)	; Get the address of the TPT
	SKIPE	T1		; Have something to point this at?
	 PUSHJ	P,M$USEB	; Set up the pointer
	POP	P,T2		; Restore T2
	POP	P,(P)		; Remove the return address
	PUSHJ	P,@1(P)		; Call our caller back
	 JRST	.+2		; Handle non-skip return
	  AOS	(P)		; And skip return
	PUSH	P,T1		; Save T1
	PUSH	P,T2		; And T2
	XMOVEI	T1,$XSBUF(XS)	; Get the address of the pointer
	SKIPE	(T1)		; Really have something to return?
	 PUSHJ	P,M$RELB	; Release it
	POP	P,T2		; Restore T2
	POP	P,T1		; And T1
	ADJSP	XS,-$XSCLN	; Remove the items
	POPJ	P,		; And return
	SUBTTL	Block clearing -- .ZCHNK - Clear a chunk of memory

;+
;.hl1 _.ZCHNK
;This routine will clear a chunck of memory.  This routine is called
;with the length and the address.  (Possibly extended address).
;.literal
;
; Usage:
;	T1/ Length to clear
;	T2/ Address
;	PUSHJ	P,.ZCHNK
;	(return)
;
; On return:
;	- Memory block cleared.
;
;.end literal
;-

.ZCHNK:
IFE FTXADR,<
	$SAVE	<T1,T2>			; Save two registers
>; End of IFE FTXADR
IFN FTXADR,<
	$SAVE	<T1,T2,T3>		; Save a few registers
	TXNN	T2,LH.ALF		; Extended address?
	  JRST	ZCHN.0			; No, skip this
	SETZM	(T2)			; Clear the first word
	AOS	T3,T2			; Get the address of the next word
	EXTEND	T1,[XBLT]		; Clear the block
	POPJ	P,			; Return to the caller

ZCHN.0:	TXO	T2,IFIW			; Make this a local address
>; End of IFN FTXADR
	SETZM	(T2)			; Clear the first word
	CAIG	T1,1			; More than one word?
	 POPJ	P,			; No, all done already
	HRL	T2,T2			; Build the BLT pointer
	AOJ	T2,			; Point to the next word
	ADDI	T1,-1(T2)		; Build the ending address
	BLT	T2,-1(T1)		; Clear the block
	POPJ	P,			; Return to the caller
	SUBTTL	.INSRT - Insert text into a QRG block

;+
;.HL1 _.INSRT
;This routine will cause text to be inserted into the specified QRG
;block at the current pointer
;.b.literal
; Usage:
;	MOVEI	T1,QRG.block.address
;	MOVEI	T2,[$STRING(to be typed)]
;	PUSHJ	P,.INSRT
;	(Return)
;
;.end literal
;-

.INSRT:	MOVEM	T1,INSQRG	; Store the QRG block address
	MOVEI	T1,[$STRING (<^X/INSCHR/^S/(T2)/>)] ; Get the string to type
	PJRST	T$TYPE		; Output the string

; Here to do the real work of inserting the character into the QRG block

INSCHR:	$SAVE	<T1,T2,T3,T4>	; Save T1 to T4
	MOVEM	CH,INSCH	; Store the character
	MOVE	T1,[POINTR(INSCH,^O<177_7>)] ; Get the byte pointer
	MOVEI	T2,1		; Only one character at a time
	MOVE	T3,INSQRG	; Get the current editing buffer QRG
	LOAD.	T3,TPTADR,+$QRTPT(T3) ; Get the address
	SETZ	T4,		; Flag that the byte pointer is not in a BLK
	PUSHJ	P,M$INSS	; Insert the string
	MOVE	T2,INSQRG	; Get the current editing buffer again
	LOAD.	T2,TPTADR,+$QRTPT(T2) ; Get the BLK address again
	STOR.	T1,BLKPT,(T2)	; Update the value of PT (point)
	POPJ	P,		; Return to the caller
	SUBTTL	Dispatchers -- DISPAT

;+
;.hl1 DISPAT
; This routine will dispatch on the given character.
;There is an alternate entry point at DISP1 to avoid conversion
;of lower case to upper case.
;.b
;.literal
; Usage:
;	MOVEI	CH,character
;	XMOVEI	T1,Table.address
;	PUSHJ	P,DISPAT
;	 (Not found return)
;	(Return from routine in table)
;
;.end literal
;-

DISPAT:	CAIG	CH,"z"		; Is this a lower case letter?
	 CAIGE	CH,"a"		;  .  .  .
	  JRST	DISP1		; No, don't convert it
	SUBX	CH,"a"-"A"	; Convert to upper case
DISP1:	MOVE	T2,(T1)		; Get the table entry
	JUMPE	T2,.POPJ	; If zero it is the end of the table
	CAIE	CH,(T2)		; Is it the correct character?
	 AOJA	T1,DISP1	; Not a match, try the next
	AOS	(P)		; Give a skip return when done
	HLRZ	T1,T2		; Get the routine address
	TXO	T1,IFIW		; Make it an instruction format word
	PJRST	(T1)		; And go do it
	SUBTTL	Dispatchers -- NDISPT

;+
;.HL1 NDISPT
; This routine will dispatch on the given character.  It will not return
;to the calling routine.  This routine does not convert lower case to upper
;case if called at NDISP1.
;.b
;.literal
; Usage:
;	MOVEI	T1,Dispatch table
;	MOVEI	CH,Character
;	PUSHJ	P,NDISPT
;	(Failed return)
;.end literal
;-

NDISPT:	CAIG	CH,"z"		; Is this a lower case letter?
	 CAIGE	CH,"a"		;  .  .  .
	  JRST	NDISP1		; No, don't convert it
	SUBX	CH,"a"-"A"	; Convert to upper case
NDISP1:	PUSH	P,T2		; Save T2
NDIS.0:	MOVE	T2,(T1)		; Get the table entry
	JUMPE	T2,.T2PJ	; Restore T2 and return
	CAIE	CH,(T2)		; Is this the character ?
	 AOJA	T1,NDIS.0	; No - Loop
	HLRZ	T2,T2		; Get the address
	XHLLI	T2,.		; And determine the section number
	MOVEM	T2,-1(P)	; Store the new return address
	JRST	.T2PJ		; Restore T2 and go to the routine
	SUBTTL	CKSYM - Check if character is a symbol character

;+
;.hl1 CKSYM
; This routine will check if a character is allowable in a symbol.
;It gives a skip return if it is not allowed.
;It will also upcase the character if lower case.
;.literal
; Usage:
;	MOVEI	CH,Character
;	PUSHJ	P,CKSYM
;	 (good symbol character)
;	(Not a symbol character)
;
;.end literal
;-

CKSYM:	$SAVE	<P1>		; Save P1
	MOVE	P1,CHRFLG(CH)	; Get the flags
	TXNN	P1,CF.SYM	; Is this a symbol ?
	 AOS	(P)		; No - Give a skip return
	TXNE	P1,CF.LC	; Lower case??
	 TRZ	CH,40		; Yes, make it upper
	POPJ	P,		; Return
	SUBTTL	Subroutines -- LOKNAM - Lookup a name in a table

;+
;.HL1 LOKNAM
; This routine will do a table lookup for a sixbit entry.  This routine
;expects that a mask is given to find the entry.
;.literal
;
; Usage:
;	MOVE	T1,Sixbit name
;	MOVE	T2,[AOBJN.pointer.for.table]
;	PUSHJ	P,LOKNAM
;	(Failed - Ambigious C(T2)=0, Unknown C(T2) =-1)
;	(Found T2 points to the entry)
;.end literal
;-


LOKNAM:	$SAVE	<P1,P2,P3>	; Save two registers
	DMOVEM	T1,LASNAM	; Save the arguments in case of error
	DMOVE	P1,T1		; Copy the arguments
	MOVEI	T1,77		; Start to build the mask
	SETZ	T2,		; Clear for the mask
LOKN.0:	TDNE	P1,T1		; Is this byte on ?
	 TDO	T2,T1		; Yes - Turn it on in the mask
	LSH	T1,6		; Move the mask over
	JUMPN	T1,LOKN.0	; Loop until the mask is finished
	MOVE	P3,T2		; Save in a safer place

; Now loop to see if there is an entry in the table for this name

	SETZ	T2,		; Clear the saved index
LOKN.1:	MOVE	T1,(P2)		; Get an entry
	CAMN	T1,P1		; Is this the same ?
	  JRST	[MOVE	T2,P2		; Copy the offset
		JRST	.POPJ1]		; Give a good return

	AND	T1,P3		; And in the mask
	CAME	T1,P1		; Is this the same ?
	  JRST	LOKN.2		; No - Keep on looking
	JUMPN	T2,[SETO T2,		; Return minus one
		POPJ	P,]		; . . .
	MOVE	T2,P2		; Copy the offset
LOKN.2:	AOBJN	P2,LOKN.1	; Loop looking for the entry
	MOVE	T1,P1		; Get the name back
	JUMPE	T2,.POPJ	; Return if nothing found
	JRST	.POPJ1		; Give a good return
	SUBTTL	SCNKWD - Scan a keyword given delimter
	SUBTTL	SCNKEY - Scan a keyword

;+
;.hl2 SCNKEY
;This routine will scan a keyword from the specified buffer.  It will return
;the length and byte pointer set up for a call to FNDSTR.
;.literal
;
; Usage:
;	XMOVEI	T1,xxxBUF		; Get the buffer address
;	XMOVEI	T2,Input routine address
;	PUSHJ	P,SCNKEY		; Scan the keyword
;	(Failure return)
;	(Good return)
;
; On a good return:
;	T2/ Byte pointer to the information
;	T3/ Length of the information
;
; On a failure return:
;	- Character input failed.
;.end literal
;.hl2 SCNKWD
;This routine is the same as SCNKEY except that it will accept the delimiter to
;search for.
;.literal
;
; Usage:
;	XMOVEI	T1,TPT address
;	XMOVEI	T2,Input routine address
;	MOVEI	T3,Delimter
;	PUSHJ	P,SCNKWD
;	(Failure return)
;	(Good return)
;
;.end literal
;-

SCNKWD:	$SAVE	<P1,P2>			; Save two registers
	DMOVE	P2,T2			; Get the data
	JRST	SCNK.1			; Jump into the routine

SCNKEY:	$SAVE	<P1,P2>			; Save a register
	MOVE	P2,T2			; Copy the input routine addrss
	MOVX	P3,.CHESC		; Get the delimiter

SCNK.1:	PUSHJ	P,(P2)			; Get the first character
	 POPJ	P,			; Return
	LOAD.	T4,TPTADR,(T1)		; Get the text buffer address
	LOAD.	T2,BLKPT,(T4)		; Get the byte pointer
	SOJ	T2,			; Minus one
	BLDBPT	(T2,(T4))		; Build the byte pinter to the position
	LOAD.	T3,BLKPT,(T4)		; Get the current position
	SOJA	T3,SCNK.3		; Minus one for the character we just got

; Here to read the characters until we find the escape character that will
; terminate the keyword.  After that we will calculate the length to call
; FNDSTR

SCNK.0:	PUSHJ	P,(P2)			; Read a character
	  POPJ	P,			; Scan failed, just give a fail return
SCNK.3:	CAMN	CH,P3			; Is this the ending character?
	 JRST	SCNK.2			; Yes, all done
	MOVE	T1,CHRFLG(CH)		; Get the flags
	TXNN	T1,CF.SYM		; Is this a symbol character?
	 CAXN	CH,"-"			; Or a minus?
	  JRST	SCNK.0			; Get the next character
	JUMPL	P3,SCNK.2		; If we want to break on a non-symbol, all is ok
	POPJ	P,			; No, just return

SCNK.2:	LOAD.	T1,BLKPT,(T4)		; Get the current position
	SUBM	T1,T3			; Calculate the length
	SOJA	T3,.POPJ1		; Return good
	SUBTTL	FNDSTR - This routine will find a string

;+
;.hl1 FNDSTR
;This routine will find a string in a string table.  It will return
;the pointer to the dependent information in T1.
;.literal
;
; Usage:
;	DEFINE	STRTBL,<
;	STR	Any.string,arg
;	>
;	DOSTR	(XXX)
;
;
;	MOVE	T1,[XWD -XXXLEN,XXXTBL]
;	MOVE	T2,Byte pointer to string
;	MOVE	T3,Byte count of string
;	PUSHJ	P,FNDSTR
;	(Not found)
;	(Found)
;
;.end literal
;-

FNDKWD:	TDZA	T4,T4		; Flag we will take abbreviations
FNDSTR:	 SETO	T4,		; Flag only exact matches
	$SAVE	<P1,P2,P3,P4>	; Save a few registers
	$SAVE	<CH,A1>		; Save this too
	DMOVE	P1,T1		; Copy the items
	DMOVE	P3,T3		; . . .
	MOVEM	T1,LASSPT	; Save the pointer in case of error
	MOVX	A1,CF.LC	; Load the lower case bit

FNDS.2:	MOVE	T1,(P1)		; Get the address of the item
	LOAD.	T2,STRCNT,(T1)	; Get the count of characters
	CAMN	T2,P3		; Same length ?
	 JRST	FNDS.3		; Yes, just check for a match
	JUMPL	P4,FNDS.1	; If no abbreviations allowed, try the next
	CAMG	T2,P3		; Can only be an abbreviation if string given is shorted
	  JRST	FNDS.1		; No - Point to the next item
	MOVE	T2,P3		; Get the length to check
FNDS.3:	MOVE	T3,P2		; Copy the byte pointer
	LOAD.	T1,STRBPT,(T1)	; Get the byte pointer to the string

FNDS.0:	ILDB	T4,T3		; Get the first character
	TDNE	A1,CHRFLG(T4)	; Is this lower case ?
	 SUBI	T4,"a"-"A"	; Convert to upper case
	ILDB	CH,T1		; Get the other character
	CAIE	CH,(T4)		; Are these the same ?
	  JRST	FNDS.1		; Failed
	SOJG	T2,FNDS.0	; Loop for all characters
	MOVE	T1,(P1)		; Get the address again
	CAMN	P3,1(T1)	; Exact match?
	 JRST	.POPJ1		; Yes, give a good return

; Here on an abbreviation match.  Check if this is the first one, or
;if we should give an error.

	JUMPN	P4,.POPJ	; If non-zero, we already had a match
	MOVEI	P4,(P1)		; Otherwise, remember where it was

FNDS.1:	AOBJN	P1,FNDS.2	; Loop for all the items
	JUMPLE	P4,.POPJ	; Give error return if nothing found
	MOVE	T1,(P4)		; Get the address of the data
	PJRST	.POPJ1		; And give the good return
	SUBTTL	Switch processing -- .IOCTW
	SUBTTL	Switch processing -- .IDECW

;+
;.HL2 .IOCTW
;This routine will input an octal number for a switch or path specification.
;-

.IOCTW:	SKIPA	T1,[EXP ^D8]	; Get the radix
.IDECW:	 MOVEI	T1,^D10		; Get the decimal radix
	$SAVE	<P1>		; Save P1
	MOVE	P1,T1		; And get the radix to use
	SETZ	T1,		; Clear the number
	PUSHJ	P,GNBCHR	; Get the first non-blank character
	SKIPA			; Enter the routine
IDEC.0:	PUSHJ	P,@RTN		; Input a character
	CAIL	CH,"0"		; Check for an octal number
	 CAILE	CH,"0"(P1)	; . . .
	  JRST	IDEC.1		; Not - Clean up and return

	IMULI	T1,(P1)		; Move the accumulated number over
	ADDI	T1,-"0"(CH)	; Add in the new digit
	JRST	IDEC.0		; Loop for all digits

; Here to store the octal number and return to the calling routine

IDEC.1:	MOVEM	T1,LASOCT	; Store the last number input
	POPJ	P,		; And return to the caller
	SUBTTL	Impure storage

	LOWVER	(COM,2)		; Low segment version number
	$IMPURE			; Put in correct PSECT

LASNAM:	BLOCK	2		; Last args to LOKNAM
LASSPT:	BLOCK	1		; Last string pointer

INSCH:	BLOCK	1		; Character being inserted into the buffer
INSQRG:	BLOCK	1		; QRG having text inserted into
	SUBTTL	End of TECCOM

	END			; End of TECCOM