Trailing-Edge
-
PDP-10 Archives
-
BB-JR93K-BB_1990
-
10,7/declar/declar.mac
There are 7 other files named declar.mac in the archive. Click here to see a list.
TITLE DECLARE ;Define user defined commands
SUBTTL Tarl Neustaedter/RCB 09 Jan 89
;COPYRIGHT (c) 1984,1988,1989 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH JOBDAT,MACTEN,SCNMAC,UUOSYM ;Universals
TWOSEG ;Put code in sharable hiseg
RELOC 400000 ;Starting now
ASCIZ |
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1989.
ALL RIGHTS RESERVED.
|
.REQUE REL:SCAN,REL:HELPER
.TEXT "/SYMSEG:HIGH/LOCALS"
DCLWHO==0
DCLVER==2
DCLMIN==1
DCLEDT==17
.ORG .JBVER
BYTE (3)DCLWHO(9)DCLVER(6)DCLMIN(18)DCLEDT
.ORG
;Edit history
;1) Program creation
;2) Make the command .DECLAR<CR> give an error
;3) Add version numbers
;4) Change a Z to a BLOCK 1 so that LINK knows this is a null loseg.
;5) Require a filename. COMCON requires it, make sure the error
; gets caught before we pass it to the monitor.
;6) Update handling of /UNIQUE switch to conform to new monitor handling
; introduced by MCO 11206.
;7) Add new /AUTOPUSH switch to allow access to new ability to define
; commands that preserve a core-image.
;10) Change some symbols whose names were changed in UUOSYM
; by MCO 11689. /NT
;11) Remove edit 5. COMCON doesn't require a name if the device
; is pathological and will default the name from the device definition.
;12) Fix bug with path defaulting.
;
;Released as V1(12)
;
;13) Don't do so many CORE UUOs. Maybe this will speed up declaring multiple
; commands at LOGIN time. /RCB
;
;Autopatched as V1A(13)
;
;14) Fix bug with defining commands of device only (null name).
; UUOCON requires the name word to be present, but we were
; using the wrong AC anyway, thus re-using the bits and length from
; the previous definition (or random garbage). /RCB
;
;15) Pretty up the listing format. /RCB
;
;16) Add the /SORT switch, since the results of unsorted command lists
; may not be what the user expects. This is a whole lot cheaper than
; another major hack at COMCON's table searching. /RCB
;
;Released as V2(16)
;
;17) Fix fixed-size buffer constraint for listing commands.
;
;Autopatched as 2A(17)
T4==1+<T3==1+<T2==1+<T1==1+0>>> ;Temporary ACs
P4==1+<P3==1+<P2==1+<P1==1+T4>>>;Permanent ACs
CM==P4+1 ;Pointer to command's scan block
FI==CM+1 ;Pointer to filespec scan block
LI==FI+1 ;Offset pointer into list block
C1==LI+1 ;First of two used in unsigned CAML
C2==C1+1 ;Second of pair for CAML36
P==17 ;Stack pointer
OPDEF CALL [PUSHJ P,] ;So that I don't have to type so much
OPDEF RET [POPJ P,] ;Bad return
OPDEF RETSKP [JRST .POPJ1##] ;good return from most routines
.NODDT RETSKP ;sorry, tarl, but i hate seeing this
OPDEF SKP [TRNA] ;skip over an instruction
OPDEF NOOP [TRN] ;do nothing. Ignore skip returns
DEFINE $WARN(PREFIX,TEXT),<
JSP T3,[MOVE T2,["%",,[ASCIZ \TEXT\]]
MOVE T1,[SIXBIT \DCL'PREFIX\]
JRST ERRORH] ;;And call the error handler
>
ND PDLSIZ,50
RELOC ;loseg, for data storage
STACK: BLOCK PDLSIZ ;Stack
;Scan switch locations
SW0:! ;Start of switch area
CLEARS: BLOCK 1
KILLSW: BLOCK 1
LISTSW: BLOCK 1
AUTOSW: BLOCK 1
SORTSW: BLOCK 1
;Not really switches, but we want to setom them every time
CMDNAM: BLOCK 1
CMDFIL: BLOCK 1
ERRORF: BLOCK 1
SW9:! ;End of switch area
UNIQUE: BLOCK 1 ;Switch to setzm (not setom)
OFFSET: BLOCK 1 ;For SCAN
CMDBLK: BLOCK .CMMAX ;Block to do CMAND.s in
BLOCK 1 ;Buffer word
;The following were added for COMSRT
CMDLST: BLOCK 1 ;POINTER TO NAME LIST
SRTLST: BLOCK 1 ;OFFSET COPY OF ABOVE FOR HEAPSORT
CMDDMP: BLOCK 1 ;POINTER TO INPUT DEFINITIONS
CMDINT: BLOCK 1 ;POINTER FOR SORTED DEFINITIONS
CMDCNT: BLOCK 1 ;-VE COUNT OF COMMAND NAMES
RELOC ;Hiseg, for switch tables
KEYS UNQ,<4,3,2,1> ;Possible uniqueness values
; (must be in this order)
PD.UNQ==1_<UNQ4-1> ;Default for bare switch is /UNIQUE:4
DEFINE SWTCHS,<
SN *AUTOPUSH,AUTOSW,
SS *CLEAR,CLEARS,1,
SS *KILL,KILLSW,1,
SS *LIST,LISTSW,1,
SS *SORT,SORTSW,1,
SL *UNIQUE,UNIQUE,UNQ,PD.UNQ,FS.OBV
>
DOSCAN(CM.) ;Generate the switch tables
ISBLK: ;ISCAN block
IOWD 2,[SIXBIT \DECLAR\
SIXBIT \COMMAN\]
XWD OFFSET,'DCL' ;Offset,,sixbit CCL name
XWD 0,0 ;Input,,output routines
XWD 0,0 ;Length,,block for preset indirect file
XWD 0,0 ;Prompt,,exit routines
EXP FS.INC ;Flags,,future (no CORE UUOs)
ISBLKP: XWD .-ISBLK,ISBLK
TSBLK: ;TSCAN block
IOWD CM.L,CM.N
XWD CM.D,CM.M
XWD 0,CM.P ;Switch table pointers for TSCAN
EXP -1 ;Use system helper
XWD CLRSWT,0 ;Clear all answers,,files (no files)
XWD ALLIN,ALLOUT ;Allocate input and output filespecs
TSBLKP: XWD .-TSBLK,TSBLK ;TSCAN block pointer
PDL: IOWD PDLSIZ,STACK ;Pointer to stack
;Start of the program itself.
COMMAN: PORTAL .+2 ;Allow protected execution
PORTAL .+2 ;Even for CCL entry
TDZA T1,T1 ;Non CCL entry
MOVEI T1,1 ;CCL entry
MOVEM T1,OFFSET ;SAVE AS OFFSET FOR SCAN TO LOOK AT
RESET ;oops.
MOVE P,PDL ;Set up stack pointer
MOVE T1,ISBLKP ;GET THE ISCAN BLOCK POINTER
PUSHJ P,.ISCAN## ;initialize the world
COM1: MOVE P,PDL ;Reset the stack pointer
MOVE T1,TSBLKP ;Pointer to TSCAN block
PUSHJ P,.TSCAN## ;Ask for a command
SKIPL ERRORF ;Did an error flag get set?
JRST COM1 ;YEs, forget this line
SKIPL CM,CMDNAM ;did we get an output spec? (command name)
JRST COM2 ;Yes, skip over single spec checking
SKIPG CM,CMDFIL ;Did we get an input spec
JRST [PUSH P,[COM1];Set up return address
$WARN NCG,<No command given>]
MOVEM CM,CMDNAM ;save as output filespec
SETOM CMDFIL ;And clear input filespec
COM2: CALL CMDCHK ;Check CMDNAM to make sure only name typed
JRST COM1 ;Error, try again.
CALL PRCLIN ;process the line
JRST COM1 ;and go for another line
CMDCHK: MOVE T1,.FXMOD(CM) ;Get the modifications word
TXNN T1,FX.NDV ;Make sure he didn't type a device name
$WARN CMD,<Command may not contain device field>
TXNN T1,FX.NUL ;Make sure he didn't give an extension
$WARN CMD,<Command may not contain extension field>
TXNE T1,FX.DIR ;Make sure he didn't give a directory
$WARN CMD,<Command may not contain any path specification>
RETSKP
PRCLIN: SKIPL CLEARS ;Should we clear all commands?
JRST COMCLR ;Yes, go do it.
SKIPL KILLSW ;Should we kill a command
JRST COMKIL ;Yes, kill this particular command
SKIPL LISTSW ;Should we list all the command names?
JRST COMLST ;Yes, go do it.
SKIPL SORTSW ;Should we sort the commands?
JRST COMSRT ;Yes, go do it.
SKIPL FI,CMDFIL ;Did we get an input filespec?
JRST COMADD ;Yes, we must be adding commands
SKIPN .FXNAM(CM) ;Did a command name come in on this?
RET ;Pretend this didn't happen
; JRST COMSHO ;show if command but no filespec
COMSHO: SKIPL CMDFIL ;Make sure no filespec was typed
$WARN FNA,<Filespec not allowed for /SHOW switch>
SKIPN T1,.FXNAM(CM) ;make sure he gave us a command
$WARN CMN,<Command name required for /SHOW switch>
SETCM T2,.FXNMM(CM) ;Get inverted wildcard mask from command
JUMPE T2,COMSH. ;Just show one if no wildcarding
ANDCM T1,T2 ;Mask name down for comparisons
MOVEM T1,.FXNAM(CM) ;Update where we can find it
MOVE T2,[.CMLST,,T1] ;POINT TO A 'BUFFER'
MOVEI T1,1 ;OF ONLY ONE WORD
CMAND. T2, ;SEE HOW MANY COMMANDS WE HAVE
TRN ;NOT-ENOUGH-ROOM ERROR
MOVEM T1,CMDCNT ;STORE COUNT OF COMMANDS
AOJ T1, ;OFF-BY-ONE IN UUO
PUSHJ P,GETWDS ;GET CORE FOR THE LISTING BLOCK
HRLI T2,LI ;SET UP FOR THE AOBJN LOOP
MOVEM T2,CMDLST ;SAVE POINTER TO BLOCK
MOVEM T1,(T2) ;Set length of block
MOVEI T1,(T2) ;Point to block
HRLI T1,.CMLST ;Merge in function code
CMAND. T1, ;Get the list of commands
$WARN CGL,<Couldn't get list of commands>
SETZ LI, ;Offset of 0 into CMDLST
COMSH$: CAML LI,CMDCNT ;Do we still have more commands to go?
RET ;no, return to top level
AOJ LI, ;Yes, point to next command name
MOVE T1,@CMDLST ;Get a command name
MOVE T2,T1 ;Copy the name
AND T2,.FXNMM(CM) ;Account for wildcards
CAMN T2,.FXNAM(CM) ;If it matches,
CALL COMSH. ;List it
JRST COMSH$ ;and go do another command
COMSH.: SETZM CMDBLK ;Clear CMAND. block
MOVE T2,[CMDBLK,,CMDBLK+1];BLT Pointer
BLT T2,CMDBLK+.CMMAX-1 ;Clear the whole block
MOVEM T1,CMDBLK+.CMCMN ;Which command to return information on
MOVEI T1,.CMMAX ;Maximum size of a command block
MOVEM T1,CMDBLK+.CMSIZ ;Save as amount of info to return us
MOVE T1,[XWD .CMRET,CMDBLK] ;Args for UUO
CMAND. T1, ;Get information on this command
$WARN NSC,<No such command>
MOVE T1,CMDBLK+.CMNAM ;Get command name
CALL .TSIXS## ;Type it out in sixbit
MOVEI T1,[ASCIZ | = |] ;ASCII equals sign
CALL .TSTRG## ;Type it out
SKIPN T1,CMDBLK+.CMDVC ;Get device name
JRST COMSH1
CALL .TSIXN## ;Type out device name
CALL .TCOLN## ;indicate device with a colon
COMSH1: MOVE T1,CMDBLK+.CMFLE ;Get filename
CALL .TSIXN## ;Type it out.
SKIPN T1,CMDBLK+.CMEXT ;Get extension
JRST COMSH2 ;skip
MOVEI T1,"." ;Dot.
CALL .TCHAR## ;Precede it with a dot
MOVE T1,CMDBLK+.CMEXT ;get extension back again
CALL .TSIXN##
COMSH2: MOVE T1,[TS.DRP,,CMDBLK+.CMPPN] ;Point to PPN + SFDs
SKIPE CMDBLK+.CMPPN ;If we have a PPN,
PUSHJ P,.TDIRB## ;Type the path
MOVE T2,CMDBLK+.CMFLA ;Get flags
MOVEI T1,[ASCIZ | /AUTOPUSH|] ;String to use
TXNE T2,CM.AUT ;Is auto-push lit?
CALL .TSTRG## ;Yes, type it out
LDB P1,[POINTR CMDBLK+.CMFLA,CM.UNQ]
JUMPE P1,COMSH0 ;If no uniqueness, skip it
MOVEI T1,[ASCIZ | /UNIQUE:|] ;Switch string
CALL .TSTRG## ;Type it
MOVE T1,UNQSTR(P1) ;Get translation string for the bits
CALL .TSTRG## ;Type the value(s)
COMSH0: PJRST .TCRLF## ;End typeout and return
COMADD: SETZM CMDBLK ;Clear CMAND uuo block
MOVE T1,[CMDBLK,,CMDBLK+1] ;BLT pointer
BLT T1,CMDBLK+.CMMAX-1 ;clear it all out
MOVE T1,.FXNAM(CM) ;Get the command name
MOVEM T1,CMDBLK+.CMNAM;Save as command name in uuo block
MOVE T1,.FXDEV(FI) ;Device name (DSK: default)
MOVEM T1,CMDBLK+.CMDVC ;Save as device to run off of
MOVE T1,.FXNAM(FI) ;Get the filename of program to be run
MOVEM T1,CMDBLK+.CMFLE ;save as filename
MOVEI P2,4 ;Number of words we have taken already
HLLZ T1,.FXEXT(FI) ;Get extension
JUMPE T1,COMAD2 ;If nothing, proceed
MOVEM T1,CMDBLK+.CMEXT;Set as extension of program to run
MOVEI P2,5 ;Bump P2 to include this
COMAD2: MOVE T4,.FXDIR(FI) ;Get ppn returned by SCAN
TLNN T4,-1 ;Project number seen?
HLL T4,.MYPPN## ;No, default it
TRNN T4,-1 ;Programmer number seen?
HRR T4,.MYPPN## ;No, default that
SKIPE .FXDIM(FI) ;Was there any point to this exercise?
MOVEM T4,.FXDIR(FI) ;Yes, update the ppn word
MOVEI T4,.FXDIR(FI) ;Pointer to source directory
MOVE T3,[XWD -6,CMDBLK+.CMPPN] ;Pointer to destination directory
COMAD3: SKIPN T1,(T4) ;Anything in the source?
JRST COMAD8 ;nope.
MOVEI P2,-CMDBLK+1(T3);Update number of words deposited
MOVEM T1,(T3) ;Save directory word
ADDI T4,2 ;Point to next input directory name
AOBJN T3,COMAD3 ;And go get another word
COMAD8: SKIPE T1,UNIQUE ;Uniqueness bits specified?
DPB T1,[POINTR P2,CM.UNQ] ;Yes, add flags to count word
SKIPLE AUTOSW ;/AUTO:YES?
TXO P2,CM.AUT ;Yes, add flag to count word
MOVEM P2,CMDBLK+.CMFLA ;Save number of words we picked up
MOVE T1,[XWD .CMADD,CMDBLK] ;Arg for UUO
CMAND. T1, ;Add this command
$WARN CUA,<CMAND. UUO function .CMADD failed>
RET ;Command added, done.
COMCLR: SKIPN .FXNAM(CM) ;Did we get a command name?
SKIPL CMDFIL ;or an input filespec?
$WARN CLS,</CLEAR switch must be standalone>
SETZM CMDBLK+0 ;Clear command block
MOVE T1,[XWD .CMINT,CMDBLK] ;Initialize (clear) command data base
CMAND. T1, ;Wipe.
$WARN CUI,<CMAND. UUO function .CMINT failed>
RET
COMKIL: SKIPL CMDFIL ;Make sure we don't have a filespec
$WARN KMN,</KILL switch cannot take a filespec>
MOVEI T1,2 ;Number of words in argument block
MOVEM T1,CMDBLK+.CMCOU ;Put into list block
MOVE T1,.FXNAM(CM) ;Get command name to wipe
MOVEM T1,CMDBLK+1 ;Save as command to delete
MOVE T1,[.CMDEL,,CMDBLK] ;Delete a command
CMAND. T1, ;Wipe!
$WARN NSC,<No such command>
RET
COMSRT: SKIPN .FXNAM(CM) ;Did we get a command name?
SKIPL CMDFIL ;or an input filespec?
$WARN SMA,</SORT switch must be standalone>
;The rest of this routine was stolen from elsewhere.
;So, if it looks like it doesn't belong here, that's why.
MOVE T2,[.CMLST,,T1] ;POINT TO A 'BUFFER'
MOVEI T1,1 ;OF ONLY ONE WORD
CMAND. T2, ;SEE HOW MANY COMMANDS WE HAVE
TRN ;NOT-ENOUGH-ROOM ERROR
CAIG T1,1 ;NOTHING TO DO UNLESS MULTIPLE COMMANDS
RET ;THAT WAS EASY
MOVNM T1,CMDCNT ;STORE -VE COUNT OF COMMANDS
PUSHJ P,GETWDS ;GET CORE FOR THE LISTING BLOCK
HRLI T2,LI ;SET UP FOR THE AOBJN LOOP
MOVEM T2,CMDLST ;SAVE POINTER TO BLOCK
HRRI T2,-1(T2) ;OFFSET FOR HEAP-SORT
MOVEM T2,SRTLST ;SAVE FOR SORT ROUTINE
IMULI T1,.CMMAX ;HOW MUCH CORE WE MIGHT NEED
AOJ T1, ;PLUS ONE FOR THE TERMINATOR
PUSHJ P,GETWDS ;GET CORE FOR THE DUMP BLOCK
MOVEM T2,CMDDMP ;SAVE POINTER
MOVEM T1,(T2) ;SET UP LENGTH FOR UUO
HRLI T2,.CMDMP ;UUO ARG LIST
CMAND. T2, ;GET THE COMMANDS
$WARN CDF,<CMAND. to dump the definitions failed>
PUSHJ P,SETUP ;BUILD THE LIST OF NAMES, WHICH
PUSHJ P,GETWDS ;RETURNS NEEDED SIZE IN T1
MOVEM T2,CMDINT ;SAVE POINTER TO INIT BLOCK
PUSHJ P,SORT ;ORDER THE LIST OF NAMES
PUSHJ P,SWAP ;ORDER THE DEFINITIONS IN THE INIT BLOCK
IFN .CMINT,<MOVE T1,[.CMINT,,CMDINT]> ;GET ADDRESS OF BLOCK TO USE
IFE .CMINT,<HRRZ T1,CMDINT> ;GET ADDRESS OF BLOCK TO USE
CMAND. T1, ;DEFINE THE NAMES
$WARN CRF,<Command redefinition failed>
RET
SUBTTL GETWDS - CORE ALLOCATION
;CALL:
; MOVEI T1,NUMBER OF WORDS NEEDED
; PUSHJ P,GETWDS
; ONLY RETURN
;
;RETURNS T1 UNCHANGED, ADDRESS OBTAINED IN T2.
;PRESERVES ALL OTHER ACS
;RETURNS ON BEHALF OF CALLER ON CORE UUO FAILURE
GETWDS: ADDM T1,.JBFF ;UPDATE FIRST FREE LOCATION
SOS T2,.JBFF ;GET LAST WORD IN BLOCK
CAMG T2,.JBREL ;DO WE NEED TO EXPAND CORE?
JRST GETWD1 ;NO, SO DON'T
CORE T2, ;YES, TRY IT
JRST GETWDF ;BARF AND RETURN
GETWD1: AOS T2,.JBFF ;FIXUP FIRST FREE AGAIN
SUB T2,T1 ;POINT TO THE START OF THE BLOCK
POPJ P, ;RETURN TO CALLER
GETWDF: POP P,T2 ;RETURN ON CALLER'S BEHALF
$WARN CAF,<Core allocation failed>
SUBTTL SETUP - BUILD THE NAME LIST
;COPIES THE COMMAND NAMES FROM CMDDMP TO CMDLST, COUNTING SPACE AS IT GOES.
;RETURNS THE NUMBER OF WORDS NEEDED FOR CMDINT IN T1.
SETUP: SETZB LI,T1 ;INITIALIZE INDEX AND COUNTER
MOVE T2,CMDDMP ;WHERE WE DUMPED THE COMMANDS
SETUP1: HRRZ T3,(T2) ;GET LENGTH OF THIS COMMAND DEFINITION
JUMPE T3,SETUP2 ;DONE IF AT END
ADDI T1,(T3) ;ACCOUNT FOR LENGTH
MOVE T4,.CMNAM(T2) ;GET NAME
MOVEM T4,@CMDLST ;SAVE IN LIST BLOCK
ADDI T2,(T3) ;UPDATE POINTER TO NEXT COMMAND
AOJA LI,SETUP1 ;LOOP OVER ALL COMMANDS
SETUP2: AOJ T1, ;NEED EXTRA WORD TO TERMINATE INIT BLOCK
CPOPJ: POPJ P, ;RETURN AS ADVERTISED
SUBTTL SORT - SORT THE NAME LIST
;HEAP-SORTS THE COMMAND NAMES USING UNSIGNED COMPARISONS.
;ROUTINE STOLEN WITH MINOR CHANGES FROM HELP.MAC.
SORT: MOVN P2,CMDCNT ;LENGTH OF ARRAY
MOVEI T4,(P2) ;INITIALIZE
LSH T4,-1 ;T4=N/2
AOJ T4,
SORT2: CAIG T4,1 ;DECREASE T4 OR P2
JRST SORT9
SOS LI,T4 ;T4 POINTS TO FIRST UNCHECKED NODE
MOVE P1,@SRTLST ;GET THAT ENTRY
SORT3: MOVEI T3,(T4) ;PREPARE FOR SIFT-UP
SORT4: MOVEI T2,(T3) ;ADVANCE DOWNWARD
LSH T3,1 ;T3 POINTS TO FIRST SON
CAMN T3,P2
JRST SORT6 ;JUMP IF LAST ENTRY
CAML T3,P2
JRST SORT8 ;T3 TOO HIGH--JUMP
MOVE LI,T3 ;FIND "LARGER" SON
MOVE T1,@SRTLST
AOS LI,T3
MOVE C1,T1 ;GET A COPY OF T1
PUSHJ P,CAML36 ;DO A 36-BIT UNSIGNED "CAML C1,@SRTLST"
SOJ T3,
SORT6: MOVE LI,T3 ;LARGER THAN P1?
MOVE C1,P1 ;GET A COPY OF P1
PUSHJ P,CAML36 ;DO THE "CAML C1,@SRTLST"
JRST SORT8
; MOVE LI,T3 ;MOVE IT UP
MOVE T1,@SRTLST
MOVE LI,T2
MOVEM T1,@SRTLST
JRST SORT4
SORT8: MOVE LI,T2 ;STORE P2
MOVEM P1,@SRTLST
JRST SORT2
SORT9: MOVEI LI,1 ;SET UP OFFSET
MOVE T1,@SRTLST ;FETCH HIGH WORD
EXCH P2,LI ;POINT TO END
MOVE P1,@SRTLST ;FETCH NEW END
MOVEM T1,@SRTLST ;SAVE HIGH WORD IN ITS SLOT
EXCH LI,P2 ;RESTORE OFFSETS
SOJ P2, ;LIST IS SHORTER NOW
CAILE P2,1 ;CHECK IF DONE
JRST SORT3 ;NO, HEAPIFY AGAIN
MOVEM P1,@SRTLST ;YES, UPDATE FIRST ENTRY
POPJ P, ;RETURN WITH A SORTED LIST
CAML36: MOVE C2,@SRTLST ;GET A COPY OF @SRTLST
TXC C2,1B0 ;TOGGLE SIGN-BIT ON EACH NUMBER
TXC C1,1B0 ; ...
CAMGE C1,C2 ;DO THE COMPARISON
AOS (P) ;GIVE SKIP-RETURN
POPJ P, ; OR NOT
SUBTTL SWAP - BUILD THE .CMINT BLOCK FROM THE SORTED NAME LIST
;PERHAPS NOT THE MOST EFFICIENT METHOD, BUT IT WORKS.
;IT ASSUMES NO CORE CORRUPTION.
SWAP: HRLZ LI,CMDCNT ;GET AOBJN INDEX TO CMDLST
MOVE T2,CMDINT ;STORAGE POINTER TO NEW LIST
SWAP1: MOVE T4,@CMDLST ;GET NAME TO BE INSERTED NEXT
MOVE T3,CMDDMP ;AND THE ADDRESS OF THE DEFINITIONS
SWAP2: CAMN T4,.CMNAM(T3) ;IS THIS A MATCH?
JRST SWAP3 ;YES, STUFF IT IN
HRRZ T1,(T3) ;NO, GET SIZE OF THE DEFINITION
ADDI T3,(T1) ;UPDATE SEARCH POINTER
JRST SWAP2 ;AND LOOK SOME MORE
SWAP3: HRLZ T1,(T3) ;GET LENGTH OF DEFINITION IN LH
MOVN T1,T1 ;-VE LENGTH FOR AOBJN
HRRI T1,(T3) ;AND COMPLETE THE AOBJN POINTER
SWAP4: MOVE T3,(T1) ;GET A WORD FROM THE OLD DUMP
MOVEM T3,(T2) ;INSERT INTO NEW BLOCK
AOJ T2, ;ADVANCE INIT POINTER
AOBJN T1,SWAP4 ;LOOP OVER ALL WORDS IN OLD DEFINITION
AOBJN LI,SWAP1 ;LOOP OVER ALL NAMES IN THE NAME LIST
SETZM (T2) ;MAKE SURE OF THE TERMINATING ZERO
POPJ P, ;RETURN
COMLST: SKIPN .FXNAM(CM) ;Did we get a command name?
SKIPL CMDFIL ;or an input filespec?
$WARN CLS,</LIST switch must be standalone>
MOVE T2,[.CMLST,,T1] ;POINT TO A 'BUFFER'
MOVEI T1,1 ;OF ONLY ONE WORD
CMAND. T2, ;SEE HOW MANY COMMANDS WE HAVE
TRN ;NOT-ENOUGH-ROOM ERROR
MOVEM T1,CMDCNT ;STORE COUNT OF COMMANDS
AOJ T1, ;OFF-BY-ONE IN UUO
PUSHJ P,GETWDS ;GET CORE FOR THE LISTING BLOCK
HRLI T2,LI ;SET UP FOR THE AOBJN LOOP
MOVEM T2,CMDLST ;SAVE POINTER TO BLOCK
MOVEM T1,(T2) ;Set length of block
MOVEI T1,(T2) ;Point to block
HRLI T1,.CMLST ;Merge in function code
CMAND. T1, ;Get the list of commands
$WARN CUL,<CMAND. UUO function .CMLST failed>
SETZB P1,LI ;Clear both counters
COMLS1: CAML LI,CMDCNT ;Have we typed out all commands?
JRST .TCRLF## ;yes, let CRLF terminate for us
SOJG P1,COMLS4 ;Check to see if we should crlf
CALL .TCRLF## ;Yes, terminate the line
MOVEI P1,^D8 ;reset number of commands to type before crlf
SKP ;and skip
COMLS4: CALL .TTABC## ;Seperate
AOJ LI, ;Advance to next command in list
MOVE T1,@CMDLST ;Get the command name
CALL .TSIXN## ;Type it out
JRST COMLS1 ;And go do another command
CLRSWT:
HLRZ T1,.JBSA ;Get original amount of core
MOVEM T1,.JBFF ;save as current amount of core
SETOM SW0 ;Clear first switch
MOVE T1,[SW0,,SW0+1] ;BLT pointer to clear all switches
BLT T1,SW9-1 ;Clear them all
SETZM UNIQUE ;Also clear the bit-valued switch
RET ;return
ALLIN: SKIPL CMDFIL ;Make sure we don't already have a filespec
CALL [$WARN MFI,<Multiple filespecs are not legal>]
HRRZ T1,.JBFF ;Get pointer to free core
MOVEM T1,CMDFIL ;Save as input filespec
ALLOC: MOVEI T2,.FXLEN
ADDM T2,.JBFF ;Increase memory size
MOVE T3,.JBFF ;Current core size
SOJ T3, ;Only allocate what we'll use
CAMG T3,.JBREL ;Do we already have this much?
RET ;Yes, just return info to scan
CORE T3, ;Make sure we get it
$WARN CUF,<Core UUO failed in memory allocater>
RET ;And return to scan
ALLOUT: SKIPL CMDNAM ;Count times we have given this away
CALL [$WARN MCN,<Multiple command names are not legal>]
HRRZ T1,.JBFF ;Get pointer to free area
MOVEM T1,CMDNAM ;save as output filespec
PJRST ALLOC ;And allocate the core we are taking
ERRORH: CALL .ERMSA## ;Call scan's error handler
CALL .TCRLF## ;Finish the line
AOS ERRORF ;Bump error count (flag)
RET ;and return
;The translation table for uniqueness bits (right-adjusted) to display text
UNQSTR: [ASCIZ |NONE|] ;0
[ASCIZ |4|] ;CM.UN4
[ASCIZ |3|] ;CM.UN3
[ASCIZ |(3,4)|] ;CM.UN3!CM.UN4
[ASCIZ |2|] ;CM.UN2
[ASCIZ |(2,4)|] ;CM.UN2!CM.UN4
[ASCIZ |(2,3)|] ;CM.UN2!CM.UN3
[ASCIZ |(2,3,4)|] ;CM.UNQ^!CM.UN1
[ASCIZ |1|] ;CM.UN1
[ASCIZ |(1,4)|] ;CM.UN1!CM.UN4
[ASCIZ |(1,3)|] ;CM.UN1!CM.UN3
[ASCIZ |(1,3,4)|] ;CM.UNQ^!CM.UN2
[ASCIZ |(1,2)|] ;CM.UN1!CM.UN2
[ASCIZ |(1,2,4)|] ;CM.UNQ^!CM.UN3
[ASCIZ |(1,2,3)|] ;CM.UNQ^!CM.UN4
[ASCIZ |(1,2,3,4)|] ;CM.UNQ
END COMMAN