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

;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
;	       1983,1984,1985,1986    Maynard, Massachusetts, USA


	TITLE MSUTL - Utility routines for MS and related programs

	SEARCH GLXMAC,MSUNV
	PROLOG (MSUTL)

	CPYRYT
	MSINIT

;Declare globals

;	GLOBS
;	GLOBRS

;Routines defined in this module

	INTERNAL BSERC0, BINOUT, SBTMV1
	INTERNAL ALCFOB, ALCSB, CFIELD, CLRCTO, CLRFIB, CMDER1, CMDERR
	INTERNAL CMDINI, COMPAC, COUNTS, CPYATM, CRIF, CRLF, DPROMP
TOPS10<	INTERNAL ECHOON >
;**;[3096] Change 1 line at INTERNAL EXPAND,....	Ned	12-Aug-87
	INTERNAL EXPAND, FSCOPY, FSPEC, FSPEC0, KBFTOR, FENTRM
	INTERNAL MOVST0, MOVST1, MOVST2, MOVSTR
	INTERNAL R, RSKP
	INTERNAL RELFOB, RELSB, REPARS
	INTERNAL RFIELD, RFLDE, RSTPSZ
TOPS20<	INTERNAL RUNFIL, RUNFL0, RUNFL2 >
	INTERNAL SETIOJ, SETPSZ, SSEARC, TBADDS, TBOUT, TNOUT, TSOUT
	INTERNAL UPDTOR,RDELAY,SREGV1,SRGRV1
TOPS10<	INTERNAL XDATI >
TOPS20<	INTERNAL GETTYM,SETTYM >

;Global data items defined herein

	INTERNAL ATMBUF, CJFNBK, CMDBUF, CMDACS
	INTERNAL LSCERR, REPAR0, REPARA, SBK

;Global routines defined elsewhere

;**;[3096] Insert 2 lines at INTERNAL LSCERR,... + 3	Ned	12-Aug-87
;MS.MAC
	EXTERNAL FSCPKL

;Global data items defined elsewhere

;MS.MAC
	EXTERNAL CRFDEV, CRFDIR, INIP, INIRET, LFCNT, FSJFN
TOPS20<	EXTERNAL SAVMOD >
TOPS10<	EXTERNAL MYPPN, TTYUDX, SAVPSZ >
	EXTERNAL TAKPTR, TTXTIB, UPDPTR,MINWSZ,SCRLFL,BLKTIM

;Local storage

	IMPUR0

;**;[3096] Delete (move to MS) 8 lines at FSCPKL:	Ned	12-Aug-87
   TOPS20<
FRKACS:	BLOCK 20		; Setup for editor fork's ac's
   >;End TOPS20

FSCACS:	BLOCK 20		; AC's during FSCOPY
SRCBUF:	BLOCK 40		; Search pattern buffer
CMDBLN==:10000			; Ten page command buffer (for big adr lists)
CMDBUF::BLOCK CMDBLN
CMDACS::BLOCK 20		; saved ac's from beginning of command line
ATMBLN==:CMDBLN
ATMBUF::BLOCK ATMBLN		; holds last parsed field
SBK::	BLOCK 20		; COMND JSYS state block
CJFNBK::BLOCK CJFNLN		; GTJFN block for COMND JSYS
REPARA::BLOCK 1			; reparse address for COMND
REPAR0:	BLOCK 1			; saved reparse address when inside GETUSR
CMDFRM:	BLOCK 1			; marks bottom of stack
CMDPLN==:NPDL			; amount of stack we can save
CMDPDL:	BLOCK CMDPLN		; room to save PDL
LSCERR:	BLOCK 2			; Last S%CMND error code and addr of CR block

	PURE

;Move a string
;Call:	A/ byte pointer
;	B/ address of string (MOVSTR)
;	or byte pointer	     (MOVST1)

MOVSTR:	HRLI B,(<POINT 7,0>)
MOVST1:	ILDB C,B
	JUMPE C,MOVST3
	IDPB C,A
	JRST MOVST1


; Move string and terminating null

MOVST0:	HRLI B,(<POINT 7,0>)
MOVST2:	ILDB C,B
	IDPB C,A
	JUMPN C,MOVST2
MOVST3:	RET

 SUBTTL SSEARCH - Fast string search routine

;Call:	V/ character pointer to string to search through (subject)
;	W/ length of subject string
;	T/ address of string to search for
;Return	+1: not found
;	+2: found, A/ byte pointer to start of string

SSEARCH:CHR2BP			; Form byte pointer to context string
SSERC0:	HRLI T,(<POINT 7,0>)	; Form byte pointer to pattern string
	SETZB C,U
SEARC1:	ILDB B,T		; Get a character
	MOVEM B,SRCBUF(C)	; Compile search table
	JUMPE B,SEARC2
	AOJA C,SEARC1

SEARC2:	CAMGE W,C		; Pattern larger than subject string?
	 RET			; Yes - return failure now
	TLNE A,(1B0)		; Word boundary?
	JRST SEARC4		; Yes - start fast match now
SEARC3:	TLNN A,(76B5)		; At end of word?
	AOJA A,SEARC4		; Yes - do fast match for rest
	CALL EQSTR		; See if the strings match
	 AOJA U,SEARC3		; No - try next character
	RETSKP			; Yes, skip return

;Entry points callable from BLISS code

BSEARC::CALL SSEARC		; Call work routine
	 TDZA B,B		; Failure, return zero
	MOVEI B,1		; Success, return one
	RET

BSERC0::CALL SSERC0		; Call work routine
	 TDZA B,B		; Failure, return zero
	MOVEI B,1		; Success, return one
	RET

SEARC4:	SUBI W,(U)		; Correct count for chars done
	JUMPLE W,R		; Return if no more string
	MOVEI B,(W)		; Number of bytes to do
	IDIVI B,5		; Get number of words
	JUMPE C,.+2
	 AOJ B,
	MOVEI T,(B)		; That is number of words to try to do
	PUSH P,L		; Get a reg
	MOVE L,SRCBUF		; First character
	IMUL L,[<BYTE (7) 1, 1, 1, 1, 1>_-1]
	LSH L,1
	MOVE O,L
	XOR O,[BYTE (7) 40, 40, 40, 40, 40]
	MOVE X,[BYTE (7) 1, 1, 1, 1, 1]

SEARC5:	MOVE B,L		; Pattern to match
	MOVE C,O		; Case indept one
	MOVE D,(A)		; Word to try
	MOVE E,(A)
	JCRY0 .+1		; Clear carry flags
	EQVB D,B
	EQVB E,C
	ADD D,X
	ADD E,X
	EQV D,B
	EQV E,C
	JCRY0 SEARC6		; Found a match
	TDNN D,X
	 TDNE E,X
	 JRST SEARC6
SEAR5B:	SOJLE T,[POP P,L		; Not found, restore L
		RET]			; and give failure return
	SUBI W,5		; Account for word we've scanned
	AOJA A,SEARC5		; Try some more

SEARC6:	MOVSI U,-5		; Try matching withing this word
	HRLI A,(<POINT 7,,>)	; Start on word boundary
SEARC7:	CALL EQSTR		; Try to match string
	 AOBJN U,SEARC7		; No match, keep trying
	JUMPGE U,SEAR5B		; Not found this word, try some more
	POP P,L			; Restore L
	RETSKP			; Found it, skip return

; Try to match pattern against one in srcbuf
; W has length of subject string, A points to it

EQSTR:	PUSH P,A		; Save pointer
	MOVE E,W		; Make trashable copy of length
	SETZ B,			; Init index to search table
