.sbttl INTRODUCTION .rem ` This version of UCL is brought to you by: William K. Walker RDB/Alpha Systems P. O. Box 149 Alpha, OH 45301-0149 (513) 426-7094/0344 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 TSXUCL program in that symbols may be either "global" or "local" depending upon the installation method. 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. (UCL+ can be set up to use a separate data file, if necessary.) Also, 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 "UCLs". 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. A command of this type is included as a conditional assembly: a DCL-style RNO command for use with DECUS RUNOFF version M02.4. 9. You can enter special characters into a symbol definition by specifying their octal code. 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 (CLIs). 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-E-Invalid Command" or "?UCL-E-Ambiguous Command" (whichever is appropriate) error message. UNLESS the CHAIN command is in effect -- in which case it passes the "invalid" command line on to the next program in the chain. 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: Under TSX-Plus V5 or later, invalid and ambiguous commands are ultimately passed 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 edit$ = 000020 ;SL disable bit spxit$ = 000040 ;Special chain exit ovly$ = 001000 ;Overlay bit ttlc$ = 040000 ;Lower case bit userto = 50 ;Location of program's high limit address errbyt = 52 ;RT's error byte userrb = 53 ;User error byte warn$ = 002 ;"Warning" bit error$ = 004 ;Normal, "E" level error bit fatal$ = 010 ;"Fatal" error bit 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 kt11$ = 010000 ;XM bit in configuration word sysgen = 372 ;Offset to RMON sysgen features word tsxp$ = 100000 ;TSX+ bit in sysgen features word and STATUS + $inddv = 426 ;RMON fixed offset pointer to INDDEV ; CLI enabled bits in CLIFLG byte (invalid prior to RT-11 V5.2)... ucfon = 001 dclon = 002 cclon = 004 uclon = 010 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 = 000001 ;UCL invoked by RUN command + ximm = 000002 ;Execute-immediate flag + dspla = 000004 ;DISPLAY command encountered + dsplx = 000010 ;DISPLAY/EXECUTE encountered + odopn = 000020 ;A device/file is open for LIST output + hwamb = 000040 ;Ambiguous command after "hard-wired" search + sumary = 000100 ;Summary listing requested ucimd = 000200 ;UCI_MODE in effect +* ucfmd = 000400 ;Running as UCF + jrnli = 001000 ;Journal input active + jrnlo = 002000 ;Journal output active + jrnlq = 004000 ;Do "quiet" journaling + eefnd = 010000 ;Input string contains a symbol definition operator ("==") + ; 020000 ;RESERVED + rtv5.2 = 040000 ;Running under RT-11 V5.2 + ;tsxp$ = 100000 ;TSX+ bit in sysgen features word and STATUS + <= NOTE ; PFLAGS... uclxm = 001 ;Special XM version of UCL * ;ucimd = 200 ;UCI_MODE in effect +* <= NOTE .sbttl . Status Bits For PLINE Routine PLSTAT Status Word plprg = 000001 ;Purge channel on completion plnf0 = 000200 ;/NOFORM0 in effect plprn = 100000 ;/PRINT in effect .sbttl . Status Bits For Command Execution Status cxdsp = 000200 ;Command is potentially DISPLAYable cxnuc = 100000 ;Command-line text may not be "memorized" .sbttl . Switch Bit Definitions all = 000001 ;/ALL noq = 000002 ;/NOQUERY qry = 000004 ;/QUERY idv = 000010 ;/INDIVIDUAL ; 000020 ;RESERVED out = 000040 ;/OUTPUT prn = 000100 ;/PRINTER trm = 000200 ;/TERMINAL exe = 000400 ;/EXECUTE nex = 001000 ;/NOEXECUTE fm0 = 002000 ;/FORM0 nf0 = 004000 ;/NOFORM0 ; 010000 ;RESERVED ; 020000 ;RESERVED badopt = 040000 ;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 blocks in context area nwords = nbloks * 256. ;Number of words in context area chbufl = 182. ;Buffer length "chain area" buffsz = chbufl + 2 ;Size of input line buffer ht = 011 ;Horizontal tab lf = 012 ;Linefeed cr = 015 ;Carriage Return space = 040 ;Space prcent = 045 ;Percent sign star = 052 ;Asterisk bit7 = 000200 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 ; NOTE: Use LINK/BOUNDARY:512. to force MAIN psect to start on a block ; boundary!!! .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 its 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 .if eq ucl$xm call swch17 .endc 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 ccproc ;Handle tabs and "" stuff 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 55$: .gtrec #buff ;Get the next input record bcs 70$ ;Branch on end-of-file call adjr0 ;Anything entered?... tstb (r0) beq 55$ ;If not, go get next record br 50$ ;Otherwise, go process it 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 that it could ; attempt to RUN (the "run-by-name" path device list guides the file search). ; 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$: tstb (r1) ; (fixup to handle unexpected spaces beq 60$ ; and nulls courtesy C. E. Chew -- cmpb (r1),#space ; Why didn't I catch that?!) beq 60$ 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 eerrx ;Go do error exit... ;Invalid DISPLAY stuff comes here: baddsp:: mov #mbadsp,r5 ;"Invalid DISPLAY Argument"... mov savr0,r4 ;R4 => buffer contents jmp eerrx ;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 ERRORS ; =============== .sbttl . eerrx, ferrx ; Errors handled here... ; ; On entry, ; R5 => message text ; R4 => any additional text (=0 if none) ; ; Message issued is "?UCL-E- " or ; "?UCL-F- ; ; If UCL was invoked by RT-11, and entry is at EERRX, a hard exit is executed ; with the "E" level error bit set. If UCL was run directly, EERRX returns to ; the program mainline. ; ; Entry at FERRX always causes a hard exit, with the "fatal" error bit set. .enabl lsb ferrx:: bic #runc,status ;Ensure we exit to monitor mov #fatal$,r1 ;R1 = fatal error bit for USERRB mov #muclf,r0 ;R0 => "?UCL-F-" br 5$ eerrx:: mov #error$,r1 ;R1 = "E" level error bit mov #mucle,r0 ;R0 => "?UCL-E-" 5$: bic #,status ;Zap any DISPLAY bits .print ;Print error prefix 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 r1,@#userrb ;Set error bit jmp hrdxit ; and do a hard exit... .dsabl lsb .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 eerrx 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 and status (SDS) blocks ; into UCL.SAV... wtstbl:: .writw #area,#17,#sdsat,#nwords,sdsbbk ;Write SDS area bcs 10$ return ;Return 10$: mov #strerr,r5 ;"Write error while updating symbol blocks" mov #wtfail,r4 ; and quit... 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) call sparse ;Parse the argument string 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.. printi #resinf ;"Replaced Existing Symbol"... 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 "0" through "9", then a parsed section of the argument string ; is inserted. The sequence "^0" is a special case: it is the ASCII digit ; representing the number of non-null segments in the argument string. A ; space or a null is a terminator for the purposes of string parsing ; (e.g., if the string is "me too", ^0 = "2", ^1 = "me", and ^2 = "too"). ; ; If string insertion is indicated and the corresponding string is null, ; SCOPY checks the symbol definition string to see if a default string has ; been defined. If so, the default string is inserted. ; ; 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),#'| ;Quote character? bne 20$ ;Branch if not inc r1 ;If so, skip it, and br 100$ ; force copy of next character 20$: cmpb (r1),#'\ ;"\" encountered? bne 40$ ;Branch if not tst r3 ;Copy count exhausted? beq 30$ ;Branch if so clrb (r2)+ ;Insert a null byte dec r3 ;Adjust copy counts... inc r0 inc r1 ;Adjust input pointer 30$: return 40$: cmpb (r1),#'^ ;"insert argument" flag encountered? bne 100$ ;Branch if not push r1 ;Save R1 inc r1 ;Point at next character cmpb (r1),#'0 ;Is it a "0" through "9"?... blt 60$ cmpb (r1),#'9 bgt 60$ mov r1,(sp) ;Save R1 (incremented) push r4 ;Save R4 movb (r1),r4 ;Get the character bic #^C<17>,r4 ;Make it an offset into the parse address asl r4 ; table... inc r1 ;See if a valid default string call tstdf ; is defined... mov dfstat,dfstat ;Test for no default string... beq 50$ mov dfstat,2(sp) ;Adjust stacked input pointer bcs 50$ ;Branch if NOP nested default tstb @paddr(r4) ;Pointing at a null string? bne 50$ ;Branch if not inc r1 ;Adjust string address mov r1,paddr(r4) ;Store in sub-string index and merge ; with "normal" sub-string processing... 50$: mov paddr(r4),r1 ;R1 now points to the nth argument section call ccopyt ;Insert the sub-string pop r4 ;Restore R4 br 90$ ;Go clean up 60$: call tstdf ;Test for a valid default string... mov dfstat,dfstat ;Test for no default string... beq 80$ mov dfstat,(sp) ;Adjust stacked input pointer bcs 80$ ;Branch if NOP nested default tstb (r4) ;Null argument string? bne 80$ ;Branch if not inc r1 ;Make R1 point at default string push r4 ;Save R4 70$: movb (r1)+,(r4)+ ;Move default string into argument cmp r1,2(sp) ; string buffer... blo 70$ clrb (r4) ;Add trailing null pop r4 ;Restore R4 call sparse ;Parse arg. string for sub-string locations 80$: mov r4,r1 ;Make R1 => argument string call ccopy ;Insert it 90$: inc r5 ;Bump insert counter pop r1 ;Restore R1 inc r1 ;Adjust input pointer br 10$ ;Go look at next character 100$: tst r3 ;Copy count OK? beq 110$ ;Branch if done movb (r1)+,(r2)+ ;Copy a character inc r0 ;Adjust counters... dec r3 beq 110$ ;Branch if done tstb -1(r1) ;Did we just copy a null? bne 10$ ;If not, go get next 110$: 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 string addresses are produced. If there are less than nine sections, ; the remaining addresses point at the trailing null byte. ; ; The "zeroth" address at the beginning of the address list is a special ; case. It points to an ASCII digit representing the number of non-null ; string sections. ; ; 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: savrg ;Save working registers mov #paddr+2,r1 ;R1 => parse address list mov r4,r0 ;R0 => string to be parsed mov #9.,r2 ;R2 = no. of addresses to be calculated clr pcount ;Initialize count for non-null segments 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 tstb (r0) ;Was this a null segment? beq 40$ ;Branch if so inc pcount ;If non-null, increment counter 40$: sob r2,10$ ;If not done, go look for next terminator bisb #60,pcount ;Make PCOUNT value ASCII return ;Quit, restore working registers .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, R1 points at the symbol name in CMD which has already ; been purged of extraneous characters. The original input string, ; processed for "" sequences, is stored in BFSAV. tstfmt: savrg ;Save registers mov r1,r0 ;R0 => symbol name call len ;Check length... cmp r5,#lcccc ble 10$ printw #trswrn ;"Truncating Symbol Name..." 10$: mov #bfsav,r0 ;R0 => input string call syfee ;Make R0 point at definition part call len ;Check length of definition... cmp r5,#lssss ble 20$ printw #trdwrn ;"Truncating Symbol Definition..." 20$: return ;Quit, restore registers .sbttl . tstdf ; Routine to test if a string meets the format to specify a default ; string. TSTDF also does the necessary pointer adjustment for nested ; sub-string defaults. The format is ; ; [s...s] ; ; where "s...s" is the default string framed by square brackets (the ; framing characters can be changed by modifying assembly conditionals ; DFPFX and DFSFX). ; ; On entry, R1 is assumed to point at the prefix character ; R4 should be an offset into the parse address table (PADDR) if ; this is a default for a sub-string ; ; On return, if the format test fails, carry is set and DFSTAT = 0 ; if the test succeeds, carry is clear and DFSTAT contains ; the address of the trailing frame character ; if this is a valid nested sub-string default ("^m[^n]", where ; an nth substring exists) the mth PADDR entry is replaced ; with the nth entry ; if the nested sub-string format is valid, but the nth string ; is null, DFSTAT points at the trailing frame character ; and the carry bit is set; nonsense nested defaults such as ; "^[^1]" get the same treatment ; ; No registers are destroyed. tstdf: push r1 ;Save R1 cmpb (r1),#dfpfx ;Prefix character? beq 30$ ;Branch if so 10$: clr dfstat ;If not, clear DFSTAT, 20$: pop r1 ; restore R1, sec ; and quit with carry set... return 30$: tstb (r1)+ ;Null byte? beq 10$ ;Just quit if so cmpb (r1),#'| ;Quote character? bne 40$ ;Nope inc r1 ;Yep, don't check next character... br 30$ 40$: cmpb (r1),#dfsfx ;Suffix character? bne 30$ ;Keep looking if not mov r1,dfstat ;Store suffix pointer mov (sp),r1 ;R1 => default string prefix character push r5 ;Save R5 inc r1 ;R1 => 1st char. in default string spec. cmpb (r1)+,#'^ ;Insertion operator? bne 80$ ;Branch if not mov #'1,r5 ;Assume "[^]" cmpb (r1),#dfsfx ;If so, branch around checks for "n"... beq 50$ cmpb (r1),#'0 ;Is next character 0 - 9?... blt 80$ cmpb (r1),#'9 bgt 80$ movb (r1)+,r5 ;Save ASCII digit cmpb (r1),#dfsfx ;Is next one the suffix character? bne 80$ ;Oh, never mind, if not 50$: mov 2(sp),r1 ;Nonsense "^[^n]" operation?... cmpb -(r1),#'^ bne 70$ ;Branch if not 60$: pop r5 ;If so, restore R5, br 20$ ; and quit with carry set 70$: bic #^C<17>,r5 ;Make R5 an offset into the parse address asl r5 ; table... tstb @paddr(r4) ;Is a "^m" string already defined? bne 80$ ;Branch if so tstb @paddr(r5) ;Null nth substring? beq 60$ ;Branch if so mov paddr(r5),paddr(r4) ;Adjust sub-string pointer 80$: pop ;Restore R5, R1 clc ;Clear carry return ;Quit .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 ; CLENCM provides some basic clean-up and testing for input text if a symbol ; is being defined or deleted. "Extraneous" characters, allowed for ; compatibility with the distributed RT-11 UCL program, are stripped out. ; The symbol name and definition are checked for length. ; ; On entry, R1 points at the symbol name in CMD; R0 points at the argument ; boundary in BUFF (at the "==" if this is a symbol operation). 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 .if eq ucl$xm .sbttl . swch17 ; Routine to "switch" channel 17 to the external data (XD) file ; ; In effect, SWCH17 just opens channel 17 to the XD file. However, the XD ; version of UCL+ starts up with this channel set up as a fake overlay ; channel. SWCH17 purges 17, and then attaches it to the data file, ; creating the file, if necessary. This slightly ornate approach makes it ; possible to patch the XD version to act like the non-XD version, and vice ; versa. swch17:: tst sdsbbk ;XD mode enabled? bne 20$ ;Just return if not savrg ;Save working registers movb #space,xdvsfx ;Modify release/version string .purge #17 ;Grab "overlay" channel for our own purposes .fetch dspace,#xddev ;Fetch XD device bcc 5$ ;Branch if no error mov #^RSY,xddev ;XD device invalid, use SY instead... br 10$ 5$: mov r0,dspace ;Update handler load address 10$: mov #xdluer,r5 ;Attempt to lookup XD file... .lookup #area,#17,#xddev bcs 30$ mov #xdrder,r5 .readw #area,#17,#sdsat,#nwords,#0 ;Read in the context area... bcs 40$ 20$: return ;Quit; SAVALL coroutine restores registers 30$: cmpb @#errbyt,#1 ;Lookup failed; file-not-found? bne 40$ ;Go die if not printi #nu1inf ;Tell 'em we're creating a new file mov #xdener,r5 ;Attempt to create the file... .enter #area,#17,#xddev,#nbloks bcs 40$ mov #xdwter,r5 ;Init the new file by writing internal SDS .writw #area,#17,#sdsat,#nwords,#0 ; area to it bcs 40$ .close #17 ;Make the file permanent, and br 10$ ; loop back to reopen it ; Errors come here... 40$: .purge #17 ;Do some housekeeping clr r4 ;Tell FERRX there's no trailing text jmp ferrx ;Quit with error .endc .sbttl . ccproc ; CCPROC "filters" the string in BUFF by converting instances of "" into ; the equivalent single ASCII character with value "nnn" octal. If the string ; is a symbol definition, it also converts any tabs in the symbol name into ; single spaces. Tabs prefixed to the definition string are also converted. ccproc: savrg ;Save registers mov #buff,r0 ;R0 => BUFF mov r0,r2 ;Save value in R2 also 10$: tstb (r0) ;Null byte? beq 55$ ;If so, go to control-character processing cmpb (r0)+,#'= ;"=" found? bne 10$ ;If not, keep looking mov r0,r1 ;Save pointer into BUFF cmpb (r0),#'| ;Gratuitous quote character?... bne 20$ inc r0 20$: cmpb (r0)+,#'= ;Found a second "="? beq 30$ ;Branch if so mov r1,r0 ;If not, restore pointer and br 10$ ; keep looking 30$: cmpb (r0)+,#space ;Find a space trailing "=="? bgt 40$ ;Branch if hit definition string beq 30$ ;Keep going if space cmpb -1(r0),#ht ;Also keep going if it was a tab... beq 30$ 40$: mov r2,r1 ;R1 => start of buffer 45$: cmpb (r1)+,#ht ;Tab? bne 50$ ;Nope movb #space,-1(r1) ;Yep, replace it with a space 50$: cmp r1,r0 ;Hit definition string yet? blt 45$ ;Continue if not 55$: mov r2,r1 ;R1 => BUFF for input (R2 => BUFF for output) br 70$ 60$: cmpb -1(r2),#'| ;Last one a quote character? bne 70$ ;If not, no problem movb (r1)+,r0 ;If so, just copy this one... br 80$ 70$: call ccasc ;Filter a character 80$: movb r0,(r2)+ ;Store it bne 60$ ;Keep going if it wasn't a null return ;Quit, restore registers .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: savrg ;Save registers 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 return ;Quit, restore registers .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 eerrx .sbttl . badswx badswx: mov #mbadsw,r5 ;"Invalid Switch..." br ambsw0 .sbttl . ambswx ambswx: mov #mambsw,r5 ;"Ambiguous Switch..." ambsw0: mov #swbuf,r4 jmp eerrx .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 hrdxit ;Branch if not bisb #ucfxit,@cliadr ;Set "UCF has something for you" bit .sbttl . "Hard" exit for UCL+ hrdxit:: .settop #0 ;Prevent unecessary swapping clr r0 ;Do a hard exit... .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, ccopyx, ccopys ; 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 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 ; The following set of CCOPYx routines are used for copying argument sub- ; strings. Entry for the group is normally at CCOPYT. ; ; ---------- ; ; CCOPYT copies argument sub-strings in either "default-spec" or "normal" ; modes. The method used depends on whether the sub-string is preceded by ; the default sub-string prefix character or not. ccopyt: cmpb -1(r1),#dfpfx ;String preceded by "default prefix"? bne ccopys ;Branch to CCOPYS routine if not ; Command string copy. Terminates on framing suffix character for default ; sub-strings. Also recognizes quoting. ccopyx: tstb (r1) ;Null byte? beq 30$ ;Yep... cmpb (r1),#'| ;Quote character? bne 10$ ;Nope inc r1 ;Yep, force copy of next character... br 20$ 10$: cmpb (r1),#dfsfx ;Match with trailing framer? beq 30$ ;Branch on this one too 20$: movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count sob r3,ccopyx ;Continue if copy limit not exceeded 30$: return ;Otherwise, return ; Command string copy, terminates on a space or null. ccopys: tstb (r1) ;Null byte? beq 10$ ;Yep... cmpb (r1),#space ;Space? beq 10$ ;Quit if so movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count sob r3,ccopys ;Continue if copy limit not exceeded 10$: return ;Otherwise, 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: push r0 ;Save R0 printj #muclw ;"?UCL-W-" printj wrnmad ; pop r0 ;Restore R0 bit #runc,status ;Were we RUN? bne 10$ ;Branch if so bisb #warn$,@#userrb ;Set "warning" bit in user error byte 10$: return .sbttl . infom ; Routine to issue informational messages... ; ; Prints "?UCL-I-". Address of should be in location ; INFMAD. Message is not issued if RECALL/JOURNAL/QUIET is in effect. infom: push r0 ;Save R0 printj #mucli ;"?UCL-I-" printj infmad ; pop r0 ;Restore R0 10$: return .sbttl . prntj ; PRNTJ does a .PRINT unless quiet journaling is in effect. prntj: bit #jrnlq,status ;Doing quiet journaling? bne 10$ ;Branch if so .print ;Print the message 10$: return ;Quit .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 .PRINTs ; ; 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 its 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 error "no device" otherwise... call plcfn 50$: jmp eerrx 60$: .lookup #area,#0,#scrach ;Non file structured lookup on LP: bcc 80$ ;Branch if no error mov #lpluer,r5 ;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,#256. ;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,#256. ;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,#256.,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 . ccasc ; CCASC converts a string of the form "" into an ASCII character ; represented by the octal value "nnn". If, on entry to CCASC, R1 is ; not pointing to a string of this form, the ASCII character is just ; passed through. ; ; On entry: R1 => string ; ; On return: R1 => next character position ; R0 = "filtered" character ccasc: movb (r1)+,r0 ;R0 = 1st character cmpb r0,#'< ;Is it a "<"? beq 10$ ;If so, check for and process "" return ;Just return otherwise 10$: push ;Save working regs, R0 at base of stack mov #4,r2 ;R2 = max. remaining char in "" 20$: cmpb (r1)+,#'> ;Look for trailing ">" beq 30$ ;Branch if found sob r2,20$ ;If not found within limit, 25$: pop ; clean up and quit... return 30$: dec r1 ;Make R1 point at last presumed digit neg r2 ;Calculate no. of digits... add #4,r2 mov r2,r0 ;Save no. in R0 for later 40$: cmpb -(r1),#'0 ;If digits are not legit, just quit... blo 25$ cmpb (r1),#'7 bhi 25$ sob r2,40$ clr r3 ;Clear R3; it will contain result 50$: asl r3 ;Shift 3 bits to left (mult. by 8) asl r3 asl r3 movb (r1)+,r2 ;Get an ASCII digit bic #^C<7>,r2 ;Mask for lower 3 bits bis r2,r3 ;Set them in result sob r0,50$ ;Do next digit, if more of them cmp r3,#377 ;If result is too large, bhi 25$ ; just give up mov r3,(sp) ;Otherwise, update stacked R0 inc r1 ; and R1 values... mov r1,2(sp) br 25$ ;Go quit .sbttl . bytasc, octasc ; BYTASC transforms non-printing characters (8-bit, control, and DEL) into ; an output string of the form ""; normal 7-bit characters are not ; disturbed. ; ; On input, R0 contains the character to be processed; R1 points at the ; output buffer. ; ; On return, R0 is destroyed; R1 points at the next byte past the end of ; the output string. bytasc: bic #^C<377>,r0 ;Strip for byte of interest bne 20$ ;Branch if it is not a null 10$: movb r0,(r1)+ ;Put character in output buffer return ;Quit 20$: cmp r0,#177 ;Do we have DEL or greater (8-bit)? bge 30$ ;Branch if so cmp r0,#space ;Just pass it through if it is printable... bge 10$ ;Make OCTASC routine give us "1nnn" to 30$: bis #1000,r0 ; force leading zeros call octasc ;Convert to octal ASCII movb #'<,-4(r1) ;Enclose result in brackets... movb #'>,(r1)+ return ;Quit ; OCTASC converts a binary value to an octal ASCII string ; ; On input, R0 contains the value to be converted; R1 points at the output ; buffer. ; ; On return, R0 is destroyed; R1 points at the next character position past ; the output string. octasc: mov r0,-(sp) ;Put R0 on stack bic #^C<7>,(sp) ;Mask for lower 3 bits add #60,(sp) ;Make result an ASCII digit ror r0 ;Rotate next group of 3 bits into low asr r0 ; order bits of R0... asr r0 beq 20$ ;If result is zero, we are done call octasc ;If not, call ourself 20$: movb (sp)+,(r1)+ ;LIFO from stack to text buffer... return .sbttl . match ; This routine compares an ASCIZ string pointed to by R1 against a pattern ; string pointed to by R2. The pattern string can contain wildcard ; characters, which are: ; "%" -- match against any single character (except null) ; "*" -- match against any string ; ; Both strings must end with a null. ; ; Note that this routine will match against embedded blanks! Anything goes ; except nulls. ; ; R0 returns non-zero on a match; 0 if no match ; ; R1, R2 and R3 are affected as well as R0. match: clr r0 ;Assume failure 10$: movb (r1)+,r3 ;Get the next pattern character cmpb #star,r3 ;Is it a "*"? bne 20$ ;Branch if not tstb @r1 ;Are we at the end of the string? beq 30$ ;Branch if so. We have a match 20$: tstb @r2 ;Is this the end of the test string? bne 40$ ;Branch if not tstb r3 ;At the end of the pattern string? bne 60$ ;Branch if not; return a level 30$: inc r0 ;Else it matched br 60$ ;Return a level 40$: tstb r3 ;Is this the end of the pattern string? beq 60$ ;Branch if so cmpb #star,r3 ;Is the pattern character a "*"? beq 50$ ;Branch if so cmpb (r2)+,r3 ;Does test char match pattern char? beq 10$ ;Branch if yes cmpb #prcent,r3 ;Is the pattern char a "%"? beq 10$ ;Branch if so. It matches. br 60$ ;Else return to caller 50$: push ;Save R1 and R2 call 10$ ;And call self pop ;Restore R2 and R1 tst r0 ;Did the strings match? bne 60$ ;Branch if so tstb (r2)+ ;At the end of the test string yet? bne 50$ ;Branch if not 60$: return ;Return a level .sbttl . shiftu ; SHIFTU examines an ASCIZ string, converting lower-case characters ; to upper-case (a-z shifted to A-Z). ; ; On entry, R0 points at the ASCIZ string to be shifted. ; ; R0 is altered, no other registers are disturbed. shiftu: cmpb (r0),#'a ;Is it less than "a"? blt 10$ ;Branch if so cmpb (r0),#'z ;Is it greater than "z"? bgt 10$ ;Branch if so bicb #40,(r0)+ ;Shift it br shiftu ;Go look at the next one 10$: tstb (r0)+ ;Null byte? bne shiftu ;If not, go look at next one return ;If so, quit .sbttl . savall ; This is a version of the notorious register save/restore coroutine. ; ; **************************** ; * CALL THIS ROUTINE WITH * ; * * ; * JSR R5,SAVALL * ; * * ; * REENTER WITH * ; * * ; * RTS PC * ; **************************** savall: push mov 14(sp),r5 call @(sp)+ pop return .sbttl UCL DATA AREA ; ============= .sbttl . Pointers, Register Storage, Status sdsbbk:: ;Base (1st) block of symbol def. & status area .word blok1 ; If 0, XD mode; if 1, non-XD (internal) mode 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 infmad: .word 0 ;Address of informational message for INFOM wrnmad: .word 0 ;Address of warning message for WRNGM dfstat: .word 0 ;TSTDF's status word listat: .word 0 ;LISTI's status word .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 buffsz ;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/.READWs, etc. 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 .if eq ucl$xm xddev:: .word uclddv ;External data (XD) device xdfil:: .rad50 "UCL" ;XD file name/extension... .rad50 "PLS" .rad50 "DAT" .endc paddr:: .word pcount ;SPARSE routine's address list area .blkw 9. pcount: .word 0