.title UCL+ User Command Linkage .sbttl INTRODUCTION .ident /WKW06D/ .enabl lc ; This version of UCL is brought to you by: ; ; William K. Walker ; Monsanto Research Corp. ; P. O. Box 32 ; Miamisburg, OH 45342 ; (513) 865-3557 ; ; UCL+ is a user command linkage program for use with RT-11 V5 and later ; monitors. It is upward compatible with the UCL program distributed with ; V5.1 with the following exceptions: ; ; 1. Symbol definitions are listed with the LIST (or LIST SYMBOLS) ; command; this is accomplished by typing "UCL" with the distributed ; UCL. ; ; 2. UCL+ accepts the "VMS-like" symbol definition syntax used by DEC's ; UCL, but it ignores it. Instead, the number of characters that ; must be typed to specify a command or symbol unambiguously is a ; function of context. E.g., if you have defined two symbols ; starting with "S", "SUPPER" and "SUPER", you must type four ; characters to distinguish between them. However, if they are ; "SIPPER" and "SUPER", only two characters are necessary. ; ; 3. UCL+ currently allows symbol names of no more than six characters. ; If you use a longer name in a definition, UCL+ will truncate it to ; six characters and issue a warning message to that effect. ; ; UCL+ contains a number of extensions to the distributed UCL program: ; ; 1. UCL+ is optimized to minimize disk access. The symbol definitions ; are contained in internal tables rather than a separate data file ; and an "execute-immediate" mode is available for commands that are ; defined in terms of other UCL commands. ; ; 2. More than one symbol definition can be deleted in a single command ; line via the ERASE command. All current symbol definitions can be ; removed with ERASE/ALL. ; ; 3. Provision has been made to chain to additional "UCL's". ; ; 4. A "run-by-name path" can be defined which extends the RT-11 "run- ; from-SY:" default. ; ; 5. You can STORE/RECALL the program settings to/from a separate ; ".UCL" file. ; ; 6. A PASS_ON command is included that allows you to force UCL+ to ; "pass-on" a given command string to the next program in the chain ; (the default mode) or to a program that you specify. ; ; 7. Symbol expansions can be DISPLAYed with or without execution. The ; DISLAY command can also be used to print pre-defined ASCII stings ; on the console (handy for sneaky escape sequences). ; ; 8. Provision has been made to make the addition of "hard-wired" ; commands fairly easy. These are, typically, commands that are too ; complex to define as symbols. Two commands of this type are ; included as examples (and because the author finds them very ; handy!): a CD command which changes the default device (works a ; lot like the CP/M CD command) and an RNO command which is a DCL- ; style command for use with DECUS RUNOFF version M02.4. ; ; 9. If you run it directly, UCL+ will accept lower-case input. ; ; Here's how everything works: ; ; First, read sections 2.2.4.1 and 2.2.4.2 (pages 2-39 through 2-41) of the ; version 5 Software Support Manual... ; ; OK, now that you've done your homework (and saved me a lot of typing)... ; ; As you will recall, if you are using a version of RT-11 that is sysgened ; to support User Command Linkage, RT goes through a certain logical ; sequence to evaluate a command line. First, it looks at the first word to ; see if this a valid RT-11 command. If not, it looks on SY: for a program ; to run that has the same name as this first word (let's call it "word1"). ; If "SY:word1.SAV" is not found, it runs SY:UCL.SAV (if it exists) and ; passes the entire command line to UCL in the chain area. ; ; UCL understands two types of commands: "hard-wired" commands, which are ; installed by modifying the UCL source code (hereafter referred to simply ; as "commands"), and "symbols", which are commands that you define (or ; modify or delete) from the console. First, UCL checks to see if word1 is ; a valid command and, if so, calls the appropriate routine. If the command ; check fails, UCL looks for a match against the currently defined symbols ; and, if successful, invokes the symbol processing stuff (redefinition of a ; symbol is trapped at this point also). Next, UCL checks to see if a new ; symbol is being defined and takes care of it if so. Finally, UCL uses the ; "run-by-name" path to look for "dev:word1.SAV" (the default is dev=DK:) ; and, if found, runs it by passing the command "RUN command-string" to RT-11. ; If all else fails, you get a "?UCL-F-Invalid Command" or "?UCL-F-Ambiguous ; Command" (whichever is appropriate) error message. UNLESS the CHAIN command ; is in effect -- in which case it chains to the specified program, passing it ; the original command line. ; ; In summary then, when you enter a command: ; ; 1) RT-11 tries to execute it, then ; 2) RT-11 tries to run it off SY:, then ; 3) UCL tries to execute it as a command, then ; 4) UCL tries to execute it as a symbol, then ; 5) UCL tries to run it off one of the series of devices in the ; run-by-name path, then ; 6) you either get a nasty comment or UCL chains to another program. ; ; Oh yeah, symbols are defined by entering a "symbol definition string" in ; the format: symbol==definition. Where "symbol" is the command you are ; defining (6 characters max.) and "definition" is the character-string (72 ; characters max.) that will govern the way that the symbol is replaced when ; it is interpreted. In the simplest case, suppose you define the symbol ; "BUILD" by entering ; BUILD==EX/MAC/NORUN ; If you subsequently enter ; BUILD MYFILE ; this line is interpreted by UCL and passed back to RT-11 as ; EX/MAC/NORUN MYFILE ; ; You may also get multiple-line definitions via the backslash ("\") ; character. For example, the symbol "WHEN" defined as ; WHEN==DATE\TIME ; executes as if you had typed ; DATE ; TIME ; ; A "^" character or characters in the definition governs where the ; "argument-part" of the input command string is inserted when a symbol ; is expanded. Thus, ; BUILD==EX/MAC/NORUN ; and ; BUILD==EX/MAC/NORUN ^ ; are equivalent symbol definitions. The "^" operator is really handy ; when the "argument-part" is to be embedded in the middle of the ; expansion somewhere rather than tacked on the end. For example: ; VERSIO==RESORC SY:^.SAV/V ; If you type ; VERSION PIP ; this symbol will expand as ; RESORC SY:PIP.SAV/V ; ; Finally, you may precede the "definition-part" with an underscore ; character ("_"). This will cause UCL to process the symbol expansion ; in "execute-immediate" mode. This means that the expanded symbol is ; processed immediately by UCL rather than being passed on to RT-11 as ; a command string. This feature will speed up command execution ; substantially in those cases where one symbol is defined in terms of ; another symbol or hard-wired command. For example, ; SAY==DISPLAY "^ ; and ; SAY==_DISPLAY "^ ; are equivalent definitions. If you type ; SAY HELLO ; both will expand as ; DISPLAY "HELLO ; BUT, in the first instance, the UCL program will be invoked twice: ; once to expand SAY HELLO and pass the string back to RT-11, and a ; second time to execute DISPLAY "HELLO. However, in the second example, ; UCL expands the command and then immediately executes the resultant ; command string. This latter form executes much faster, especially on ; a floppy-based system! ; ; Note that you are restricted to using "_" with definitions that expand ; to a single line. ; A==_B\C\D ; will not work correctly. .mcall .chain, .close, .csigen, .csispc, .exit, .gtlin .mcall .print, .purge, .readw, .settop, .sreset, .ttyout .mcall .writw .mcall push, pop, .getcom, .cscan ;(in UCLMAC library) .sbttl ADDRESSES, VALUES, DEFINITIONS ; ============================== vzn = 6 ;Version rls = 4 ;Release .sbttl Handy RT Addresses and Bit Definitions jsw = 44 ;Job Status Word userto = 50 ;Location of program's high limit address errbyt = 52 ;RT's error byte userrb = 53 ;User error byte chname = 500 ;CHAIN program name in syscom area bytcnt = 510 ;Byte count in syscom area cmdbuf = 512 ;Command text in syscom area warn$ = 2 ;"Warning" bit in user error byte sever$ = 10 ;"Severe error" bit in user error byte spxit$ = 40 ;JSW bit for special chain exit ovly$ = 1000 ;Overlay bit in JSW ttlc$ = 40000 ;Lower case bit in JSW .sbttl Status Bits In STATUS runc = 1 ;UCL invoked by RUN command ximm = 2 ;Execute-immediate flag dspla = 4 ;DISPLAY command encountered dsplx = 10 ;DISPLAY/EXECUTE encountered .sbttl Switch Bit Definitions all = 1 ;/ALL noq = 2 ;/NOQUERY qry = 4 ;/QUERY rst = 10 ;/RESET out = 40 ;/OUTPUT prn = 100 ;/PRINTER trm = 200 ;/TERMINAL exe = 400 ;/EXECUTE nex = 1000 ;/NOEXECUTE badopt = 40000 ;Invalid switch option cnswer = 100000 ;Conflicting switches .sbttl Other Values nsyms = 111. ;Maximum number of symbol definitions lcccc = 6 ;Maximum length of symbol name lssss = 72. ;Maximum length of symbol definition lsyms = lcccc+lssss+2 ;Maximum length of a symbol definition buffer nbloks = 18. ;Number of symbol blocks chbufl = 182. ;Buffer length "chain area" lf = 012 ;Linefeed cr = 015 ;Carriage Return space = 040 ;Space .asect ; Setting the overlay bit in the JSW will cause channel 17 to automatically ; be open to UCL.SAV... ; Also set lower-case bit for TT: input... . = jsw .word ttlc$ ! ovly$ .sbttl SYMBOL/STATUS BLOCKS ; ==================== .psect ssblks ; These buffers will form blocks 1 - 6 of the file's SAV image. The ; first 32 words form table SDSAT, the symbol definition string address ; table. It contains the addresses of the existing symbol definition ; strings, sorted in string alphabetical order (what do you mean, why? ; it's faster to search for a match and determine ambiguity this way... ; you don't think I'd go to all this trouble for nothing do you?). The ; remaining 31 x 32 byte area contains the buffers for 31 symbol ; definition strings. ; ; A symbol definition string is entered at the console as ; "symbol==definition" (example: HANG==SUSPEND RTMON) and stored in a ; symbol definition string buffer in the format: ; ; CCCCCC0SSSSSSSSSSSS...SSSSSSSSSSSS0 ; ; where ; ; CCCCCC is an up-to-six character symbol, padded with nulls, ; ; 0 represents a null byte, and ; ; SSS... is the symbol definition (72 char. max., null padded). ; ; The first byte is set to 377 if a particular buffer is unused. ; ; The latter part of the last block contains the UCL version and release ; numbers, the "run-by-name" path and, possibly, the name of a file for ; a chain exit. ; ; When any of the information in these blocks is changed (symbol is ; defined, redefined, deleted; path/chain data is modified), the updated ; versions of blocks 1 - 18 are written to UCL.SAV. sdsat:: ;Symbol definition string address table... .blkw nsyms-1 sdsatl: .word 0 ;Last possible address entry in table sdsate: .word 0 ;End of table, always 0 sdsbfr: .rept nsyms ;Symbol definition string buffers... .byte 377 .blkb lsyms-1 .endr vznrls: .byte vzn,rls ;Version, release pthbuf: .asciz /DK:/ ;Path list buffer .blkw 39. chanto: .word 0 ;Name of program to chain to .blkw 7 ssbsiz = . - sdsat ;Pad out to an even block... filler = - rzrvd: .blkb filler .sbttl PROGRAM MAINLINE ; ================ .psect main .nlist bex vrshun: .ascii / UCL+ Version / .asciz .list bex .even ; UCL can be entered in one of two ways. Usually, it is invoked by RT-11 ; because RT was unable to interpret a command line. In this case, the ; original command line text is passed to UCL in the chain area starting at ; location 512 with the byte count in the word at 510. UCL detects this ; non-zero byte count, moves the command line to it's input buffer, ; processes it, and executes the appropriate return to the monitor. ; ; A byte count of zero indicates that UCL has been invoked with a monitor R ; or RUN command. This situation causes UCL to request an input line from ; the console (or an indirect command file). Command line processing is the ; same as above with one exception: if command execution does not require a ; return to the monitor (e.g., LIST SYMBOLS), UCL prompts for another ; command line after processing the previous line. ucl:: mov @#userto,dspace ;Set up address of handler load area... add #2,dspace mov @#bytcnt,r0 ;Get no. of bytes in command line beq 20$ ;If none, go prompt for something mov #cmdbuf,r1 ;R1=>command line from RT-11 mov #buff,r2 ;R2=>input buffer 10$: movb (r1)+,(r2)+ ;Move command line into buffer... sob r0,10$ clrb (r2) br 30$ ;Go interpret it 20$: .gtlin #buff,#prompt ;Ask for a command line bis #runc,status ;Set "we been run" flag tstb buff ;Anything entered? bne 30$ ;Yep... .print #vrshun ;Nope, print version and br 20$ ; ask again 30$: bic #ximm,status ;Clear "execute-immediate" flag .getcom #buff,#cmd ;Get command into command buffer call clencm ;Zap any "other-UCL-style" stuff .cscan ,#rsalst ;Look for a match call @cealst(r5) ;Execute the indicated routine bit #ximm,status ;"Execute-immediate" flag set? bne 30$ ;Branch if so bit #runc,status ;Were we RUN? bne 20$ ;Branch if so .settop #0 ;Exit otherwise... .exit .sbttl TRAPS: BAD AND AMBIGUOUS COMMANDS ; ================================= ; The following stuff is the traps for invalid (BADCOM) and ambiguous (AMBCOM) ; hard-wired commands. ; ; First, BADCOM tries to execute the command as a symbol. ; ; Next, BADCOM tests for a "==" sequence in the input string to see if someone ; is trying to insert a new symbol definition (redefining a symbol is trapped ; in step 1). ; ; Finally, BADCOM checks to see if the command represents a file, not on SY:, ; that it could attempt to RUN (if the file was on SY:, RT would have RUN it, ; and UCL would not have been invoked in the first place). If a file is ; found, BADCOM sticks the string "RUN" ahead of the full original input ; string and passes the whole assemblage back to RT-11 as a command string. ; If no file is found and the CHAIN command is not in effect, BADCOM reports ; an invalid command. If CHAIN is in effect, the original command line is ; loaded into the chain area and UCL chains to the specified program. ; ; In short, BADCOM triggers symbol processing and implements a non-SY: ; "run-by-name" facility as well as trapping invalid commands. ; ; AMBCOM traps and reports ambiguous commands for UCL. ; When we enter this piece of code below, we have failed to find a match with ; any of the "hard-wired" commands. The next step is to scan the symbol ; definitions. A match here will result in either the execution or ; redefinition of a symbol. .sbttl badcom badcom:: push cmd+6 ;Save 7th character in command clrb cmd+6 ;Truncate command to 6 characters .cscan ,#sdsat ;Try for a match in SDS table pop cmd+6 ;Restore 7th command character jmp @sealst(r5) ;Go handle result of scan ; If no symbol is found either, the above JMP instruction enters here. ; Three possibilities now remain: we are inserting a new symbol ; definition, we wish to run a program that does not reside on DK:, or, last ; but not least, this really is a bad command. badcm0: call tstee ;Hmmm...are we defining a symbol? bcs 10$ ;Branch if not jmp synsrt ;Go handle symbol otherwise ;Try for a non-SY: "run-by-name"... 10$: mov #buff,r0 ;Save pointer to command line... call adjr0 mov r0,savr0 mov #4,r0 ;"DEV:" prefix on command?... 20$: cmpb (r1)+,#': beq 30$ sob r0,20$ br 50$ 30$: clrb rundev ;Ensure null at end of "RUN " command 40$: mov savr0,r0 ;Go do "run-by-name"... mov #runcmd,r1 jmp subcmd 50$: mov #pthbuf,r0 ;R0 => path data buffer 60$: .getcom ,#cmd ;Get a "DEV:" into command buffer tstb (r0) ;End of path list? beq 70$ ;Branch if so inc r0 ;Skip the comma 70$: push r0 ;Save R0 (points at next "DEV:") mov r1,r0 ;Get length of device mnemonic... call len add r5,r1 ;Concatenate command to "DEV:"... .getcom savr0 clrb 6(r1) ;Ensure 6-char name mov sp,spsav ;See if there is a file out there called .csigen dspace,#dext,#cmd ;"DEV:command.SAV"... bcc 80$ ;Branch if there is mov spsav,sp ;Restore the stack pointer pop r0 ;Restore R0 (points at next "DEV:" in path) tstb (r0) ;End of the path? beq badcmx ;Go complain if so br 60$ ;Otherwise, go try next "DEV:" 80$: .close #3 ;Hand-holding mov spsav,sp ;Clean up the stack... pop r0 mov #cmd,r1 ;Build "RUN DEV:" string... call tstdmn .getcom r1,#rundev br 40$ ;Go do "run-by-name" badcmx: tst chanto ;Are we gonna CHAIN? bne chanr ;Branch if so mov #mbad,r5 ;Nope, "Invalid Command"... br pbuff ; Traps for ambiguous commands come here: .sbttl ambcom ambcom:: call tstee ;Defining a symbol? bcc synsrt ;Branch if so mov #mamb,r5 ;"Ambiguous Command"... pbuff: mov #buff,r4 br ferrx ;Go do "fatal" error exit .sbttl chanr ; This code is executed if UCL can not identify the command and if the CHAIN ; command is in effect. chanr:: .csispc #scrach,#dext,#chanto ;convert filename to RAD50, lazy way mov #4,r0 ;Move filename to chain area... mov #scrach+36,r1 mov #chname,r2 10$: mov (r1)+,(r2)+ sob r0,10$ mov savr0,r1 ;R1 => Original input text mov #cmdbuf,r2 ;R2 => chain text data area 20$: movb (r1)+,(r2)+ ;Move text to data area... beq 30$ inc r0 br 20$ 30$: mov r0,@#bytcnt ;Put length of text string in data area mov #1000,sp ;Reset stack pointer .sreset ;Make sure every little thing is cleaned up .chain ;Bye! .sbttl EXIT FOR "SEVERE" ERRORS ; ======================== ; "Severe" errors handled here... ; ; On entry, ; R5 => message text ; R4 => any additional text (=0 if none) ; ; Message issued is "?UCL-F- ; ; If UCL was invoked by RT-11, a hard exit is executed with the "severe ; error" bit set. ; ; If UCL was run directly, FERRX returns to the program mainline. ferrx:: .print #muclf ;"?UCL-F-" mov r5,r0 ;R5 => error message .print ;Print it mov r4,r0 ;R4 => additional text beq 10$ ;Branch if none .print ;Print text 10$: bit #runc,status ;Were we RUN? beq 20$ ;Branch if not mov #776,sp ;Force a return to the mainline return ; if we were... 20$: bisb #sever$,@#userrb ;Set error bit .settop #0 ; and do a hard exit... clr r0 .exit .sbttl SYMBOL PROCESSING ROUTINES ; ========================== .sbttl synsrt ; SYNSRT inserts a new definition into the tables. ; On entry, R0 is pointing at the definition string in the input buffer, BUFF ; (i.e., just after the "==") and R1 points at the command buffer, CMD which ; contains the string representing the symbol. synsrt:: tst sdsatl ;Test last entry in SDS table beq 20$ ;Branch if room available 10$: mov #synrm,r5 ;"No Room" and go exit... clr r4 jmp ferrx 20$: call adjr0 ;Skip any leading blanks in definition tstb (r0) ;Null definition string? bne 30$ ;Branch if not .gtlin #buff,#sydefq ;"Symbol Definition?" mov #buff,r0 ;R0 => input buffer (contains definition) br 20$ ;Go check definition just entered 30$: mov #sdsbfr,r2 ;R2 => SDS buffer mov #nsyms,r3 ;R3 = max. no. symbols 40$: cmpb (r2),#377 ;Is this slot available? beq 50$ ;Branch if so add #lsyms,r2 ;R2 => next slot sob r3,40$ ;Go check next slot br 10$ ;Oops! no room (shouldn't get here) 50$: push ;Save addresses of slot to fill and definition mov #lcccc,r3 ;R3 = max. symbol length call ccopy ;Copy symbol to buffer slot inc r3 ; and pad with nulls... 60$: clrb (r2)+ sob r3,60$ pop r1 ;R1 => definition string (old R0 value) mov #lssss,r3 ;r3 = max. def. string length call ccopy ;Copy def. string to slot inc r3 ; and pad with nulls... 70$: clrb (r2)+ sob r3,70$ ;OK, now we sort the address table so ; it points in alphabetical order... pop r1 ;R1 => slot address (old R2 value) mov #sdsate,r4 ;R4 => end of SDS address table mov #nsyms,r5 ;R5 = max. no. entries 80$: tst -(r4) ;Find last non-zero entry... bne 90$ sob r5,80$ mov r1,(r4) ;Must be empty... br wtstbl 90$: mov (r4),r2 ;Point at symbol string 100$: call scomp ;Compare new one with it... tst r3 bgt 110$ ;Branch if new > this one mov (r4),2(r4) ;Move this address down one mov -(r4),r2 ;Point at next address up sob r5,100$ ; and go do another comparison 110$: mov r1,2(r4) ;Insert address of new definition .sbttl wtstbl ; Here we write the revised symbol definition blocks into UCL.SAV... wtstbl:: mov #1,wblok ;Set initial block no. mov #sdsat,wbufa ;Set address of initial block to write mov #nbloks,r5 ;R5 = no. blocks to write 20$: .writw #area,#17 ;Write a block bcs 30$ ;Branch on error inc wblok ;Bump block no. add #512.,wbufa ;Bump buffer address sob r5,20$ return ;Return 30$: mov #wtfail,r5 ;"Output Error..." clr r4 ; and exit... jmp ferrx .sbttl syproc ; This section processes a symbol that has been found to exist in the symbol ; definition string buffer area. ; It either, ; 1) uses the definition string for the symbol and the remainder of the ; original input string to build a command sequence and pass it to ; RT-11 for execution, or ; 2) detects that this is a redefinition of an existing symbol, and ; takes the appropriate action to update the definition. syproc:: call tstee ;Symbol definition? bcc syrepl ;Branch if so push r0 ;Save R0 call adjr0 ;Skip leading blanks in input string mov r0,r4 ;Set R4 = R0 clr r0 ;Set R0 = 0 (counts no. char. copied) mov sdsat(r5),r1 ;R1 => sym. def. string buffer add #,r1 ;R1 => part to substitute cmpb (r1),#'_ ;Definition flagged for "execute-immediate"? bne 5$ ;Branch if not bis #ximm,status ;Flag it if so inc r1 ;Adjust pointer 5$: mov #chbuf,r2 ;R2 => "chain buffer" mov #chbufl-1,r3 ;R3 = max. # char. in final command string(s) clr r5 ;Set R5 = 0 (counts no. of argument inserts) 10$: call scopy ;Copy/build a command line tst r3 ;Hit byte limit? beq 20$ ;Branch if so tstb -1(r1) ;Done? bne 10$ ;Branch if not pop r1 ;Get R1 off stack (old R0) tst r5 ;Used input string remainder yet? bne 20$ ;Branch if so tstb -(r2) ;Adjust R2 call ccopy ;Copy input string stuff 20$: clrb (r2) ;Ensure trailing null... inc r0 mov #chbuf,r1 ;R1 => "chain buffer" bit #ximm,status ;"Execute immediate"? bne 30$ ;Branch if so jmp setcm0 ;Go execute result of your labors... 30$: mov #buff,r0 ;R0 => UCL input buffer 40$: movb (r1)+,(r0)+ ;Move fleshed-out command into input bne 40$ ; buffer... return ;Return to mainline .sbttl syrepl syrepl:: tst r3 ;Exact match? beq 10$ ;Branch if so jmp synsrt ;Go do an insert otherwise 10$: call adjr0 ;Skip leading blanks tstb (r0) ;Null definition? bne 20$ ;Branch if not jmp er1sy0 ;Must want to erase it... 20$: mov r0,r1 ;R1 => new substitution string mov sdsat(r5),r2 ;Make R2 => destination for new sub. string... add #,r2 mov #lssss,r3 ;R3 = max. string length call ccopy ;Copy the string inc r3 ;Pad it with nulls... 30$: clrb (r2)+ sob r3,30$ call wtstbl ;Go write out changes.. mov #reswrn,wrnmad ;"Replaced Existing Symbol"... call wrngm bit #runc,status ;Were we run? beq 40$ ;Branch if so bisb #warn$,@#userrb ;Set warning bit in user error byte 40$: return .sbttl scopy ; This routine copies/builds a command line to the "chain buffer". This is ; done by copying a symbol definition string until a null byte or a "\" is ; encountered. Any time a "^" is encountered during the copying process, the ; "argument-part" of the original UCL input string is inserted at that point. ; Register use is as follows: ; ; R0 is incremented by the number of bytes copied ; R1 points at the symbol definition string ; R2 points at the output buffer ; R3 on entry, contains the maximum number of bytes to copy ; R4 points at the argument string to be inserted ; R5 is incremented every time an argument is inserted scopy: 10$: cmpb (r1),#'\ ;"\" encountered? bne 30$ ;Branch if not tst r3 ;Copy count exhausted? beq 20$ ;Branch if so clrb (r2)+ ;Insert a null byte dec r3 ;Adjust copy counts... inc r0 inc r1 ;Adjust input pointer 20$: return 30$: cmpb (r1),#'^ ;"insert argument" flag encountered? bne 40$ ;Branch if not push r1 ;Save R1 mov r4,r1 ;Make R1 => argument string call ccopy ;Insert it pop r1 ;Restore R1 inc r1 ;Adjust input pointer inc r5 ;Bump insert counter br 10$ ;Go look at next character 40$: tst r3 ;Copy count OK? beq 50$ ;Branch if done movb (r1)+,(r2)+ ;Copy a character inc r0 ;Adjust counters... dec r3 beq 50$ ;Branch if done tstb -1(r1) ;Did we just copy a null? bne 10$ ;If not, go get next 50$: return .sbttl tstee ; This routine tests for the presence of an "==" sequence in a string pointed ; to by R0. If it tests true, the carry is cleared and R0 points at the byte ; following the "==". If false, the carry bit is set and R0 is unchanged. ; Note that the test fails if there are any intervening non-blank characters. ; ; Tests are also made on the lengths of the symbol name (pointed to by R1) ; and the symbol definition. A warning message is issued if the symbol name ; or definition is too long. tstee: push r0 ;Save R0 call adjr0 ;Skip any blanks cmpb (r0)+,#'= ;"="? bne 10$ ;Branch if not cmpb (r0)+,#'= ;Another "="? beq 20$ ;Branch if so 10$: pop r0 ;Restore R0 sec ;Set carry return 20$: mov r5,(sp) ;Save R5 push r0 ;Save R0 mov r1,r0 ;R0 => symbol name call len ;Check length... cmp r5,#lcccc ble 30$ mov #trswrn,wrnmad ;"Truncating Symbol Name..." call wrngm 30$: pop r0 ;Restore R0 call len ;Check length of definition... cmp r5,#lssss ble 40$ mov #trdwrn,wrnmad ;"Truncating Symbol Definition..." call wrngm 40$: pop r5 ;Restore R5 clc ;Clear carry return .sbttl scomp ; This routine compares two strings. ; On entry, ; R1 => string 1 ; R2 => string 2 ; On return, ; R3 = -1, s1 < s2 ; 0, s1 = s2 ; 1, s1 > s2 scomp: push ;Save r2,r1... clr r3 ;Assume strings equal 10$: cmpb (r1)+,(r2)+ ;Compare a pair of characters blt 30$ ;Branch if 1st smaller bgt 40$ ;Branch if 1st larger tstb -1(r1) ;Past end of 1st string? bne 10$ ;Go look at next character if not 20$: pop ;Restore r1,r2... return 30$: dec r3 ;Flag 1st < 2nd br 20$ 40$: inc r3 ;Flag 1st > 2nd br 20$ .sbttl UTILITY ROUTINES FOR PROCESSING COMMAND LINES ; ============================================= .sbttl clencm ; Routine to clean up a command (zaps asterisk and terminating colon)... ; This routine scans a command from left to right and removes the first ; embedded asterisk that is encountered. It will also, if found, delete ; a trailing colon. This routine is used to provide compatibility with ; the UCL distributed with RT-11 V5.1. ; On entry, R1 points at the command string to be cleaned up. No registers ; are disturbed by this routine. clencm: push ;Save R0, R1 10$: tstb (r1) ;Null byte? beq 30$ ;Go quit if it is cmpb (r1)+,#'* ;"*" encountered? bne 10$ ;Branch if not mov r1,r0 ;Point R0 at position of "*"... dec r0 20$: movb (r1)+,(r0)+ ;Shift rest of command left 1 byte... bne 20$ tst -(r1) ;Point R1 at current terminating null 30$: cmpb -(r1),#': ;Is last character a ":"? bne 40$ ;Branch if not clrb (r1) ;Zap it if so 40$: pop ;Restore R1, R0 return .sbttl swtchs ; Routine to process switches... ; This routine uses the GETCOM/CSCAN calling sequence to detect and report on ; any switches that might be present in a command line. ; ; On entry: ; ; R0 points into the input buffer, immediately after the command or ; argument that may be followed by some switches. ; ; R4 points at an argument list: ; ; _________ ; R4 => | SRSAL | ; --------- ; | SEAL | ; --------- ; | SSBL | ; --------- ; | STXAL | ; --------- ; ; SRSAL is the address of the beginning of a switch reference string ; address list. This list is similar to the RSAL for commands. It ; is a list of pointers to the ASCIZ strings representing the valid ; switches. As with commands, these addresses are sorted in alpha- ; betical order by the strings that they refer to. ; ; SEAL is the address of a switch execution address list, sorted by ; the referenced switch strings. This list contains the addresses of ; the routines that will be executed when a given switch is found. ; ; SSBL is the address of the beginning of a switch status bit list. ; This list is a series of contiguous words containing the bit(s) that ; should be set in the switch status word SWSTAT if a given ; corresponding switch is detected and these words should be in ; alphabetical order by their referenced switches. ; ; STXAL is the address of an optional switch text address list. It uses ; the same ordering as the above lists and contains pointers to ASCIZ ; strings that represent the output switch text to be generated by the ; corresponding switch handing routines. For example, a /STRIP switch ; might generate the text "/S" in the switch text buffer when building ; an output command string. ; ; ; On return: ; ; R0 will be pointing at the next byte past the last detected switch. ; ; R1 - R4 will be unchanged ; ; R5 will contain one of the following values: ; ; -8 invalid switch option ; -6 conflicting switches ; -4 invalid switch ; -2 ambiguous switch ; 0 no errors ; ; SWSTAT will contain the status bit(s) for any detected switches. ; ; The ERASE and RNO command routines contain examples of switch processing. swtchs:: clr swstat ;Clear any old switch status bits mov #stxbuf,stxbp ;Reset pointer into STXBUF push ;Save R1 - R4... 10$: push r4 mov #swbuf,r1 ;R1 => switch buffer call adjr0 ;Skip leading blanks cmpb (r0),#'/ ;Find a switch? bne 20$ ;Branch if not... inc r0 ;Extract the switch string... .getcom ,#swbuf,#tmtblc .cscan ,(r4) ;Try to identify it tst r5 ;Error? bmi 30$ ;Branch if so pop r4 ;Restore R4 (points at argument list) mov 2(r4),r3 ;R3 => switch execution addr. list add r5,r3 ;R3 => addr. of switch routine to execute call @(r3) ;Go process switch bcc 10$ ;Go look for another switch if no errors mov #-6,r5 ;Assume conflicting switches bit #cnswer,swstat ; and test for this bne 40$ ; and branch if so mov #-10,r5 ;Otherwise, it must be invalid switch option br 40$ ;Go quit 20$: clr r5 ;Clear R5 (no errors) 30$: pop r4 ;Restore R4 - R1... 40$: pop return ; The following is a selection of switch handling routines. They are used by ; ERASE and RNO and, as they handle fairly common situations, could be used ; by any new hard-wired commands that you might add. ; ; On entry to any switch routine: ; ; R0 points at the byte in the input buffer immediately following the ; switch string being processed. Note that this means that, if the ; switch takes an argument, R0 will be pointing at the beginning of ; the argument string (example: "/OUT:MYFILE; R0 points at ":"). ; ; R4 points at the argument list (described at beginning of SWTCHS ; routine). ; ; R5 contains the current offset into the switch Execution Address ; List and, thus, the proper offset for locating the appropriate ; bit mask in SSBL and the output switch text in STXAL. ; ; On return: ; ; Any appropriate status bits should be set in SWSTAT. Note that ; if an error flag bit is set (conflicting switch or invalid option), ; SWTCHS will set the appropriate offset in R5. ; ; The carry bit should be set if an error occurred and cleared ; otherwise. ; ; If the routine processed a switch option, R0 should be pointing at ; the next character past it in the input buffer. R0 should be ; undisturbed otherwise. .sbttl swbits ; SWBITS is used to set the appropriate bits in SWSTAT. swbits: push r5 ;Save R5 add 4(r4),r5 ;R5 => bit mask bis (r5),swstat ;Set switch status bit(s) pop r5 ;Restore R5 clc ;Clear carry return ;Return .sbttl prntsr ; /PRINTER switch routine... prntsr: push ;Save R0 and R1... .getcom #lpnam,#outfnm ;Move "LP:" to buffer pop ;Restore R1 and R0... jmp swbits ;Go finish up (set SWSTAT bit & clear carry) lpnam: .asciz /LP:/ .even .sbttl termsr ; /TERMINAL switch routine... termsr: push ;Save R0 and R1... .getcom #ttnam,#outfnm ;Move "TT:" to buffer pop ;Restore R1 and R0... jmp swbits ;Go finish up (set SWSTAT bit & clear carry) ttnam: .asciz /TT:/ .even .sbttl outsr ; /OUTPUT:filename switch... outsr: call swbits ;Set status cmpb (r0),#': ;Pointing at ":"? beq 10$ ;Branch if so bis #badopt,swstat ;Error: set bad option flag, sec ; set carry, return ; and return 10$: push r1 ;Save R1 inc r0 ;Point at filename .getcom ,#outfnm ;Put filename in buffer pop r1 ;Restore R1 clc ;Clear carry return .sbttl stxotx ; This is a general routine for switches that map: ; "/input-switch-text:option-text" => "/output-switch-text:option-text" ; Example: "/END:7" => "/E:7." ; The mapped string is appended to any existing text in STXBUF. Note that ; a decimal point is appended to numeric options. stxotx: call gstxp ;R1 => output switch text call ctstxb ;Copy to STXBUF call getopt ;Get any option stuff bcc 20$ ;Branch if there is some dec stxbp ;Zap extraneous ":" in output... clrb @stxbp 10$: jmp swbits ;Go update switch status 20$: push r1 ;Save R1 (points at option text) 30$: cmpb (r1),#'0 ;See if option text is entirely numeric... blt 40$ cmpb (r1)+,#'9 bgt 40$ tstb (r1) bne 30$ movb #'.,(r1)+ ;Append decimal point... clrb (r1) 40$: pop r1 ;Restore R1 call ctstxb ;Append option text br 10$ ;Go quit .sbttl stxoly ; General routine for switches that map: ; "/input-switch-text" => "/output-switch-text" ; Example: "/NOUNDERLINE" => "/U:N" stxoly: call gstxp ;R1 => output switch text call ctstxb ;Copy to STXBUF call swbits ;Update switch status call getopt ;Test for and skip any option stuff bcs 10$ ;Branch if none bis #badopt,swstat ;Error: shouldn't be any options... sec return 10$: clc ;Return with no errors return .sbttl gstxp ; This routine can be used in a switch handling routine to point R1 ; at the appropriate output switch text. gstxp: mov 6(r4),r1 ;R1 => STX address list add r5,r1 ;R1 => STX address mov (r1),r1 ;R1 => STX return .sbttl ctstxb ; This routine appends output switch text to the contents of the switch ; text buffer, STXBUF. ; ; On entry, ; R1 => switch text to be appended. ; On return, ; The text is appended to the current contents of STXBUF, ; the pointer STXBP is updated. ; The contents of R0 and R2 - R5 are undisturbed. ctstxb: push ;Save R0, R2, R3... mov #80.,r3 ;Use CCOPY to append the text... mov stxbp,r2 call ccopy clrb (r2) ;Insert null byte mov r2,stxbp ;Save current last character position pop ;Restore R3, R2, R0... return .sbttl getopt ; This routine extracts the text for an option from the input buffer ; and puts it in the option buffer, OPBUF. ; ; On entry, it is assumed that R0 points at the beginning of some option ; text in the input buffer. ; ; On return, R0 will point at the character immediately following the option ; text in the input buffer, a copy of the option text will be in the buffer ; OPBUF, R1 will be pointing at OPBUF, and the carry bit will be cleared. ; If no option is located, R0 and R1 will be undisturbed and the carry will ; be set. getopt: call adjr0 ;Skip leading blanks cmpb (r0),#': ;Pointing at ":"? beq 10$ ;Branch if so sec ;No option, set carry and return ; return 10$: inc r0 ;Point at option text .getcom ,#opbuf ;Copy option text to buffer clc ;Clear carry and return ; return ; Here are some standard switch error traps for command routines that ; want to use 'em... .sbttl badopx badopx: mov #mbadop,r5 ;"Invalid Option..." br cnfsw0 .sbttl cnfswx cnfswx: mov #mcnfsw,r5 ;"Conflicting Switches..." cnfsw0: clr r4 jmp ferrx .sbttl badswx badswx: mov #mbadsw,r5 ;"Invalid Switch..." br ambsw0 .sbttl ambswx ambswx: mov #mambsw,r5 ;"Ambiguous Switch..." ambsw0: mov #swbuf,r4 jmp ferrx .sbttl setcmd, setcm0 ; Routine to pass a command string or strings to RT-11... ; ; This routine passes one or more ASCIZ strings to RT-11 for execution. ; On entry, R1 points at a word containing the number of bytes in the ; string(s). It is assumed that the ASCIZ stuff immediately follows the ; byte count (i.e., 2 + address in R1 = address of text to be passed). ; At entry SETCM0, R0 should contain the byte count, and R1 the text address. setcmd: mov (r1)+,r0 ;Put byte count in R0 cmp r0,#chbufl ;R0 less than or equal to max? ble setcm0 ;Branch if so mov #chbufl,r0 ;If not, set to max setcm0: bit #dspla,status ;Display bit set? beq 5$ ;Branch if not call dsplst 5$: mov #bytcnt,r2 ;R2 => syscom area mov r0,(r2)+ ;Store byte count mov #1000,sp ;Reset stack pointer (now we're committed!) 10$: movb (r1)+,(r2)+ ;Move text into syscom... sob r0,10$ bis #spxit$,@#jsw ;Tell RT what we've done .settop #0 ;Do a hard exit... clr r0 .exit .sbttl subcmd ; Routine to substitute a UCL command for an RT command (presumably)... ; ; What this routine actually does is copy the string pointed to by R1 into ; buffer CHBUF followed by the string pointed to by R0. It then causes this ; concatenated string to be passed to RT-11 as a command string. ; ; Note that, on entry to a CSE routine, R0 points at the remainder of the ; original input string following the command that UCL has parsed-out and ; interpreted. For example, this would allow a CSE routine for a BUILD ; command to change the input string "BUILD/MAC MYPROG" ; to "EXECUTE/NORUN/MAC MYPROG" ; and then cause it to be executed by simply pointing R1 at the .ASCIZ string ; for "EXECUTE/NORUN" and calling or jumping to SUBCMD. subcmd: push r0 ;Save contents of R0 on stack clr r0 ;Clear R0 mov #chbuf,r2 ;R2 => CHBUF mov #chbufl-1,r3 ;Put max byte count in R3 call ccopy ;Copy first part of string into CHBUF pop r1 ;Get address of 2nd part of string off stack call ccopy ;Stuff 2nd string into CHBUF clrb (r2) ;Terminate with null byte... inc r0 mov #chbuf,r1 ;Point R1 at concatenated string and br setcm0 ; go pass it to RT-11 as a command string .sbttl ccopy, ccopy0 ; Command string copy routine... ; ; On entry, R1 points at the string to be copied ; R2 points at the destination for the string ; R3 contains the maximum allowable number of bytes to copy ; ; R0 is incremented by the number of bytes copied ; R3 is decremented by the same amount ; ; Copying is terminated by the detection of a null byte in the input string ; (the null byte is NOT copied!!!) or if the value in R3 decrements to zero. ccopy: tstb (r1) ;Null byte? bne 10$ ;Nope... return ;Yep, return 10$: movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count dec r3 ;Decrement copy limit count bne ccopy ;If R3 > 0, try for another return ; otherwise, return ; Command string copy with null (CCOPY with null terminator)... ; ; This routine works just like CCOPY above except that it copies the ; terminator byte (null) as well. The null is not copied if this would exceed ; the "maximum allowable number of bytes to copy" value in R3. ccopy0: call ccopy ;Copy the string (less null) tst r3 ;Max. copy count exhausted? bgt 10$ ;Branch if not return 10$: movb (r1)+,(r2)+ ;Copy the null inc r0 ;Adjust byte count dec r3 ;Adjust copy counter return .sbttl adjr0 ; Routine to skip leading spaces... ; ; This routine adjusts the buffer pointer (assumed to be R0) to point at the ; first non-blank character encountered. adjr0: tstb @r0 ;Pointing at a null? bne 10$ ;Branch if not return 10$: cmpb (r0)+,#space ;Blank? beq adjr0 ;Branch if so dec r0 ;Adjust the pointer and return ; quit .sbttl len ; Routine to return the length of a string... ; ; On entry, R0 points at the string to be inspected -- it is assumed to be ; terminated with a null. ; ; On return, R0 is unchanged and R5 contains the number of bytes in the ; string. len: push r0 ;Save R0 clr r5 ;Clear R5 10$: tstb (r0)+ ;Null? beq 20$ ;Branch if so inc r5 ;Bump byte count br 10$ ;Go look at next one 20$: pop r0 ;Restore R0 return .sbttl wrngm ; Routine to issue warning messages... ; ; Prints "?UCL-W-". Address of should be in location ; WRNMAD. If RUNC bit not set in STATUS, also sets WARN$ bit in user ; error byte. wrngm: push r0 ;Save R0 .print #muclw ;"?UCL-W-" .print wrnmad ; pop r0 ;Restore R0 bit #runc,status ;Were we RUN? beq 10$ ;Branch if not bisb #warn$,@#userrb ;Set "warning" bit in user error byte 10$: return .sbttl UCL DATA AREA ; ============= .sbttl Buffers, Registers, Arguments dspace: .word 0 ;Address of handler load area spsav: .word 0 ;Save area for stack pointer savr0: .word 0 ;Save area for BUFF pointer status: .word 0 ;Program status word swstat: .word 0 ;Switch status word wrnmad: .word 0 ;Address of warning message for WRNGM buff:: .blkb 184. ;Input buffer cmd:: .blkb 134. ;Buffer for command parsing swbuf:: .blkb 82. ;Buffer for switch parsing opbuf:: .blkb 82. ;Buffer for option parsing stxbp:: .word stxbuf ;Pointer to next byte in STXBUF stxbuf: .blkb 82. ;Buffer for output switch text outfnm: .blkb 42. ;Buffer for output file name chbuf: .blkb 182. ;Intermediate "chain exit" buffer scrach: .blkw 45. ;Scratch area area: .word 0 ;Area for .WRITW programmed request... wblok: .word 0 wbufa: .word 0 .word 256. .word 0 dext: .rad50 "SAV" ;Default extension for .CSIGEN call .word 0,0,0 .sbttl ASCII Stuff .nlist bex prompt: .ascii /UCL> /<200> ;Prompt for .GTLIN request runcmd: .ascii /RUN / rundev: .blkb 5 muclw: .ascii /?UCL-W-/<200> muclf: .ascii /?UCL-F-/<200> mbadop: .asciz /Invalid Or Missing Option/ mcnfsw: .asciz /Conflicting Switches/ mbad: .ascii /Invalid Command /<200> mamb: .ascii /Ambiguous Command /<200> synrm: .asciz /Symbol Definition Table Full/ sydefq: .ascii /Symbol Definition? /<200> wtfail: .asciz /Output Error While Updating Symbol Blocks/ mbadrg: .ascii /Invalid Argument /<200> mbadsw: .ascii /Invalid Switch /<200> mambsw: .ascii /Ambiguous Switch /<200> trswrn: .asciz /Truncating Symbol Name To 6 Characters/ trdwrn: .asciz /Truncating Symbol Definition To 72 Characters/ reswrn: .asciz /Replaced Existing Symbol/ toqry: .ascii /To? /<200> millfn: .ascii /Illegal File Name /<200> mfilnf: .ascii /File Not Found /<200> mnroom: .ascii /Not Enough Room For File /<200> mpfilf: .ascii /Protected File Already Exists /<200> rclerr: .ascii /Read Error /<200> strerr: .ascii /Write Error /<200> vrerr: .ascii /Wrong Version Of UCL /<200> dspqry: .ascii /Command? /<200> eraqry: .asciz /Erase All Symbols/ ersqry: .ascii /Erase Symbol /<200> rusure: .ascii /Are You Sure? /<200> er1qry: .ascii /Symbol? /<200> erawrn: .ascii /Erased Symbol /<200> er1nfm: .ascii /Symbol Not Found /<200> er1amm: .ascii /Ambiguous Symbol /<200> listcm: .asciz /Valid Commands:/ listpm: .asciz /"Run-by-name" Path:/ listsm: .asciz /Current Symbols:/ listsn: .asciz /(None Defined)/ listse: .asciz / Entries Remaining/ listxm: .ascii /CHAIN In Effect To /<200> listx0: .asciz /No CHAIN In Effect/ dkcoln: .asciz /DK:/ dmnqry: .ascii /Device List? /<200> dmnerr: .asciz /Illegal Device/ filqry: .ascii /File? /<200> crlf: .byte 0 .list bex .even