EQSTR1:	JUMPL E,EQSTR2		; If subject text gone, quit
	SKIPN C,SRCBUF(B)	; Get next char
	 JRST [	POP P,(P)		; Toss A, caller wants the update
		RETSKP]			; Null, we found a match
	ILDB D,A		; Get next char
	JUMPE D,[SOJG E,.-1		; Ignore nulls which MAILER inserts
		JRST EQSTR2]		; Subject exhausted, quit
	CAIN D,(C)		; Matches?
	 AOJA B,[SOJA E,EQSTR1]	; Yes, keep trying
	TRC D,(C)		; Try case indept
	CAIN D,40
	 AOJA B,[SOJA E,EQSTR1]	; Yes, keep trying
EQSTR2:	POP P,A			; No match - restore pointer
	IBP A			;  and advance one character
	RET

;Universal Text Output Routine which uses UPDPTR
; Called from $TEXT macros all over the place

UPDTOR:	IDPB A,UPDPTR
	$RET


;Handy routine necessary 'ciz GLXTXT doesn't necessarily zero
; B (S2) before calling TOR

KBFTOR:	JUMPE A,[$RET]		; This is dumb until definition of $RET changes
	PUSH P,B
	SETZ B,
	$CALL K%BUFF
	POP P,B
	$RET

;Allocate heap space for a string
;Call:	A/ number of bytes in the string
;Return	+1: failure
;	+2: success
;	A/ unchanged
;	B/ address of first available word.  The word before this
;	   word contains a count of the number of words in the block.

ALCSB:	$SAVE <A>
	ADDI A,^D10		; Round up, account for hdr word and null
	IDIVI A,5		; Compute words required
	$CALL M%GMEM		; Allocate a chunk
	JUMPF R			; Propagate failure
	MOVEM A,(B)		; Save size of this block
	ADDI B,1		; Skip header word
	RETSKP

;Release a string block.
;Call:	A/ address of string block (1st wd of string, NOT header wd)
;Return	+1: always

RELSB:	MOVEI B,-1(A)		; Point at real start of chunk
	MOVE A,(B)		; Get size of the chunk
	$CALL M%RMEM		; Release
	RET


;CPYATM - Count the bytes in the string in the atom buffer, allocate
;	  a chunk for it, and copy the string into the chunk.
;Call:	no arguments
;Return	+1: failure, no room
;	+2: OK, A has address of first word of string in chunk

CPYATM:	STKVAR <STRAD>
	MOVE A,[POINT 7,ATMBUF]	; Count the bytes
	CALL COUNTS		;  ..
	CALL ALCSB		; Get a chunk
	 RET			; Propagate failure
	MOVEM B,STRAD		; Save string address
	MOVE A,B		; Copy address of string space
	HRLI A,(POINT 7,)	; Form byte pointer
	MOVEI B,ATMBUF		; Copy from atom buffer to chunk
	CALL MOVST0		; With the null
	MOVE A,STRAD		; Return string address to caller
	RETSKP			; Success!

;Count the bytes in an ASCIZ string
;Call:	A/ Byte pointer to string
;	CALL COUNTS
;Return	+1: always
;	A/ count

COUNTS:	MOVE B,A
	SETZ A,
COUNT0:	ILDB C,B
	JUMPE C,R
	AOJA A,COUNT0

;Compact a dynamically allocated keyword table.  This is done after building
; the table, when you're sure it won't ever grow, and returns the remainder
; of the table storage to the heap.
;Call:	A/ address of table
;Return	+1: always

COMPAC:	STKVAR <TBL>
	MOVEM A,TBL		; Save table address
	HRRZ A,@TBL		; Get words allocated for table
	HLRZ B,@TBL		; Get actual words used
	HRRM B,@TBL		; Shrink the table
	SUBI A,(B)		; Compute no. of unused words
	JUMPE A,R		; If exactly full, just return
	ADD B,TBL		; Compute addr of 1st unused word
	ADDI B,1		; Account for header word
	$CALL M%RMEM		; Return unused space to free pool
	RET

;Expand a TBLUK-style table.  This routine allocates a new chunk twice
; as big as the current table size, BLTs the table to the new chunk, and
; releases the space occupied by the old copy of the table.
;Call:	A/ address of header word of table
;Return	+1: failure, no room, table left intact
;	+2: success, A contains address of new copy of table

EXPAND:	STKVAR <OTBL,NTBL>	; Old table addr, new table addr
	MOVEM A,OTBL		; Save for later
	HRRZ A,@OTBL		; Get current size of table
	LSH A,1			; Times two
	$CALL M%GMEM		; Allocate bigger chunk
	JUMPF R			; Failure, give nonskip return
	MOVEM B,NTBL		; Save new table address
	SUBI A,1		; Account for header word
	HRRZM A,(B)		; OK, set maximum size of new table
	HRL A,OTBL		; Get address of old table
	ADD A,[1,,0]		; Skip header word
	HRRI A,1(B)		; Address of 1st data word of new table
	HLRZ B,@OTBL		; Get count of entries actually present in old
	ADD B,NTBL		; Compute last address to BLT into
	BLT A,(B)		; Copy the table
	MOVE B,OTBL		; Get address of old table
	HRRZ A,(B)		; Get max word count
	ADDI A,1		; Account for header word
	$CALL M%RMEM		; Release storage for old table
	MOVE A,NTBL		; Return new table address to caller
	RETSKP			; Success return

;TBADDS - Do a TBADD (S%TBAD), and if table gets full, allocate a bigger
;	  one, copy the old one to it, and do the add.
;Call:	A/ address of pointer to table (updated if table grows)
;	B/ entry to add
;Return	+1: failure, no memory or TBADD failure other than full table
;	+2: success

TBADDS:	$SAVE <C,D>		; We'll use these
	STKVAR <ENTRY0>		; Entry to add
	MOVEM B,ENTRY0
	MOVE D,A		; Save address of table pointer
	SKIPE (D)		; Table exist yet?
	JRST TBADD0		; Yes, go add to it
	MOVEI A,^D32		; No, start off with 32 words
	$CALL M%GMEM		;  ..
	JUMPF R			; Failure
	SUBI A,1		; Account for header word
	HRRZM A,(B)		; Init table header
	MOVEM B,(D)		; Report address of new table to caller
	MOVE B,ENTRY0		; Get table entry to add back
TBADD0:	MOVE A,(D)		; Get table address
	$CALL S%TBAD		; Try adding
	JUMPT RSKP		; If win, return now
	CAIE A,ERTBF$		; Table full error?
	RET			; No, pass failure on to user
	HRRZ A,@(D)		; Get current size of table
	LSH A,1			; Double it
	$CALL M%GMEM		; Get some space
	JUMPF R			; Failure, give up
	SUBI A,1		; Account for header word
	HRRZM A,(B)		; Init new table header
	HRRZ C,(D)		; Get old table address
	ADDI C,1		; Skip header word
	HRL C,C			; This is origin of BLT
	HRRI C,1(B)		; Destination is new chunk address plus one
	HLRZ A,@(D)		; Get count of entries in old table
	HRLM A,(B)		; Init count of entries occupied in new table
	ADD A,B			; Form end of BLT destination
	BLT C,(A)		; Copy the table
	HRRZ A,@(D)		; Get size of old table
	ADDI A,1		; Account for header word
	MOVE C,B		; Save address of new table
	MOVE B,(D)		; Get address of old table
	$CALL M%RMEM		; Release it
	MOVEM C,(D)		; Update caller's pointer to table
	MOVE B,ENTRY0		; Get entry back
	JRST TBADD0		; Go try again

