.title DCLCOMPLETE tcsh style filename completion for DCL ;++ ; ; The following code provides command and filename completion in DCL. ; It works by hooking the $GET RMS service and figuring out whether the ; call is a DCL command line. Yes, it's a hack. ; ; TAB triggers both command and filename completion. A partial command ; is looked up in the CLI tables. (Someone might like to add a symbol ; search to get foreign commands.) If the last element of the command ; is not the first "word", it's treated as a file, and completed. ; ; HERE BE DRAGONS! This is supervisor mode code, with exec and kernel ; mode stuff to load it. I don't think it does anything nasty, but when ; was the last time you saw 100% bug-free code? ; ; Compiling/linking: ; $ MACRO DCLCOMPLETE ; $ LINK DCLCOMPLETE ; ; Installing: ; $ RUN DCLCOMPLETE ; ; Note: This requires CMKRNL privilege to install. Once installed in your ; process requires no privileges, thus DCLCOMPLETE can be INSTALLed with ; CMKRNL. Remember that installed images must be linked /NOTRACEBACK. ; ; Note too that DCLCOMPLETE installs itself into the current process; it ; does not install itself into subprocesses automatically. ; ; This code is copyright Don Stokes 1993. Non-commercial distribution ; is allowed, but contributions to my hacking fund are always welcome. ; ; Questions, bug reports, money, bug fixes, kudos, money, offers, money ; etc to: ; Don Stokes, Network Manager ; Computing Services Centre ; Victoria University of Wellington ; New Zealand. ; ; Phone +64 4 495-5052 ; Phax +64 4 471-5386 ; ; Email don@zl2tnm.gen.nz (Home), don@vuw.ac.nz (Work) ; ; Note: VMS hacking is my hobby, not my job. Don't hold VUW responsible for ; your problems. (Don't give 'em the credit either.) You can hold me ; responsible if it makes you feel better, but if you think I'm going to ; guarantee this crap, you've got another thing coming.... 8-) ; ; Kudos to Joe Meadows for VERB, part of which I've ripped off to do the ; command completion, and a useful tool all round. ; ; Note: 15-Jul-94 Ramon Curiel ; I don't know if this is true with the original version, but it ; would appear to be the case. When using "application keypad" ; mode - redrawing the current line (e.g completing a filename) ; will not work correctly. The changes I've made shouldn't affect ; this part of the code and this appears to be interaction problem ; with this code and the terminal driver(?)... ; ; ; Changes: ; 2 Aug 94 Ramon M. Curiel ; Fix problem with qualifier completion on negation. ; ; 21 Jul 94 Ramon M. Curiel ; Incorporate Jerry Leichters code to use ? as ; the list sequence. This is a neat hack that allows ; us to use non-terminating codes to change things. ; Make it a compile time option (Jerry Mode). Make ; lowercasing file names compile time option (Don mode) ; and lowercasing commands compile time option (Ray mode). ; ; 20 Jul 94 Ramon M. Curiel ; Fix problem with display when quoting a "special" ; char. Do this by ^H and Space to blank quote char. ; Add code to parse a top-level qualifier. Now we ; have three levels of completion Filenames, command, ; and top-level qualifiers. Next should be parameters ; and then second level qualifiers the keywords... ; ; 15 Jul 94 Ramon M. Curiel ; Use Don's suggestion of not echoing the termination ; character. We then explicitly check to see if ; the termination char is CR. If it is then we do a ; $QIO to write a CR. ; ; 13 Jul 94 Ramon M. Curiel ; Didn't like using Ctrl Chars to do lists - use ; "?" for what it was created for. Need to allow ; users to quote this, so if we're inside quotes ; let it through. Check previous char for "\" our ; quote character if there let it through...Allow ; to be quoted... ; ; Add input redirection in here. Note: order that ; redirection is attempted is important. Output ; redirection must be last or it won't work... ; Restructure redirection checks... ; ; 6 Jul 94 Ramon M. Curiel ; Change redirection code and allow piping and ; multiple commands. Piping and multiple commands ; combined with redirection require an "assist" ; insert the string "PIPE " infront of string and ; pass to do_get... ; ; 20 Jun 94 Ramon M. Curiel SRI ; Add code to allow redirection of output. This ; code looks for " >> " and assigns sys$output ; to a string following this... ; ; 18 Jun 94 Ramon M. Curiel SRI ; Make list possible matching commands... ; ; 17 Jun 94 Ramon M. Curiel SRI ; Didn't like the way file list wildcarded subdirs. ; When looking for a list see if we got a DIR END ; if not then the wildcard is changed and need to ; fixup the display. Also make " ; list the filenames that match the filespec... ; ; 9/9/93/dcs Made system service remapping code *much* more ; paranoid. ; ;-- .link "SYS$SYSTEM:SYS.STB"/selective_search .link "SYS$SYSTEM:DCLDEF.STB"/selective_search .library "SYS$LIBRARY:LIB.MLB" ; ; The following definitions change certain aspects of DCLCOMPLETE ; NOTE: when completing or get a list of Qualifiers the partial ; qualifier or completed qualifier is ALWAYS uppercased! ; Don = 1 ; lowercase filenames Ray = 1 ; Don't lowercase Commands ;Jerry = 1 ; Change how we do list via terminator ; ; off list_char or list_char complete_char ; System definitions: $IODEF ; $QIO function codes $TRMDEF ; Terminal function item codes $PRTDEF ; Page protection codes $PSLDEF ; PSL symbols (processor modes) $RMSDEF ; RMS stuff $FABDEF ; FAB stuff $NAMDEF ; NAM stuff $XABDEF ; Standard XAB stuff $RABDEF ; RAB stuff $XABTRMDEF ; Terminal XAB stuff $IPLDEF ; IPL definitions $LNMDEF ; LNM definitions $SSDEF ; DEFINE SYSTEM MESSAGES $CLIMSGDEF ; DEFINE ERROR/STATUS VALUES $STSDEF ; DEFINE STATUS CODE FIELDS ; ; Some constants ; complete_char = 9 ; File completion character (TAB) CR_CHAR = 13 ; Carriage Return list_char = ^A/?/ ; File List Character (Ctrl-P) Mult_Char = ^A/;/ ; Command Separator... Pipe_char = ^A/|/ ; Pipe command character (|) Qual_Char = ^A"/" ; Qualifiers Quote_char = ^A/\/ ; \ Redi_char = ^A// ; Redirection output char reloc_sigval = 12345678 ; Signature value cr_ctrl = ^X00010000 ; CR/LF for QIO ReDirects = ^A/|;> to list files... ; Flags is used to inform code we want a complete list... ; Terminators: .blkb 8 ; include ? Term_Len = .-Terminators ;get size of last block Flags: .long 0 ;Use this to flag or VecTbl: .long 0 ;This is a copy of R8 we'll need QualBlk: .long 0 ;Address of Qualifier Entity block KeyBlk: .long 0 ;Future use ParBlk: .long 0 ;Future use TQBuf: .long 0 ;Temp Qualifer buffer SQBuf: .long 0 ;Saved one used for completion APT: .long 0 ; Some temporaries rab_address: .blkl ; Address of callers RAB xab_address: .blkl ; " " " XABTRM itmlst_address: .blkl ; " " " item list itmlst_length: .blkl ; Length " " " " fab: .blkb FAB$K_BLN ; FAB for file lookups nam: .blkb NAM$K_BLN ; NAM for same rsa: .blkb 256 ; Resultant string address esa: .blkb 256 ; Expanded string address scratch: .blkb 256 ; Scratch buffer dirlen: .blkl 1 ; Directory length local=. .=tmp ; End of local variables ; ;Local Vars for Pipe_it ; PTmp = . . = 0 InChan: .Word 0 ;MBX Input Chan OutChan: .Word 0 ;MBX Output chan InNam: .Blkb 64 ;InMBX Name OutNam: .blkb 64 ;OutMBx Name PItmLst: .blkb 6*12 ;roome for 6 Items... PLocal = . . = PTmp ; ; Variables used by install code ; pagetweak: .blkl 2 ; Virtual address of page containing SYS$SETDDIR vectmp: .blkb 512 ; Temp storage while we tear the system service ; vectors down and rebuild 'em. tty: .ascid "SYS$COMMAND:" ; Terminal name to assign channel to ; ; Mainline code -- install completion code and revector $GET to point ; to it. ; .entry dclcomplete, ^M<> ;;; movaq -(sp),r2 ; get a Descriptor ;;; movzwl #8,(r2) ; ;;; movaq -(sp),4(r2) ;Allocate input buffer ;;; pushl r2 ;return length ;;; pushl #0 ;don't prompt ;;; pushl r2 ;one shot if there use ;;; Calls #3,G^Lib$Get_Foreign ;okay... ;;; blbc r0,100001$ ;;; Tstw (r2) ;Anything ;;; beql 100001$ ;nope continue ;;; movc3 (r2),@4(r2),comp_ch ;overwrite defaults 100001$: cmpl @#SYS$GET,#^x9F170FFC ; Check that $GET has not been bneq 1$ ; revectored... ; 9f170ffc = .entry; jmp @# movl @#SYS$GET+4, R1 ; If so, find vectored code movl #SS$_ABORT, R0 cmpl reloc_sig-reloc(R1), #reloc_sigval bneq 99$ ; Check signature value ; If not ours, abandon ship NOW! $CMKRNL_S routin=deinstall_code ; Get rid of the old stuff. blbc R0, 99$ 1$: $CMKRNL_S routin=install_code ; Install routine into P1 pool blbc R0, 99$ 99$: ret ; All done ; ; Install $GET revector routine in P1 pool, assign channel to terminal. ; Exec mode, image context. ; ; .macro movo src,dst ; movq src,dst ; movq src+8,dst+8 ; .endm .entry install_code, ^m movo @#SYS$GET, real_get ; Save real vector $ASSIGN_S chan=ttychan, devnam=tty, acmode=#PSL$C_SUPER blbc R0, 98$ ; Give us a supervisor channel ; for later use movl #reloc_len, R1 ; R1=length of allocated block jsb @#EXE$ALOP1PROC ; Get P1 pool blbs R0, 1$ ; Got it? movl #SS$_INSFMEM, R0 ; Not enuff pool.... 98$: ret 1$: movl R1, reloc_alloc_len ; Save length of block movl R2, R6 ; R6=address of block in P1 movc3 #reloc_len, reloc, (R2) ; Copy reloc into P1 ; ; This is where me prepare the vectors to be written to. ; The steps are: ; Make a copy of the page where the $GET vector lives ; Create a kernel mode demand-zero page over the top of it ; Copy the saved vectors back over it ; Set protection to URKW ; Lock it into the working set ; ; NOTE: Once $CRETVA has done its thing, several important system services ; are unreachable. It would be bad if we run into problems before ; restoring the saved vectors into the page, and setting the page ; protection to URKW. We really want the pages locked down fairly soon ; too. We don't want any ASTs delivered to us here, so crank IPL up to ASTDEL. ; ; If something fails in here, go into a loop (at IPL 2!). This way we can ; be probed with SDA (priorities willing!) while letting the rest of the ; system continue, protected from being forced into continuing with a fubared ; process. We don't know if the unreachable system services will be called ; during rundown, for example. ; ; We don't need to do this stuff if the page is already writable. (DEBUG ; can do this for us, for example.) ; probew #0, #8, @#SYS$GET bneq 2$ bicl3 #^x000001FF, #SYS$GET, pagetweak movl pagetweak, pagetweak+4 ; Calculate page address that ; $GET lives in movc3 #512, @pagetweak, vectmp ; Save page to be mapped SETIPL #IPL$_ASTDEL ; Crank up IPL shields ; We don't wanna be killed now! $CRETVA_S inadr=pagetweak,acmode=#PSL$C_KERNEL blbc R0, 99$ ; Create memory over the page movc3 #512, vectmp, @pagetweak ; Restore vectors from copy $SETPRT_S inadr=pagetweak,acmode=#PSL$C_KERNEL,prot=#PRT$C_URKW blbc R0, 99$ ; Set page protection to URKW $LKWSET_S inadr=pagetweak,acmode=#PSL$C_KERNEL blbc R0, 99$ ; Lock the buggers down SETIPL #0 ; Shields down ; ; Things are safe(ish) now. Re-write the $GET vector. ; 2$: ; Point vector at our code in P1 movl #^x9F170FFC, @#SYS$GET ; .entry $GET ; JMP @# movl R6, @#SYS$GET+4 ; code movl #SS$_NORMAL, R0 ; Success. ret 99$: brb 99$ ; Emergency stasis field: ; ; Remove $GET revector code, deassign channel to terminal ; Kernel mode, image context ; .entry deinstall_code, ^m movl @#SYS$GET+4, R2 ; Get location of code in P1 $DASSGN_S chan=ttychan-reloc(R2) blbc R0, 99$ movl reloc_alloc_len-reloc(R2), R1 ; Get length of P1 block movo real_get-reloc(R2), @#SYS$GET ; Restore $GET vector movl R2, R0 jsb @#EXE$DEAP1 ; Deallocate P1 block movl #SS$_NORMAL, R0 99$: ret ; ; Code & stuff relocated into P1 pool. ; This must be relocatable, and is read-only in supervisor mode (the page ; protection is UREW). ; .psect code_reloc, long,pic,wrt,exe,noshr ; ; Preamble, used for identification etc. ; reloc: brw code ; Entry point at start of code .align long reloc_sig: .long reloc_sigval ; Signature value reloc_alloc_len:.blkl ; Length of alocated P1 block real_get: .blkb 2 ; $GET vector code: entry mask real_get_code: .blkb 14 ; actual code ttychan: .blkw ; Channel to command terminal Comp_ch: .byte complete_char List_ch: .byte List_char Quot_ch: .byte Quote_Char Pipe_Ch: .byte Pipe_Char Mult_Ch: .byte Mult_Char Redo_Ch: .byte Redo_char ; Redi_ch: .byte Redi_char ; .byte 0 ;keep things aligned ; ; Read-only data ; tchars: .ascii " ,+(@=/" ; Command element delimiters tchars_term_l = .-tchars ; File name delimiters .word ^A":" ; Device terminators .word ^A"<[" ; Directory opener tdchars: .word ^A">]" ; Directory close tdchar_sz = .-tdchars .word ^A"." ; Type specifier tchars_len = .-tchars ; Flag values fv_typ = 0 ; Type fm_typ = 1 fv_die = 1 ; Directory end fm_die = 2 fv_dib = 2 ; Directory begin fm_dib = 4 fv_dev = 3 ; Device fm_dev = 8 compflags: .byte fm_dev, fm_typ!fm_die!fm_dib ; Device .byte fm_dib, fm_typ!fm_die ; Directory start .byte fm_die, fm_typ ; Directory end .byte fm_typ, 0 ; Type DirWildList: .ascii "%*.dir" DirWLst_Sz = .-DirWildList wildcard_d: .ascii "%*]" ; Bits of the wildcard spec... wildcard_f: .ascii "*." wildcard_t: .ascii "*" wildcard_e: wildcard_tbl: ; DirB DirE Typ .byte wildcard_e-wildcard_f ; .byte wildcard_e-wildcard_t ; X .byte wildcard_e-wildcard_f ; X .byte wildcard_e-wildcard_t ; X X .byte wildcard_e-wildcard_d ; X .byte wildcard_e-wildcard_d ; X X .byte wildcard_e-wildcard_f ; X X .byte wildcard_e-wildcard_t ; X X X bel: .byte 7 ; A spare BEL to beep with Erase: .byte 8,32 ; ^H,Space AOut: .Ascii "SYS$OUTPUT" ;Used for redirection AOut_Sz = . - AOut ;Need size to... AIn: .Ascii "SYS$INPUT" ;Used for redirection AIn_Sz = . - AIn ;Need size to... LTbl: .ascii "LNM$PROCESS" LT_SZ = . - LTBL RDSize = <2*3*4> ;CRELNM ItmLst Size ; 2 Items * 3 Longwords/Itme * 4 Bytes/LW ;Actually a single item plus termination ;longword plus a ACMODE Byte... .align long fab_proto: $FAB fop=ppf ; FAB & NAM for file search nam_proto: $NAM ess=255, rss=255 ; ; All calls to $GET come here. *ALL*! ; Decide what to do with it. ; The $GETs we're interested in come at us in supervisor mode, with a RAB ; carrying a XABTRM, who's prompt string points to the DCL prompt. The DCL ; prompt must not be a continuation prompt (_$). ; ; DCL plays silly buggers with its prompt. The prompt string specified by ; SET PROMPT comes with a three character preamble; the first two characters ; may or may not be CR/LF, the third is eithe nul or '_' if it's a continuation ; prompt. ; code: movpsl R0 ; Abandon ship if not supervisor bbc #, R0, 99$ bbs #, R0, 99$ movl 4(AP), R6 ; R6=RAB address movl RAB$L_XAB(R6), R7 ; R7=XAB address from RAB beql 99$ ; No XABs? bye bye! cmpb XAB$B_COD(R7), #XAB$C_TRM ; XABTRM? bneq 99$ ; No? bye bye! movzwl XAB$W_ITMLST_LEN(R7), R8 cmpw R8, #24 ; Two item itemlist? beql 1$ ; Yes, OK cmpw R8, #48 ; Four item itemlist? bneq 99$ ; No? exit 1$: movl XAB$L_ITMLST(R7), R9 ; R9=address of itemlist moval @#CTL$AG_CLIDATA, R1 ; locate start of prompt movl PPD$L_PRC(R1), R1 movab PRC_G_PROMPT-3(R1), R1 cmpl R1, 16(R9) ; Does XAB's prompt point there? bneq 99$ ; No? bye bye! tstb 2(R1) ; 0 in continuation field? beql dcl_input ; Y: we've got you! 99$: brw real_get_code ; Bounce off to the real $GET ; ; Come here when we've got a real live DCL input ; ; On entry: R6 = RAB address ; R7 = XABTRM address ; R8 = XABTRM itemlist length ; R9 = XABTRM itemlist address ; ; Build a new XABTRM item list ; dcl_input: subl2 #local, SP ; Allocate some space on the movl SP, R11 ; stack. R11=base pointer movc5 #0, dcl_input, #0, #itmlst_len, itmlst(R11) movw #TRM$_MODIFIERS, itmlst_mod+itm_cod(R11) movl #TRM$M_TM_NORECALL!TRM$M_TM_ESCAPE!TRM$M_TM_TRMNOECHO,- itmlst_mod+itm_adr(R11) ; Clear out the new itemlist movc3 12(R9), @16(R9), prompt(R11) movw #TRM$_PROMPT, itmlst_prompt+itm_cod(R11) movw 12(R9), itmlst_prompt+itm_len(R11) movab prompt(R11), itmlst_prompt+itm_adr(R11) ; Copy the prompt to it movw #Term_Len,- Itmlst_termsk+Itm_Len(r11);ADDed by RMCJ movc5 #0, dcl_Input,#0,- #Term_Len, terminators(r11) ;Added by RMCJ movw #TRM$_TERM, itmlst_termsk+itm_cod(R11) ; _^]\[ZYXWVUTSRQPONMLKJIHGFEDCBA@ movab Terminators(r11),- itmlst_termsk+itm_adr(R11) movl #^b00000100000000000010000000000100,- Terminators(r11) bbss #complete_char,Terminators(r11),10001$ 10001$: .If Not_Defined Jerry bbss #List_char,Terminators(r11),10002$ 10002$: .endc ; Put in the terminator mask movw #12*3, XAB$W_ITMLST_LEN(R7); Set the length of the itmlst cmpw R8, #24 ; Is this a long (48 byte) or beql 1$ ; short (24 byte) form itemlist? movc3 #24, 24(R9), itmlst_inistr(R11) movw #12*5, XAB$W_ITMLST_LEN(R7); append the rest of the long ; itmlst to the new one 1$: movab itmlst(R11), XAB$L_ITMLST(R7) movl R6, rab_address(R11) ; Save some stuff for later movl R7, xab_address(R11) movl R8, itmlst_length(R11) movl R9, itmlst_address(R11) ; ; Perform the $GET with the supplied RAB, decide whether we need to ; complete the character ; do_get: callg (AP), real_get ; Do it blbc R0, 99$ movl rab_address(R11), R6 ; Get RAB location bbc #DEV$V_TRM, RAB$L_CTX(R6), 99$ ; If this was not a ; terminal read, leave now. clrl Flags(r11) ;Added by RMCJ or cmpb RAB$W_STV0(R6), #complete_char beql check_list ; Check termination character .if not_defined JERRY cmpb RAB$W_STV0(R6), #List_char ;is this a "?" RMCJ bneq 99$ ;Nope Skip stuff movl #1,flags(r11) ;Signal we want list brb check_List ;see if we're quoted... .EndC 99$: cmpb RAB$W_STV0(R6), #CR_char ;is this a CR RMCJ BNEQ 100$ $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK, - p1=RAB$W_STV0(R6), p2=#0, p4=#^X008D0000 ; DO CR 100$: Calls #0,Check_ReDirect ; movl xab_address(R11), R7 ; Going out, restore the things movl itmlst_length(R11), XAB$W_ITMLST_LEN(R7) ; we diddled with movl itmlst_address(R11), XAB$L_ITMLST(R7) ret ; ; Code from here to comments before complete_file added by RMCJ ; 13-Jul-94 ;We're using ? to list characters, this could be a valid character in ;some instances - DCL may want it some where - in those cases it needs ;to be quoted. Also, if the preceding char is "\" also let it through, ;but replace the "\"... Check_list: movl rab$l_rbf(r6),r8 ;address of buffer movzwl rab$W_RSZ(r6),r9 bneq 10$ 1$: brw Error ;Empty line 10$: clrq r2 ;use this to count "'s 20$: cmpb (r8)+,#^A/"/ bneq 30$ incl r2 30$: sobgtr r9,20$ ;tight loop till done cmpb #Quote_char,-1(r8) ;check last char .if not_defined Jerry bneq 33$ ;this is ray mode .endc .if defined Jerry beql 32$ cmpb #List_char,-1(r8) ;check for list char here bneq 33$ movl #1,Flags(r11) ;set list mode decw rab$W_rsz(r6) ;remove last char brb Complete_File ;go complete the file 32$: .endc decw rab$W_rsz(r6) ;remove last char decl r8 ;adjust pointer brb 35$ 33$: blbc r2,complete_file ;not quoted all done get list cmpw rab$w_rsz(r6),- rab$w_usz(r6) bgeq 1$ ;beep no room 35$: cmpl rab$l_ubf(r6),rab$l_rbf(r6) ;Same Buffer beql 37$ ;yes skip movc3 Rab$W_RSZ(r6),- ; @Rab$L_Rbf(r6),- @Rab$L_UBf(r6) ;copy to input buffer movl r3,r8 ;save pointer here movl rab$l_ubf(r6),rab$l_rbf(r6) ; 37$: movb Rab$W_Stv0(r6),(r8) ;set this 39$: incw rab$w_rsz(r6) ;add it to the end brw error1 ;this isn't a real error... ; ; Come here when the user hits the TAB key ; complete_file: movc3 #FAB$K_BLN, fab_proto, fab(R11) ; Fill FAB & NAM movc3 #NAM$K_BLN, nam_proto, nam(R11) movab nam(R11), fab+FAB$L_NAM(R11) ; Fixup pointers movab esa(R11), nam+NAM$L_ESA(R11) movab rsa(R11), nam+NAM$L_RSA(R11) movl RAB$L_RBF(R6), R8 ; R8=address of text movzwl RAB$W_RSZ(R6), R9 ; R9=length of text to search bneq 22$ brw error ; Empty cmd line? Beep! 22$: ; ; This is a bit tricky. ; R10 contains a bit mask of the filespec components we have seen as we ; run backwards down the length of the partial filename. ; R7 contains a mask of bits _not_ to be set. Mainly, this is so that ; once we've started into a directory (ie crossed a ']' or '>') we don't ; signal that we've found the delimiter between the name & type. ; clrl R10 ; R10=Filespec components flags clrl R7 ; R7=Mask clrl R4 ; R4=Directory end location movl r8,r1 ; need an address in r1 movl R9, R2 ; Search backward through text 1$: decl R2 ; for beginning of filespec blss 2$ ; R2=index locc (R8)[R2], #tchars_len, tchars beql 1$ subl3 R0, #tchars_len, R0 subl2 #tchars_term_l, R0 blss 2$ ;Note this stuff is added by RMCJ < with out trailing > don't work ;change < to [ cmpb (r1),#^A/,- r7 movl r9,r2 2301$: decl r2 blss 23$ ;didn't find it skip to normal... cmpb scratch(r11)[r2],#^a/./ ;end of dir bneq 2301$ ;keep looking till we find bbss #FV_Die,flags(r11),2303$ 2303$: movb #^a/]/,scratch(r11)[r2] ;assume "[" brb 24$ 23$: movab wildcard_tbl, R7 movzbl (R7)[R0], R7 ; R7=length of wildcard portion movab wildcard_e, R6 subl2 R7, R6 ; R6=address of wildcard portion 24$: movc3 R7, (R6), scratch(R11)[R9] addl3 R7, R9, R3 ; R3=length of wildcard spec ; ; Set up the FAB & NAM, parse & search. ; movab fab(R11), R6 ; R6=address of FAB movab nam(R11), R7 ; R7=address of NAM movab scratch(R11), FAB$L_FNA(R6) movb R3, FAB$B_FNS(R6) ; Set up search file nam in FAB $PARSE (R6) ; Parse blbs R0, 9$ 8$: brw error ; Not found or error, beep. 9$: $SEARCH (R6) ; and search ; ; Code from here to 10$ added by RMCJ to get list of possible ; filenames. Don't know if this might cause errors later ; on since we don't go through and clean up later, but errors ; may not need to do this.... ; blbs Flags(r11),900$ ; get a list? no then complete brw 999$ 900$: movl Nam$L_Rsa(r7),r3 blbs r0,901$ ;check status move line if all done clrl r2 brb 909$ 901$: movzbl Nam$B_RSL(r7),r2 bbc #fv_die,flags(r11),909$ movc3 r2,(r3),Scratch(r11) ;Save this cuz we goin to muck it movzbl Nam$B_RSL(r7),r2 movab scratch(r11),r3 movl r2,r1 ; 903$: decl r1 bleq 909$ ;alldone here cmpb (r3)[r1],#^a/./ ;version ? bneq 905$ addl3 #1,r1,r2 ;save for later movb #^a/]/,(r3)[r1] ;make it a dir brb 903$ 905$: cmpb (r3)[r1],#^a/]/ ; bneq 903$ movb #^a/./,(r3)[r1] ;make it a dir 909$: $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK, - p1=(r3), p2=r2, p4=#CR_CTRL ; show filespec TstL r2 bneq 9$ brw error ; ; Decide what to do with the result. ; If there was a start '[' (or '<'), but no closing bracket, we need to ; fill out the directory spec -- do elsewhere. ; We then work out the amount of stuff that needs to be taken from the ; original line, and the parts of the searched spec we need to add. ; 999$: blbs r0,10$ brw error 10$: clrl R6 ; R6=preamble length bbs #fv_die, R10, 3$ ; if ']' found, process bbs #fv_dib, R10, directory ; if '[' found -- must be dir bbc #fv_dev, R10, 11$ ; Strip device name off if locc #^A":", R9, (R8) ; device found but no dir ; ; code from here to 1002$ added by RMCJ to deal with DECNET... ; tstl r0 beql 1002$ ;end of string? skip cmpb 1(R1),#^A/:/ ; is this a node? bneq 1002$ ; no then device decl r0 beql 1002$ ;End of String? movl r0,r2 ;save incase no dev found decl r0 addl #2,r1 locc #^A":", R0, (R1) ; device found but no dir bneq 1002$ ; found okay movl r2,r0 ; restore dev not found 1002$: subl3 R0, R9, R6 incl R6 brb 4$ 3$: movl dirlen(R11), R6 ; Come here if dir found 4$: movc3 R6, (R8), scratch(R11) ; Copy dir/dev to filespec 11$: movzbl NAM$B_NAME(R7), R9 ; R9=filename lenght bbc #fv_typ, R10, 5$ ; Add type if a '.' found. addb NAM$B_TYPE(R7), R9 5$: movc3 R9, @NAM$L_NAME(R7), scratch(R11)[R6] addl2 R6, R9 ; Copy the name to the end ; of the spec brw done ; and off to common code ; ; Come here if a directory was found. ; This is a bit yucky... ; directory: movl R9, R6 ; R6 = counter 1$: decl R6 ; BOL? bleq 2$ ; Y: done cmpb (R8)[R6], #^A"<" ; Looking for first directory beql 2$ ; delimiter... cmpb (R8)[R6], #^A"[" beql 2$ cmpb (R8)[R6], #^A"." bneq 1$ 2$: incl R6 ; R6=beginning of last dir ; name movl NAM$L_DIR(R7), R5 movzbl NAM$B_DIR(R7), R4 movl R4, R0 3$: decl R0 ; Find a '.' in found directory bleq 4$ ; spec, or beginning of dir cmpb (R5)[R0], #^A"." bneq 3$ 4$: incl R0 ; R0=start of dir spec subl R0, R4 ; R4=length of last dir name addl R0, R5 ; R5=address " " " " decl R4 addl3 R4, R6, R9 movc3 R4, (R5), scratch(R11)[R6]; Copy to new filespec ; ; Come here when we have a filespec ; Lowercase the string (R9 = length) ; done: .if defined DON ; Don Likes Lowercased strings - Ray doesn't :-) movl R9, R0 ; R0=loop counter 1$: decl R0 blss 2$ cmpb scratch(R11)[R0], #^A"A" ; A-Z? blss 1$ cmpb scratch(R11)[R0], #^A"Z" bgtr 1$ bisb #32, scratch(R11)[R0] ; Yes, make it a-z. brb 1$ 2$: .EndC ; ; Now call $PARSE/$SEARCH with a null filespec. This is to avoid a nasty ; little problem with running out of PPF space. ; 3$: movab fab(R11), R6 ; R6=FAB address movab scratch(R11), FAB$L_FNA(R6) clrb FAB$B_FNS(R6) ; Null filespec $PARSE (R6) ; Don't care if these "succeed" $SEARCH (R6) ; or "fail" ; ; Insert the rest of the command line in front of our new filename. ; 10$: movl rab_address(R11), R7 ; R7 = input RAB subl3 RAB$L_RBF(R7), R8, R6 ; R6 = preamble length movc3 R9, scratch(R11), scratch(R11)[R6] ; Move filename up movc3 R6, @RAB$L_RBF(R7), scratch(R11) ; Move preamble in addl3 R6, R9, R8 ; R8=length of preamble+filespec ; ; This is common code for the command and filename completion stuff. ; Diddle the inistrng part of the itemlist to point to our scracth buffer. ; Resubmit the $GET. ; fix_itmlst: movl xab_address(R11), R7 ; Get the XAB address bsbw prepare_retry ; Fiddle the itemlist readty to ; retry the $GET movab scratch(R11), itmlst_inistr+itm_adr(R11) movw R8, itmlst_inistr+itm_len(R11) ; Point the inistr at our line brw do_get ; Round we go again... ; ; Come here if we need to complete the command rather than the filespec. ; This runs through the command tables looking for a command that matches ; the typed portion. ; ; This code is ripped off from Joe Meadows' VERB, and I haven't really ; paid much attention to how it works, hence the relative lack of comments. 8-) ; complete_cmd: movl @#CTL$AG_CLITABLE,R0 addl3 R0, VEC_L_COMDPTR(R0),R1 movzwl VEC_W_TRO_COUNT(R1), R6 addl3 #8,R1,R3 clrl R4 10$: movl (R3)[R4],R5 ; comand_block TRO addl @#CTL$AG_CLITABLE, R5 movzwl CMD_W_NAME(R5),R0 ; name BRO addl R0,R5 ; ascic all names movzbl (R5),R2 20$: incl R5 ; Ascic verb name movzbl (R5), R7 movl R9, R1 ; R1=loop counter from cmd len cmpl R1,R7 ; Bigger than cmd? Forget it bgtr 8$ 1$: decl R1 ; Case-insensitive string blss 99$ ; compare (CLI table is upcase) bicb3 #32, (R8)[R1], R0 cmpb R0, 1(R5)[R1] beql 1$ 8$: decl R2 subb (R5),R2 bleq 30$ addl R7,R5 brb 20$ 30$: aoblss R6,R4,10$ ; If this falls thru, forget blbc flags(r11),35$ clrl r0 bsbw 205$ 35$: brw error ; it. 99$: blbc flags(r11),100$ bsbw 200$ brb 30$ 100$: movab 1(R7), R8 ; Come here when command found movb #32,scratch(R11)[R7] ; Put a space at the end of .If defined RAY movc3 r7,1(r5),scratch(r11) ; Copy command .Endc ; the command .if Not_defined Ray 2$: decl R7 ; Copy and lowercase the command blss 3$ ; to the command buffer bisb3 #32, 1(R5)[R7], scratch(R11)[R7] brb 2$ 3$: .endc brw fix_itmlst ; Done. 200$: movzbl r7,r0 205$: End_List: movab 1(r5)[r7],r1 subl2 r0,r1 $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK, - p1=(r1), p2=r0, p4=#CR_CTRL ; show filespec rsb ; ; Come here on error. Ring the terminal bel, and redisplay the current ; line. Note: Error1 redisplays using rab$L_rbf and rab$l_rsz without ; ringing the bell - we do this on a quoted ? and its not a real error. ; Error1: $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK!IO$M_NOFORMAT, - p1=Erase, p2=#2 ; Backspace,space BRB Error2 error: $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK!IO$M_NOFORMAT, - p1=bel, p2=#1 ; Beep! Error2: movl rab_address(R11), R6 ; Get some stuff back movl xab_address(R11), R7 bsbw prepare_retry ; Fix up the itemlist movl RAB$L_RBF(R6), itmlst_inistr+itm_adr(R11) movw RAB$W_RSZ(R6), itmlst_inistr+itm_len(R11) ; And point the inistring at ; read buffer brw do_get ; And around we go. ; ; This prepares the prompt and itemlist for a retry. ; We put CR/NULL in the carriage control portion to return to the cursor ; to the margin before reprompting -- we only make the line longer so ; clearing to EOL is not necessary. ; prepare_retry: cmpw XAB$W_ITMLST_LEN(R7), #12*5 ; First try? beql 1$ ; No? not much to do. movw #TRM$_INISTRNG, itmlst_inistr+itm_cod(R11) movw #TRM$_INIOFFSET, itmlst_offset+itm_cod(R11) movw #12*5, XAB$W_ITMLST_LEN(R7) 1$: movb #13, prompt(R11) ; Set carr control to CR NUL clrb prompt+1(R11) rsb ;++++ ; We come here when we are looking to complete or list ; potential qualifiers / or / ; Need to get the command first inorder to get the ; quals that match - at this time only do toplevel ; quals... Complete_Qual: addl2 R2, R8 ; R8=address of Qual subl2 R2, R9 ; R9=length " " movzwl #4,r2 ;Assume more then 4 cmpw Rab$W_Rsz(r6),#4 ; bgeq 1$ ;only use first 4 chars movzwl Rab$W_RSZ(r6),r2 ;Limit of chars to check 1$: movl Rab$L_Rbf(r6),r3 ;expecting things there... movab Scratch(r11),r5 clrl r4 ;zero index 2$: locc (r3)[r4],#tchars_len, tchars bneq 10$ ; bicb3 #32,(r3)[r4],(r5)[r4] ;move and upcase the byte aoblss r2,r4,2$ 10$: bsbw Locate_DCL ;match DCL command blbc r0,200$ ;not found movl r9,r1 ; movl r8,r2 movl QualBlk(r11),r8 BEQL 200$ ;IF NO BLOCK! SKIP clrl SQBuf(r11) ;Zero this for later bsbw Find_KeyWord ;Find keyword blbs Flags(r11),20$ ;Already have list... ;;;; blbc r0,200$ ;ambiguous keword movl r2,r8 ;restore this movl SQBuf(r11),r5 ;get unique match beql 200$ cmpw (r5),(r8) ; beql 15$ ;Not equal means negated subl2 #2,r9 ;strip NO addl2 #2,r8 ;advance past NO 15$: movzbl -1(r5),r4 ;crete descriptor beql 200$ BRW Move_End ;move it and retry 20$: clrl r0 ;need to zero this bsbw End_List 200$: BRW ERROR ;ring bell and reprompt Move_End: subl3 r9,r4,r1 ;get length to move bleq 100$ ;nothing to do addw3 Rab$W_RSZ(r6),- r1,r2 cmpw r2,rab$w_Usz(r6) ;how much room bleq 10$ ;okay to procede subw3 rab$w_rsz(r6),- rab$w_usz(r6),r1 ;space we have to move 10$: addw2 r1,Rab$W_Rsz(r6) movab (r8)[r9],r2 movab (r5)[r9],r3 movc3 r1,(r3),(r2) ;copy it 100$: brw Error2 ;--- ;Locate qualifers for DCL command ;Input: ; r4/r5 - DCL command to find ;output: ; r1 - Address of QualBlock ;--- Locate_DCL: pushr #^M ;Save scratch regs movl @#CTL$AG_CLITABLE,R8 ; ; FIND BASE AND SIZE OF VERB AND POINTER TABLES. ; 20$: ADDL3 VEC_L_COMDPTR(R8),R8,R7 ;GET BASE OF POINTER TABLE ADDL #VEC_K_HEADER_LENGTH,R7 ;SKIP PAST POINTER TABLE HEADER ADDL3 VEC_L_VERBTBL(R8),R8,R3 ;GET BASE OF VERB TABLE CVTWL VEC_W_SIZE(R3),R2 ;GET SIZE OF TABLE + HEADER SUBL #VEC_K_HEADER_LENGTH,R2 ;REMOVE HEADER DIVL3 #4,R2,R6 ;GET SIZE IN VERBS (4 BYTES PER VERB) ADDL #VEC_K_HEADER_LENGTH,R3 ;SKIP PAST VERB TABLE HEADER ; ; SEARCH VERB TABLE FOR SPECIFIED VERB. ; 22$: MATCHC R4,(R5),R2,(R3) ;SCAN FOR VERB MATCH BEQL 25$ ;BR IF VERB MATCH movl #CLI$_IVVERB,r0 brb 50$ ;return ; ; IF MATCH WAS NOT ON LONGWORD BOUNDARY, THEN KEEP LOOKING. ; 25$: SUBL3 R4,R3,R0 ;GET ADDRESS OF MATCHED VERB BICL3 #3,R0,R1 ;ROUND ADDR TO LONGWORD ADDR CMPL R0,R1 ;IS IT SAME AS ORIGINAL? BEQL 27$ ;YES, THEN DONE SUBL3 #1,R4,R0 ;START SEARCH ONE CHAR AFTER SUBL R0,R3 ; FIRST CHAR OF MATCH ADDL R0,R2 ; BRB 22$ ;KEEP LOOKING ; ; VERB MATCH FOUND - GET ADDRESS OF CMD BLOCK. ; 27$: movl r8,VecTbl(r11) ;Save this for later DIVL3 #4,R2,R9 ;CALCULATE INVERSE COMMAND INDEX SUBW3 R9,R6,R9 ;CALCULATE VERB INDEX SUBW #1,R9 ;ZERO BASE THE RESULT ADDL3 r8,(R7)[R9],R9 ;GET ADDRESS OF COMMAND BLOCK MOVL CMD_L_QUALS(R9),R0 ;GET OFFSET TO FIRST QUALIFIER DESC BEQL 40$ ;IF EQL NONE ADDL R8,R0 ;CALCULATE ACTUAL ADDRESS 40$: MOVL R0,QualBlk(r11) ;SET ADDRESS OF QUALIFIER DESCRIPTORS MOVL #SS$_NORMAL,R0 ;IT'S OKAY NOW... 50$: popr #^M ;Save scratch regs RSB ;++++ ; FIND_KEYWORD - Look up a keyword in specified list ; ; This routine is mostly from the V4 fiche of parsent.mar modified ; to work here ; ; INPUTS: ; ; R1/R2 - Descriptor of keyword to look up ; R6 - 0 if qualifier keyword, M_KEYWD if regular keyword ; R8 - Address of list of descriptor blocks ; R11 - Scratch area ; ; OUTPUTS: ; ; SQBuf - Points Buffer of matched keyword ; - if list mode is on outputs matching keywords to ; - screen. ;- FIND_KEYWORD: PUSHR #^M ;SAVE REGISTERS movq r1,r3 1$: decl r3 blss 2$ ;okay so far bicb2 #32, (R4)[R3] ;uppper case it brb 1$ ;string is done ; ; IF KEYWORD LIST, THEN SKIP PAST TYPE BLOCK. ; 2$: CMPB ENT_B_TYPE(R8),#BLOCK_K_TYPE ;TYPE BLOCK? BNEQ 5$ ;NO, THEN SKIP ADDL3 VecTbl(R11),- ;GET ADDR OF FIRST ENT BLOCK TYPE_L_KEYWORDS(R8),R8 ; ; ; SAVE ADDRESS OF LIST OF DESCRIPTOR BLOCKS. ; 5$: MOVL R8,R9 ;SAVE LIST ADDRESS ; ; INITIALIZE SEARCH PARAMETERS. ; 10$: CLRL R7 ;CLEAR QUALIFIER NUMBER CLRQ -(SP) ;SET NULL AS QUALIFIER FOUND ; ; IF QUALIFIER THEN ONLY CHECK FIRST FOUR CHARACTERS OF KEYWORD, ; ELSE CHECK THE WHOLE THING. ; MOVL R1,APT(r11) ;SAVE ORIGINAL TOKEN SIZE ; ; GET NEXT QUALIFIER IN LIST ; 30$: CVTWL ENT_W_NAME(R8),R0 ;GET OFFSET TO ASCIC QUALIFIER NAME MOVAB (R8)[R0],R5 ;FIND ADDRESS OF QUALIFIER KEY LENGTH MOVAB 1(R8)[R0],TQBuf(R11) ;FIND ADDRESS OF QUALIFIER KEY TEXT and save MOVQ R1,R3 ;COPY QUALIFIER STRING DESCRIPTOR movzbl (r5),r0 ; ; COMPARE THE QUALIFIER WITH THE INPUT ; ;; pushr #^M ;; movl TQBuf(r11),r1 ;; $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK, - ;; p1=(r1), p2=r0, p4=#CR_CTRL ; show filespec ;; popr #^M cmpB R3,R0 ; Bigger than cmd? Forget it bgtr 70$ movl TQBuf(r11),r0 31$: decl R3 ; Case-insensitive string blss 63$ ; compare (CLI table is upcase) cmpb (R0)[r3], (r4)[r3] bneq 70$ brb 31$ ;it was equal continue ; ; WHAT KIND OF MATCH DO WE HAVE? ; 63$: bsbw 500$ CMPB apt(r11),(R5) ;IS TABLE QUALIFIER SAME LENGTH BNEQ 65$ ;NO, THEN SKIP ADDL #8,SP ;YES, THEN WE HAVE A UNIQUE MATCH BRB 83$ ;RESTORE STACK, BRANCH TO EXIT ; ; CHECK FOR AMBIGUITY AND SAVE MATCH. ; 65$: TSTL 4(SP) ;FIND MATCH BEFORE? BEQL 67$ ;BR IF NOT AMBIGUOUS BISL #M_AMBIG,R6 ;SET AMBIGUOUS BIT 67$: MOVQ R7,(SP) ;SAVE MATCHED QUALIFIER VALUES ; ; CHECK NEXT QUALIFIER IN LIST. ; 70$: INCL R7 ;INCREMENT QUALIFIER NUMBER MOVL ENT_L_NEXT(R8),R8 ;GET OFFSET TO NEXT QUALIFIER DESCRIPTOR BEQL 75$ ;IF EQL THEN DONE ADDL VecTbl(R11),R8 ;CALCULATE ADDRESS BRW 30$ ;CHECK NEXT QUALIFIER ; ; ALL QUALIFERS HAVE BEEN CHECK WITHOUT AMBIGUITY, NOW SEE IF ANY MATCHED. ; 75$: movl #CLI$_ABKEYW,r0 ;ASSUME AMBIGUOUS BBSC #V_AMBIG,R6,85$ ;BR IF TRUE MOVQ (SP)+,R7 ;RESTORE MATCHED QUALIFER PARAMETERS BNEQ 83$ ;BR IF ONE WAS FOUND ; ; QUALIFIER DESCRIPTOR TABLE EXHAUSTED - TRY NEGATION ; 77$: XORL #M_NEGAT,R6 ;COMPLEMENT NEGATION FLAG SUBL3 #2,apt(r11),R1 ;REDUCE CHARACTER COUNT BLEQ 80$ ;IF LEQ NO MATCH POSSIBLE MOVL R9,R8 ;RESTORE ADDRESS OF DESCRIPTOR LIST CMPW #^A/NO/,(R2)+ ;KEYWORD START WITH 'NO'? BNEQ 80$ ;IF EQL YES ;;;; bsbw 500$ brw 10$ ; ; SET STATUS, CLEAN UP, AND RETURN ; 80$: movl #CLI$_IVQUAL,r0 ;ASSUME INVALID QUALIFIER BBC #V_KEYWD,R6,90$ ;BRANCH IF QUALIFIER PROCESSING movl #CLI$_IVKEYW,r0 ;SET INVALID KEYWORD STATUS BRB 90$ ;EXIT WITH ERROR STATUS 83$: movl #SS$_Normal,r0 BRB 90$ ;EXIT WITH ERROR STATUS 85$: MOVQ (SP)+,R7 ;RESTORE MATCHED QUALIFIER PARAMETERS 90$: bbss #FV_DIB,Flags(r11),95$ ;if this is set we already tried no tstl SQBuf(r11) ;Did we find a match? beql 77$ ;No the try stripping NO 95$: INCL R7 ;ADJUST TO ACTUAL KEYWORD NUMBER POPR #^M ;RESTORE REGISTERS RSB ;RETURN FROM SUBROUTINE 500$: pushr #^m movl r0,SQBuf(r11) ;Save for later blbc Flags(r11),510$ ;not listing just return movzbl (r5),r1 bleq 510$ $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK, - p1=(r0), p2=r1, p4=#CR_CTRL ; show filespec 510$: popr #^M RSB ;+++ ; check_Redirect: ; Okay here we go with the piping and redirection routines. ; This requires some cooperation with an outside program. ; This routine basically checks for special characters and ; modifies the input buffer to insert the pipe command infront ; of the input command. It also checks to see if this was ; already done before (doesn't need to do it again if it did). ; ; If multiple command or pipe chars aren't found it will check ; for redirection and do that if necessary here - point a user ; mode sys$output logical name to file. No attempt is made ; to determine if new file or append should be used (I think ; this can be done by using a supervisor level translation, ; but I'm punting that for now...) ; ; Note: ; The order in which checking is done is important in that ; output redirection needs to be last... ; ; Input: ; R6 - Points to input RAB. ; r11 - points to scratch area.. ; Output: ; r0 - SS$_Normal in most cases or CRELNM errors... ; RMS$_TNS on truncation if not enough room ; to add "PIPE "... ; ; Side Affects: ; if Redirection in affect Sys$output points to a file (logical name ; assigned in User Mode...Change Size Rab$W_Rsz to new Length. ; If piping or multiple commands add PIPE to beginning and update ; rab$w_rsz... ; ;--- .Entry Check_Redirect,- ^M ;don't muck with these clrl r10 movaq -(Sp),r9 ;Allocate descriptor movaq -(Sp),r8 ;allocate longword for subl2 #RDSize,SP movl sp,r7 ;itmlst in r5 movl #^a/ /,(r8) ;Redirect chars... brw 200$ 50$: movb #redo_char,1(r8) ;Output Redirection 60$: MatchC #3,(r8),- ;Check for Rab$W_Rsz(r6),- ; Redirect Chars in @Rab$L_Rbf(r6) ; Input Buffer bneq 90$ ;Nope all Done movl r2,r0 ;Did we get filename? beql 90$ ;no, then all done addl2 #3,r0 ;GET total length not needed subw2 r0,Rab$W_Rsz(r6) ;Change length to strip end... movzwl #LT_Sz,(r8) ;Create static descriptor movab LTbl,4(r8) ;point to buffer blbs r10,70$ movzwl #AOut_Sz,(r9) movab AOut,4(r9) ; brb 80$ 70$: movzwl #AIn_Sz,(r9) movab AIn,4(r9) ; 80$: movl r7,r0 ;Now Build Itmlst movw r2,(r0)+ ;Length of equivalence movw #LNM$_String,(r0)+ ;Item Code movl r3,(r0)+ ;Address of buffer clrq (r0)+ ;Clear last item and terminate list movzbl #PSL$C_User,(r0) ;set user mode... $crelnm_s - TabNam=(r8),- LogNam=(r9),- AcMode=(r0),- ItmLst=(r7) ;All Done blbc r0,101$ ;If error let user know... 90$: blbs r10,100$ ;all done movl #^a/ /,(r8) ;Redirect chars... movb #redi_char,1(r8) ;Input Redirection incl r10 99$: brb 60$ 100$: movl #SS$_Normal,r0 ;Assume all okay... 101$: Ret 200$: movb #Pipe_char,1(r8) ; " > " -->> " | " 205$: incl r10 MatchC #3,(r8),- ;Check for Rab$W_Rsz(r6),- ; Redirect Chars in @Rab$L_Rbf(r6) ; Input Buffer beql 210$ ;Nope check for "pipe" blbs r10,207$ brw 50$ 207$: movb #MULT_char,1(r8) ; " > " -->> " ; " brb 205$ 210$: movl r2,r0 beql 100$ ;skip if movl #P_Com,(r8) ; movl Rab$l_rbf(r6),r1 movl r8,r2 movl #3,r3 214$: bicb3 #32, (R1)+, R0 cmpb r0,(r2)+ bneq 215$ sobgeq r3,214$ brb 100$ ;Did start with PIPE... 215$: movl #ss$_Normal,r7 addw3 #,rab$W_rsz(r6),r0 ;remove stuff starting from cmpw r0,rab$w_usz(r6) ;more than we have? bleq 230$ ;Safe to move movw rab$w_usz(r6),r0 ;use max size movl #rms$_tns,r7 ;terminator not seen 220$: subw rab$W_rsz(r6),r0 bgeq 230$ ;should be okay to move addw2 r0,rab$w_rsz(r6) ;adjust it... 230$: movl rab$L_Ubf(r6),r1 ;get buffer area movc3 rab$w_rsz(r6),- ;amount of data to move @rab$l_ubf(r6),- (r1) ;move it here movl rab$l_ubf(r6),r1 movl #P_Com,(r1)+ ;put pipe command in front movb #32,(r1) ; of input string addw2 #,rab$W_rsz(r6) ;add pipe to command movl r7,r0 brw 101$ ; ; And that, friends, is all. ; reloc_len = .-reloc ; Length of relocatable stuff .end dclcomplete