.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 DISPLAY, ERASE, and LIST! You might need them! * ; * * ; ****************************************************************** ; "Display Command Expansion" DISPLAY ; ======= /EXECUTE ; /NOEXECUTE dsplay: mov sp,dspsp ;Save current stack pointer value push r4,r5 ;Save R4, R5... 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$: pop r5,r4 ;Restore R5, R4... 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$: call getcom ;Cause command execution... call cscan 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 r0,r1,r2 ;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 r2,r1,r0 ;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 ; "Erase A Symbol" ERASE ; ===== /ALL ; /NOQUERY ; /QUERY erase: 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?" cmpb buff,#'Y ;"Y"-for-yes? beq 20$ ;Branch if so return 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$ eraseq: call wtstbl ;Write changes to SAV image and return ; return er1sym: call adjr0 ;Skip any blanks tstb (r0) ;Null byte? bne 10$ ;Branch if not .gtlin #cmd,#er1qry ;"Symbol?" tstb cmd ;Null response? bne 20$ ;Branch if not return 10$: mov #cmd,r1 ;R1 => command buffer call getcom ;Extract symbol from input string 20$: mov #sdsat,r4 ;R4 => symbol string addr. table call cscan ;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?" cmpb buff,#'Y ;"Y"-for-yes? 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 ; 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 ; "List Current UCL Commands" LIST ; ==== ALL ; COMMANDS ; SYMBOLS lister: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null argument? beq lista ;Force default to "LIST ALL" mov #lisal,r4 ;R4 => reference string address list call getcom ;Move argument to command buffer call cscan ;Look for valid argument jmp @liseal(r5) ;Go execute appropriate stuff lista: ;"LIST ALL"... call listc ;List commands call lists ;List symbols 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 50$ ;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 mov #30.,r2 ; and store result... mov #63,r1 cmp r5,r2 bge 30$ sub #10.,r2 dec r1 cmp r5,r2 bge 30$ sub #10.,r2 dec r1 cmp r5,r2 blt 40$ 30$: movb r1,(r0) sub r2,r5 40$: bis #60,r5 movb r5,1(r0) .print ;Print resulting string return 50$: mov #buff,r2 ;R2 => buffer 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... add #,r1 call ccopy clrb (r2) ;Terminate with null .print #buff ;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 ; Reference string address list for LIST: lisal: .word allsw .word comsw .word symsw .word 0 ; Argument execution address list for LIST: .word badopx .word cnfswx .word badcmx .word ambcom liseal: .word lista .word listc .word lists ; "Change Default Device" CD ; == ; CD dev becomes ASSIGN dev DK: ; ; CD with no argument becomes DEASSIGN 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 => "DEASSIGN DK:" stuff jmp setcmd ;Go execute it .nlist bex ddk: .word assign-ddktxt ddktxt: .ascii /DEASSIGN/ dk: .asciz / DK:/ assign: .ascii /ASSIGN / argbuf: .blkb 5 .list bex .even ; Runoff Command Routine RNO ; === ; ; 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:/U:S...= ; /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:/U:S" 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 r0,r1 ;Save R0, R1... mov #deftxt,r0 ;Copy default stuff to output-spec. buffer... mov #outfnm,r1 10$: movb (r0)+,(r1)+ bne 10$ pop r1,r0 ;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$: 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 r3,r4,r5 ;Save R3 - R5 mov #uswrsa,r4 ;Look for a match... call cscan 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 r5,r4,r3 ;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:/U:S" 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 .end ucl