;Allocate FOB, link to FD, and set up for ASCII file open
;Call:	 A/ addr of FD
;Returns +1: can't allocate space for FOB
;	 +2: success, FOB size in A and address in B (setup for call to F%xOPN)

ALCFOB:	STKVAR <FD>
	MOVEM A,FD		; Save FD addr
	MOVEI A,FOB.SZ		; Allocate FOB
	$CALL M%GMEM		; Get a chunk
	JUMPF R
	MOVE A,FD		; Get FD address back
	MOVEM A,FOB.FD(B)	; Stuff into FOB
	MOVEI A,7		; 7-bit bytes
	TXO A,FB.LSN		; Ignore line sequence numbers
	MOVEM A,FOB.CW(B)	;  ..
   TOPS10<
	MOVE A,MYPPN		; My PPN for access checking
	MOVEM A,FOB.US(B)	;  ..
	SETZM FOB.CD(B)		; Zero connected directory word
   >;End TOPS10
   TOPS20<
	SETZM FOB.US(B)		; This doesn't apply for TOPS20
	SETZM FOB.CD(B)		; No funny connected directory stuff please
	MOVX C,FB.PHY		; Set up physical bit in case of SYSTEM:MS.INIT
	TXNN F,F%F1		; Are we trying to take SYSTEM:MS.INIT?
	 IORM C,FOB.CW(B)	; Yes, light the physical bit
   >;End TOPS20
	MOVEI A,FOB.SZ		; Return size in A, addr in B
	RETSKP


;Clean up after ALCFOB -- deallocates FOB and FD
;Call:	 A/ FOB size
;	 B/ FOB address
;Returns +1: always

RELFOB:	STKVAR <<FOB,2>>
	DMOVEM A,FOB		; Save for a moment
	MOVE B,FOB.FD(B)	; Address of FD
	HLRZ A,.FDLEN(B)	; Size of FD
	$CALL M%RMEM		; Release it
	DMOVE A,FOB		; Release FOB
	$CALL M%RMEM
	RET
CRIF:	$SAVE <A,B>
	$CALL K%FLSH		; Flush terminal output buffers first
	$CALL K%TPOS		; Get terminal cursor position
	SKIPF			; If K%TPOS fails, assume need CRLF
	SKIPE A			; Cursor at left margin (position zero)?
	CALL CRLF		; No, need CRLF then
	RET

CRLF:	PUSH P,A		; Save possibly clobbered regs
	PUSH P,O
	MOVE A,[POINT 7,CRLF0]
	CALL KBFTOR		; Type it
	AOS LFCNT		; Count lines for those interested
	POP P,O
	POP P,A
	RET

CRLF0:	BYTE (7) 15,12,0

SUBTTL TSOUT - simulate a SOUT

TSOUT:	STKVAR <SIFN,PTR>	; IFN, source ptr
	TLC B,-1		; Check for TOPS20-style string ptr
	TLCN B,-1		;  ..
	HRLI B,(POINT 7,)
	TLC A,-1
	TLCN A,-1
	HRLI A,(POINT 7,)
	MOVEM A,SIFN
	MOVEM B,PTR		; Save source ptr
	TXZ F,F%F1		; Assume zero byte count
	SKIPE C			; Is it?
	TXO F,F%F1		; No, remember significance of C

TSOUT0:	MOVE A,SIFN		; IFN
	ILDB B,PTR		; Next byte
	TXNN F,F%F1		; Is byte count significant?
	JRST [	JUMPE B,TSOUTX		; No, null?  done...
		JRST TSOUT1]		; More to come... type it
	SKIPLE C			; Positive count?
	JRST [	CAIN B,(D)		; Yes, is this the ending byte?
		JRST TSOUTX		; Yes, then quit
		SOJA C,TSOUT1]		; No, update count
	SKIPE C			; Unless C is zero already,
	ADDI C,1		;  count towards zero
TSOUT1:	CAIN B,12		; Count line feeds for those interested
	AOS LFCNT		;  ..
	CAIN A,.PRIOU		; Terminal?
	JRST [	MOVE A,B		; Yes, handle differently
		$CALL KBFTOR
		JRST TSOUT2]
	TLNE A,-1		; Byte ptr or IFN?
	JRST [	IDPB B,A		; Byte ptr, stuff it
		MOVEM A,SIFN		; Store updated ptr
		JRST TSOUT2]		; Get next byte
	$CALL F%OBYT		; Write the byte
TSOUT2:	TXNN F,F%F1		; Is byte count significant?
	JRST TSOUT0		; No, keep going then
	JUMPN C,TSOUT0		; Yes, if count is nonzero, keep going

TSOUTX:	TLNN A,-1		; If destination not byte pointer
	SKIPA A,SIFN		;  restore IFN
	JRST [	PUSH P,A		;  else save ptr to last byte
		SETZ B,			;  append a null
		IDPB B,A		;  ..
		POP P,A			; Leave ptr pointing to last byte
		JRST .+1]		; Rejoin main flow
	MOVE B,PTR		; Return updated byte pointer
	TXZE F,F%F1		; Was byte-to-stop-on null?
	RET			; No, just quit
	SETZ C,			; Yes, get a null in case
	TLNE A,-1		; Are we writing to a string?
	IDPB C,SIFN		; Yes, write a null
	RET

SUBTTL TNOUT - simulate a NOUT -- CAUTION !  Bases 10 and 8 only!

TNOUT:	STKVAR <SAVD>		; IFN
	MOVEM D,SAVD		; Preserve D
	MOVE D,A		; For TNOUT0
	CAIE C,^D8		; Octal?
	JRST TNOUT1		; No, must be decimal
	$TEXT (TNOUT0,<^O/B/^A>)
TNOUTX:	MOVE D,SAVD
	RET

TNOUT1:	CAIE C,^D10		; Better be decimal
	FATAL (Invalid radix at TNOUT)
	$TEXT (TNOUT0,<^D/B/^A>)
	JRST TNOUTX

TNOUT0:	MOVE B,A		; Set up for TBOUT
	MOVE A,D		; IFN
	CALL TBOUT		; Move that byte!
	$RET

;Simulate BOUT -- if .PRIOU, call KBFTOR, else F%OBYT
;Call:	A/ IFN or .PRIOU
;	B/ character

TBOUT:	PUSH P,A		; Preserve A
	PUSH P,B
	CAIN A,.PRIOU
	JRST [	MOVE A,B		; Copy char
		$CALL KBFTOR		; Type it
		JRST TBOUTX]
	$CALL F%OBYT
TBOUTX:	POP P,B
	POP P,A
	RET

 SUBTTL COMND support routines

;Here on COMND JSYS error.  Let user try again.

MESLN==30

CMDERR::STKVAR <<ERMES,MESLN>>
	CALL CLRFIB		; Clear typeahead
	CALL CRIF		; Insure that we're at left margin
   TOPS20<
	$TEXT (KBFTOR,<?MS command error: ^A>)
	$CALL K%FLSH
	MOVX A,.PRIOU		; Type on terminal
	MOVE B,[.FHSLF,,-1]	; Ourself, most recent error
	SETZ C,
	ERSTR			; Get error string
	 JFCL
	 JFCL			; Unexpected errors
	MOVE A,[POINT 7,ATMBUF]	; Tell user exactly what COMND didn't like
	$TEXT (KBFTOR,<: "^Q/A/">)
   >;End TOPS20
   TOPS10<
	MOVX A,.PRIOU		; Turn echo back on
	HRRM A,SBK+.CMIOJ	;  ..
	MOVE A,[POINT 7,ATMBUF]	; Tell user exactly what lost
	$TEXT (KBFTOR,<?MS command error: ^E/[-1]/: "^Q/A/">)	; Type msg
   >;End TOPS10
