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