Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/msutl.mac
There are 7 other files named msutl.mac in the archive. Click here to see a list.
;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.