CMDER1:	MOVE B,TAKPTR		; Point to top of IFN stack
	HRRZ B,(B)		; Current IFN for command input
	CAIN B,.PRIIN		; If not TTY, type losing command
	JRST CMDER2		; TTY - user has seen the losing command
	MOVEI A,ERMES		; Where to build copy of losing command
	HRLI A,(POINT 7,)	;  ..
	MOVE B,[POINT 7,CMDBUF]	; Where to get it from
	MOVEI C,<MESLN*5>-1	; Maximum byte count
	MOVEI D,15		; Stop on EOL
	CALL TSOUT		; Copy the command
	CALL CRIF		; Insure left margin
	MOVEI A,ERMES		; Point to copy of command
	HRLI A,(POINT 7,)	;  ..
	$TEXT (KBFTOR,<  in command: ^Q/A/>)
	MOVE A,TAKPTR		; Point to command file stack
	MOVE A,-1(A)		; Get FOB address for this file
	MOVE A,FOB.FD(A)	; Fetch FD address for printing filespec
	$TEXT (KBFTOR,<  in command file: ^F/(A)/>)
	MOVEI A,^D10		; Ten seconds, please
	CALL RDELAY		; Insure user has time to read the message
CMDER2:	SOS REPARA		; Modify reparse address so reprompt happens
;	JRST REPARS

;Place to transfer if user edits previously parsed fields

REPARS:	MOVE P,CMDACS+P		; First restore P so we know how much stack to restore
	HRLI A,CMDPDL		; Restore stack from saved stack
	HRR A,CMDFRM		; Copy to bottom of stack
	BLT A,(P)		; Restore the stack
	MOVSI 16,CMDACS		; Make BLT pointer
	BLT 16,16		; Restore rest of AC's
	JRSTF @REPARA		; Transfer back to just after .CMINI call

;Routine to prompt for new command or new prompt line of command.
; Call this routine with pointer to prompt in A, or 0 if no prompt.

DPROMP::CAIN A,0		; Any prompt?
	HRROI A,[0]		; No, point to a null string
	MOVEM A,SBK+.CMRTY	; Save pointer to prompt
	MOVE B,TAKPTR		; Is input coming from the terminal?
	HRRZ B,(B)		;  ..
	CAIE B,.PRIIN		;  ..
	JRST DPROM0		; No, skip this slow stuff then
	$CALL K%FLSH		; Yes, empty terminal output buffers
	PUSH P,A		; Preserve .CMRTY pointer
	CALL CLRCTO		; Clear ctrl-O
	POP P,A			; Restore A
DPROM0:	POP P,REPARA		; Remember reparse address
	DMOVEM 0,CMDACS+0	; Save AC's
	MOVE 1,[2,,CMDACS+2]
	BLT 1,CMDACS+17
	HRL A,CMDFRM		; Save from bottom of stack
	HRRI A,CMDPDL		; Move data to COMND PDL area
	HRRZ B,P		; See where top of stack is now
	SUB B,CMDFRM		; Calculate number of words
	MOVE C,[IOWD CMDPLN,CMDPDL]	; Get pointer to saved stack
	ADJSP C,(B)		; Generate error if too much stack to save
	BLT A,CMDPDL(B)		; Save the stack
	PUSH P,REPARA		; Make stack like it was
	MOVEI A,[FLDDB. .CMINI]	; Type prompt
	CALL RFIELD
	$CALL M%CLNC		; Clean up core image
	RET			; Return to caller

;Read a field routine.  Give it address of function block in A.
; JRSTs to CMDERR if error.  A, B, and C will have
; result of COMND JSYS in them.

RFIELD::CALL RFLDE		; Read field, skip if success
	 JRST CMDERR		; Handle failure
	RET			; Success

;Routine to read a field and skip IFF successful.
; Return +1: Failure, B contains error code
;	 +2: Success, B contains data returned by COMND
; For both, A contains address of CR.xxx block built by GLXLIB
; If EOF is encountered on the input stream, F%CEOF is lit.

RFLDE::	MOVE B,A		; Put function block pointer in B
	MOVEI A,SBK		; Pointer to state block in A
	$CALL S%CMND		; Call GLXLIB routine
	DMOVEM A,LSCERR		; Save potential error code and CR blk addr
	JUMPF [	HLRZ A,SBK+.CMIOJ	; Get JFN of COMND input
		CALL DGTSTS		; See if EOF occurred
		TXNN B,GS%EOF		;  ..
		JRST [	MOVE A,LSCERR		; No, fetch addr of CR block
			TXZ F,F%CEOF		;  indicate not caused by EOF
			RET]			;  and give failure return
		MOVE T,TAKPTR		; Yes, get IFN stack ptr
		POP T,A			; Get IFN of cmd input
		CAIN A,.PRIIN		; Better be a file
		JCERR (COMND failure)	; Isn't - strange
		$CALL F%REL		; OK, release the IFN
		POP T,B			; Get FOB info
		POP T,A			;  ..
		CALL RELFOB		; Release FOB storage
		MOVE A,(T)		; Point to next IFN
		CALL SETIOJ		; Read commands from it
		MOVEM T,TAKPTR		; Save updated pointer
		TXNE F,F%CEOF		; Caller wish to handle EOF?
		RET			; Yes, return then
		MOVE A,(T)		; Are we unwinding to TTY:?
		CAIE A,.PRIIN		;  ..
		JRST REPARS		; No, just reparse then
		SKIPN A,INIRET		; Init file in progress?
		JRST CMDER1		; No, force prompt and parse again
		MOVE P,INIP		; Yes, return to INITF then
		JRST (A)]		;  ..
	MOVEI A,(B)		; Return addr of S%CMND return block in A
	MOVE B,CR.FLG(A)	; Get flags returned
	TXNE B,CM%NOP		; Did command parse correctly?
	JRST [	MOVE B,CR.RES(B)	; No, get result returned
		TXZ F,F%CEOF		; Indicate not caused by EOF
		RET]			;  and give failure return
   TOPS10<			; *** TEMPORARY CROCK UNTIL S%CMND FIXED ***
	MOVE B,CR.COD(A)	; Get function parsed
	CAIE B,.CMKEY		; Keyword?
	JRST RFLDE1		; No, fetch result and return now
	HLRZ B,@CR.RES(A)	; Yes, point at potential flags
	MOVE B,(B)		; Get possible flags
	TLNE B,774000		; Is this text or flags?
	JRST RFLDE1		; Text, just return result then
	TXNN B,CM%FW		; Really flags?
	JRST RFLDE1		; No, weird, just return
	TXNN B,CM%ABR		; OK, is this abbreviation?
	JRST RFLDE1		; No, just return the expected result then
	HRRZ B,@CR.RES(A)	; Yes, point to real entry then
	JRST RSKP		;  and give OK return
   >;End TOPS10			;*** END OF CROCK ***
RFLDE1:	MOVE B,CR.RES(A)	; Get result from S%CMND block
RSKP:	AOS 0(P)
R:	RET

;Read a field and require carriage return after it for confirmation

CFIELD::CALL RFIELD		; Read the field
	PUSH P,A		; CONFRM wipes these
	PUSH P,B
	CONFRM			; Get confirmation
	POP P,B
	POP P,A
	RET			; Return to caller

;COMND JSYS initialization routine.  Call only once at start of program.
; Always call this routine at a less-than-or-equally nested location
; within the program in comparison with any subsequent call to the COMND
; JSYS execution routines.

