Trailing-Edge
-
PDP-10 Archives
-
decuslib20-08
-
decus/20-0177/uuocon.mac
There are 20 other files named uuocon.mac in the archive. Click here to see a list.
Subttl Table of contents for Memory
; -- Section -- -- Page --
;
; 1. Table of contents............................................. 1
; 2. Uuocon module initialization................................. 2
; 3. Uuocon routine............................................... 3
; 4. Printing module
; 4.1 %Print routine........................................ 5
; 4.2 Setjfn routine and dispatch table..................... 6
; 4.3 Special character subroutines......................... 7
; 5. GETJFN routine - Obtain a jfn on a file...................... 10
; 6. Crash routine - Handle program fatal errors.................. 12
; 7. Memory management
; 7.1 Memory management symbols............................. 13
; 7.2 Free and used block formats........................... 14
; 7.3 %INIMEM - Memory initialization....................... 15
; 7.4 %GETMEM - get a block of memory....................... 16
; 7.5 %GIVMEM - return a memory chunk....................... 17
; 7.6 Addmem - add memory to free list...................... 18
; 7.7 General subroutines................................... 19
; 8. Sorting module
; 8.1 %Sort (main routine).................................. 20
; 8.2 Partitioning routine.................................. 21
; 9. CMD routines
; 9.1 Cmdini and Prompt..................................... 22
; 9.2 Rflde, Rfield, Cfield................................. 22
; 9.3 Noise and Confrm...................................... 23
; 9.4 Support routines...................................... 23
; 10. String Routines
; 10.1 Insert............................................... 24
; 10.2 Copy and Delete...................................... 25
;
; (End of table of contents)
Subttl Uuocon module initialization
Search Symbol ; Set up macro definitions
Sall ; Supress expansions
;Version information
Vmajor==2 ; Major version
Vminor==2 ; Minor version
Vedit==37 ; Edit number
Vcust==4 ; WCC originated
.TTN. UUOCON,Local UUO controller
;Author: Douglas Bigelow, Wesleyan Computing Center
;We come here when we have an opcode between 0 and 37, vectored by location
;41 which contains a PUSHJ P,UUOCON.
;Set up the UUO trap
LOC 41 ; Uuo vector location
CALL UUOCON ; The instruction
RELOC ; Relocate to previous context
;External storage
Extern UUOTAB
Subttl Uuocon routine
;Almost all accumulators are respected in these routines, which may use freely
;ACs A-D and T1-T4. Accumulator A is sometimes used to return arguments,
;so for those routines, A and B are smashed. Otherwise A and B as well
;as all other ac's must be preserved.
;The following structures refer to the LUUO instruction
DEFSTR (INSFLD,40,8,9) ; Instruction field
DEFSTR (ACFLD,40,12,4) ; Accumulator field
DEFSTR (MEMFLD,40,35,18) ; Memory address field
;Beginning of the routine
UUOCON: TRVAR <<SAVAB,2>,<SAVCD,2>,<SAVT12,2>,<SAVT34,2>>
DEFINE RETPC <-1(.fp)> ; Symbol for return address
DMOVEM A,SAVAB ; Save all the acs we use
DMOVEM C,SAVCD
DMOVEM T1,SAVT12
DMOVEM T3,SAVT34
LOAD B,MEMFLD ; Get the memory field
LOAD C,ACFLD ; Get the calling ac
MOVE A,(C) ; Get the contents of the ac
CAIN C,B ; Ac b is special. is it there?
MOVE A,1+SAVAB ; Yes, get the value
CAIN C,A ; Ac a is special too
MOVE A,0+SAVAB ; Get that value
CAIN C,C ; Finally, check for ac c
MOVE A,0+SAVCD ; Get value from ac c
LOAD C,INSFLD ; Get instruction code
CAIL C,T%%MIN## ; If too low
CAILE C,T%%MAX## ; Or too high?
JRST ILLUUO ; Illegal value
SUBI C,T%%MIN## ; Convert to dispatch offset
CALL @UUOTAB(C) ; Call the routine
UUO.Z: DMOVE A,SAVAB ; Non-skip return means restore a and b
DMOVE C,SAVCD ; Restore other acs
DMOVE T1,SAVT12
DMOVE T3,SAVT34
RET ; And return to caller
;Here if the instruction was illegal
;If the interrupt system is enabled, this routine will generate an interrupt
;on the illegal instruction code panic channel. Otherwise it will just cause
;an error message to print out and the call will be ignored.
ILLUUO: MOVEI A,.FHSLF ; Our handle
MOVX B,II%ILI ; Illegal instruction code
IIC% ; Initiate an interrupt
PRGERR (Illegal instruction code,CONT)
JRST UUO.Z ; Restore ACs and return
;Here for unimplemented instructions
ENTRY %NOTIN
%NOTIN: PRGERR (<Illegal use of non-included UUO function>,RETN)
Subttl Printing module -- %Print routine
;Call with A containing parameter to print, if applicable.
;B contains the address of the string to print.
;JFN storage goes into data segment
;STG (P..JFN) ; Holds current output jfn
Extern P..JFN ; Defined in host program
ENTRY %PRINT
%PRINT: TRVAR <<P..STR,100>> ; Storage for string
MOVE T3,A ; Save value for later use
HRRZ T1,B ; Get location
HRLI T1,(POINT 7,) ; Make a byte pointer
BPM T2,P..STR ; Destination byte pointer
;Loop reading and writing bytes
PR.A: ILDB B,T1 ; Get a byte
CAIN B,"%" ; Is it special flag?
JRST PR.B ; Nope
IDPB B,T2 ; Deposit byte
JUMPN B,PR.A ; Loop until null
;Here on the end of the string
SKIPN A,P..JFN ; Jfn set up?
MOVEI A,.PRIOU ; Nope, use primary
HRROI B,P..STR ; Point to string
SETZ C, ; End on a null
SOUT% ; Send it
RET ; And return
;Here when we found a percent sign
PR.B: ILDB B,T1 ; Get following symbol
CAILE B,"Z" ; Lower case?
SUBI B,40 ; Yes, convert to upper
SUBI B,"A" ; Remove ascii offset
JUMPL B,PR.A ; Negative not allowed
CAILE B,"Z" ; Neither is anything too high
JRST PR.A ; Reject
CALL @PRITAB(B) ; Call proper routine
JRST PR.A ; Loop
Subttl Printing module -- Setjfn routine and dispatch table
;Setjfn - sets up the output jfn for the print routines. Call with
;B containing the jfn to use.
ENTRY %SETJF
%SETJF: MOVEM B,P..JFN ; Set the jfn
RET ; And return
;Dispatch table follows
DEFINE DISTAB(CH..),<
IRPC CH..,<EXP TAB.'CH..>
>
;Sample: (ABCDEFGHIJKLMNOPQRSTUVWXYZ)
PRITAB: DISTAB ($BCDE$$$$J$$$NOPQ$STUV$$$$)
Subttl Printing module -- Special character subroutines
;These routines all have labels of the form TAB."X", where "X" is the
;letter which involked the routine. All unimplemented letters trap to
;the routine TAB.$
;Unimplemented functions
TAB.$: RET ; Return
;Type a crlf
TAB.C: MOVEI A,15 ; Cr
IDPB A,T2 ; Deposit it
MOVEI A,12 ; Lf
IDPB A,T2 ; Deposit
RET ; Return
;Type the time of day
TAB.D: MOVE A,T2 ; Get pointer
SETO B, ; Current time
SETZ C, ; Regular format
ODTIM% ; Type it
MOVE T2,A ; Regain new byte pointer
RET ; And return
;Print out the last error encountered by the process
TAB.E: MOVE A,T2 ; Get pointer
HRLOI B,.FHSLF ; This fork
SETZ C, ; No limit
ERSTR% ; Get last error
JFCL
JFCL ; Ignore error returns
MOVE T2,A ; Restore string pointer
RET ; And return
;Print JFN information for a file
TAB.J: MOVE A,T2 ; Destination
MOVE B,T3 ; The jfn
SETZ C, ; Standard format
JFNS% ; Type it
MOVE T2,A ; Get pointer back
RET ; And return
;; continued on next page
;Type a number in binary [PBG 19-Jan-82]
TAB.B: MOVEI C,2 ; Binary
JRST TAB.O+1 ; Jump to output routine
;Type a number in decimal
TAB.N: MOVEI C,12 ; Decimal
CAIA ; Skip
;Type a number in octal
TAB.O: MOVEI C,10 ; Octal
MOVE B,T3 ; Get the number
MOVE A,T2 ; Get pointer
NOUT% ; Type it
RET ; Can't
MOVE T2,A ; Restore pointer
RET ; And return
;Type a percent sign
TAB.P: MOVEI A,"%" ; Get it
IDPB A,T2 ; Deposit it
RET ; And return
;Initialize for an error message
TAB.Q: MOVEI A,.CTTRM ; Controlling terminal
CFIBF% ; Clear input buffer
DOBE% ; Wait for output to complete
MOVE A,T2 ; Get string pointer
HRROI B,[BYTE (7) 15,12,"?",40,0]
SETZ C, ; No limit
SOUT% ; Append string
MOVE T2,A ; Get revised pointer
RET ; Done
;Type out a sixbit word
TAB.S: MOVEI C,6 ; Max 6 characters
MOVE B,[POINT 6,T3] ; Sixbit pointer
TAB.S1: ILDB A,B ; Get a byte
JUMPE A,TAB.S2 ; Ignore spaces
ADDI A,40 ; Convert to ascii
IDPB A,T2 ; Deposit it
TAB.S2: SOJG C,TAB.S1 ; Loop for all six
RET ; And return
;Type a tab
TAB.T: MOVEI A,11 ; Get it
IDPB A,T2 ; Deposit it
RET ; And return
;Type out a user or directory name
TAB.U: MOVE A,T2 ; Get pointer
MOVE B,T3 ; Get number
DIRST% ; Type it out
RET ; If error
MOVE T2,A ; Restore pointer
RET ; And return
;Type out the version number of the calling program
TAB.V: MOVEI A,.FHSLF ; Our handle
GEVEC% ; Get entry vector
HLRZ A,B ; Isolate length
HRRZS B ; And address
CAIGE A,(JRST) ; Jrst means old style
CAIGE A,3 ; Less than 3 means old style
SKIPA T4,137 ; So copy version
MOVE T4,2(B) ; Otherwise copy new style version
MOVE A,T2 ; Copy pointer
LDB B,[POINT 9,T4,11] ; Get major version
MOVEI C,10 ; Octal
NOUT%
JFCL
LDB D,[POINT 6,T4,17] ; Get minor version
JUMPE D,TAB.V1 ; If no minor, don't print it
MOVEI B,"." ; A period
BOUT% ; Print it
MOVE B,D ; Get the number
NOUT% ; Write it
JFCL
TAB.V1: MOVEI B,"(" ; Seperator
BOUT%
LDB B,[POINT 18,T4,35] ; Get edit
NOUT%
JFCL
MOVEI B, ")" ; End seperator
BOUT%
LDB D,[POINT 3,T4,2] ; Get cust
JUMPE D,TAB.V2 ; Return if zero
MOVEI B,"-" ; Now the vcust
BOUT%
MOVE B,D ; Get the number
NOUT%
JFCL
TAB.V2: MOVE T2,A ; Copy back the pointer
RET ; Return
Subttl GETJFN routine - Obtain a jfn on a file
;This routine finds a file in either DSK:, your login area, or both in
;either order.
ENTRY %GETJF
%GETJF:TRVAR <<TMPBF,30>> ; Get some storage
LOAD T1,ACFLD ; Get calling ac
MOVE T2,B ; Store the string address
CAIN T1,4 ; Output file?
JRST GTJ.2 ; Yes
CAIG T1,1 ; Code 0 or 1?
JRST GTJ.1 ; Yes
CALL GT.LOG ; 2 or 3, try login area first
RETSKP ; Success
CAIN T1,3 ; Is it log: area only?
JRST GTJ.3 ; Yes, quit
;Here to try DSK: first
GTJ.1: CALL GT.DSK ; Try disk area
RETSKP ; Success
JUMPN T1,GTJ.3 ; Return if not code 0
CALL GT.LOG ; Try login area
RETSKP ; Success
JRST GTJ.3 ; Failure
;Here to open an output file
GTJ.2: CALL GT.LOG ; Try login area only
RETSKP ; Success
JRST GTJ.3 ; Failure
;Here for failure return
GTJ.3: SETZ A, ; No jfn returned
RETSKP ; Return
;Routine to test for file in default disk area
GT.DSK: MOVX A,GJ%OLD!GJ%SHT ; Old file only
HRRO B,T2 ; Get the string
GTJFN% ; Get a jfn
RETSKP ; Failure
RET ; Success, jfn in a
;Routine to test for file in LOGIN area
GT.LOG: HRROI A,TMPBF ; Point to destination
HRROI B,[ASCIZ .PS:<.] ; Initial string
SETZ C, ; End on null
SOUT% ; Transfer it
MOVE T3,A ; Save the pointer
GJINF% ; Get our job info
MOVE B,A ; User number into b
MOVE A,T3 ; Byte pointer
DIRST% ; Write out our directory
RETSKP ; Return without success
MOVEI B,">" ; Directory terminator
IDPB B,A ; Tack it on
HRRO B,T2 ; Get filename string
SETZ C, ; Copy until null
SOUT% ; Transfer it
MOVX A,GJ%SHT!GJ%OLD ; File flags
CAIN T1,4 ; Output file?
MOVX A,GJ%SHT!GJ%FOU ; Yes, set different flags
HRROI B,TMPBF ; Point to buffer
GTJFN% ; Get a jfn
RETSKP ; Can't
RET ; Success
Subttl Crash routine - Handle program fatal errors
;Uses the Jsys acs, and restarts the program at the starting address
;if continued.
ENTRY %CRASH
%CRASH: BPL A,< Error at PC >
ESOUT ; Type string with accompanying effects
MOVEI A,.PRIOU ; Primary output
HRRZ B,RETPC ; Location we came from
SUBI B,2 ; Reset to point at location in error
MOVEI C,10 ; In octal
NOUT% ; Type the pc
JFCL ; If we can't, give up
TYPNCR < -- > ; Spacer
MOVEI A,.PRIOU ; Primary output again
HRLOI B,.FHSLF ; This fork,,last error
SETZ C, ; No limit
ERSTR% ; Type last error string
JFCL ; Ignore errors
JFCL ; Ignore errors
TYPE <> ; End with a crlf
HALTF% ; Halt this fork
;Here if continued
HRRZ A,120 ; Starting address
JRST (A) ; Go to it
;End of printer module
PRGEND
Subttl Memory management -- Memory management symbols
Title Memory - Memory management section
Search Symbol,Macsym,Monsym
Sall
;Symbol definitions used in storage management routines
Extern MEMLNK,MEMBLK ; Define in host program
LNK==T4 ; Link register
PROSIZ==3 ; Size of prototype memory block
MINSIZ==4 ; Minimum size of requested block
FSTFRE==121 ; First free location
TAGVAL==123456 ; Block used tag
;Program storage goes into data segment
;STG (MEMLNK) ; Link to first block
;STG (MEMBLK,PROSIZ) ; Prototype memory block
;Structures offset by value of LNK
DEFSTR (TAG,(LNK),17,18) ; Tag field
DEFSTR (SIZE,(LNK),35,18) ; Size of block
DEFSTR (LAST,1(LNK),17,18) ; Backward link
DEFSTR (NEXT,1(LNK),35,18) ; Forward link
;Structures where offset must be added
DEFSTR (XTAG,0,17,18) ; Tag (no index)
DEFSTR (XSIZE,0,35,18) ; Size (no index)
DEFSTR (XLAST,1,17,18) ; Backward link (no index)
DEFSTR (XNEXT,1,35,18) ; Forward link (no index)
Subttl Memory management -- Free and used block formats
; Format of free storage block
;
;
; 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
; 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
; |-----------------------------------------------------------------------|
;+0 | Tag field (565656) | Size of block |
; |-----------------------------------------------------------------------|
;+1 | Backward link | Forward link |
; |-----------------------------------------------------------------------|
;+2 | Free space |
; | - - - - - - - - - - - - - - - - - |
; | ( M word block ) |
; |-----------------------------------------------------------------------|
;+N | Tag field (565656) | Size of block |
; |-----------------------------------------------------------------------|
;
; Format of used storage block
;
;
; 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
; 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
; |-----------------------------------------------------------------------|
;+0 | (Unused) | Size of block |
; |-----------------------------------------------------------------------|
;+1 | Free space (First location known to caller) |
; | - - - - - - - - - - - - - - - - - |
; | ( M word block ) |
; |-----------------------------------------------------------------------|
;
Subttl Memory management -- %INIMEM - Memory initialization
;No arguments - call when all memory manipulation is complete (all desired
;program segments have been called, etc.)
ENTRY %INIME
%INIME: MOVEI LNK,MEMBLK ; Prototype memory block
MOVEM LNK,MEMLNK ; First link
MOVEI A,TAGVAL ; Get free block tag
STOR A,TAG ; Store it
MOVEI A,PROSIZ ; Size of block
STOR A,SIZE ; Store it
STOR LNK,LAST ; Set back link to itself
STOR LNK,NEXT ; And next link too
;Now we add a chunk of memory to the end of our core image
CALL ADDMEM ; Add a k
JRST NOMORE ; Can't, machine size exceeded
RET ; Return to caller, restoring A and B
;Here if requested space can't be obtained
NOMORE: MOVEI A,.FHSLF ; Our handle
MOVEI B,.ICMSE ; Machine size exceeded
IIC% ; Initiate an interrupt
PRGERR (Machine size exceeded,CONT)
RET ; Return if we didn't die
Subttl Memory management -- %GETMEM - get a block of memory
;Call with B containing number of words desired.
;Returns with A containing address of block returned.
ENTRY %GETME
%GETME: MOVEI A,1(B) ; Real number of words requested
MOVE LNK,MEMLNK ; Get first link
CAIGE A,MINSIZ ; Minimum size of block
MOVEI A,MINSIZ ; Set if necessary
JRST M.GE.B ; Skip first part
;Here we get the next link and make sure that we haven't circled around
M.GE.A: LOAD LNK,NEXT ; Get next link
CAME LNK,MEMLNK ; Where we started?
JRST M.GE.B ; Nope, keep looking
CALL ADDMEM ; Yes, try adding more memory
JRST NOMORE ; No more memory!
MOVE LNK,MEMLNK ; Restart the search
M.GE.B: LOAD T3,SIZE ; Get size of block
CAMGE T3,A ; Size big enough?
JRST M.GE.A ; Nope, try again
PUSH P,A ; Save size for later use
MOVE A,LNK ; Get address in a for unlink routine
LOAD T1,NEXT ; Get next link
MOVEM T1,MEMLNK ; Reset the memory link
CALL UNLINK ; Unlink the block from the chain
CALL CLEAR ; Clear the block
MOVEI A,1(LNK) ; Caller's start of block is one past real
POP P,T2 ; Get back size requested
LOAD T1,SIZE ; Get size received
SUB T1,T2 ; Get difference
CAIG T1,MINSIZ ; Enough to bother with?
RETSKP ; Nope, toss it in as an extra
STOR T2,SIZE ; Set new size of requested block
ADD LNK,T2 ; Point to overage
STOR T1,SIZE ; Store size of new block
PUSH P,A ; Save info we're returning
CALL M.GIVX ; While we return the extra chunk
POP P,A ; Restore info
RETSKP ; Return to caller with A set up
Subttl Memory management -- %GIVMEM - return a memory chunk
;Call with B containing the block of memory to be returned. Note that only
;a block obtained from %GETMEM can be returned via %GIVMEM, and the whole bloc
;must be returned, rather than just a part.
ENTRY %GIVME
%GIVME: MOVEI LNK,-1(B) ; Get true block address
M.GIVX: MOVEI A,1(LNK) ; Also make sure a is set
MOVE T1,-1(LNK) ; Get contents of previous word
HLRZ T2,T1 ; Get tag field
CAIE T2,TAGVAL ; Is it a free block tag?
JRST M.GI.A ; Nope, check the following chunk
SUBI A,1(T1) ; Point to previous block
HLRZ T2,(A) ; Get tag field
CAIE T2,TAGVAL ; Is it another tag?
JRST M.GI.A ; Nope, give up
CALL UNLINK ; Unlink the previous block
EXCH LNK,A ; Make link point to previous block
CALL COLLAP ; Collapse the blocks
;Here we attempt to tack on the following block
M.GI.A: LOAD A,SIZE ; Get size of block
ADD A,LNK ; Get address of following block
HLRZ T2,(A) ; Get tag field
CAIE T2,TAGVAL ; A tag field?
JRST M.GI.B ; Nope, quit
LOAD T1,XSIZE,(A) ; Get size of block
ADDI T1,-1(A) ; Add it's address
HLRZ T2,(T1) ; Get tag field
CAIE T2,TAGVAL ; Match?
JRST M.GI.B ; Nope, give up
CALL UNLINK ; Unlink the block pointed to by a
CALL COLLAP ; Yes, collapse the blocks
;Here when we're ready to link in the new block
M.GI.B: MOVE A,MEMLNK ; Get link word for start of list
STOR A,LAST ; Store as new block's last link
LOAD T1,XNEXT,(A) ; Get next link
STOR T1,NEXT ; Store as new block's next link
STOR LNK,XNEXT,(A) ; Store our link as last block's next link
STOR LNK,XLAST,(T1) ; Store our link as next block's last link
MOVEM LNK,MEMLNK ; Store us as the first block in chain
MOVEI T1,TAGVAL ; Get tag value
STOR T1,TAG ; And store it
LOAD T1,SIZE ; Size of block
ADDI T1,-1(LNK) ; Point to last word
MOVE T2,(LNK) ; Get block header
MOVEM T2,(T1) ; Make it block trailer, too
RET ; Finally return to caller, restoring A and B
Subttl Memory management -- Addmem - add memory to free list
;Subroutine to add memory at the end of our core image to the free list.
;Error return is taken if no more memory available.
ADDMEM: HRRZ A,FSTFRE ; Get first free memory location
ADDI A,777 ; Bump up to next page (maybe)
LSH A,-^D9 ; Convert to page number
HRLI A,.FHSLF ; Fork handle in left
RPACS% ; Read page access
TXNE B,PA%PEX ; Existing page?
RET ; Yes, can't add it
HRRZ LNK,A ; Get page number
LSH LNK,^D9 ; Make into address again
ADDI LNK,777 ; And get to last word in page
SETZM (LNK) ; Clear last word
MOVE T1,LNK ; Get last word in block + 1
EXCH LNK,FSTFRE ; Set new first free word, get start of block
SUB T1,LNK ; Get length of block
STOR T1,SIZE ; Store it in block
CALL M.GIVX ; Add to the free pool
RETSKP ; And return
Subttl Memory management -- General subroutines
;Subroutine to collapse two adjacent blocks.
;Call with LNK containing address of first block, and T1 containing size
;of block being appended.
COLLAP: LOAD T1,SIZE ; Get size of block
ADDI T1,(LNK) ; Point to next
HRRZ T2,(T1) ; Get size of next
ADDM T2,(LNK) ; Add in size of new block
RET ; Return
;Subroutine to unlink a block from the queue.
;Call with A containing address of block to unlink.
UNLINK: LOAD T1,XLAST,(A) ; Get last block
LOAD T2,XNEXT,(A) ; Get next block
STOR T1,XLAST,(T2) ; Store back link in forward link's back link
STOR T2,XNEXT,(T1) ; Store next link in backward link's next link
CAMN A,MEMLNK ; Have we unlinked the first block?
MOVEM T2,MEMLNK ; Yes, must provide another
RET ; Return to caller
;Subroutine to clear a memory block
;Call with LNK pointing to the block
CLEAR: HRLI T1,1(LNK) ; First word to clear
HRRI T1,2(LNK) ; Second
SETZM 1(LNK) ; Clear it
LOAD T2,SIZE ; Size of block
ADDI T2,-1(LNK) ; Add address to yield last word of block
BLT T1,(T2) ; Clear the block
RET ; And return
;End of memory management segment
PRGEND
Subttl Sorting module -- %Sort (main routine)
Title Sorter -- Sorting module
Search Symbol,Macsym,Monsym
Sall
;Call with parameters:
; T1 is address of start of array
; T2 is address of end of array
;All acs are respected
;Uses Quicksort algorithm to sort array into descending order.
ENTRY %SORT
%SORT: STKVAR <<KEEP,2>,<CONT,2>> ; Storage
DMOVEM A,KEEP ; Store acs
DMOVE T1,A ; Also move them
MOVX A,.INFIN ; Plus infinity
EXCH A,-1(T1) ; Store in array start-1
MOVX B,.MINFI ; Minus infinity
EXCH B,1(T2) ; Store in array end+1
DMOVEM A,CONT ; Store them
CALL QSORT ; Quicksort the array
DMOVE T1,KEEP ; Restore acs
DMOVE A,CONT ; Get values
MOVEM A,-1(T1) ; Restore first
MOVEM B,1(T2) ; And last
RET ; Return
;Qsort - a recursive sorting algorithm
QSORT: STKVAR <II,JJ,KK> ; Local storage
MOVEM T1,II ; Store variables
MOVEM T2,JJ ; ...
CAML T1,T2 ; I<j?
RET ; Nope, exit from qsort
CALL PART ; Partition the array from i to j
MOVEM T1,KK ; Store returned value
SOS T2,T1 ; End point into t2
MOVE T1,II ; Beginning point into t1
CALL QSORT ; Quicksort this part of array
AOS T1,KK ; Get k+1 value
MOVE T2,JJ ; End of array
CALL QSORT ; Quicksort this part of array
RET ; And return
Subttl Sorting module -- Partitioning routine
;This algorithm partitions the data and returns an index to the array such
;that everything before the partition is greater than the partition value, and
;everything beyond is less.
PART: MOVEI A,1(T1) ; First index
MOVE B,T2 ; Second
MOVE C,(T1) ; Partition value
PART.1: CAMLE A,B ; A greater than b?
JRST PART.4 ; Yes, end
PART.2: CAMG C,(A) ; Compare value
AOJA A,PART.2 ; Loop until partition value is higher
PART.3: CAMLE C,(B) ; Compare value
SOJA B,PART.3 ; Loop until partition value is exceeded
CAML A,B ; Low index below high index?
JRST PART.4 ; Nope, don't switch
MOVE T3,(A) ; Switch array values
EXCH T3,(B) ; ...
MOVEM T3,(A) ; ...
AOJ A, ; Bump low index
SOJ B, ; Decrement low index
JRST PART.1 ; And loop
PART.4: MOVE T3,(T1) ; Now switch array values
EXCH T3,(B) ; ...
MOVEM T3,(T1) ; ...
MOVE T1,B ; This is the parameter returned
RET ; Finished
;End of sorter module
PRGEND
Subttl CMD routines -- Cmdini and Prompt
Title Comand - Comnd% jsys routines
Search Symbol,Macsym,Monsym
Sall
Extern SBK,CMDBUF,ATMBUF,CMDACS,CJFNBK,REPARA,CMBLT1,CMBLT2
Extern CMDPDL,CMDBLN,CMDPLN,ATMBLN
;Special definitions
;** This must match the trvar at UUOCON:.
TRVAR <<SAVAB,2>,<SAVCD,2>,<SAVT12,2>,<SAVT34,2>>
DEFINE RETPC <-1(.fp)> ; Symbol for return address
;Initial state block for cmdini
inisbk: z,,repars ; .cmflg -- no flags,, where to reparse
.priin,,.priou ; .cmioj -- i/o
point 7,[z] ; .cmrty -- default is null prompt
point 7,cmdbuf ; .cmbfp -- where our buffer is
point 7,cmdbuf ; .cmpnt -- first input field
cmdbln*5 ; .cmcnt -- max number of chars
z ; .cminc -- no unparsed chars yet
point 7,atmbuf ; .cmabp -- where atom buffer is
atmbln*5 ; .cmabc -- size of atom buffer
cjfnbk ; .cmgjb -- location of gtjfn block
;Cmdini -- initialize CMD package
;Argument is IOWD pointer to stack.
;(Must be reinitialized if a new stack is used.)
ENTRY %CMDIN
%CMDIN: move a,[inisbk,,sbk] ; Blt pointer
blt a,sbk+.cmgjb ; Copy initial state block to state block
ifn. b ; Is there an argument?
move a,(b) ; Yes, get argument
else. ; Nope, make a best guess
move a,.fp ; By assuming that stack bottom
sub a,[2,,2] ; Was the calling address
endif.
hlre b,a ; Get the size field
movns b ; Negate it
caig b,cmdpln ; Is there enough room?
ifskp. ; Nope, time to complain
movei a,.fhslf ; Cause an interupt on the push-down
movx b,ii%pov ; Overflow panic channel
iic% ; If continued, exlain
prgerr (CMDPLN too small to save stack,EXIT)
endif.
movsi b,1(a) ; We're ok, make blt pointer
hrri b,cmdpdl ; stak,,cmdpdl
movem b,cmblt1 ; Our first pointer
movni b,(a) ; Now figure how stack to save
addi b,cmdpdl ; -<stak-1>+cmdpdl
hrli b,p ; 1-stak+cmdpdl(p)
movem b,cmblt2 ; Which is our second pointer
ret ; Done
;Prompt -- start new command line
;Possible arguments in memory field
; address of asciz string to use as prompt, or
; 0 for no prompt at all (null string), or
; -1 to reuse previous prompt (same as 0 if first call)
ENTRY %PROMP
%PROMP: skipn b ; If argument is zero
movei b,[z] ; Then prompt is a null string
caie b,-1 ; If argument isn't minus one
hrrom b,sbk+.cmrty ; Then it's the new prompt's address
dmove a,savab ; Get saved a and b
move c,savcd ; Get saved c
dmovem f,cmdacs+f ; Save two acs
move a,[b,,cmdacs+b] ; Blt pointer
blt a,cmdacs+16 ; Save most of the acs
movei a,retpc ; Get address of top of stack
movem a,cmdacs+p ; Save last ac
move a,cmblt1 ; Save the stack
blt a,@cmblt2
move a,retpc ; Get called address
movem a,repara ; This is our reparse address
movei b,[flddb. .cmini]
call field ; Go type the prompt
jfcl ; Shouldn't happen
ret ; Done
Subttl CMD routines -- Rflde, Rfield, Cfield
;Field parsing routines
;Argument is address of function discriptor block.
;Returns with these results in acs 1 and 2
;ac1/ LH: flags from cmd state block.
; RH: address of function block used to parse command.
;ac2/ data returned by COMND% jsys,
; or error code if rflde is returning an error.
;rflde -- parse a field, skip iff successful
ENTRY %RFLDE
%RFLDE: call field ; Try to parse
ifskp. (aos retpc) ; Pass skip down the line
hrr a,c ; Copy func block pointer
retskp ; Return, keep new a and b
;rfield -- parse a field, proccess any errors.
; Returns only on success.
ENTRY %RFIEL
%RFIEL: call field ; Parse the field
jrst cmderr ; Failed, go proccess error
hrr a,c ; Copy function block pointer
retskp ; Return, keep new a and b
;cfield -- same as rfield, but confirm afterwards
ENTRY %CFIEL
%CFIEL: call field ; Parse the field
jrst cmderr ; Failed, go process error
dmovem a,savab ; Store returned values
call %confr ; Confirm
ret ; Done
Subttl CMD routines -- Noise and Confrm
;noise -- parse (generate) a noise word
;Argument is address of string to type
ENTRY %NOISE
%NOISE: move t2,b ; Get the string address
tlo t2,-1 ; Convert to pointer
movx t1,fld(.cmnoi,cm%fnc)
movei b,t1 ; Function block is t1-t2
call field ; Go parse (type) the string
jfcl ; This shouldn't happen
ret ; Done
;confrm -- get confirmation
;No argument
ENTRY %CONFR
%CONFR: movei b,[flddb. .cmcfm]
call field ; Get confirmation
jrst cmderr ; Didn't confirm, go complain
ret ; Done
subttl CMD routines -- Support routines
;field -- parsing routine, does actual COMND% jsys
;b/ address of function block
field: movei a,sbk ; Get address of state block
comnd% ; The real thing!
erjmp r ; Single return on errors
txne a,cm%nop ; Did it parse?
ret ; Nope, single return
retskp ; Success, skip return
;cmderr -- handles cmd errors
cmderr: hrroi a,asc(Command error -- )
esout%
movei a,.priou ; To primary output
hrloi b,.fhslf ; Most recent error
setz c, ; Any length
erstr% ; Standard error message
jfcl
jfcl
sos repara ; Make reprompt happen
; (fall into repars)
;repars -- where COMND% jsys jumps to for reparse
repars: move p,cmdacs+p ; Get old stack pointer
movs a,cmblt1 ; Restore the stack
blt a,(p)
movsi 16,cmdacs ; Restore rest of the acs
blt 16,16
jrstf @repara ; Go reparse or reprompt
PRGEND ; End of comand module
Subttl String Routines -- Insert
Title String - String manipulation routines
Search Symbol,Macsym,Monsym
Sall
Extern S1,S2 ; External string pointer storage
ENTRY %Inser
; Here we insert either AC B blanks into S1, or B characters from the pointer
; specified in A into S1. If B is zero, we just insert spaces.
; The string in S1 is assumed to end in a null.
%Inser: move t1,s1+1 ; Get the pointer to the string
move p1,a ; The counter is in p1
move p2,@b ; Save the possible pointer
move p3,s1 ; Save the current pointer
; Now loop, looking for the string end:
ildb a,t1 ; Get a character
jumpn a,.-1 ; If not the null, get the next one
; Now we're at the end of the string, insert AC A blanks into the string
move a,p1 ; Get the character count
adjbp a,t1 ; Adjust our byte pointer that many...into a
movem a,s1 ; And save it as our returned pointer
movei c,40 ; Put a space into c
.inlup.:movem a,t2 ; Now t1 has the old end, t2 has the new end
camn t1,p3 ; Are we at the word for insertion?
jrst .inin. ; Yes, do the insertion
ldb a,t1 ; Get a character from the end
dpb c,t1 ; Write over it with a space
dpb a,t2 ; Deposit it to the new end
seto a, ; Get a negative one
adjbp a,t1 ; Move the pointer back one
move t1,a ; Get the pointer back into t1
seto a, ; Negate a again
adjbp a,t2 ; Move the new end back one
jrst .inlup. ; And loop
; Here when we've inserted the proper number of spaces into the string.
; If we have a pointer, copy the characters, if not, return:
.inin.: skipn p2 ; Do we have a pointer to string to insert?
ret ; No, just return then
ildb a,p2 ; Yes, get a character
idpb a,p3 ; And move it
sojg p1,.-2 ; Loop until done
ret ; When done transfering, just return
Subttl String Routines -- Copy and Delete
ENTRY %Copy
; Copy loops, copying from S1 to S2, stopping when it reaches the character in
; B or the number of times in A.
%Copy: ildb c,s1 ; Get a char from the source string
idpb c,s2 ; No, copy the character to the destination
camn b,c ; Is it the one we're looking for?
ret ; Yes, return, restoring all AC's
jumpl a,%copy ; If counter is negative, get the next char
sojg a,%copy ; Decriment counter...if still positive, loop
ret ; If zero, we've done enough...return
ENTRY %Delet
; Here to delete the number of characters in ac B starting at the char pointed
; to by S1, or until we come to the character in ac A:
%Delet: move t3,b ; Get the number of characters to copy
jumpe a,.dnum. ; If the character to stop on is null, just
; copy the specified number
; Here to delete until we reach a specified character. First we see how many
; characters from the current pointer the specified character is:
setz t3, ; Clear our char counter
move t4,s1 ; Copy the pointer
ildb t1,t4 ; Get a character
aos t3 ; Increment our counter
caml t3,a ; Are we still below the max given?
jrst .+3 ; No, stop looking
came t1,b ; Is it the character we're looking for?
jrst .-5 ; No, look at the next one
; Here when we've found the character. Delete the number of chars in t3:
.dnum.: setz d, ; Put a null in D
adjbp t3,s1 ; Point to the next character to keep
move t4,s1 ; Now get the original
.delch.:ldb a,t3 ; Get the next character to keep
idpb d,t3 ; Write over it with a null
dpb a,t4 ; Save it in t4
skipe a ; A null?
ret ; Yes, return, deletion complete
ibp t4 ; Increment the byte pointer
jrst .delch. ; Loop until we reach a null
ENTRY %FIND
; Find The letter C in the string pointed to by Ac. The pointer
; is set to char found, or if not found, pointer is at end of
; string. The pointer is returned in A, and last character is
; in B:
%Find: ildb t1,a ; Get a character
camn b,t1 ; Is it the one we're looking for?
retskp ; Yes, return to caller
jumpn t1,%find ; If not a null, look at the next character
retskp ; If it is a null, return
;End of subroutine package
END ; No start address specified