.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 and later monitors. It is upward compatible with the UCL program distributed with V5.01 with the following exceptions: 1. Symbol definitions are listed with the LIST (or LIST SYMBOLS) command; this is accomplished by typing "UCL" with the distributed UCL. 2. UCL+ accepts the "VMS-like" symbol definition syntax used by DEC's UCL, but it ignores it. Instead, the number of characters that must be typed to specify a command or symbol unambiguously is a function of context. E.g., if you have defined two symbols starting with "S", "SUPPER" and "SUPER", you must type four characters to distinguish between them. However, if they are "SIPPER" and "SUPER", only two characters are necessary. 3. UCL+ currently allows symbol names of no more than six characters. If you use a longer name in a definition, UCL+ will truncate it to six characters and issue a warning message to that effect. UCL+ contains a number of extensions to the distributed UCL program: 1. UCL+ is optimized to minimize disk access. The symbol definitions are contained in internal tables rather than a separate data file and an "execute-immediate" mode is available for commands that are defined in terms of other UCL commands. 2. More than one symbol definition can be deleted in a single command line via the ERASE command. All current symbol definitions can be removed with ERASE 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 ".UCL" file. 6. A PASS_ON command is included that allows you to force UCL+ to "pass-on" a given command string to the next program in the chain (the default mode) or to a program that you specify. 7. Symbol expansions can be DISPLAYed with or without execution. The 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. You may also dynamically redefine the prompt string issued by UCL+. 12. Starting with UCL+ V07.04, a UC "pseudo-device" handler is pro- vided as an option which allows UCL+ to "remember" the "argument- part" of the last UCL+ command. This text can be retrieved, at the command level, by using the "^" character in place of the argument in a subsequent command. 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. NOTE: Starting with V07.04, you may use UCL+ in conjunction with the UC handler to "remember" what might be called the "input-spec" part of the last UCL+ command line. This stored text can be retrieved for use in a subsequent command **AT THE COMMAND LEVEL** via the "^" character. This is most useful when using UCL+ in UCI_MODE, and it works a lot like the "^" construct in symbol definitions. The difference is that only the part of the command string preceeded by a leading space and ending with a "terminator" (space, "/", "=", comma, or null byte) is "memorized". For example, the command sequence FOO/BAR ARG1 FREEP ^ is equivalent to FOO/BAR ARG1 FREEP ARG1 The UC handler must be memory-resident (loaded) to use this feature. | .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 chname = 500 ;CHAIN program name in syscom area bytcnt = 510 ;Byte count in syscom area cmdbuf = 512 ;Command text in syscom area config = 300 ;Offset to RMON configuration word sysgen = 372 ;Offset to RMON sysgen features word 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 .sbttl Status Bits For STATUS/PFLAGS 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 ucres = 100 ;UC handler available ucimd = 200 ;UCI_MODE 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" 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$ .sbttl SYMBOL/STATUS BLOCKS ; ==================== .psect ssblks ; These buffers will form blocks 1 - 18 of the file's SAV image. The ; first 32 words form table SDSAT, the symbol definition string address ; table. It contains the addresses of the existing symbol definition ; strings, sorted in string alphabetical order (what do you mean, why? ; it's faster to search for a match and determine ambiguity this way... ; you don't think I'd go to all this trouble for nothing do you?). The ; remaining 31 x 32 byte area contains the buffers for 31 symbol ; definition strings. ; ; A symbol definition string is entered at the console as ; "symbol==definition" (example: HANG==SUSPEND RTMON) and stored in a ; symbol definition string buffer in the format: ; ; CCCCCC0SSSSSSSSSSSS...SSSSSSSSSSSS0 ; ; where ; ; CCCCCC is an up-to-six character symbol, padded with nulls, ; ; 0 represents a null byte, and ; ; SSS... is the symbol definition (72 char. max., null padded). ; ; The first byte is set to 377 if a particular buffer is unused. ; ; The latter part of the last block contains the UCL version and release ; numbers, the "run-by-name" path and, possibly, the name of a file for ; a chain exit. ; ; When any of the information in these blocks is changed (symbol is ; defined, redefined, deleted; path/chain data is modified), the updated ; versions of blocks 1 - 18 are written to UCL.SAV. sdsat:: ;Symbol definition string address table... .blkw nsyms-1 sdsatl: .word 0 ;Last possible address entry in table sdsate: .word 0 ;End of table, always 0 sdsbfr: .rept nsyms ;Symbol definition string buffers... .byte 377 .blkb lsyms-1 .endr vznrls: .byte 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: .byte 0 ;"Permanent" flags byte ssbsiz = . - sdsat ;Pad out to an even block... filler = - rzrvd: .blkb filler .sbttl PROGRAM MAINLINE ; ================ .psect main .nlist bex vrshun: .ascii / UCL+ / .nlcsi ,part=RLSVER .list bex .even ; UCL can be entered in one of two ways. Usually, it is invoked by RT-11 ; because RT was unable to interpret a command line. In this case, the ; original command line text is passed to UCL in the chain area starting at ; location 512 with the byte count in the word at 510. UCL detects this ; non-zero byte count, moves the command line to it's input buffer, ; processes it, and executes the appropriate return to the monitor. ; ; A byte count of zero indicates that UCL has been invoked with a monitor R ; or RUN command. This situation causes UCL to request an input line from ; the console (or an indirect command file). Command line processing is the ; same as above with one exception: if command execution does not require a ; return to the monitor (e.g., LIST SYMBOLS), UCL prompts for another ; command line after processing the previous line. ucl:: mov #tsxp$,status ;Assume TSX+, init status word .gval #scrach+2,#sysgen ;Get contents of SYSGEN word in RMON tst r0 ;Running under TSX+ V5 or later? bmi 5$ ;Branch if so clr status ;Reset TSX+ bit in status word .gval #scrach+2,#config ;Get contents of CONFIG word in RMON bit #kt11$,r0 ;XM monitor? beq 5$ ;Branch if not .settop #-2 ;Ensure we "own" handler load area 5$: mov @#bytcnt,r0 ;Get no. of bytes in command line beq 20$ ;If none, go prompt for something mov #cmdbuf,r1 ;R1=>command line from RT-11 mov #buff,r2 ;R2=>input buffer 10$: movb (r1)+,(r2)+ ;Move command line into buffer... sob r0,10$ clrb (r2) br 40$ ;Go interpret it 20$: .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 20$ ;Nope, ask again 30$: movb (r0)+,(r1)+ ;Ensure leading blanks squeezed out... bne 30$ 40$: bic #ximm,status ;Clear "execute-immediate" flag .getcom #buff,#cmd ;Get command into command buffer... call clencm ;Zap any "other-UCL-style" stuff call tstuc ;Test for availability of UC handler .if ne pfx call ucitst ;Handle any UCI_MODE arrangements .endc .cscan ,#rsalst ;Look for a match call procap ;"Memorize/Recall" rest of input string call @cealst(r5) ;Execute the indicated routine bit #ximm,status ;"Execute-immediate" flag set? bne 40$ ;Branch if so bit #runc,status ;Were we RUN? bne 20$ ;Branch if so .settop #0 ;Exit otherwise... .exit .sbttl TRAPS: BAD AND AMBIGUOUS COMMANDS ; ================================= ; The following stuff is the traps for invalid (BADCOM) and ambiguous (AMBCOM) ; 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 call tstee ;Hmmm...are we defining a symbol? bcs 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 mov sp,spsav ;See if there is a file out there called .csigen dspace,#dext,#cmd ;"DEV:command.SAV"... bcc 90$ ;Branch if there is mov spsav,sp ;Restore the stack pointer pop r0 ;Restore R0 (points at next "DEV:" in path) tstb (r0) ;End of the path? beq badcmx ;Go complain if so br 70$ ;Otherwise, go try next "DEV:" 90$: .close #3 ;Hand-holding mov spsav,sp ;Clean up the stack... pop r0 mov #cmd,r1 ;Build "RUN DEV:" string... call tstdmn .getcom r1,#rundev br 50$ ;Go do "run-by-name" badcmx: tstb pflags ;UCI_MODE? bpl 10$ ;Go check CHAINing if not mov savr0,r1 ;If 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 call tstee ;Defining a symbol? bcc synsrt ;Branch if so mov #mamb,r5 ;"Ambiguous Command"... mov #buff,r0 tsttsx: bit #runc,status ;Were we RUN? bne 10$ ;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$: mov r0,r4 ;R4 => unrecognized command string br ferrx ;Go do "fatal" error exit... ;Invalid DISPLAY stuff comes here: baddsp:: bic #,status ;Zap any DISPLAY bits 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. chanr:: bit #dspla,status ;DISPLAY active? beq 10$ ;Branch if not jmp baddsp 10$: .csispc #scrach,#dext,#chanto ;convert filename to RAD50, lazy way mov #4,r0 ;Move filename to chain area... mov #scrach+36,r1 mov #chname,r2 20$: mov (r1)+,(r2)+ sob r0,20$ mov savr0,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! .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:: .print #muclf ;"?UCL-F-" mov r5,r0 ;R5 => error message .print ;Print it mov r4,r0 ;R4 => additional text beq 10$ ;Branch if none .print ;Print text 10$: bit #runc,status ;Were we RUN? beq 20$ ;Branch if not mov #776,sp ;Force a return to the mainline return ; if we were... 20$: bisb #sever$,@#userrb ;Set error bit .settop #0 ; and do a hard exit... clr r0 .exit .sbttl SYMBOL PROCESSING ROUTINES ; ========================== .sbttl synsrt ; SYNSRT inserts a new definition into the tables. ; On entry, R0 is pointing at the definition string in the input buffer, BUFF ; (i.e., just after the "==") and R1 points at the command buffer, CMD which ; contains the string representing the symbol. synsrt:: 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 adjr0 ;Skip any leading blanks in definition tstb (r0) ;Null definition string? bne 40$ ;Branch if not .gtlin #buff,#sydefq ;"Symbol Definition?" mov #buff,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 110$: call scomp ;Compare new one with it... tst r3 bgt 120$ ;Branch if new > this one mov (r4),2(r4) ;Move this address down one mov -(r4),r2 ;Point at next address up sob r5,110$ ; and go do another comparison 120$: mov r1,2(r4) ;Insert address of new definition .sbttl wtstbl ; Here we write the revised symbol definition blocks into UCL.SAV... wtstbl:: mov #1,wblok ;Set initial block no. mov #sdsat,wbufa ;Set address of initial block to write mov #nbloks,r5 ;R5 = no. blocks to write 20$: .writw #area,#17 ;Write a block bcs 30$ ;Branch on error inc wblok ;Bump block no. add #512.,wbufa ;Bump buffer address sob r5,20$ return ;Return 30$: mov #wtfail,r5 ;"Output Error..." clr r4 ; and exit... jmp ferrx .sbttl syproc ; This section processes a symbol that has been found to exist in the symbol ; definition string buffer area. ; It either, ; 1) uses the definition string for the symbol and the remainder of the ; original input string to build a command sequence and pass it to ; RT-11 for execution, or ; 2) detects that this is a redefinition of an existing symbol, and ; takes the appropriate action to update the definition. .enabl lsb syproc:: call tstee ;Symbol definition? bcc syrepl ;Branch if so push r0 ;Save R0 call adjr0 ;Skip leading blanks in input string mov r0,r4 ;Set R4 = R0 clr r0 ;Set R0 = 0 (counts no. char. copied) mov sdsat(r5),r1 ;R1 => sym. def. string buffer add #,r1 ;R1 => part to substitute cmpb (r1),#'_ ;Definition flagged for "execute-immediate"? bne 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$: 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 scopy ; This routine copies/builds a command line to the "chain buffer". This is ; done by copying a symbol definition string until a null byte or a "\" is ; encountered. Any time a "^" is encountered during the copying process, the ; "argument-part" of the original UCL input string is inserted at that point. ; Register use is as follows: ; ; R0 is incremented by the number of bytes copied ; R1 points at the symbol definition string ; R2 points at the output buffer ; R3 on entry, contains the maximum number of bytes to copy ; R4 points at the argument string to be inserted ; R5 is incremented every time an argument is inserted scopy: 10$: cmpb (r1),#'\ ;"\" encountered? bne 30$ ;Branch if not tst r3 ;Copy count exhausted? beq 20$ ;Branch if so clrb (r2)+ ;Insert a null byte dec r3 ;Adjust copy counts... inc r0 inc r1 ;Adjust input pointer 20$: return 30$: cmpb (r1),#'^ ;"insert argument" flag encountered? bne 40$ ;Branch if not push r1 ;Save R1 mov r4,r1 ;Make R1 => argument string call ccopy ;Insert it pop r1 ;Restore R1 inc r1 ;Adjust input pointer inc r5 ;Bump insert counter br 10$ ;Go look at next character 40$: tst r3 ;Copy count OK? beq 50$ ;Branch if done movb (r1)+,(r2)+ ;Copy a character inc r0 ;Adjust counters... dec r3 beq 50$ ;Branch if done tstb -1(r1) ;Did we just copy a null? bne 10$ ;If not, go get next 50$: return .sbttl tstee ; This routine tests for the presence of an "==" sequence in a string pointed ; to by R0. If it tests true, the carry is cleared and R0 points at the byte ; following the "==". If false, the carry bit is set and R0 is unchanged. ; Note that the test fails if there are any intervening non-blank characters. ; ; Tests are also made on the lengths of the symbol name (pointed to by R1) ; and the symbol definition. A warning message is issued if the symbol name ; or definition is too long. tstee: push r0 ;Save R0 call adjr0 ;Skip any blanks cmpb (r0)+,#'= ;"="? bne 10$ ;Branch if not cmpb (r0)+,#'= ;Another "="? beq 20$ ;Branch if so 10$: pop r0 ;Restore R0 sec ;Set carry return 20$: mov r5,(sp) ;Save R5 push r0 ;Save R0 mov r1,r0 ;R0 => symbol name call len ;Check length... cmp r5,#lcccc ble 30$ mov #trswrn,wrnmad ;"Truncating Symbol Name..." call wrngm 30$: pop r0 ;Restore R0 call len ;Check length of definition... cmp r5,#lssss ble 40$ mov #trdwrn,wrnmad ;"Truncating Symbol Definition..." call wrngm 40$: pop r5 ;Restore R5 clc ;Clear carry return .sbttl scomp ; This routine compares two strings. ; On entry, ; R1 => string 1 ; R2 => string 2 ; On return, ; R3 = -1, s1 < s2 ; 0, s1 = s2 ; 1, s1 > s2 scomp: push ;Save r2,r1... clr r3 ;Assume strings equal 10$: cmpb (r1)+,(r2)+ ;Compare a pair of characters blt 30$ ;Branch if 1st smaller bgt 40$ ;Branch if 1st larger tstb -1(r1) ;Past end of 1st string? bne 10$ ;Go look at next character if not 20$: pop ;Restore r1,r2... return 30$: dec r3 ;Flag 1st < 2nd br 20$ 40$: inc r3 ;Flag 1st > 2nd br 20$ .sbttl UTILITY ROUTINES FOR PROCESSING COMMAND LINES ; ============================================= .sbttl clencm ; Routine to clean up a command (zaps asterisk and terminating colon)... ; This routine scans a command from left to right and removes the first ; embedded asterisk that is encountered. It will also, if found, delete ; a trailing colon. This routine is used to provide compatibility with ; the UCL distributed with RT-11 V5.1. ; On entry, R1 points at the command string to be cleaned up. No registers ; are disturbed by this routine. clencm: push ;Save R0, R1 10$: tstb (r1) ;Null byte? beq 30$ ;Go quit if it is cmpb (r1)+,#'* ;"*" encountered? bne 10$ ;Branch if not mov r1,r0 ;Point R0 at position of "*"... dec r0 20$: movb (r1)+,(r0)+ ;Shift rest of command left 1 byte... bne 20$ tst -(r1) ;Point R1 at current terminating null 30$: cmpb -(r1),#': ;Is last character a ":"? bne 40$ ;Branch if not clrb (r1) ;Zap it if so 40$: pop ;Restore R1, R0 return .sbttl procap ; Routine to process the "argument part" of a command line... ; PROCAP checks the remainder of the input string following the command. If ; there is no "argument part" (AP), or if a symbol definition operator ("==") ; is detected, PROCAP takes no action. If a "^" character or characters is ; encountered, PROCAP retrieves the last "input-file" string from UC: (if the ; handler is available). This string is then inserted wherever a "^" occurred ; in the original input string. If an AP string is present, PROCAP sends the ; entire input string to UC: (UC: parses out the "input-file" part of the ; string and stores it). ; On entry: ; R0 is assumed to point at the next character past the command part of ; the input string ; R5 should contain the command match offset from the call to CSCAN ; On return the registers are undisturbed procap:: bit #ucres,status ;UC: available? beq 70$ ;Branch if not push ;Save registers call adjr0 ;Skip leading blanks tstb (r0) ;Null string? beq 60$ ;Branch if so mov r0,r1 ;R1 => buffer 10$: cmpb (r0)+,#'= ;Look for "=="... bne 20$ cmpb (r0),#'= beq 60$ ;Just quit if found 20$: tstb (r0) ;End of string yet? bne 10$ ;Branch if not mov r1,r0 ;R0 => buffer 30$: cmpb (r0)+,#'^ ;Pointing at "^"? beq 40$ ;Branch if so tstb r0 ;Null? bne 30$ ;If not, keep looking tst cxslst(r5) ;Are we allowed to stash the string? bmi 60$ ;Branch if not call loducb ;"Memorize" AP string... br 60$ ; "It all comes back to me now. The ball, it's beginning to clear..." ; -- The Firesign Theater on "I Think We're All Bozos On This Bus" 40$: mov #scrach,r4 ;R4 => buffer for UC: string push r1 ;Save R1 mov r4,r1 ;Get string from UC:... call getucb clr r0 ;R0 will contain length of resultant string mov (sp),r1 ;R1 => string to insert mov #obufr,r2 ;R2 => destination for resultant string mov #82.,r3 ;R3 = max. length of result call scopy ;Build the string pop r1 ;Recall R1 (points into UCL's input buffer) mov #obufr,r2 ;R2 => string we just built 50$: movb (r2)+,(r1)+ ;Replace old AP string with new one... sob r0,50$ 60$: pop ;Restore registers 70$: return ;Quit .sbttl swtchs ; Routine to process switches... ; This routine uses the GETCOM/CSCAN calling sequence to detect and report on ; any switches that might be present in a command line. ; ; On entry: ; ; R0 points into the input buffer, immediately after the command or ; argument that may be followed by some switches. ; ; R4 points at an argument list: ; ; _________ ; R4 => | SRSAL | ; --------- ; | SEAL | ; --------- ; | SSBL | ; --------- ; | STXAL | ; --------- ; ; SRSAL is the address of the beginning of a switch reference string ; address list. This list is similar to the RSAL for commands. It ; is a list of pointers to the ASCIZ strings representing the valid ; switches. As with commands, these addresses are sorted in alpha- ; betical order by the strings that they refer to. ; ; SEAL is the address of a switch execution address list, sorted by ; the referenced switch strings. This list contains the addresses of ; the routines that will be executed when a given switch is found. ; ; SSBL is the address of the beginning of a switch status bit list. ; This list is a series of contiguous words containing the bit(s) that ; should be set in the switch status word SWSTAT if a given ; corresponding switch is detected and these words should be in ; alphabetical order by their referenced switches. ; ; STXAL is the address of an optional switch text address list. It uses ; the same ordering as the above lists and contains pointers to ASCIZ ; strings that represent the output switch text to be generated by the ; corresponding switch handing routines. For example, a /STRIP switch ; might generate the text "/S" in the switch text buffer when building ; an output command string. ; ; ; On return: ; ; R0 will be pointing at the next byte past the last detected switch. ; ; R1 - R4 will be unchanged ; ; R5 will contain one of the following values: ; ; -8 invalid switch option ; -6 conflicting switches ; -4 invalid switch ; -2 ambiguous switch ; 0 no errors ; ; SWSTAT will contain the status bit(s) for any detected switches. ; ; The ERASE and RNO command routines contain examples of switch processing. swtchs:: clr swstat ;Clear any old switch status bits mov #stxbuf,stxbp ;Reset pointer into STXBUF push ;Save R1 - R4... 10$: push r4 mov #swbuf,r1 ;R1 => switch buffer call adjr0 ;Skip leading blanks cmpb (r0),#'/ ;Find a switch? bne 20$ ;Branch if not... inc r0 ;Extract the switch string... .getcom ,#swbuf,#tmtblc .cscan ,(r4) ;Try to identify it tst r5 ;Error? bmi 30$ ;Branch if so pop r4 ;Restore R4 (points at argument list) mov 2(r4),r3 ;R3 => switch execution addr. list add r5,r3 ;R3 => addr. of switch routine to execute call @(r3) ;Go process switch bcc 10$ ;Go look for another switch if no errors mov #-6,r5 ;Assume conflicting switches bit #cnswer,swstat ; and test for this bne 40$ ; and branch if so mov #-10,r5 ;Otherwise, it must be invalid switch option br 40$ ;Go quit 20$: clr r5 ;Clear R5 (no errors) 30$: pop r4 ;Restore R4 - R1... 40$: pop return ; The following is a selection of switch handling routines. They are used by ; ERASE and RNO and, as they handle fairly common situations, could be used ; by any new hard-wired commands that you might add. ; ; On entry to any switch routine: ; ; R0 points at the byte in the input buffer immediately following the ; switch string being processed. Note that this means that, if the ; switch takes an argument, R0 will be pointing at the beginning of ; the argument string (example: "/OUT:MYFILE; R0 points at ":"). ; ; R4 points at the argument list (described at beginning of SWTCHS ; routine). ; ; R5 contains the current offset into the switch Execution Address ; List and, thus, the proper offset for locating the appropriate ; bit mask in SSBL and the output switch text in STXAL. ; ; On return: ; ; Any appropriate status bits should be set in SWSTAT. Note that ; if an error flag bit is set (conflicting switch or invalid option), ; SWTCHS will set the appropriate offset in R5. ; ; The carry bit should be set if an error occurred and cleared ; otherwise. ; ; If the routine processed a switch option, R0 should be pointing at ; the next character past it in the input buffer. R0 should be ; undisturbed otherwise. .sbttl swbits ; SWBITS is used to set the appropriate bits in SWSTAT. swbits: push r5 ;Save R5 add 4(r4),r5 ;R5 => bit mask bis (r5),swstat ;Set switch status bit(s) pop r5 ;Restore R5 clc ;Clear carry return ;Return .sbttl prntsr ; /PRINTER switch routine... prntsr: push ;Save R0 and R1... .getcom #lpnam,#outfnm ;Move "LP:" to buffer pop ;Restore R1 and R0... jmp swbits ;Go finish up (set SWSTAT bit & clear carry) lpnam: .asciz /LP:/ .even .sbttl termsr ; /TERMINAL switch routine... termsr: push ;Save R0 and R1... .getcom #ttnam,#outfnm ;Move "TT:" to buffer pop ;Restore R1 and R0... jmp swbits ;Go finish up (set SWSTAT bit & clear carry) ttnam: .asciz /TT:/ .even .sbttl outsr ; /OUTPUT:filename switch... outsr: call swbits ;Set status cmpb (r0),#': ;Pointing at ":"? beq 10$ ;Branch if so bis #badopt,swstat ;Error: set bad option flag, sec ; set carry, return ; and return 10$: push r1 ;Save R1 inc r0 ;Point at filename .getcom ,#outfnm ;Put filename in buffer pop r1 ;Restore R1 clc ;Clear carry return .sbttl frmsr, nfrmsr ; /[NO]FORM0 switch... nfrmsr: mov #1,wblok0 ;Set PLINE to start output with block 1... br frmsr0 frmsr: clr wblok0 ;Set PLINE to start output with block 0... 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 .settop #0 ;Do a hard exit... clr r0 .exit .sbttl subcmd ; Routine to substitute a UCL command for an RT command (presumably)... ; ; What this routine actually does is copy the string pointed to by R1 into ; buffer CHBUF followed by the string pointed to by R0. It then causes this ; concatenated string to be passed to RT-11 as a command string. ; ; Note that, on entry to a CSE routine, R0 points at the remainder of the ; original input string following the command that UCL has parsed-out and ; interpreted. For example, this would allow a CSE routine for a BUILD ; command to change the input string "BUILD/MAC MYPROG" ; to "EXECUTE/NORUN/MAC MYPROG" ; and then cause it to be executed by simply pointing R1 at the .ASCIZ string ; for "EXECUTE/NORUN" and calling or jumping to SUBCMD. subcmd: push r0 ;Save contents of R0 on stack clr r0 ;Clear R0 mov #chbuf,r2 ;R2 => CHBUF mov #chbufl-1,r3 ;Put max byte count in R3 call ccopy ;Copy first part of string into CHBUF pop r1 ;Get address of 2nd part of string off stack call ccopy ;Stuff 2nd string into CHBUF clrb (r2) ;Terminate with null byte... inc r0 mov #chbuf,r1 ;Point R1 at concatenated string and br setcm0 ; go pass it to RT-11 as a command string .sbttl ccopy, ccopy0 ; Command string copy routine... ; ; On entry, R1 points at the string to be copied ; R2 points at the destination for the string ; R3 contains the maximum allowable number of bytes to copy ; ; R0 is incremented by the number of bytes copied ; R3 is decremented by the same amount ; ; Copying is terminated by the detection of a null byte in the input string ; (the null byte is NOT copied!!!) or if the value in R3 decrements to zero. ccopy: tstb (r1) ;Null byte? beq 10$ ;Yep... movb (r1)+,(r2)+ ;Move a byte inc r0 ;Bump byte count dec r3 ;Decrement copy limit count bne ccopy ;If R3 > 0, try for another 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. wrngm: push r0 ;Save R0 .print #muclw ;"?UCL-W-" .print wrnmad ; pop r0 ;Restore R0 bit #runc,status ;Were we RUN? beq 10$ ;Branch if not bisb #warn$,@#userrb ;Set "warning" bit in user error byte 10$: return .sbttl 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 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 50$ ;Branch if so tstb prlfnm ;Is there a file to open? bne 20$ ;Branch if so .print ;Just print line at console br 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) mov sp,spsav ;Save stack pointer .csigen dspace,#dext,#prlfnm ;Open output file bcs plcser ;Handle errors mov spsav,sp ;Restore stack bis #odopn,status ;Tell 'em we're open mov #obufr,obptr ;Init output buffer pointer mov wblok0,wblok ; and block number 50$: mov obptr,r1 ;R1 => next loc in output buffer 60$: movb (r4)+,(r1)+ ;Put a character in buffer bgt 90$ ;Branch if not a terminator bmi 70$ ;Branch if end of string (200 byte) mov #eolstr,r4 ;Append cr/lf... dec r1 br 60$ 70$: dec r1 ;Adjust and store next loc pointer... mov r1,obptr br plinx ;Go quit 90$: cmp r1,#obptr ;Buffer full? blt 60$ ;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 60$ ;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 30$ ;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$: .close #0 ;Close the file bic #odopn,status ;Reset status and file name buffer... 30$: clrb prlfnm plinx: pop ;Restore registers 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 ; Routines to access UC handler... .sbttl tstuc ; TSTUC tests to see if the UC handler is loaded in memory. If so, ; the "UC resident" bit is set in the status word. .enabl lsb tstuc:: bic #ucres,status ;Ensure "UC resident" bit cleared push r0 ;Save R0 .serr ;Set up to trap possible .LOOKUP error .lookup #ucablk,#16,#ucname ;Attempt to open channel to UC: bcc 10$ ;Branch if no error tstb @#errbyt ;Did we already check? (i.e., channel is open) bne 20$ ;Nope 10$: bis #ucres,status ;Flag success 20$: .herr ;Reenable normal error trapping 30$: pop r0 ;Restore R0 return ;Quit .sbttl getucb ; GETUCB gets the contents (if any) of the text storage buffer in UC:. ; On entry, R1 is assumed to point at the beginning of the destination ; buffer. getucb:: push ;Save R0, R1 .readw #ucablk,#16,r1,#41.,#0 ;Get buffer contents pop r1 ;Quit... br 30$ .sbttl loducb ; LODUCB loads the UC: text storage buffer. loducb:: push r0 ;Save R0 .writw #ucablk,#16,#buff,#41.,#0 ;Stash buffer contents br 30$ ;Go quit .dsabl lsb .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 status: .word 0 ;Program status word swstat: .word 0 ;Switch status word wrnmad: .word 0 ;Address of warning message for WRNGM .sbttl Buffers buff:: .blkb 184. ;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 182. ;Intermediate "chain exit" buffer scrach: .blkw 45. ;Scratch area obufr: .blkw 256. ;Output buffer for listings obptr: .word 0 ;Pointer for above .sbttl Argument Blocks area: .word 0 ;Argument block area for .WRITW's... wblok: .word 0 wbufa: .word 0 wcnt: .word 256. .word 0 wblok0: .word 0 ;Initial block no. for .WRITW output ucablk: .blkw 5 ;Argument block for UC EMT's ucname: .rad50 "UC " ;Handler name for .LOOKUP... .word 0,0,0 dext: .rad50 "SAV" ;Default extensions for .CSIGEN call .rad50 "LST" .word 0,0