CMDINI::MOVEI A,REPARS		; Reparse address
	MOVEM A,SBK+.CMFLG
	MOVE T,TAKPTR		; Point to current input IFN
	MOVE A,(T)		; Get the IFN from the stack
	CALL SETIOJ		; Set up COMND and TEXTI blocks
	HRROI A,CMDBUF		; Pointer to command buffer
	MOVEM A,SBK+.CMBFP
	MOVEM A,SBK+.CMPTR	; Pointer to next field
	MOVEI A,CMDBLN*5	; Room for typin
	MOVEM A,SBK+.CMCNT
	SETZM SBK+.CMINC	; No unparsed characters yet
	HRROI A,ATMBUF		; Pointer to atom buffer
	MOVEM A,SBK+.CMABP
	MOVEI A,ATMBLN*5
	MOVEM A,SBK+.CMABC	; Room in atom buffer
	MOVEI A,CJFNBK		; Pointer to JFN block
	MOVEM A,SBK+.CMGJB
	MOVEM P,CMDFRM		; Remember beginning of stack
	RET

;Routine to set up COMND state block to take input from a file
; Call with IFN (or .PRIIN) in A

SETIOJ:	MOVX B,.PRIOU		; Assume output to TTY
	CAIN A,.PRIIN		; Primary input?
	JRST SETIO1		; Yes, this is easy
	MOVX B,.NULIO		; Output to NUL: if input from file
   TOPS20<
	PUSH P,B		; Preserve output designator for a bit
	MOVX B,FI.CHN		; On TOPS20, must put JFN into .CMIOJ
	$CALL F%INFO		;  instead of IFN
	MOVX B,7		; Also must set byte size to 7
	SFBSZ
	 JFCL			; Garbagey skip returns!!!
	POP P,B			; Restore output designator
   >
SETIO1:	HRLZ A,A		; position in LH
	HRR A,B			; Output designator
	MOVEM A,SBK+.CMIOJ	; inform COMND of this
	MOVEM A,TTXTIB+.RDIOJ	; Also TEXTI
	RET

 SUBTTL Operating-system-specific code

; Clear typeahead for terminal

CLRFIB:
   TOPS20<
	MOVEI A,.PRIIN		; Clear input buffer of type ahead
	CFIBF
   >;End TOPS20
   TOPS10<
	CLRBFI
   >;End TOPS10
	RET


;Set page size for scrolling, page size in A

SETPSZ:
   TOPS20<
	MOVE B,SAVMOD		; Original TTY modes
	DPB A,[POINT 7,B,10]	; New page size
	MOVX A,.PRIOU
	STPAR
	RET
   >;End TOPS20
   TOPS10<
	PUSH P,A		; Sigh...  since TOPS10 TTY I/O is
	$CALL K%FLSH		;  asynchronous with respect to the user,
	$CALL K%TPOS		;  we must flush buffers and wait for
	POP P,A			;  output to finish before changing anything.
	MOVX B,.TOSET+.TOSSZ	; Set TTY STOP size
	MOVE C,TTYUDX
	MOVE D,A		; Size
	MOVE A,[3,,B]
	TRMOP. A,
	 JFCL
	MOVX B,.TOSET+.TOPCT	; On TOPS10 must also reset line counter
	MOVE C,TTYUDX		;  ..
	SETZ D,			;  to zero (top of page)
	MOVE A,[3,,B]
	TRMOP. A,
	 JFCL
	RET
   >;End TOPS10

;Restore TTY page size

RSTPSZ:
   TOPS20<
	MOVX A,.PRIOU
	MOVE B,SAVMOD		; Original RFMOD word
	STPAR
	RET
   >;End TOPS20
   TOPS10<
	MOVE A,SAVPSZ		; Get saved page size
	CALLRET SETPSZ		; Restore it, set line counter, and return
   >;End TOPS10


;Simulate GTSTS to see if EOF occurred on JFN of command input

TOPS10< GS%EOF==IO.EOF >

DGTSTS:
   TOPS20<
	GTSTS			; This is easy on TOPS20
	RET
   >;End TOPS20
   TOPS10<
	SETZ B,			; Clear bits
	MOVE A,LSCERR		; Get last S%CMND error
	CAIN A,EREOF$		; EOF happened?
	TXO B,GS%EOF		; Yes, light the bit
	RET

;Turn S%CMND echoing back on in case monitor command

ECHOON:	MOVX A,.PRIOU
	HRRM A,SBK+.CMIOJ
	RET

   >;End TOPS10

;Clear ctrl-O

CLRCTO:
   TOPS20<
	MOVX A,.PRIOU		; Get current TTY modes
	RFMOD
	TXZ B,TT%OSP		; Clear ctrl-O bit
	SFMOD
	RET
   >;End TOPS20
   TOPS10<
	MOVE A,[3,,B]
	MOVX B,.TOSET+.TOOSU	; Clear ctrl-O function
	MOVE C,TTYUDX
	SETZ D,
	TRMOP. A,
	 JFCL
	RET
   >;End TOPS10

 SUBTTL Run some file in an inferior

   TOPS20<
RUNFIL:	TXZ F,F%F3		; Default run enabled
RUNFL0:	MOVSI A,(GJ%OLD!GJ%SHT)
	GTJFN
	 ERJMP [JRETER <Couldn't find file to run>
		RET]
	PUSH P,A		; Save the jfn
	MOVSI A,(CR%CAP)	; Yes, give it our caps
	CFORK
	 ERJMP [JRETER <Couldn't create fork>
		RET]
	RPCAP
	SETZ C,
	TXZE F,F%F3		; Run enabled?
	EPCAP			; No, disable
	EXCH A,(P)		; Get back jfn
	HRL A,(P)
	GET
	POP P,A			; Get back fork handle
RUNFL2:	SETZ B,
	SFRKV			; At regular startup point
	WFORK
	RETSKP
   >;End TOPS20

;Get a filespec, confirm, fill in FD, allocate FOB and link to FD
;FSPEC - Input file only, no args required
;FSPEC0 - Caller supplies FLDDB. address in A
;Returns +1: CR typed with no filespec or no memory available
;	 +2: Filespec parsed OK
;	  A/ FOB size
;	  B/ FOB address (set up for call to F%xOPN)
;
;JRSTs to CMDERR if bad filespec typed

FSPEC:
   TOPS20<
	MOVX A,GJ%OLD		; Input file, must exist
	MOVEM A,CJFNBK+.GJGEN	;   ..
   >;End TOPS20
	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<Input filespec>,,[FLDDB. (.CMFIL,CM%SDH)])]

FSPEC0:
   TOPS20<
	PUSH P,A
	SKIPE A,FSJFN		; [ESM] Any stray JFNs around?
	 JRST [	RLJFN%		; Yes, release
		 JFCL
		SETZM FSJFN	; and forget
		JRST .+1 ]
	POP P,A
	SKIPN CRFDEV		; Defaulting to connected directory?
	JRST [	SETZM CJFNBK+.GJDEV	; Yes, zero GTJFN fields
		SETZM CJFNBK+.GJDIR	;  ..
		JRST FSPEC1]		;  ..
	HRROI B,CRFDEV		; No, point to appropriate fields
	MOVEM B,CJFNBK+.GJDEV
	HRROI B,CRFDIR		; Directory name
	MOVEM B,CJFNBK+.GJDIR
   >;End TOPS20
