.sbttl INTRODUCTION .rem ` 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 or later, and TSX-Plus V4.1 or later. It contains full support for the UCL/UCF/UCI facilities in these monitors. It is upward compatible with the UCL program distributed with RT-11 V5.2 with the following exceptions: 1. 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. 2. 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. 3. In addition, it is different from the TSX-Plus V5.1 TSXUCL program in that all symbols are "global" rather than "local". It also does not "forget" symbol definitions after logoff. 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 or ERASE *. 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 file. You can do this in either a "binary" or "journaling" mode. Journal files can be edited. 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 DISPLAY command can also be used to print pre-defined ASCII strings at 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. 10. You may, in addition to the symbol definitions, list other program parameters, and list output may be directed to devices/files other than the console. 11. UCL+ can be employed, via the UCI_MODE command, as a User Command Interpreter (UCI). This functionality was added with UCL+ V7 to take advantage of the UCI linkage available in TSX+ and Share-11. 12. You may dynamically redefine the prompt string issued by UCL+. 13. A "quoting" facility is available to override the effect of "operator" characters. 14. In order to allow more complex command definitions, UCL+ supports the parsing of argument strings into as many as nine sub-strings. 15. A CI "handleroid" is included which allows you, under RT-11 V5.2 or later, to control and display the action of the various Command Language Interpreters (CLI's). For example, SET CI UCF turns on User Commands First support. 16. A special version of UCL+ is available for V5.2 or later RT-11 XM monitors. This version is very fast, and uses only about 500 decimal words of low memory. 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 (NOTE: In UCI mode, UCL+ attempts to process the command line before passing it to the monitor.) 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. Two advanced features, "quoting" and "argument string parsing", were added starting with V07.50. Preceeding an "operator" such as "^" with the quote character ("|") causes it to be treated as normal text. UCL+ can also break the argument part of a command string into as many as nine sub-strings (sub- strings are assumed to be delineated by spaces). Insertion of these sub- strings is controlled by suffixing the insert operator ("^") with a number from 1 through 9 -- thus, the third substring is denoted with a "^3" sequence. ` .sbttl ADDRESSES, VALUES, DEFINITIONS ; ============================== .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 tsxsiz = 56 ;SETSIZ location for TSX+ chname = 500 ;CHAIN program name in syscom area bytcnt = 510 ;Byte count in syscom area cmdbuf = 512 ;Command text in syscom area sysver = 276 ;Offset to RT-11 version/release data config = 300 ;Offset to RMON configuration word sysgen = 372 ;Offset to RMON sysgen features word $inddv = 426 ;RMON fixed offset pointer to INDDEV warn$ = 2 ;"Warning" bit in user error byte sever$ = 10 ;"Severe error" bit in user error byte edit$ = 20 ;SL disable bit in JSW spxit$ = 40 ;JSW bit for special chain exit ovly$ = 1000 ;Overlay bit in JSW kt11$ = 10000 ;XM bit in configuration word ttlc$ = 40000 ;Lower case bit in JSW tsxp$ = 100000 ;TSX+ bit in sysgen features word and STATUS + ; CLI enabled bits in CLIFLG byte (invalid prior to RT-11 V5.2)... ucfon = 1 dclon = 2 cclon = 4 uclon = 10 ucfxit = 200 ;When set, UCF is passing line to KMON ; CLI type values in CLITYP byte (invalid prior to RT-11 V5.2)... ucf$cl = 0 ;Running as UCF dcl$cl = 1 ;Run from DCL ccl$cl = 2 ;Run from CCL ucl$cl = 3 ;Running as UCL .sbttl . Status Bits For STATUS (+) and PFLAGS (*) ; STATUS... runc = 1 ;UCL invoked by RUN command + ximm = 2 ;Execute-immediate flag + dspla = 4 ;DISPLAY command encountered + dsplx = 10 ;DISPLAY/EXECUTE encountered + odopn = 20 ;A device/file is open for LIST output + hwamb = 40 ;Ambiguous command after "hard-wired" search + ; 100 RESERVED ucimd = 200 ;UCI_MODE in effect +* ucfmd = 400 ;Running as UCF + jrnli = 1000 ;Journal input active + jrnlo = 2000 ;Journal output active + jrnlq = 4000 ;Do "quiet" journaling + eefnd = 10000 ;Input string contains a symbol definition operator ("==") + ; 20000 RESERVED + rtv5.2 = 40000 ;Running under RT-11 V5.2 + ;tsxp$ = 100000 ;TSX+ bit in sysgen features word and STATUS + <= NOTE ; PFLAGS... uclxm = 1 ;Special XM version of UCL * ;ucimd = 200 ;UCI_MODE in effect +* <= NOTE .sbttl . Status Bits For PLINE Routine PLSTAT Status Word plprg = 1 ;Purge channel on completion plnf0 = 200 ;/NOFORM0 in effect plprn = 100000 ;/PRINT in effect .sbttl . Status Bits For Command Execution Status cxdsp = 200 ;Command is potentially DISPLAYable cxnuc = 100000 ;Command-line text may not be "memorized" .sbttl . Switch Bit Definitions all = 1 ;/ALL noq = 2 ;/NOQUERY qry = 4 ;/QUERY out = 40 ;/OUTPUT prn = 100 ;/PRINTER trm = 200 ;/TERMINAL exe = 400 ;/EXECUTE nex = 1000 ;/NOEXECUTE fm0 = 2000 ;/FORM0 nf0 = 4000 ;/NOFORM0 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" buffsz = chbufl + 2 ;Size of input line buffer lf = 012 ;Linefeed cr = 015 ;Carriage Return space = 040 ;Space bit7 = 200 bit15 = 100000 .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$ ; Put the number of K words required by UCL+ in location 56. If run under ; TSX-Plus, this will prevent unnecessary swapping. .if eq ucl$xm . = tsxsiz .word / 4000 .endc .sbttl SYMBOL/STATUS BLOCKS ; ==================== .psect ssblks ; These buffers will form blocks 1 - 18 of the file's SAV image (blocks 3 - ; 20 for the XM version). The first 112 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? ...it ; also makes them list nicely). The remaining 111 x 80 byte area contains the ; buffers for 111 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 rls,vzn ;Release, version pthbuf: .asciz /DK:/ ;Path list buffer .blkw 39. chanto: .word 0 ;Name of program to chain to .blkw 7 prompt: .ascii /UCL> /<200> ;Prompt string .byte 0,0,0 pflags: ;"Permanent" flags byte .if eq ucl$xm .byte 0 .iff .byte uclxm .endc ssbsiz = . - sdsat ;Pad out to an even block... filler = - rzrvd: .blkb filler .sbttl PROGRAM MAINLINE ; ================ .psect main vrshun: vrstr ;ID string goes here... ; 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 #buff,r2 ;R2=>input buffer clrb (r2) ;Initialize it mov @#bytcnt,r0 ;Get no. of bytes in command line beq 20$ ;If none, just go check context mov #cmdbuf,r1 ;R1=>command line from RT-11 tstb (r1) ;If null line, check context... beq 20$ 10$: movb (r1)+,(r2)+ ;Move command line into buffer... sob r0,10$ clrb (r2) 20$: call contxt ;Do various run-time context checks tstb buff ;If we got text from the chain area, bne 50$ ; go process it 30$: .rctrlo ;Ask for a command line... .gtlin #buff,#prompt bis #runc,status ;Set "we been run" flag mov #buff,r0 ;Anything entered?... mov r0,r1 call adjr0 tstb (r0) beq 30$ ;Nope, ask again 40$: movb (r0)+,(r1)+ ;Ensure leading blanks squeezed out... bne 40$ 50$: bic #ximm,status ;Clear "execute-immediate" flag call qtproc ;Do quoting; make buffer copy for symbol proc .getcom #buff,#cmd ;Get command into command buffer... call tstsho ;Handle possible V5.2 "show commands" stuff bcs 70$ ;Branch if we took care of any call clencm ;Zap any "other-UCL-style" stuff .if ne uci$c call ucitst ;Handle any UCI_MODE arrangements .endc .cscan ,#rsalst ;Look for a match call @cealst(r5) ;Execute the indicated routine bit #jrnli,status ;Journaling active? beq 60$ ;Branch if not .gtrec #buff ;Get the next input record bcc 50$ ;Go process it if no EOF br 70$ ;Go quit otherwise 60$: bit #ximm,status ;"Execute-immediate" flag set? bne 50$ ;Branch if so 70$: bit #runc,status ;Were we RUN? bne 30$ ;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) ; 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 chaining 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: push r0 ;Save pointer to command line... mov #buff,r0 call adjr0 mov r0,savr0 pop r0 bit #eefnd,status ;Hmmm...are we defining a symbol? beq 20$ ;Branch if not 10$: jmp synsrt ;Go handle symbol otherwise 20$: bit #hwamb,status ;Should it actually be ambiguous? bne ambcom ;Branch if so ;Try for a non-SY: "run-by-name"... mov #4,r0 ;"DEV:" prefix on command?... 30$: cmpb (r1)+,#': beq 40$ sob r0,30$ br 60$ 40$: clrb rundev ;Ensure null at end of "RUN " command 50$: mov savr0,r0 ;Go do "run-by-name"... mov #runcmd,r1 jmp subcmd 60$: mov #pthbuf,r0 ;R0 => path data buffer tstb (r0) ;Skip path stuff if null list... ble badcmx 70$: .getcom ,#cmd ;Get a "DEV:" into command buffer tstb (r0) ;End of path list? beq 80$ ;Branch if so inc r0 ;Skip the comma 80$: 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 .serr ;Inhibit abort on monitor errors mov sp,spsav ;See if there is a file out there called .csigen dspace,#dext,#cmd ;"DEV:command.SAV"... mov spsav,sp ;Restore the stack pointer bcc 90$ ;Branch if file found (carry untouched by mov) .herr ;Turn .serr off pop r0 ;Restore R0 (points at next "DEV:" in path) tstb (r0) ;End of the path? beq badcmx ;Go complain if so br 70$ ;Otherwise, go try next "DEV:" 90$: .close #3 ;Hand-holding .herr ;Turn .serr off pop r0 ;Restore R0 (points at next "DEV:" in path) mov #cmd,r1 ;Build "RUN DEV:" string... call tstdmn .getcom r1,#rundev br 50$ ;Go do "run-by-name" badcmx: bit #,status ;UCF/UCI_MODE? beq 10$ ;Go check CHAINing if not mov savr0,r1 ;If UCF/UCI_MODE, set up to pass original line mov #scrach,r0 ; to KMON... clr (r0) jmp subcmd ;And go do it 10$: tst chanto ;Are we gonna CHAIN? bgt chanr ;Branch to chain stuff if so mov #mbad,r5 ;"Invalid Command"... mov savr0,r0 ;R0 => original command string br tsttsx ; Traps for ambiguous commands come here: .sbttl . ambcom ambchw:: bis #hwamb,status ;Set hard-wired ambiguity bit jmp badcom ;Go check symbols ambcom:: bic #hwamb,status ;Clean up status word bit #eefnd,status ;Defining a symbol? bne synsrt ;Branch if so mov #mamb,r5 ;"Ambiguous Command"... mov #buff,r0 tsttsx: bit #runc,status ;Were we RUN? bne 20$ ;Branch if so tst status ;Running under TSX+? bpl 10$ ;Branch if not mov #huh,r1 ;R1 => "?" prefix jmp subcmd ;Let TSX take a look at the command... 10$: bit #ucfmd,status ;Running as UCF? bne badcmx ;Branch if so 20$: mov r0,r4 ;R4 => unrecognized command string br ferrx ;Go do "fatal" error exit... ;Invalid DISPLAY stuff comes here: baddsp:: mov #mbadsp,r5 ;"Invalid DISPLAY Argument"... mov savr0,r4 ;R4 => buffer contents jmp ferrx ;Go complain .sbttl . chanr ; This code is executed if UCL can not identify the command and if the CHAIN ; command is in effect. The CHANR0 entry point is for routines that set up ; their own chaining text (the PASS_ON command, for example). .enabl lsb chanr:: bit #dspla,status ;DISPLAY active? beq 10$ ;Branch if not jmp baddsp 10$: push #bfsav ;Stash address of original input text mov sp,spsav ;Save current stack pointer .csispc #scrach,#dext,#chanto ;convert filename to RAD50, lazy way mov spsav,sp ;Restore stack pointer chanr0: mov #4,r0 ;Move filename to chain area... mov #scrach+36,r1 mov #chname,r2 20$: mov (r1)+,(r2)+ sob r0,20$ pop r1 ;R1 => Original input text mov #cmdbuf,r2 ;R2 => chain text data area 30$: movb (r1)+,(r2)+ ;Move text to data area... beq 40$ inc r0 br 30$ 40$: 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! .dsabl lsb .sbttl EXIT FOR "SEVERE" ERRORS ; ======================== .sbttl . ferrx ; "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:: bic #,status ;Zap any DISPLAY bits .print #muclf ;"?UCL-F-" mov r5,r0 ;R5 => error message .print ;Print it mov r4,r0 ;R4 => additional text bne 10$ ;Branch if we have some mov #crlf,r0 ;Just do a cr/lf otherwise 10$: .print ;Print text 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:: bit #dspla,status ;DISPLAY active? beq 10$ ;Branch if not jmp badcm0 10$: tst sdsatl ;Test last entry in SDS table beq 30$ ;Branch if room available 20$: mov #synrm,r5 ;"No Room" and go exit... clr r4 jmp ferrx 30$: call syfee ;Make R0 point at definition string in BFSAV call adjr0 ;Skip any leading blanks in definition tstb (r0) ;Null definition string? bne 40$ ;Branch if not .gtlin #bfsav,#sydefq ;"Symbol Definition?" mov #bfsav,r0 ;R0 => input buffer (contains definition) br 30$ ;Go check definition just entered 40$: mov #sdsbfr,r2 ;R2 => SDS buffer mov #nsyms,r3 ;R3 = max. no. symbols 50$: cmpb (r2),#377 ;Is this slot available? beq 60$ ;Branch if so add #lsyms,r2 ;R2 => next slot sob r3,50$ ;Go check next slot br 20$ ;Oops! no room (shouldn't get here) 60$: 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... 70$: clrb (r2)+ sob r3,70$ 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... 80$: clrb (r2)+ sob r3,80$ ;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 90$: tst -(r4) ;Find last non-zero entry... bne 100$ sob r5,90$ mov r1,(r4) ;Must be empty... br wtstbl 100$: mov (r4),r2 ;Point at symbol string 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 sub #2,r4 ;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 #blok1,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. .enabl lsb syproc:: bit #eefnd,status ;Symbol definition? bne 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 10$ ;Branch if not bis #ximm,status ;Flag it if so inc r1 ;Adjust pointer 10$: 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) 20$: call scopy ;Copy/build a command line tst r3 ;Hit byte limit? beq 30$ ;Branch if so tstb -1(r1) ;Done? bne 20$ ;Branch if not pop r1 ;Get R1 off stack (old R0) tst r5 ;Used input string remainder yet? bne 30$ ;Branch if so tstb -(r2) ;Adjust R2 call ccopy ;Copy input string stuff 30$: clrb (r2) ;Ensure trailing null mov #chbuf,r1 ;R1 => "chain buffer" bit #dspla,status ;"Display" flag set? bne 40$ ;Branch if so bit #ximm,status ;"Execute immediate"? bne sypxim ;Branch if so 40$: jmp setcm0 ;Go execute result of your labors... sypxim: mov #buff,r0 ;R0 => UCL input buffer 50$: movb (r1)+,(r0)+ ;Move fleshed-out command into input bne 50$ ; buffer... return ;Return to mainline .dsabl lsb .sbttl . syrepl syrepl:: bit #dspla,status ;DISPLAY active? beq 10$ ;Branch if not jmp badcm0 ;Take error exit 10$: tst r3 ;Exact match? beq 20$ ;Branch if so jmp synsrt ;Go do an insert otherwise 20$: call adjr0 ;Skip leading blanks tstb (r0) ;Null definition? bne 30$ ;Branch if not jmp er1sy0 ;Must want to erase it... 30$: call syfee ;Make R0 point at definition string in BFSAV 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... 40$: clrb (r2)+ sob r3,40$ call wtstbl ;Go write out changes.. mov #reswrn,wrnmad ;"Replaced Existing Symbol"... call wrngm bit #runc,status ;Were we run? beq 50$ ;Branch if so bisb #warn$,@#userrb ;Set warning bit in user error byte 50$: return .sbttl . syfee ; SYFEE is used by some of the symbol processing routines to locate the ; beginning of the symbol definition string in BFSAV (buffer containing ; the raw copy of the original input string). syfeet: .asciz "=" ;Terminator table for .getcom syfee: push r1 ;Save R1 .getcom #bfsav,#bfsav,#syfeet ;Make R0 point at "=="... inc r0 ;Make R0 point at second "=" (probably) cmpb (r0)+,#'= ;Check for possible gratuitous quote char. beq 10$ ;Branch if it is a "=" inc r0 ;Compensate for quote operator if not 10$: pop r1 ;Restore R1 call adjr0 ;Skip any leading blanks return ;Quit .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. ; If a two-character string is encountered in the format "^n", where "n" is ; in the range "1" through "9", then a parsed section of the argument string ; is inserted. A space or a null is a terminator for the purposes of string ; parsing (e.g., if the string is "me too", ^1 = "me", and ^2 = "too"). ; 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: call sparse ;Parse the argument string 10$: cmpb (r1),#'| ;Quote character? bne 15$ ;Branch if not inc r1 ;If so, skip it, and br 40$ ; force copy of next character 15$: 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 inc r1 ;Point at next character cmpb (r1),#'1 ;Is it a "1" through "9"?... blt 35$ cmpb (r1),#'9 bgt 35$ movb (r1),r1 ;Get the character bic #^C<17>,r1 ;Make it an offset into the parse address dec r1 ; table... asl r1 mov paddr(r1),r1 ;R1 now points to the nth argument section call ccopyb ;Insert the string pop r1 ;Restore R1 inc r1 ;Adjust pointer br 38$ ;Go clean up 35$: mov r4,r1 ;Make R1 => argument string call ccopy ;Insert it pop r1 ;Restore R1 38$: 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 . sparse ; SPARSE is used to parse a string based on the number of embedded blanks. ; It doesn't modify the string; it just produces an address list pointing ; to the sections framed by a leading blank and a trailing blank or null. ; Nine addresses are produced. If there are less than nine sections, the ; remaining addresses point at the trailing null byte. ; ; On entry, R4 is assumed to point at the string to be parsed. ; No registers are disturbed by this routine (no guarantees are made about ; the author, however). sparse: push ;Save working registers mov #paddr,r1 ;R1 => parse address list mov r4,r0 ;R0 => string to be parsed mov #9.,r2 ;R2 = no. of addresses to be calculated br 20$ ;Go do first string segment 10$: cmpb (r0),#space ;Found a space? beq 20$ ;Branch if so tstb (r0) ;Or was it a null? beq 30$ ;Branch if this is true inc r0 ;Bump the string pointer br 10$ ;Go look at next character 20$: call adjr0 ;Skip any leading blanks 30$: mov r0,(r1)+ ;Stash the address of this segment sob r2,10$ ;If not done, go look for next terminator pop ;Restore working registers return ;Quit .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. ; TSTEE also sets the EEFND bit in STATUS if an "==" string is found. ; ; Note that the test fails if there are any intervening non-blank characters. tstee: bic #eefnd,status ;Reset "== found" bit in STATUS 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$: tst (sp)+ ;Adjust stack bis #eefnd,status ;Set "== found" bit in STATUS clc ;Clear carry return .sbttl . tstfmt ; Routine to check the format of a symbol definition string... ; ; Tests are made on the lengths of the symbol name and the symbol ; definition. A warning message is issued if the symbol name or definition is ; too long. On entry, R0 points at the definition part of the string; R1 ; points at the symbol name. tstfmt: push ;Save R5, R0 mov r1,r0 ;R0 => symbol name call len ;Check length... cmp r5,#lcccc ble 10$ mov #trswrn,wrnmad ;"Truncating Symbol Name..." call wrngm 10$: pop r0 ;Restore R0 call len ;Check length of definition... cmp r5,#lssss ble 20$ mov #trdwrn,wrnmad ;"Truncating Symbol Definition..." call wrngm 20$: pop r5 ;Restore R5 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)... ; If a symbol is being defined, 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. clencm: call tstee ;Symbol definition? bcs 50$ ;Just quit if not push ;Save R0, R1 10$: tstb (r1)+ ;Find end of command string... bne 10$ dec r1 cmpb -(r1),#': ;Is last character a ":"? bne 40$ ;Quit if not clrb (r1) ;Zap it if so mov (sp),r1 ;Retrieve command pointer 20$: tstb (r1) ;Null byte? beq 40$ ;Go quit if it is cmpb (r1)+,#'* ;"*" encountered? bne 20$ ;Branch if not mov r1,r0 ;Point R0 at position of "*"... dec r0 30$: movb (r1)+,(r0)+ ;Shift rest of command left 1 byte... bne 30$ 40$: pop ;Restore R1, R0 call tstfmt ;Check the symbol definition format 50$: return .sbttl . contxt ; This routine checks the UCL run-time context. It decides if we are running ; under a version of RT-11 or TSX-Plus that we should know about, bombs the ; XM version if things are not right, checks to see if we are being run as a ; UCF, and cleans up any extraneous .GTLIN input. ; ; NOTE ; ~~~~ ; RT-11 V5.1 contains a bug that causes extraneous bits to be set in the ; monitor release/version word. The code at label "FUDGE" should be NOPed ; for early patch level V5.1 monitors to disable the release/version test. ; Failure to do so may cause UCL+ to behave incorrectly. Of course, no ; such test is done in the XM version of UCL+ since it uses features of ; RT-11 that were not available prior to V5.2. .enabl lsb contxt:: mov #rtv5.2,status ;Assume RT-11 V5.2 compatible monitor .if eq ucl$xm .gval #scrach+2,#sysver ;Get version/release of RT-11 swab r0 ;Make it "comparable" cmp r0,#<5*400!2> ;Preserve the RT-11 V5.2 flag in STATUS if fudge:: bge 20$ ; we are running under that version or later clr status ;Zap RT-11 V5.2 bit .endc 20$: bis #tsxp$,status ;Assume TSX+ .gval #scrach+2,#sysgen ;Get contents of SYSGEN word in RMON tst r0 ;Running under TSX+ V5 or later? bmi 40$ ;Branch if so bic #tsxp$,status ;Reset TSX+ status bit .if eq ucl$xm .gval #scrach+2,#config ;Get contents of CONFIG word in RMON bit #kt11$,r0 ;XM monitor? beq 40$ ;Branch if not .settop #-2 ;Ensure we "own" handler load area .endc 40$: .if ne ucl$xm mov @#userto,dspace ;Save pointer to handler load area .endc ; (in LOW memory!) bit #rtv5.2,status ;RT-11 V5.2 style monitor? beq 50$ ;Branch if not tst status ;TSX+? bmi 50$ ;Branch if so .gval #scrach+2,#$inddv ;R0 => INDDEV word (1 word past CLIFLG) mov -(r0),r5 ;Put CLIFLG/CLITYP word in R5 mov r0,cliadr ;Save this pointer bic #^C<3*400>,r5 ;Mask for the bits we want bne 60$ ;Branch if result non-zero (0 means UCF) bis #ucfmd,status ;Set UCF mode bit in STATUS, bisb #ucfon,(r0) ; set UCFON bit in monitor CLIFLG byte, 50$: return ; and quit 60$: cmp r5,# ;Just quit if we are running as UCL... beq 50$ tstb buff ;Anything picked up from chain area? beq 50$ ;Just return if not .gtlin #scrach+2 ;Otherwise, flush the .GTLIN input text return ; and quit .dsabl lsb .sbttl . qtproc ; This routine does the initial processing of any quote characters that ; may appear in an input string. Unless a symbol is being defined, it is ; desireable not to have quote characters embedded in the string. Thus, ; QTPROC does two things: ; ; 1) It puts a copy of the original string in the buffer BFSAV. ; ; 2) It "quote processes" the string in BUFF. I.e., each time it ; encounters a quote character, it strips it out, and retains the ; following character. qtproc: push ;Save the registers we will use mov #buff,r0 ;R0 => input string buffer mov #bfsav,r1 ;R1 => save area for original string 10$: movb (r0)+,(r1)+ ;Make a copy of the original string... bne 10$ mov #buff,r0 ;R0 => input string buffer mov #bfsav,r1 ;R1 => save area for original string 15$: cmpb (r1),#'| ;Quote character? bne 20$ ;Branch if not inc r1 ;If so, skip it 20$: movb (r1)+,(r0)+ ;Move a character back into BUFF bne 15$ ;Continue until null byte found pop ;Restore working registers return ;Quit .sbttl . tstsho ; This routine checks to see if a string passed to UCL is in the format: ; "=" ; TSTSHO is invoked after a call to GETCOM with R0 pointing at the ; terminator encountered in the input buffer and R1 pointing at the ; string that has been copied into the command buffer. If the string is in ; the above format, it is assumed to be the result (or equivalent) of an RT-11 ; SHOW COMMANDS command. If so, TSTSHO executes an internal LIST SYMBOLS ; command, sets the carry bit, and returns. If not, TSTSHO just returns with ; the carry clear. tstsho: cmpb (r0),#'= ;R0 pointing at "="? bne 10$ ;Go quit if not tstb 1(r0) ;Null immediately following "="? beq 20$ ;Go do listing if so 10$: clc ;Clear carry and quit... return 20$: mov #prlfnm,r0 ;Copy the string to PLINE's file name 30$: movb (r1)+,(r0)+ ; buffer... bne 30$ call plinit ;Ensure that PLINE is initialized call lists ;Force a LIST SYMBOLS .prlin #0 ;Clean up any leftovers in last block sec ;Set carry and quit... 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... bis #plprn,plstat ;Flag /PRINT for PLINE (in case it's called) 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 . frmsr, nfrmsr ; /[NO]FORM0 switch... nfrmsr: mov #1,wblok0 ;Set PLINE to start output with block 1 bisb #plnf0,plstat ; and set flag in PLSTAT br frmsr0 frmsr: clr wblok0 ;Set PLINE to start output with block 0 bicb #plnf0,plstat ; and ensure flag is cleared in PLSTAT frmsr0: jmp swbits ;Go set designated SWSTAT bits .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 bit #ucfmd,status ;Running as UCF? beq 20$ ;Branch if not bisb #ucfxit,@cliadr ;Set "UCF has something for you" bit 20$: .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, ccopyb, 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? beq 10$ ;Yep... movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count sob r3,ccopy ;Continue if copy limit not exceeded 10$: return ;Otherwise, return ; Command string copy, blank terminator ; ; Works like CCOPY, but will also terminate copying at a space character ; as well as a null byte. ccopyb: tstb (r1) ;Null byte? beq 10$ ;Yep... cmpb (r1),#space ;Or a space? beq 10$ ;Branch on this one too movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count sob r3,ccopyb ;Continue if copy limit not exceeded 10$: 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? beq 10$ ;Branch if so movb (r1)+,(r2)+ ;Copy the null inc r0 ;Adjust byte count dec r3 ;Adjust copy counter 10$: 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? beq 10$ ;Branch if so cmpb (r0)+,#space ;Blank? beq adjr0 ;Branch if so dec r0 ;Adjust the pointer and 10$: 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. Message is not issued if RECALL/JOURNAL is in effect. wrngm: bit #jrnlq,status ;Doing quiet journaling? bne 10$ ;Branch if so push r0 ;Save R0 .print #muclw ;"?UCL-W-" .print wrnmad ; pop r0 ;Restore R0 10$: bit #runc,status ;Were we RUN? bne 20$ ;Branch if so bisb #warn$,@#userrb ;Set "warning" bit in user error byte 20$: return .sbttl . pline ; PLINE is a subroutine to do .PRINT-style output to a device/file. ; ; On entry, R0 points at the string to be output and the ascii name of the ; file to be used should be in buffer PRLFNM ; ; PLINE will open the output file at the first write. If R0=0, PLINE will ; clean up and close the file. ; ; If no file is specified in PRLFNM, PLINE just does .PRINT's ; ; In order to keep the RT-11 spooler from screwing things up, PLINE does a ; non file structured lookup on LP: if both the /PRINT and /NOFORM0 switches ; are in effect. In this case, it also purges the I/O channel when output is ; complete to avoid the possible output of a trailing form feed. ; ; PLINE has it's own status word, PLSTAT, with the following bits defined: ; ; PLPRG = 1 purge bit ; PLNF0 = 200 /NOFORM0 in effect ; PLPRN = 100000 /PRINT in effect pline: push ;Save the registers we're going to use mov r0,r4 ;R4 => string to output bne 10$ ;Branch if not zero (not closing file) jmp plclos ;Go close up 10$: bit #odopn,status ;Got a file open? bne 90$ ;Branch if so tstb prlfnm ;Is there a file to open? bne 20$ ;Branch if so .print ;Just print line at console jmp plinx ;Go quit 20$: mov #prlfnm,r5 ;R5 => output spec 30$: tstb (r5) ;Find end of string... beq 40$ inc r5 br 30$ 40$: movb #'=,(r5) ;Stick "=" on end mov r5,plcfn0 ;Store location of "=" inc r5 ;Ensure trailing null... clrb (r5) tst plstat ;/PRINT in effect?... bpl 70$ tstb plstat ;/NOFORM0 in effect?... bpl 70$ bisb #plprg,plstat ;Set purge flag mov #^RLP,scrach ;Put rad50 "LP" in scratch area clr scrach+2 ; followed by 0 word .fetch dspace,#scrach ;Fetch the LP handler bcc 60$ ;Branch if no error mov #dmnerr,r5 ;Do fatal error "no device" otherwise... call plcfn 50$: jmp ferrx 60$: .lookup #area,#0,#scrach ;Non file structured lookup on LP: bcc 80$ ;Branch if no error mov #lpluer,r5 ;Fatal error "Unable to access LP:"... clr r4 br 50$ 70$: mov sp,spsav ;Save stack pointer .csigen dspace,#dext,#prlfnm ;Open output file mov spsav,sp ;Restore stack bcs plcser ;Handle errors 80$: bis #odopn,status ;Tell 'em we're open mov #obufr,obptr ;Init output buffer pointer mov wblok0,wblok ; and block number 90$: mov obptr,r1 ;R1 => next loc in output buffer 100$: movb (r4)+,(r1)+ ;Put a character in buffer bgt 120$ ;Branch if not a terminator bmi 110$ ;Branch if end of string (200 byte) mov #eolstr,r4 ;Append cr/lf... dec r1 br 100$ 110$: dec r1 ;Adjust and store next loc pointer... mov r1,obptr br plinx ;Go quit 120$: cmp r1,#obptr ;Buffer full? blt 100$ ;Branch if not .writw #area,#0,#obufr ;Write a block bcs plwter ;Handle any errors inc wblok ;Bump block number mov #obufr,r1 ;Reset pointer br 100$ ;Go get next character eolstr: .byte cr,lf,200,0 ;Carriage return/linefeed string ; Close the output file... plclos: bit #odopn,status ;File open or just .PRINTing? beq 40$ ;Branch if no file mov obptr,r1 ;R1 => next loc in buffer cmp r1,#obptr ;Buffer full? beq 20$ ;Branch if so 10$: clrb (r1)+ ;Append a null byte cmp r1,#obptr ;Buffer full? blt 10$ ;Branch if not .writw #area,#0,#obufr ;Write last block bcs plwter ;Handle errors 20$: bitb #plprg,plstat ;Purge bit set in PLSTAT? beq 30$ ;Nope .purge #0 ;Yep, purge channel 0 instead of closing it... br 40$ 30$: .close #0 ;Close the file 40$: call plinit ;Reset flags, status, etc. plinx: pop ;Restore registers return ; Initialization routine for PLINE... plinit: bic #odopn,status ;Reset status and file name buffer... clrb prlfnm clr plstat ;Reset PLSTAT clr wblok0 ;Reset initial output block number return ; Error traps... plcser: call plcfn ;Set up for error message jmp opnur0 ;Go handle error plwter: call plcfn ;Set up for error message jmp sterx0 ;Go handle error plcfn: mov #prlfnm,r4 ;R4 => file name clrb @plcfn0 ;Zap "=" return plcfn0: .word 0 ;Pointer to "=" at end of file name .sbttl . grec ; GREC inputs records from a file in a manner similar to the .GTLIN request. ; On entry, a file is assumed to be open on channel 3, the initial block ; number for the .READW (WBLOK) should be set, and the input buffer pointer ; (IBPTR) should point BEYOND the end of the I/O buffer (IBUFR). R0 should ; point at the buffer to receive the record retrieved by GREC. ; When GREC detects an end-of-file condition it closes the input channel, ; clears the JRNLI bit in STATUS, and sets the carry bit. ; On normal return, the carry is clear and no registers are disturbed. grec:: push ;Save the working registers bit #jrnlq,status ;Do this quietly? bne 10$ ;Branch if so .print #prompt ;Issue prompt... 10$: mov (sp),r0 mov ibptr,r1 ;R1 => next record in input buffer mov #buffsz-2,r3 ;R3 = max record length 20$: cmp r1,#ibufr+512. ;Time to read another block? blo 30$ ;Branch if not push r0 .readw #area,#3,#ibufr,,rblksv ;Read a block bcs grrder ;Branch on error pop r0 ;Restore R0 mov #ibufr,r1 ;Reset buffer pointer inc rblksv ;Bump block no. for next read 30$: movb (r1)+,r2 ;Get a character bicb #^C<177>,r2 ;Strip parity beq 20$ ;Branch if null cmpb r2,#lf ;Ignore linefeed... beq 20$ cmpb r2,#cr ;Carriage return? bne 50$ ;Branch if not clrb (r0) ;Mark end of record with null mov r1,ibptr ;Save buffer pointer value pop r0 ;Print what we got... bit #jrnlq,status bne 40$ .print 40$: pop ;Restore the registers clc ;Indicate a record is available return ; and quit 50$: clrb (r0) ;Ensure potential end-of-record byte dec r3 ;Decrement record byte count ble 20$ ;Just ignore character if record at max length movb r2,(r0)+ ;Stuff character in record buffer br 20$ ;Go look for another grrder: bic #,status ;Reset JRNLI/JRNLQ bits in STATUS tstb @#errbyt ;End of file? bne 10$ ;Branch if not .close #3 ;Close the channel .print #eofmsg ;"" pop ;Restore the registers sec ;Indicate end-of-file return ; and quit 10$: .if eq ucl$xm mov #rclerr,r5 ;R5 => "Read error" mov #eronjf,r4 ;R4 => "on journal file" jmp ferrx ;Take fatal error exit .iff push #rclerr ;Put error message on stack jmp @#grl$xx ;Take global loader error exit .endc .sbttl UCL DATA AREA ; ============= .sbttl . Pointers, Register Storage, Status dspace: .word top ;Address of handler load area spsav: .word 0 ;Save area for stack pointer savr0: .word 0 ;Save area for BUFF pointer cliadr: .word 0 ;Save area for address of CLIFLG/CLITYP word status: .word 0 ;Program status word swstat: .word 0 ;Switch status word plstat: .word 0 ;PLINE status word wrnmad: .word 0 ;Address of warning message for WRNGM .sbttl . Buffers bfsav:: .blkb buffsz ;Save area for input string buff:: .blkb buffsz ;Input buffer cmd:: .blkb 82. ;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 prlfnm: .blkb 42. ;Buffer for PLINE's output file name chbuf: .blkb buffsz-2 ;Intermediate "chain exit" buffer scrach: .blkw 45. ;Scratch area ibufr: obufr: .blkw 256. ;General I/O buffer ibptr: obptr: .word 0 ;Pointer for above rblksv: .word 0 ;Save area for .READW block number .sbttl . Argument Blocks area: .word 0 ;Argument block area for .WRITW/.READW's... wblok: .word 0 wbufa: .word 0 wcnt: .word 256. .word 0 wblok0: .word 0 ;Initial block no. for .WRITW output dext: .rad50 "SAV" ;Default extensions for .CSIGEN call .rad50 "LST" .word 0,0 paddr:: .blkw 9. ;SPARSE routine's address list area