From: SMTP%"MACRO32%WKUVX1.BITNET@uu7.psi.com" 9-SEP-1993 12:28:28.14 To: EVERHART CC: Subj: Re: DCL command/filename completion X-Listname: "VMS Internals, MACRO, & BLISS Discussions" Warnings-To: <> Errors-To: MacroMan%WKUVX1.BITNET@uu7.psi.com Sender: MacroMan%WKUVX1.BITNET@uu7.psi.com From: don@zl2tnm.gen.nz Reply-To: MACRO32%WKUVX1.BITNET@uu7.psi.com X-Newsgroups: vmsnet.internals Subject: Re: DCL command/filename completion Message-Id: <1993Sep9.222005.2343@zl2tnm.gen.nz> Date: 9 Sep 93 22:20:05 +1200 Organization: The Wolery Lines: 716 To: MACRO32@WKUVX1.BITNET X-Gateway-Source-Info: USENET > Expect to see a new version shortly. Here 'tis. Please ditch the old version of DCLCOMPLETE; it can crash your system, either by running it with CMKRNL but not with PSWAPM, and also by hitting Ctrl/Y at just the right moment... Fixing this bug is the only major change to it. Don Stokes, CSC Network Manager, Victoria University of Wellington, New Zealand Ph+64 4 495-5052 Fax+64 4 471-5386 Work:don@vuw.ac.nz Home:don@zl2tnm.gen.nz .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. ; ; Changes: ; 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" ; 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 ; ; Some constants ; complete_char = 9 ; File completion character (TAB) reloc_sigval = 12345678 ; Signature value ; ; Local variables allocated on (supervisor) stack ; tmp=. ; Define some local variables .=0 itmlst: ; Itemlist for XABTRM itm_len = 0 ; length field itm_cod = 2 ; code field itm_adr = 4 ; address field itm_ret = 8 ; retaddress field itmlst_mod: .blkb 12 ; Modifiers itmlst_prompt: .blkb 12 ; Prompt itmlst_termsk: .blkb 12 ; Terminator Mask itmlst_inistr: .blkb 12 ; Initial String itmlst_offset: .blkb 12 ; Cursor offset itmlst_len = .-itmlst prompt: .blkb 40 ; Prompt string (we fiddle with this) ; 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 ; ; 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<> 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 ; ; Read-only data ; tchars: .ascii " ,+(@=" ; Command element delimiters tchars_term_l = .-tchars ; File name delimiters .word ^A":" ; Device terminators .word ^A"<[" ; Directory opener .word ^A">]" ; Directory close .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 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 .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, 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 #TRM$_TERM, itmlst_termsk+itm_cod(R11) ; _^]\[ZYXWVUTSRQPONMLKJIHGFEDCBA@ movl #^b00000100000000000010000000000100+<1@complete_char>, - itmlst_termsk+itm_adr(R11) ; 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. cmpb RAB$W_STV0(R6), #complete_char beql complete_file ; Check termination character 99$: 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 ; ; 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 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$ bicl #1, R0 movab compflags, R3 movb (R3)[R0], R1 ; Get bits to set bicb R7, R1 ; Mask off bits already in use bisb R1, R10 bisb 1(R3)[R0], R7 cmpb R1, #fm_die ; Dir end char? bneq 1$ ; No, loop movb R2, R4 ; Yes, note its location incl R4 brb 1$ ; Come here when we've hit 2$: incl R2 ; a delimiter or BOL. bneq 21$ ; If BOL then go and complete brw complete_cmd ; the command. ; ; We're completing the filespec. ; We now need to decide what sort of wildcard spec to feed to $SEARCH. ; This is determined by taking the bits we set above and using the wildcard_x ; table to decide how much of the wildcard extension we need. ; 21$: addl2 R2, R8 ; R8=address of filespec subl2 R2, R9 ; R9=length " " subl3 R2, R4, dirlen(R11) movc3 R9, (R8), scratch(R11) ; Copy filename to scratch buf movab scratch(R11), R2 ; R2=address of scratch buffer bicl3 #fm_dev, R10, R0 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 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 blbc R0, 8$ ; ; 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. ; 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 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: 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$: ; ; Now call $PARSE/$SEARCH with a null filespec. This is to avoid a nasty ; little problem with running out of PPF space. ; 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. ; 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 brw error ; it. 99$: movab 1(R7), R8 ; Come here when command found movb #32,scratch(R11)[R7] ; Put a space at the end of ; the command 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$: brw fix_itmlst ; Done. ; ; Come here on error. Ring the terminal bel, and redisplay the current ; line. ; error: $QIOW_S chan=ttychan, func=#IO$_WRITEVBLK!IO$M_NOFORMAT, - p1=bel, p2=#1 ; Beep! 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 ; ; And that, friends, is all. ; reloc_len = .-reloc ; Length of relocatable stuff .end dclcomplete