FSPEC1:	CALL RFIELD		; Get filespec or CR
	MOVE A,CR.COD(A)	; See which
	CAIN A,.CMCFM		; Just CR?
	 RET			; Yes - return
	PUSH P,B		; Save JFN or FD address
	MOVEM B,FSJFN		; [ESM] Remember it in case of reparse
	CONFRM			; Confirm
	SETZM FSJFN
   TOPS10<			; On TOPS10, GLXLIB has already built FD
	MOVEI A,FDXSIZ		; Must move to private copy, though...
	$CALL M%GMEM		; Get a chunk
	JUMPF [	WARN (Can't acquire space for FD)
		POP P,A			; Flush stack
		RET]
	POP P,A			; Restore address of GLXLIB's FD
	HRLZ A,A		; Built BLT pointer
	HRR A,B			; Move to new FD
	MOVE C,B		; Copy address of new FD
	ADDI C,FDXSIZ-1		; Last word in new FD
	BLT A,(C)		; Make the copy
	MOVE A,B		; Address of new FD
	JRST FSPECX		; Allocate FOB, link, and return
   >
   TOPS20<
	MOVEI A,FDXSIZ		; On TOPS20, we must build FD
	$CALL M%GMEM		; Allocate chunk for FD
	JUMPF [	WARN (Can't acquire space for FD)
		POP P,A
		RLJFN
		 JFCL
		RET]			; Failure return
	HRROI A,.FDSTG(B)	; Where in chunk to put string
	EXCH B,(P)		; Save chunk addr, get JFN
	MOVX C,<1B2+1B5+1B8+1B11+1B14+JS%PAF>	; Full filespec
	JFNS			; Do it up
	MOVE A,B		; Release this now useless JFN
	RLJFN
	 JFCL
	POP P,A			; Restore address of FD
	MOVEI B,FDXSIZ		; Size of FD
	HRLZM B,.FDLEN(A)	; Store in FD
   >;End TOPS20

FSPECX:	CALL ALCFOB		; Allocate FOB, link to FD
	 JRST [	WARN (Can't allocate file open block)
		RET]
	RETSKP			; Return with FOB size in B and addr in A

 SUBTTL FSCOPY - Fast String Copy

;	Courtesy of KLH
;	A - Source BP
;	O - Dest BP
;	C - char count
;	Updates destination pointer in O, smashes AC's A-C freely

KLWINC==^D18	; # chars at which hairy word move starts wining over bp loop

$STENT==1	; offset from beg of loop for entry to STORE phase
$GENT==4	; offset from beg of loop for entry to GET phase

FSCOPY:	CAIL C,KLWINC		; Less than break-even point?
	 JRST FSCPY2		; No, use hairy word copy.
	ILDB B,a		; simple byte-by-byte copying.
	IDPB B,O
	SOJG C,.-2
	POPJ P,

	; Wheee, using hairy word copying!

;Since O is now AC 0 (forced by GALAXY's AC usage), we must use another
; AC because ADJBP does the wrong thing for AC 0

OO==M				; Destination byte pointer

FSCPY2:	MOVEM M,FSCACS+M	; This is a pain, but faster than using PDL,
	MOVEM O,FSCACS+O	; O and M are no longer contiguous...
	MOVE M,[D,,FSCACS+D]	; and we need to do something
	BLT M,FSCACS+M-1	; since ACs will be massacred.

	LDB E,[360300,,A]	; get low 3 bits of P field for source
	SKIPGE E,FSCHTB(E)	; Get resulting # chars, skip if addr ok
	 MOVEI A,1(A)		; P= 01, must bump address.
	MOVEI L,1(A)		; anyway, get addr+1 into 12.
	MOVE OO,O		; Put dest ptr into nonzero AC
	LDB D,[360300,,OO]	; Repeat procedure for dest
	SKIPGE D,FSCHT2(D)	; using slightly different table
	 AOSA V,OO		; and addr goes into 10
	  MOVEI V,(OO)		; and isn't normally bumped.
	MOVEI OO,(C)		; update the destination pointer in OO
	ADJBP OO,FSCACS+O	; from initial value
	; Now get index for shift values, and count for words
	SUBI C,(E)		; Get # chars minus those in 1st src wd.
	ADDI E,-6(D)		; Get E index - d*5+s, zero based.
	IDIVI C,5		; find # words to loop through, rem in d.
	MOVE B,-1(L)		; and get 1st word of source.
	JRST @FPATH(E)		; MUST now pick a path...

	; BLT possible!  Jump to FSBLT0 if no shifting needed for setup.
FSBLT0:	MOVEM B,(V)		; store source word directly
	JRST FSBLT4
FSBLT:	LSH B,@SHASL(E)		; Shift source up against left
	MOVE A,(V)		; get 1st wd of dest.
	LSH A,@SHADR(E)		; right-adjust it
	LSHC A,@SHFIX(E)	; and get everything into A.
	LSH A,1			; need one more bit's worth.
	MOVEM A,(V)		; Store 1st wd of dest...

	; Now settle down to serious BLT'ing.
FSBLT4:	MOVEI T,(C)		; transfer word count
	ADDI T,(V)		; find addr of last dest word
	MOVEI V,1(V)		; Now get 1st dest addr,
	HRLI V,(L)		; and put 1st source addr in LH.
	BLT V,(T)		; Zoom!!
	JUMPE D,FSCPY9		; if no remainder, super win - done!
	ADDI L,(C)		; Hmm, must get last source word.
	MOVE B,(L)		; like so.
	MOVE A,FBMSK(D)		; and a word mask for chars
	AND B,A			; clear unused bits from source,
	ANDCAM A,1(T)		; and zap target bits in dest.
	IORM B,1(T)		; and stick last chars in.
	JRST FSCPY9		; OK, all done...


	; Can't do BLT.  Well, get A and B set up for magical shift loop.
SHSKP2:	LSH B,@SHASL(E)		; Here, only need to adjust source,
	JRST SHSKP5		; since dest will be totally clobbered.
FSSHFT:	LSH B,@SHASL(E)		; Here, both src and dest must be integrated.
SHSKP1:	MOVE A,(V)		; Here, only need adjust dest; src wd is full.
	LSH A,@SHADR(E)
SHSKP5:	LSHC A,@SHFIX(E)	; Stuff as many chars as possible into A.

	CAIE D,0		; If any remainder,
	 MOVEI C,1(C)		; add 1 more word.
	MOVNI C,(C)		; Make AOBJN pointer.
	MOVSI C,(C)

	; Now make another index for termination wrapup purposes.
	ADD D,FFINDX(E)		; Make new index using # chs left in last wd.

	; Now set things up for loop, and enter it.

	HRLI V,(<MOVEM A,(C)>)
	MOVEM V,FSCPKL+2	; Address for MOVEM
	HRRM L,FSCPKL+4		; Address for MOVE
	MOVE L,FSHINT(E)	; Get LSH for shift-in
	MOVEM L,FSCPKL
	MOVE L,FSHOUT(E)	; and shift-out
	MOVEM L,FSCPKL+3
	JUMPGE D,FSCPKL+$STENT	; Depending on flag in D, enter loop at store
	SOS V,FSCPKL+2
	JRST FSCPKL+$GENT	; or at get.

;---------------------------------------------------------------------------
	; Come here when loop finished.  The last word of the source string
	; will be in B.  It may have 1 to 5 chars left for moving, but will
	; never have 0.

	; Long wrapup.
FSCPTL:
	LSHC A,@FSCPKL		; Perform a shift-in
	LSH A,1
	MOVEM A,@10		; Store full word.
	MOVEI C,1(C)		; increment address index
				; and drop through to Medium wrapup.

	; Medium wrapup.
FSCPTM:	LSHC A,@FLOUT(D)	; Shift rest of source word into A
	MOVE B,@10		; Get dest word it will be stored into
	LSH B,@FLADJ(D)		; left-adjust chars to preserve.
				; and drop thru to Short wrapup.

	; Short wrapup.
FSCPTS:	LSHC A,@FFLOUT(D)	; Do final, last, shift-out.
	ANDCMI A,1
	MOVEM A,@10		; and store last dest word.

	; Done!!  Just restore regs and return.
FSCPY9:	MOVE O,OO		; Return updated ptr in O
	MOVE M,[FSCACS+D,,D]
	BLT M,M
	POPJ P,


	; Indexed by low 3 bits of P field, returns # chars
	; existing to right of loc BP points to.  Hence value
	; ranges from 5 to 1; if P = 01, SETZ indicates that
	; bp address needs incrementing.
FSCHTB:	1	; P=10
	SETZ 5	; P=01, increment addr
	0
	0	; randomness
	5	; P=44, full word
	4	; P=35, 4 chars to go
	3	; P=26
	2	; P=17

	; This table is just like FSCHTB except values are pre-multiplied
	; by 5 for easy addition into E.
FSCHT2:	1*5	; P=10
	SETZ 5*5 ; P=01, increment addr
	0
	0	;random
	5*5
	4*5
	3*5
	2*5

	; This table is indexed by D when it has # chars remaining from
	; dividing # chars (in C) by 5.  Provides mask for these chars.
FBMSK:	0	; Nothing here.
	BYTE (7) 177
	BYTE (7) 177, 177
	BYTE (7) 177, 177, 177
	BYTE (7) 177, 177, 177, 177

	; FPATH table vectors off to BLT and other minor stuff as
	; soon as all the basic computations are made.
	; Indexed by E.
FPATH:	FSBLT
	FSSHFT
	FSSHFT
	FSSHFT
	SHSKP1
	FSSHFT
	FSBLT
	FSSHFT
	FSSHFT
	SHSKP1
	FSSHFT
	FSSHFT
	FSBLT
	FSSHFT
	SHSKP1
	FSSHFT
	FSSHFT
	FSSHFT
	FSBLT
	SHSKP1
	SHSKP2
	SHSKP2
	SHSKP2
	SHSKP2
	FSBLT0

DEFINE ENT (A,B,C,D,E) <
	A*7
	B*7
	C*7
	D*7
	E*7
   >
	; SHASL table, contains # bits to shift first source wd left so
	; as to left-adjust it in B.  Indexed by E.
SHASL:
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0

	; SHADR table, contains # bits to shift first dest wd right so
	; as to right-adjust it in A.  Indexed by E.
DEFINE ENT1 (A,B,C,D,E) <
	0,,A*7-1
	0,,B*7-1
	0,,C*7-1
	0,,D*7-1
	0,,E*7-1
   >
SHADR:
	ENT1 -1,-1,-1,-1,-1
	ENT1 -2,-2,-2,-2,-2
	ENT1 -3,-3,-3,-3,-3
	ENT1 -4,-4,-4,-4,-4
	ENT1 -5,-5,-5,-5,-5

	; SHFIX table, contains # bits to left-shift A and B combined so
	; as to move as many characters out of B as possible.  Indexed
	; by E.  MIN(d,e) (d and e after fschtb)
SHFIX:
	ENT 1,1,1,1,1
	ENT 1,2,2,2,2
	ENT 1,2,3,3,3
	ENT 1,2,3,4,4
	ENT 1,2,3,4,5

	; FSHINT table, containing appropriate LSHC instructions for shifting
	; in the first chars of a fresh source word.  Indexed by E.
DEFINE ENTL (ARG1,ARG2,ARG3,ARG4,ARG5) <
	LSHC A,ARG1*7
	LSHC A,ARG2*7
	LSHC A,ARG3*7
	LSHC A,ARG4*7
	LSHC A,ARG5*7
   >
FSHINT:
	ENTL 5,4,3,2,1
	ENTL 1,5,4,3,2
	ENTL 2,1,5,4,3
	ENTL 3,2,1,5,4
	ENTL 4,3,2,1,5


	; FSHOUT table, containing appropriate LSHC instructions for shifting
	; out the last chars of an old source word, to make room for a
	; new one.  Indexed by E.
FSHOUT:
	ENTL 0,1,2,3,4
	ENTL 4,0,1,2,3
	ENTL 3,4,0,1,2
	ENTL 2,3,4,0,1
	ENTL 1,2,3,4,0


	; FFINDX table, contains part of D index for fast add-in.
	; Indexed by E.  Similar to FSHOUT.  Sign bit also indicates
	; whether entry point is $STENT (pos) or $GENT (neg).
DEFINE ENTS (A,B,C,D,E) <
	ENT5 A
	ENT5 B
	ENT5 C
	ENT5 D
	ENT5 E
   >
DEFINE ENT5 (X,Y) <
	X!<Y*5>
>
S==0B0
G==1B0

FFINDX:
	ENTS (<S,0>,<S,1>,<S,2>,<S,3>,<S,4>)
	ENTS (<G,4>,<S,0>,<S,1>,<S,2>,<S,3>)
	ENTS (<G,3>,<G,4>,<S,0>,<S,1>,<S,2>)
	ENTS (<G,2>,<G,3>,<G,4>,<S,0>,<S,1>)
	ENTS (<G,1>,<G,2>,<G,3>,<G,4>,<S,0>)

DEFINE ENTX (A,B,C,D,E) <	; Last item (5) is actually first (0)
	7*E
	7*A
	7*B
	7*C
	7*D
   >

	; FENTRM table, dispatching to appropriate wrapup routine when fast AC
	; loop is finished.  Indexed by D.
FENTRM:
DEFINE ENTXJ (A,B,C,D,E) <
	FSCPT'E
	FSCPT'A
	FSCPT'B
	FSCPT'C
	FSCPT'D
>
	ENTXJ M,M,M,M,S
	ENTXJ M,M,M,S,L
	ENTXJ M,M,S,L,L
	ENTXJ M,S,L,L,L
	ENTXJ S,L,L,L,L


	; FLOUT table, for use by Medium wrapup routine; pushes out remaining
	; source chars in B, making room for incoming dest word.
	; Indexed by D.
FLOUT:	ENTX 1,2,3,4,0
	ENTX 1,2,3,0,1
	ENTX 1,2,0,1,2
	ENTX 1,0,1,2,3
	ENTX 0,1,2,3,4

	; FLADJ table, also for Medium wrapup routine; adjusts dest word in
	; B to left-adjust chars to be preserved.
FLADJ:	ENTX 1,2,3,4,5
	ENTX 2,3,4,5,1
	ENTX 3,4,5,1,2
	ENTX 4,5,1,2,3
	ENTX 5,1,2,3,4

	; FFLOUT table, for Short wrapup routine.  Final Last shift-out of
	; chars in B, so that the last dest word can be stored from A.
	; Indexed by D.  Adds 1 extra bit since MOVEM A, done right after it,
	; and nothing to preserve in B.
FFLOUT:
DEFINE ENTX1 (A,B,C,D,E) <
	E*7+1
	A*7+1
	B*7+1
	C*7+1
	D*7+1
   >
	ENTX1 4,3,2,1,5
	ENTX1 3,2,1,4,4
	ENTX1 2,1,3,4,3
	ENTX1 1,2,4,3,2
	ENTX1 1,4,3,2,1

; Get tty modes

   TOPS20<

GETTYM:	MOVEI A,.FHJOB		; Get job's interrupt word
	RTIW
	DMOVEM B,3(D)
	MOVEI A,.PRIOU
	RFMOD
	MOVEM B,0(D)
	RFCOC
	DMOVEM B,1(D)
	RET


; Set tty modes

SETTYM:	MOVEI A,.FHJOB
	DMOVE B,3(D)
	STIW
	MOVEI A,.PRIOU
	MOVE B,0(D)
	SFMOD
	DMOVE B,1(D)
	SFCOC
	RET

   >;End TOPS20

;*** Crock to get around S%DATI bugs

TOPS10<

XDATI:	STKVAR <<DATTIM,10>>	; Where to make copy of date/time
	MOVEI C,DATTIM
	HRLI C,(POINT 7,)	; Point to this space
	MOVEI B,^D39		; Maximum chars in string allowed
XDATI0:	ILDB D,A		; Skip leading spaces
	CAIN D,40		;  ..
	JRST XDATI0		;  ..
XDATI1:	IDPB D,C		; OK, first nonspace
	SOJLE B,XDATIE		; Watch for overflow
	ILDB D,A		; Get next
	CAIE D,","		; Watch out for cruddy strings
	CAIN D,15		;  ..
	JRST XDATIE		;  ..
	CAIE D,";"		;  ..
	CAIN D,12		;  ..
	JRST XDATIE		;  ..
	CAIE D,40		; Watch for spaces
	JRST XDATI1		; Not space, keep going
	MOVEI D,":"		; Stupid GLXLIB now demands colon before time!
	IDPB D,C		; Just pass one space
	SOJLE B,XDATIE		;  ..
XDATI2:	ILDB D,A		; Space, eat all but one
	CAIN D,40		; Another?
	JRST XDATI2		; Yes, skip it
XDATI3:	IDPB D,C		; Nonspace, pass along
	SOJLE B,XDATIE
	ILDB D,A		; Next char
	CAIE D,15
	CAIN D,","		; Terminator?
	JRST XDATI4		; Yes, almost done
	CAIE D,12
	CAIN D,73		; Semicolon
	JRST XDATI4
	JRST XDATI3		; No, keep passing characters
XDATI4:	SETZ D,			; Insure ASCIZ
	IDPB D,C
	SOJLE B,XDATIE
	MOVEI A,DATTIM		; Point to remodelled string
	HRLI A,(POINT 7,)	;  ..
	MOVX B,CM%IDA!CM%ITM
	$CALL S%DATI
	RET

;Here if DATTIM overflows

XDATIE:	MOVE A,MSGNUM(MX)
	WARN (Badly formatted date-time field in message %1D)
	SETOB O,B		; Return current date/time, and error
	RET

>;end of TOPS10

;SREGV1 - Set scrolling region for VT100 so headers stay on screen
;	  while message text whizzily scrolls along

SREGV1:	SKIPN B,MINWSZ		; Any scrolling stuff wanted at all?
	RET			; No, just quit
	MOVEI A,^D24		; Lines in a page
	SUB A,LFCNT		;  minus lines currently occupied
	SUB A,B			;  minus lines for scrolling text
	JUMPLE A,R		; If no room, don't set scroll region
	SETOM SCRLFL		; OK, set scroll flag so we remember to undo it
	HRROI A,[BYTE (7) 33,"[",0]
	CALL BINOUT		; Commence scroll-region command
	MOVE A,LFCNT		; Get line count
	ADDI A,1		;  plus one because cursor is 1-origin
	PUSH P,A		; Save region begin
	CALL SCRNOU		; NOUT it
	POP P,B			; Restore region begin
	MOVEI A,^D24		; Screen size
	SUBI A,-1(B)		; Compute region size
	CALL SETPSZ		; Set page size
	HRROI A,[BYTE (7) ";","2","4","r",0]
	CALL BINOUT		; Finish it off
	HRROI A,[BYTE (7) 33,"[",0]
	CALL BINOUT		; Begin "cursor position" command
	MOVE A,LFCNT		; Put cursor back where it was
	ADDI A,1		;  ..
	CALL SCRNOU		;  ..
	HRROI A,[BYTE (7) ";","1","H",0]
	CALL BINOUT		; Always column one
	MOVEI A,15		; Type a CR to fake the dumb operating systems
	$CALL KBFTOR		;  into believing we're at left margin
	RET			;  (we are, but they don't believe it)


;Utility routine to expand decimal number -- standard PDP-10 recursion stuff

SCRNOU:	IDIVI A,^D10
	HRLM B,(P)
	SKIPE A
	CALL SCRNOU
	HLRZ A,(P)
	ADDI A,"0"
	$CALL KBFTOR
	RET

;SRGRV1 - Restore scroll region to full screen for VT100

SRGRV1:	SKIPN SCRLFL		; Is this necessary?
	RET			; No, skip it
	HRROI A,[BYTE (7) 33,"[","1",";","2","4","r",0]
	CALL BINOUT		; Resume scrolling entire screen
	CALL RSTPSZ		; Restore page size
	MOVEI A,15		; Type a CR to fake the dumb operating systems
	$CALL KBFTOR		;  out into believing we're at the left margin
	RET			;  (after all, we really ARE at the margin...)

;SBTMV1 - Get to bottom line of screen

SBTMV1:	SKIPN SCRLFL		; Is this necessary?
	RET			; No, skip it
	HRROI A,[BYTE (7) 33,"[","2","4",";","1","H",0]
	CALL BINOUT
	MOVEI A,15		; Fake O.S. into believing we're at
	CALL KBFTOR		;  left margin
	RET

;Routine called when error message or other unexpected event happens.
; It guarantees that the screen won't be cleared for at least n seconds
; to give the user time to react to what's happened.
; A/ number of seconds to give user

RDELAY:	STKVAR <DELAY>
	MOVEM A,DELAY
	$CALL K%FLSH		; Flush the TTY pipe
	$CALL I%NOW		; Get the current time
	MOVE B,DELAY		; Get seconds to delay
	IMULI B,<<1,,0>/<^D24*^D60*^D60>> ; Convert it to UDT format
	ADD A,B			; Add to current TOD
	MOVEM A,BLKTIM		; This is when next clear-screen is allowed
	RET

BINOUT:
   TOPS20<
	PUSH P,A		; Type string in binary mode
	$CALL K%FLSH		; Flush output buffers
	MOVEI A,.PRIOU
	RFMOD
	PUSH P,B
	TRZ B,TT%DAM		; Binary mode
	SFMOD
	EXCH A,-1(P)
	$CALL KBFTOR
	$CALL K%FLSH		; Insure typed while in binary mode
	EXCH A,-1(P)
	POP P,B
	SFMOD
	POP P,A
   >;End TOPS20

   TOPS10<
	$CALL KBFTOR
   >;End TOPS10

	RET

	END

; Edit 2462 to MSUTL.MAC by PRATT on 4-Nov-85
; Merge many changes in -10, -20, and common code.
; *** Edit 2471 to MSUTL.MAC by PRATT on 14-Nov-85
; Changes to break up MS into a smaller module.


; *** Edit 2486 to MSUTL.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2690 to MSUTL.MAC by APPELLOF on 31-Mar-86
; Make TOPS-10 preserve TTY STOP, etc. when exiting text-scroll mode.
; *** Edit 2699 to MSUTL.MAC by RASPUZZI on 20-May-86
; More of edit 2697 - make MS smart enough to search system wide logical name
; of SYSTEM: when taking SYSTEM:MS.INIT
; *** Edit 3096 to MSUTL.MAC by SANTEE on 28-Sep-87
; Move all impure data together.