.sbttl "HARD-WIRED" COMMANDS ; ===================== ; Command Execution Routines ; -------------------------- ; ; This is a collection of routines that illustrate some of the types of ; things that you can do with "hard-wired" commands. Some of them (CD, RNO) ; might not be useful to you. You can get rid of them by editing them out ; completely (don't forget the reference string and the entries in the ; tables CEALST and RSALST) or, more simply, just remove the appropriate ; CEALST and RSALST table entries and leave the code lying around for ; reference. ; ; ; ******************************************************************** ; * * ; * NOTE: Keep CHAIN, DISPLAY, ERASE, LIST, PASS_ON, PATH, RECALL, * ; * and STORE! * ; * You might need them! * ; * * ; ******************************************************************** .psect uclhwc .sbttl chain ; "Set Up Exit-On-Bad Command Chain" CHAIN file-spec ; ===== /RESET chain:: mov #chnarl,r4 ;Check for switches... call swtchs tst r5 ;Got any? bpl 10$ ;Branch if so jmp @chnsea(r5) ;Go handle errors 10$: bit #rst,swstat ;"/RESET"? beq 20$ ;Branch if not clr chanto ;Disable chaining 15$: jmp wtstbl ;Go write out the change 20$: call adjr0 ;Skip leading blanks tstb (r0) ;Null file name? bne 30$ ;Branch if not .gtlin #buff,#toqry ;"To? " mov #buff,r0 ;Point at input buffer br 20$ ;Go check it 30$: mov #chanto,r1 ;R1 => filename buffer for CHAIN mov #15.,r2 ;R2 = max. length for filename push r0 ;Save buffer pointer 40$: movb (r0)+,(r1)+ ;Move filename to CHAIN filename buffer... beq 50$ sob r2,40$ pop r4 ;Oops! filename too long... mov #millfn,r5 jmp ferrx 50$: pop r0 ;Clean up stack and br 15$ ; go write out changes chnrsa: .word rstsw ;Reference string address list for switches .word 0 .word badswx ;Switch execution addresses .word ambswx chnsea: .word swbits chnssb: .word rst ;/RESET switch status bit chnarl: .word chnrsa ;Argument list for SWTCHS call .word chnsea .word chnssb .sbttl display ; "Display Command Expansion" DISPLAY command-string ; ======= /EXECUTE ; /NOEXECUTE dsplay:: mov sp,dspsp ;Save current stack pointer value mov #dsparl,r4 ;R4 => arg. list for switches call swtchs ;Check for switches tst r5 ;Any errors? bpl 10$ ;Branch if not mov dspsp,sp ;Clean up stack and jmp @dspsea(r5) ; go handle errors 10$: bis #dspla,status ;Set display bit in status bit #exe,swstat ;"/EXECUTE"? beq 20$ ;Branch if not bis #dsplx,status ;Set display+execute bit in status 20$: call adjr0 30$: tstb (r0) ;Command entered? bne 40$ ;Branch if so .gtlin #buff,#dspqry ;"Command?" mov #buff,r0 ;R0 => input buffer br 30$ 40$: mov #buff,r1 ;Left justify remainder of input buffer... 50$: movb (r0)+,(r1)+ bne 50$ mov #buff,r0 ;R0 => input buffer cmpb (r0),#'" ;Just print the line? bne 60$ ;Branch if not inc r0 ;Skip leading " .print ;Print remainder of input line bic #dspla!dsplx,status ;Zap any display bits in status word return 60$: .getcom ,#cmd ;Cause command execution (ensure rest of call clencm ; buffer pointers reset)... .cscan ,#rsalst jmp @cealst(r5) ; This routine lists a command expansion. On entry, R0 contains the byte ; count and R1 the text address. It forces a return to the mainline unless ; the display+execute bit is set in STATUS. dsplst:: push ;Save R0 - R2... mov r0,r2 ;Put byte count in r2 .print #crlf ;Print a blank line 10$: movb (r1)+,r0 ;Get a character bne 20$ ;Branch if not null .print #crlf ;Print a CR/LF... br 40$ 20$: cmpb r0,#space ;Is it a control character? bge 30$ ;Branch if not bic #^C<37>,r0 ;Ensure no extraneous bits movb ctrltb(r0),ctrlch ;Print "^" whatever... .print #uparow br 40$ 30$: .ttyout ;Print the character 40$: sob r2,10$ ;If not done, go do another .print #crlf ;Print a blank line pop ;Restore R2 - R0... bit #dsplx,status ;Go ahead and execute the command? bne 50$ ;Branch if so mov dspsp,sp ;Nope, reset stack 50$: bic #,status ;Ensure display bits cleared and return ; return .nlist bex uparow: .ascii /^/ ctrlch: .byte 0,200 ctrltb: .ascii /@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_/ .list bex .even ; Switch routines: dspexs: bit #nex,swstat ;Switch conflict? bne dspcsw ;Branch if so jmp swbits ;Go set bit in SWSTAT otherwise dspcsw: bis #cnswer,swstat ;Set "conflicting switches" flag sec ;Set carry and return ; return dspnxs: bit #exe,swstat ;Switch conflict? bne dspcsw ;Branch if so jmp swbits ;Go set bit in SWSTAT otherwise dspsp: .word 0 ;Save area for stack pointer ; Reference string address list for switches: dsprsa: .word exesw .word nexsw .word 0 ; Switch status bit list: dspssb: .word exe .word nex ; String execution address list: .word cnfswx .word badswx .word ambswx dspsea: .word dspexs .word dspnxs ; Argument list for SWTCHS call: dsparl: .word dsprsa .word dspsea .word dspssb .sbttl erase ; "Erase A Symbol" ERASE sym1,sym2,... ; ===== /ALL ; /NOQUERY ; /QUERY sbksiz = /2 erase:: clr wrnmad ;Clear warning message buffer mov #ersarl,r4 ;R4 => switch processing argument list call swtchs ;Check for and flag switches tst r5 ;Any errors? bpl 10$ ;Branch if not jmp @erseal(r5) ;Go handle errors 10$: bit #all,swstat ;"/ALL"? beq er1sym ;Branch if not bit #noq,swstat ;"/NOQUERY"? bne 20$ ;Branch if set .print #eraqry ;"Erase All Symbols" .gtlin #buff,#rusure ;"Are You Sure?" bicb #40,buff ;"Y"-for-yes?... cmpb buff,#'Y beq 20$ ;Branch if so return ; Erase all symbols... 20$: mov #sdsat,r0 ;Clear entire symbol area... mov #sbksiz,r1 30$: clr (r0)+ sob r1,30$ mov #sdsbfr,r0 ;Insert "string deleted" bytes... mov #nsyms,r1 40$: movb #377,(r0) add #lsyms,r0 sob r1,40$ call wtstbl ;Write changes to SAV image and return ; return ; Erase one symbol at a time... .enabl lsb er1sym: call adjr0 ;Skip any blanks mov r0,savr0 ;Save input buffer pointer tstb (r0) ;Null byte? bne 10$ ;Branch if not .gtlin #buff,#er1qry ;"Symbol?" mov #buff,r0 tstb (r0) ;Null response? bne er1sym ;Branch if not return ;Return otherwise 10$: .getcom ,#cmd ;Extract symbol from input string tstb (r0) ;Last symbol in list? beq 20$ ;Branch if so inc r0 ;Skip separator 20$: mov r0,savr0 ;Save pointer .cscan ,#sdsat ;Try to find entry we want to erase tst r5 ;Find it? bpl 30$ ;Branch if so jmp @er1erx(r5) ;Go handle errors 30$: tst r3 ;Find an exact match? beq 40$ ;Branch if so bit #noq,swstat ;"/NOQUERY" bit set? bne 60$ ;Branch if it is mov sdsat(r5),r1 ;R1 => symbol definition string mov #cmd,r2 ;R2 => command buffer mov #6,r3 ;R3 = max. no. characters to copy call ccopy ;Copy full name of symbol into command buffer clrb (r2) ;Terminate with null br 50$ ;Go ask about this 40$: bit #qry,swstat ;"/QUERY"? beq 60$ ;Branch if not 50$: .print #ersqry ;"Erase Symbol...?" .print #cmd .gtlin #buff,#rusure ;"Are You Sure?" bicb #40,buff ;"Y"-for-yes?... cmpb buff,#'Y bne eraseq ;Branch if not 60$: add #sdsat,r5 ;R5 => symbol string address movb #377,@(r5) ;Flag string entry as deleted 70$: clr (r5) ;Clear address entry cmp r5,#sdsatl ;Last entry in table? beq eraseq ;Branch if so mov 2(r5),(r5)+ ;Shift up next address entry br 70$ ;Go shift next one eraseq: call wtstbl ;Write changes to SAV image tst wrnmad ;Doing "erase by name"? beq 80$ ;Branch if not call wrngm ;"UCL-W-Erased Symbol xxxxxx"... .print #cmd return 80$: mov savr0,r0 ;Get pointer to next symbol name call adjr0 ;Skip leading blanks tstb (r0) ;End of list? bne 10$ ;Branch if not return ; Entry for "erase by name"... er1sy0: mov #erawrn,wrnmad ;Set up for erase warning message br 60$ ;Go do it .dsabl lsb ; Error traps for ERASE .word er1erx .word er1er0 er1erx: mov #er1nfm,r5 ;"Symbol Not Found..." br er1er1 er1er0: mov #er1amm,r5 ;"Ambiguous Symbol..." er1er1: mov #cmd,r4 jmp ferrx ; Switch reference string address list for ERASE: ersal: .word allsw .word noqsw .word qrysw .word 0 ; Switch status bit list for ERASE: erssbl: .word all .word noq .word qry ; Switch execution address list: .word badopx .word cnfswx .word badswx .word ambswx erseal: .word swbits .word swbits .word swbits ; Argument list for SWTCHS call: ersarl: .word ersal .word erseal .word erssbl .sbttl list ; "List Current UCL Commands" LIST arg1,arg2,... ; ==== ALL ; CHAIN ; COMMANDS ; PATH ; SYMBOLS lister:: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null argument? beq lists ;Force default to "LIST SYMBOLS" 10$: .getcom ,#cmd ;Move argument to command buffer mov r0,savr0 ;Save input buffer pointer .cscan ,#lisal ;Look for valid argument tst r5 ;Invalid argument? bmi 30$ ;Branch if so call @liseal(r5) ;Go execute appropriate routine mov savr0,r0 ;Restore input buffer pointer tstb (r0) ;Done? bne 20$ ;Branch if not return 20$: inc r0 ;Point at next argument br 10$ ;Go handle it 30$: jmp @liseal(r5) ;Go handle errors lista: ;"LIST ALL"... call listc ;List commands call lists ;List symbols call listp ;List path call listx ;List chain return lists: ;"LIST SYMBOLS"... .print #listsm ;"Current Symbols" mov #nsyms,r5 ;R5 = max. no. symbols mov #sdsat,r4 ;R4 => SDS addr. table 10$: mov (r4)+,r1 ;R1 => next string address bne 70$ ;Branch if not end of table cmp r5,#nsyms ;Were there any entries? blt 20$ ;Branch if so .print #listsn ;"None Defined" 20$: mov #listse,r0 ;r0 => "___ Entries Remaining" movb #space,(r0) ;Convert number of entries remaining to ASCII cmp r5,#100. ; and store result... blt 30$ movb #'1,(r0) sub #100.,r5 30$: mov #90.,r2 mov #71,r1 movb #space,1(r0) cmpb (r0),#space beq 40$ movb #'0,1(r0) 40$: cmp r5,r2 bge 50$ dec r1 sub #10.,r2 beq 60$ br 40$ 50$: movb r1,1(r0) sub r2,r5 60$: bis #60,r5 movb r5,2(r0) .print ;Print resulting string return 70$: mov #scrach,r2 ;R2 => buffer for output string mov #,r3 ;R3 = max. no. characters to copy call ccopy ;Copy symbol part to buffer movb #'=,(r2)+ ;Insert "==" movb #'=,(r2)+ mov -2(r4),r1 ;Copy definition part (put ~'s in add #,r1 ; place of control characters)... clr r0 80$: movb (r1)+,r0 beq 100$ cmpb r0,#37 bgt 90$ movb #'~,r0 90$: movb r0,(r2)+ dec r3 bne 80$ 100$: clrb (r2) ;Terminate with null .print #scrach ;Print result dec r5 ;Adjust counter br 10$ ;Go get next string listc: ;"LIST COMMANDS"... .print #listcm ;"Valid Commands:" mov #rsalst,r1 ;R1 => Reference String Address List 10$: mov (r1)+,r0 ;Point R0 at a string beq 20$ ;Go quit if we've hit end of list .print ;Print the string on the console br 10$ ;Go look for the next one 20$: .print #crlf ;Print blank line return listp: .print #listpm ;"Run-by-name" path:" .print #pthbuf ;Print the path return listx: tst chanto ;Is CHAIN in effect? bne 10$ ;Branch if so .print #listx0 ;"No CHAIN In Effect" return 10$: .print #listxm ;"CHAIN In Effect To..." .print #chanto .print #crlf return badarg: mov #mbadrg,r5 ;Issue "?UCL-F-Invalid Argument"... mov #cmd,r4 jmp ferrx ;Take "fatal" error exit ; Reference string address list for LIST: lisal: .word allsw .word schain .word comsw .word spath .word symsw .word 0 ; Argument execution address list for LIST: .word badopx .word cnfswx .word badarg .word ambcom liseal: .word lista .word listx .word listc .word listp .word lists .sbttl pass_on ; "Pass-on Command To Next (or another) Program" PASS_ON command ; ======= /TO:program-name ; This command tells UCL to pass the specified command- ; string on to the program that you specified via the ; CHAIN command. If you specify a "program-name", then ; the command is passed to this program instead. If ; CHAINing is not in effect, and you failed to specify ; a program to chain to, you get your hand slapped with ; "UCL-F-No CHAIN In Effect". ; ; Note that the command string is passed "UCL-style" ; (byte count at location 510, string starting at 512) ; not "run-by-name" style. pass:: mov #pasarl,r4 ;Check for /TO: switch... call swtchs tst r5 ;Errors? bpl 10$ ;Branch if not jmp @passea(r5) ;Go handle errors 10$: tst swstat ;/TO: invoked? beq 30$ ;Branch if not mov #outfnm,r4 ;R4 => file-spec tstb (r4) ;Null file-spec? beq 25$ ;Branch if so mov #chanto,r1 ;Move file-spec to chain file-spec buffer... mov #15.,r2 20$: movb (r4)+,(r1)+ beq 40$ sob r2,20$ mov #outfnm,r4 ;Oops! Bad file name... 25$: mov #millfn,r5 28$: jmp ferrx 30$: tst chanto ;Is there a file-spec for chaining? bne 40$ ;Branch if so clr r4 ;Nope, "No CHAIN In Effect"... mov #listx0+2,r5 br 28$ 40$: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null command string? bne 50$ ;Branch if not .gtlin #buff,#dspqry ;"Command?" mov #buff,r0 ;R0 => command-string br 40$ ;Go check it 50$: mov r0,savr0 ;Go hand things off to the chainer... jmp chanr pasrsa: .word tosw ;Reference string address for switch .word 0 .word badopx ;Switch execution address list .word cnfswx .word badswx .word ambswx passea: .word outsr ;(use /OUT switch code) passsb: .word 1 ;Switch status bit pasarl: .word pasrsa ;Argument list for SWTCHS call .word passea .word passsb .sbttl path ; "Set Up 'Run-by-name' Search Path" PATH dev1,dev2,... ; ==== /RESET ; If a command or symbol is not found, UCL follows the ; list of devices set up with the PATH command in ; attempting a "run-by-name". It uses DK: by default. ; The limit is about 20 device mnemonics. comma = 054 path:: mov #chnarl,r4 ;Check for switches (uses same tables as call swtchs ; CHAIN command)... tst r5 bpl 5$ jmp @chnsea(r5) 5$: bit #rst,swstat ;"/RESET"? beq 10$ ;Nope mov #dkcoln,r1 ;Put the default device mnemonic in mov #pthbuf,r2 ; the path buffer... mov #4,r3 call ccopy0 br 45$ 10$: call adjr0 ;Skip leading blanks tstb (r0) ;Null list? bne 20$ ;Branch if not .gtlin #buff,#dmnqry ;"Device List?" mov #buff,r0 ;Go check response... br 10$ 20$: mov #20.,r4 ;R4 = max. no. of devices mov #pthbuf,r2 ;R2 => path buffer mov #80.,r3 ;R3 = max. no. bytes to copy 30$: call adjr0 ;Get a mnemonic... .getcom ,#cmd call tstdmn ;Check it bcs 60$ ;Branch on error push r0 ;Copy mnemonic to path buffer... call ccopy pop r0 call adjr0 ;If end of list, go quit... tstb (r0) beq 40$ inc r0 ;Skip separator (comma presumably) dec r4 ;Adjust device count bne 50$ ;Branch if still room 40$: clrb (r2) ;Add terminating null 45$: jmp wtstbl ;Go write changes 50$: movb #comma,(r2)+ ;Stick in a comma br 30$ ;Go get next device name 60$: clr r4 ;"Illegal Device"... mov #dmnerr,r5 jmp ferrx ; Routine to check a device mnemonic and force a colon on the end. ; ; On entry: ; R1 => device mnemonic ; ; On return: ; R1 is unchanged ; carry is set if mnemonic too long or too short ; carry is clear if no error tstdmn:: push ;Save R5, R0 .getcom r1,,#tmtblc ;Trim possible ":"... mov r1,r0 ;Get length of mnemonic... call len pop r0 ;Restore R0 cmp r5,#3 ;Check for valid length... bgt 10$ tst r5 bgt 20$ 10$: pop r5 ;Error: restore R5, sec ; set carry, and return ; return 20$: add r1,r5 ;R5 => end of mnemonic movb #':,(r5)+ ;Put ":" on end and clrb (r5) ; trailing null pop r5 ;Restore R5 clc ; clear carry, and return ; return .sbttl recall ; "Recall Symbol Definition and Status Tables" RECALL file-spec ; ====== ; Recalls (loads) the symbol definition and status area from a file that ; has previously been created with the STORE command. The default device ; is DK: and the default extension is .UCL (ie, DK:filnam.UCL where "filnam" ; is the file name you specify). recall:: call adjr0 ;Point at the file name clr r5 ;Open the file... call opnucl mov r0,savr0 ;Save file name pointer movb vznrls,r4 ;Get current version... mov #0,wblok ;Load symbol definition/status stuff from mov #sdsat,wbufa ; file... mov #nbloks,r5 10$: .readw #area,#3 bcs 30$ inc wblok add #512.,wbufa sob r5,10$ cmpb vznrls,r4 ;Loaded stuff same version? bne 20$ ;Branch if not .close #3 ;Close the input channel jmp wtstbl ;Go update UCL.SAV ; error traps... 20$: mov #vrerr,r5 ;R5 => "Wrong Version..." br 40$ ;Go take error exit 30$: mov #rclerr,r5 ;R5 => "Read Error..." 40$: bic #runc,status ;Force an exit (tables might be screwed-up) mov savr0,r4 ;R4 => input file name (as entered) .close #3 ;Make sure input channel closed jmp ferrx ;Go complain and quit ; This routine opens a UCL file. It is used by the RECALL and STORE commands. ; On entry: ; R0 points at the file name (ASCIZ string) ; R5 = 0 to open an existing file (RECALL) ; = -1 to open a new file (STORE) ; The registers are undisturbed on return. ; ; OPNUCL also prompts for a file name, if necessary. opnucl:: push ;Save R0 - R3 5$: call adjr0 ;Null file name?... tstb (r0) bne 10$ ;Branch if not .gtlin #buff,#filqry ;"File?"... mov #buff,r0 br 5$ 10$: mov r0,r1 ;Copy file name to scratch area... mov #scrach,r2 mov #14.,r3 call ccopy tst r5 ;Open old or new file? bpl 20$ ;Branch if old mov #newsfx,r1 ;Stick "[22]=" after file name... mov #6,r3 call ccopy 20$: clrb (r2) ;Add terminating null mov sp,spsav ;Open the file.. .csigen dspace,#uclext,#scrach bcs opnurx ;Branch on error mov spsav,sp ;Clean up the stack pop ;Restore R3 - R0 return ; error trap... opnurx: clr r5 ;Make R5 index to error message... movb @#errbyt,r5 asl r5 .purge #0 ;Ensure any open channels cleaned-up... .purge #3 mov spsav,sp ;Clean up stack pop ;Restore R3 - R1; R4 => file name mov opnuet(r5),r5 ;Point at error message jmp ferrx ;Go complain and quit ; data area for OPNUCL... uclext: .rad50 "UCL" ;Default extensions for .CSIGEN call .rad50 "UCL" .word 0,0 newsfx: .asciz /[22]=/ .even opnuet: .word millfn ;Error message address table .word dmnerr .word mpfilf .word mnroom .word mfilnf .sbttl store ; "Store Current Symbol Definition and Status Tables" STORE file-spec ; ===== ; The STORE command causes the symbol/status blocks to be written to a ; specified file. The default device is DK:, the default extension .UCL ; (DK:filnam.UCL). store:: call adjr0 ;Point at filename mov #-1,r5 ;Open the file... call opnucl mov r0,savr0 ;Save pointer to file name mov #0,wblok ;Write-out the symbol/status blocks... mov #sdsat,wbufa mov #nbloks,r5 10$: .writw #area,#0 bcs 20$ inc wblok add #512.,wbufa sob r5,10$ .close #0 ;Close the output channel return ; error trap 20$: mov @strerr,r5 ;R5 => "Write Error..." mov savr0,r4 ;R4 => file name .purge #0 ;Close channel; don't make file permanent jmp ferrx ;Go complain .sbttl cd ; "Change Default Device" CD device ; == ; CD dev becomes ASSIGN dev DK: ; ; CD with no argument becomes ASSIGN SY: DK: chngdf:: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null argument? beq 20$ ;Branch if so 10$: mov r0,r1 ;R1 => "dev" mov #argbuf,r2 ;R2 => buffer for device mnemonic mov #4,r3 ;R3 = max. no. bytes to copy call ccopy ;Copy mnemonic to buffer... clrb (r2) mov #assign,r1 ;R1 => "ASSIGN dev" mov #dk,r0 ;R0 => " DK:" jmp subcmd ;Go assemble the parts and execute the command 20$: mov #ddk,r1 ;R1 => "ASSIGN SY: DK:" stuff jmp setcmd ;Go execute it .nlist bex ddk: .word assign-ddktxt ddktxt: .ascii /ASSIGN SY:/ dk: .asciz / DK:/ assign: .ascii /ASSIGN / argbuf: .blkb 5 .list bex .even .sbttl rno ; Runoff Command Routine RNO/switches file-spec ; === ; ; RNO/switches MYFILE becomes RUNOFF outspec/switches=MYFILE ; This set of routines and tables implements an RNO command for use with ; DECUS RUNOFF version M02.4. ; ; The command switches and the RUNOFF switches and file specifications ; that they map to are as follows: ; ; RNO RUNOFF ; --- ------ ; /BEGIN:n /B:n ; /START:n ; ; /END:n /E:n ; ; /ONLY:n /B:n/E:n ; /PAGE:n ; ; /FORMLENGTH:n /F:n ; ; /HYPHENATION /H:YES ; ; /NOHYPHENATION /H:NO ; ; /HELP /I ; /INFORMATION ; ; /STRIP /S ; ; /NOSTRIP ignored ; ; /UNDERLINE /U:L ; /UNDERLINE:BACKSPACE /U:B ; :SIMULATED /U:S ; :NONE /U:N ; ; /NOUNDERLINE /U:N ; ; /VERSION /V ; ; /WAIT /W ; ; output specifications: ; ; /OUT:filename filename...= ; ; /PRINTER LP:...= ; ; /TERMINAL TT:...= ; ; no output spec. or LP:...= ; /DEFAULTS rno:: clrb outfnm ;Init. output file buffer mov #rnalst,r4 ;R5 => switch argument list call swtchs ;Process switches jmp @rnovec(r5) ;Go do whatever is right ; Above jump enters at RNOOK if no problems with switches rnook: call adjr0 ;Skip leading blanks tstb (r0) ;Null input file? bne 10$ ;Branch if not bit #4,swstat ;Input file required? bne 10$ ;Branch if not .gtlin #buff,#rnpmt ;"Input File?"... mov #buff,r0 br rnook 10$: push r0 ;Save R0 clr r0 ;Actual byte count accumulates in R0 mov #chbuf,r2 ;R2 => "chain buffer" mov #chbufl,r3 ;R3 = max. byte copy count mov #rnotxt,r1 ;Put "R RUNOFF" in chain buffer call ccopy0 bit #2,swstat ;Any output spec. entered? bne 20$ ;Branch if yes bit #4,swstat ;Output file required? bne 30$ ;Branch if not mov #deftxt,r1 ;Use "LP:" otherwise... call ccopy br 30$ 20$: mov #outfnm,r1 ;Copy output spec... call ccopy 30$: mov #stxbuf,r1 ;Copy switches... call ccopy mov #eqlsin,r1 ;Insert "="... call ccopy pop r1 ;R1 => input spec. (old R0) call ccopy0 ;Copy it to chain buffer mov #uarowc,r1 ;Copy in "^C"... call ccopy0 mov #chbuf,r1 ;Pass command line to RT-11... jmp setcm0 ; Specialized switch routines for RNO... ; /OUT:filename rnoutr: bit #2,swstat ;Already have output spec? bne confsw ;Yes jmp outsr ;No confsw: bis #cnswer,swstat ;Set "conflicting switches" flag sec ;Set carry bit return ; /PRINTER rnprnr: bit #2,swstat bne confsw jmp prntsr ; /TERMINAL rntrmr: bit #2,swstat bne confsw jmp termsr ; /DEFAULTS rndefr: bit #2,swstat ;Previous output specs? bne confsw push ;Save R0, R1... mov #deftxt,r0 ;Copy default stuff to output-spec. buffer... mov #outfnm,r1 10$: movb (r0)+,(r1)+ bne 10$ pop ;Restore R1, R0... jmp swbits ;Update switch status ; /ONLY:n and /PAGE:n rnolyr: mov #rnbsrs,r1 ;R1 => "/B:" call ctstxb ;Append it to switch text buffer call getopt ;Get the "n" part into OPBUF bcc 20$ ;Branch if it was there dec stxbp ;Zap unneeded ":"... clrb @stxbp 10$: jmp swbits ;Go update switch status 20$: push r1 ;Save R1 (points at the "n" part) 30$: cmpb (r1),#'0 ;See if "n" text is entirely numeric... blt 40$ cmpb (r1)+,#'9 bgt 40$ tstb (r1) bne 30$ movb #'.,(r1)+ ;They're all numbers; append decimal point... clrb (r1) 40$: pop r1 ;Restore R1 call ctstxb ;Append the "n" to the switch text buffer mov #rnesrs,r1 ;R1 => "/E:" call ctstxb ;Copy this part mov #opbuf,r1 ;R1 => "n" part again call ctstxb ;Copy it br 10$ ;Go quit ; /UNDERLINE:option rnuswr: call adjr0 ;Skip leading blanks cmpb (r0),#': ;Is there an option? beq 10$ ;Yes... jmp stxoly ;No, take default 10$: call getopt ;Put option in OPBUF push ;Save R3 - R5 .cscan ,#uswrsa ;Look for a match... mov r5,r1 ;Put offset in R1 bpl 20$ ;Branch if there was a match bis #badopt,swstat ;Set "bad option" flag br 30$ ; and branch 20$: mov uswsta(r1),r1 ;R1 => switch text call ctstxb ;Copy to STX buffer 30$: pop ;Restore R5 - R3... call swbits ;Update switch status bit #badopt,swstat ;Did we have bad option? beq 40$ ;Branch if not sec return 40$: clc ;Return with no errors... return ; Reference string address list for UNDERLINE options... uswrsa: .word uswb, uswn, usws, 0 ; Reference strings for options... .nlist bex uswb: .asciz /BACKSPACE/ uswn: .asciz /NONE/ usws: .asciz /SIMULATED/ .list bex .even ; UNDERLINE switch text address list... uswsta: .word rnusrb, rnusrn, rnusrs ; Address lists, tables, text for RNO command... .nlist bex rnpmt: .ascii "Input File? "<200> rnotxt: .asciz "R RUNOFF" deftxt: .asciz "LP:" eqlsin: .asciz "=" uarowc: .byte 3,0 ; Reference strings for switches: rnob: .asciz /BEGIN/ rnosta: .asciz /START/ rnod: .asciz /DEFAULTS/ rnoe: .asciz /END/ rnof: .asciz /FORMLENGTH/ rnohy: .asciz /HYPHENATION/ rnonhy: .asciz /NOHYPHENATION/ rnoi: .asciz /INFORMATION/ rnoh: .asciz /HELP/ rnooly: .asciz /ONLY/ rnoout: .asciz /OUTPUT/ rnopag: .asciz /PAGE/ rnoprn: .asciz /PRINTER/ rnos: .asciz /STRIP/ rnons: .asciz /NOSTRIP/ rnotrm: .asciz /TERMINAL/ rnou: .asciz /UNDERLINE/ rnonu: .asciz /NOUNDERLINE/ rnov: .asciz /VERSION/ rnow: .asciz /WAIT/ ; Switch text for output: rnbsrs: .asciz "/B:" rndsrs: .asciz "/D" rnesrs: .asciz "/E:" rnfsrs: .asciz "/F:" rnhsry: .asciz "/H:YES" rnhsrn: .asciz "/H:NO" rnisrs: .asciz "/I" rnssrs: .asciz "/S" rnusrb: .asciz "/U:B" rnusrl: .asciz "/U:L" rnusrn: .asciz "/U:N" rnusrs: .asciz "/U:S" rnvsrs: .asciz "/V" rnwsrs: .asciz "/W" .list bex .even ; Switch reference string address list: rnsrsa: .word rnob, rnod, rnoe, rnof, rnoh .word rnohy, rnoi, rnonhy, rnons, rnonu .word rnooly, rnoout, rnopag, rnoprn, rnosta .word rnos, rnotrm, rnou, rnov, rnow .word 0 ; Switch execution address list: rnseal: .word stxotx, rndefr, stxotx, stxotx, stxoly .word stxoly, stxoly, stxoly, swbits, stxoly .word rnolyr, rnoutr, rnolyr, rnprnr, stxotx .word stxoly, rntrmr, rnuswr, stxoly, stxoly ; Switch status bit list: rnssbl: .word 1, 2, 1, 1, 4 .word 1, 4, 1, 1, 1 .word 1, 2, 1, 2, 1 .word 1, 2, 1, 4, 1 ; Switch text address list: rnstxa: .word rnbsrs, rndsrs, rnesrs, rnfsrs, rnisrs .word rnhsry, rnisrs, rnhsrn, 0, rnusrn .word 0, 0, 0, 0, rnbsrs .word rnssrs, 0, rnusrl, rnvsrs, rnwsrs ; Argument list for SWTCHS call: rnalst: .word rnsrsa .word rnseal .word rnssbl .word rnstxa ; Jump table for results of switch parsing: .word badopx .word cnfswx .word badswx .word ambswx rnovec: .word rnook