.title disk i/o for native mode ted ; Copyright (C) 1984 Change Software, Inc. ; ; ; This software is furnished under a license and may ; be used and copied only in accordance with the ; terms of such license and with the inclusion of ; the above copyright notice. This software or any ; other copies thereof may not be provided or other- ; wise made available to any other person. No title ; to and ownership of the software is hereby trans- ; ferred. ; ; The information in this software is subject to ; change without notice and should not be construed ; as a commitment by the author. ; ; ;+ CHKFILENAME(filename) Check a filename for validity ;+ CLOSEF(tedlun) close the passed file ;+ CLOTMP() ;+ CRETMP() ;+ DCLCOMMAND(string) execute a DCL command line ;+ FIXFILENAME(dst,src) fix filename (remove version number) ;+ FLOOKUP(filename) Find a file ;+ GETBIN() Get the next character from terminal ;+ GETLINE(tedlun,buf,sizeaddr) Get a line from the terminal ;+ GETMCRCOMMAND(string) return the command line with imagename ;+ GETNEXT(resname,wildname,flag) Find the next wildcarded file ;+ GETPRM(buffer,prompt,maxlen) Get a line with prompting ;+ GETTBLOCK(bufferadr,size,vbn) Read a workfile block ;+ GETUNIQUEFILE(filename) ;+ GETVM(size_of_block) allocate/extend the workfile index ;+ GETYESNO(prompt,default) return YES/NO for the prompt ;+ INSTR(src,srclen,pat,patlen) Fast pattern matching using MATCHC ;+ ISWILD(filename) See if a filename is wildcarded ;+ OPENFI(name,tedlun) open the passed filename for r or w ;+ OPNHLP(address_helpfilename) open the passed help filename ;+ PUTBIN(buffer [,length]) Write to TT: without translation ;+ PUTLINE(tedlun,buffer,length) write to passed internal LUN ;+ PUTTBLOCK(bufferaddress,size,vbn) ;+ QUEFILE(filename) send a file to SYS$PRINT ;+ REACBU(bufferaddress,vbn) Read a cutpaste buffer in ;+ REAHLP(bufferaddress,vbn) Read a HELP buffer ;+ RSTTERMINAL() restore the terminal from SETTER ;+ SCOPY(to,from,fromsize) use MOVC3 to copy a string ;+ SETTERMINAL() setup the terminal for screen editing ;+ STRLEN(stringaddress) return the length of .asciz string ;+ WRICBU(bufferaddress,vbn) ;+ XINIT() do system dependent initialization .library /SYS$LIBRARY:LIB.MLB/ $ssdef $iodef $ttdef $tt2def $jpidef $prvdef $smrdef ; for printer $dvidef $devdef $fibdef $atrdef $fchdef .mcall $fab ; define the fab's .mcall $rab ; the record access blocks .mcall $xabpro ; for prot and ownership .mcall $connect ; connect to a record stream .mcall $disconnect ; release a record access stream .mcall $close ; close a file .mcall $create ; create a new file .mcall $open ; open existing file .mcall $get ,$put ; record read/write .mcall $read ,$write ; block i/o for work file .mcall $namdef ; name block defs .mcall $fabdef ; define fields in the fab .mcall $rabdef ; ditto for the rab .mcall $xabdef ; for extended attribute blocks .mcall $rmsdef $fabdef $rabdef $rmsdef $namdef .psect inlun ,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG inlun: .psect indlun ,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG indlun: .psect outlun ,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG outlun: .psect kblun ,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG kblun: .psect maxlen ,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG maxlen: .psect eoferror,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG eoferror: .psect filesize,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG filesize: .psect matchflag,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG matchflag: .psect prevchar,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG prevchar: .word 0,0 .blkb 30 .psect maxfilesize,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG maxfilesize: .psect astaction,PIC,USR,OVR,REL,GBL,SHR,NOEXE,RD,WRT,NOVEC,LONG astaction: .sbttl some macros that may be useful .psect rwdata ,gbl,con,noexe,noshr,rel,wrt .psect code ,lcl,con,exe,shr,rel,nowrt SYS_NORMAL = 1 SYS_TOOLONG = 2 CR = 13 LF = 10 SPACE = 32 FF = 12 CTRLZ = 26 BIGY = ^A/Y/&^o137 SMALLY = ^A/y/!^o40 BIGA = ^A/A/&^o137 BIGZ = ^A/Z/&^o137 BIGQ = ^A/Q/&^o137 .macro newline calls #0 ,print_crlf .endm newline .macro printerror val pushl val calls #1 ,print_error .endm printerror .macro decout val pushl val calls #1 ,decout calls #0 ,crlfout .endm decout .macro hexout val pushl val calls #1 ,hexout calls #0 ,crlfout .endm hexout .macro print str,len .if blank len .if_true ; if blank assume .asciz pushal str ; push the string address pushl #0 ; and flag it calls #2 ,type_ascii ; and do it .if_false pushl len ; assume passed length and pushal str ; address pushl #1 ; flag for it calls #3 ,type_ascii ; and do it .endc .endm print .sbttl data structures for file access .psect rmsdata ,long,con,noexe,noshr,rel,wrt chan_work == 0 ; read/write access chan_work1 == 1 ; read/write access chan_help == 2 ; read chan_input == 3 ; seq chan_output == 4 ; seq chan_terminal == 5 ; seq chan_ind == 6 ; seq, indirect commands chan_cut1 = 7 ; r/w access, paste buffer 0 chan_cut2 = 8 ; and 1 chan_cut3 = 9 ; and 2 tempmap:.long chan_work,chan_work1,0,0,0,0,0,0 cutmap: .long chan_cut1,chan_cut2,chan_cut3,0,0,0,0 cutopen:.long 0,0,0,0,0,0,0,0 fablist:.address fab_work,fab_scwork,fab_help,fab_input,fab_output .address fab_terminal,fab_ind,fab_cut1,fab_cut2,fab_cut3 rablist:.address rab_work,rab_scwork,rab_help,rab_input,rab_output .address rab_terminal,rab_ind,rab_cut1,rab_cut2,rab_cut3 fab_work: $fab fnm=, - fac=, - mrs=1024, - rfm=FIX, - alq=64,deq=32,rtv=0 - fop=TMD fab_scwork: $fab fnm=, - fac=, - mrs=512, - rfm=FIX, - alq=8,deq=8, - fop=TMD fab_help: $fab fnm=, - fac=,shr=,- rfm=FIX fab_input: $fab fac=,shr=,xab=in_proxab fab_ind: $fab fac=,shr= fab_output: $fab fac=,xab=out_proxab fab_terminal: $fab fnm= fab_cut1: $fab fnm=, - fac=, - mrs=512, - rfm=FIX, - alq=4,deq=4, - fop=TMD fab_cut2: $fab fnm=, - fac=, - mrs=512, - rfm=FIX, - alq=4,deq=4, - fop=TMD fab_cut3: $fab fnm=, - fac=, - mrs=512, - rfm=FIX, - alq=4,deq=4, - fop=TMD rab_work: $rab fab=fab_work rab_scwork: $rab fab=fab_scwork rab_help: $rab fab=fab_help rab_input: $rab fab=fab_input,mbc=16 rab_output: $rab fab=fab_output,mbc=16 rab_terminal: $rab fab=fab_terminal rab_ind: $rab fab=fab_ind rab_cut1: $rab fab=fab_cut1 rab_cut2: $rab fab=fab_cut2 rab_cut3: $rab fab=fab_cut3 in_proxab: $xabpro out_proxab: $xabpro in_filepro: $xabpro acpsyserror:: .long 0 tedsyserror:: .long 0 cctyped: .long 0 second: .long -10*1000*1000*1,-1 tenthsecond: .long -1*1000*1000,-1 curtime: .long 23 .address timebuffer timebuffer: .blkb 24 .align long nam_maxsize = 127 fab_find: $fab fop=NAM,nam=nam_find,fac=,shr= nam_find: $nam rsa=find_res_string,- rss=nam_maxsize,- esa=find_exp_string,- ess=nam_maxsize find_res_string:.blkb nam_maxsize .align long find_exp_string:.blkb nam_maxsize .align long fab_next: $fab fop=NAM,nam=nam_next nam_next: $nam rsa=next_res_string,- rss=nam_maxsize,- esa=next_exp_string,- ess=nam_maxsize old_wcc: .long 0 old_index: .long 0 next_res_string:.blkb nam_maxsize .align long next_exp_string:.blkb nam_maxsize .align long astflag: .long 0 ted_ast_buffer: .blkb 10 terexit: .long 0 .address rstterminal .long 1 .address tersts tersts: .long 0 terset: .long 0 oldtermchar: .blkb 12 newtermchar: .blkb 12 exquota_flag: .long 0 commandline: .long 63 .address cbuffer cbuffer: .blkb 64 commandlength: .long 0 exquota: .long <1@PRV$V_EXQUOTA> .long 0 authpriv: .word 8 .word jpi$_authpriv .address 10$ .address 20$ .long 0 10$: .quad 0 20$: .long 0 imagpriv: .word 8 .word jpi$_imagpriv .address 10$ .address 20$ .long 0 10$: .quad 0 20$: .long 0 curpriv:.word 8 .word jpi$_curpriv .address 10$ .address 20$ .long 0 10$: .quad 0 20$: .long 0 wsquota:.word 4 .word jpi$_wsquota .address 10$ .address 20$ .long 0 10$: .long 0 20$: .long 0 pid: .word 4 .word jpi$_pid .address pidval .address pidlen .long 0 pidval: .long 0 pidlen: .long 0 imagename: .word 63 .word jpi$_imagname .address cbuffer .address commandlength .long 0 vmsize: .long 0,0,0,0,0,0,0 vmbase: .long 0,0,0,0,0,0,0 vmalloc: .long 0,0,0,0,0,0,0 oldvmbase: .long 0,0,0,0,0,0,0 oldvmsize: .long 0,0,0,0,0,0,0 getdevtyp: .word 4 .word dvi$_devchar .address devchar .address devlen .long 0 devchar: .long 0 devlen: .long 0 homedir: .asciz /SYS$LOGIN:/ defsysque: .asciz /SYS$PRINT/ .align long lastlogname: .ascid /TED_LAST_FILE_EDITED/ .even temp$devname: .asciz /TED_TEMP:EDIT.TMP/ temp$name: .asciz /EDIT.TMP/ help$device: .asciz /TED_HELP:/ help$filetype: .asciz /.HLP/ .even tty_lun: .long 0 tty_outlun: .long 0 tty_nam: .long 63 .address tty_str tty_str: .blkb 63 .even tty_dev: .ascid /SYS$COMMAND/ .even tty_outdev: .ascid /SYS$OUTPUT/ .even dev_nam:.blkb 16 .byte 0,0 fil_dsc:.long 0 .long 0 fib_dsc:.long FIB$C_LENGTH .address fib fib: .blkb FIB$C_LENGTH atrlst: .word ATR$S_UCHAR .word ATR$C_UCHAR .address uchar .long 0 uchar: .blkb ATR$S_UCHAR hexmap: .asciz /0123456789ABCDEF/ .align long .psect code ,lcl,con,exe,shr,rel,nowrt .sbttl allocate virtual memory for the index ;+ char *GETVM(size_of_block,w,&all_size) allocate/extend workfile index ; ; GETVM will request the passed number of bytes from VMS and return ; the pointer to it in r0. If the allocation should fail, GETVM will ; return a value of zero. Since we can never be sure that a call to ; LIB$GET_VM will allocate the next area contiguous to the current ; area, we check for the existance of a previous area and then copy ; the entire area over if so, deallocating the previous area when ; done. Each index entry is 2 words + 1 longword (4 words) in size. ;- .psect code ,lcl,con,exe,shr,rel,nowrt .entry getvm ,^M movl 8(ap) ,r6 ; the window to allocate for tstl vmsize[r6] ; have we ever been called before? beql 10$ ; no movl vmsize[r6],oldvmsize[r6]; yes, save the old size please movl vmbase[r6],oldvmbase[r6]; and save the old vm base address 10$: mull3 4(ap),#8,vmsize[r6] ; number of entries * 4 words per pushal vmbase[r6] ; stuff the place to return the base pushal vmsize[r6] ; stuff the size of the request calls #2 ,G^lib$get_vm ; and get some memory from VMS blbc r0 ,90$ ; oops movl vmbase[r6],r0 ; success, return the base address tstl oldvmsize[r6] ; do we have to copy the old index to beql 100$ ; the new index ? divl3 #2,oldvmsize[r6],r1 ; yes movl oldvmbase[r6],r2 ; get the old size and base address movl vmbase[r6],r3 ; we are now all set to copy it 20$: movw (r2)+ ,(r3)+ ; simply copy it sobgtr r1 ,20$ ; next please pushal oldvmbase[r6] ; now free up the old region pushal oldvmsize[r6] ; base and number of bytes calls #2 ,G^lib$free_vm ; done movl vmbase[r6],r0 ; return with the current base and exit subl3 vmalloc[r6],4(ap),@12(ap);return the incremental allocation movl 4(ap) ,vmalloc[r6] ; save total allocation for next time brb 100$ ; exit 90$: pushl r0 ; print error message text calls #1 ,print_error ; clrl r0 ; failure, return 0 for address 100$: ret ; bye .sbttl allocate virtual memory for workfile buffering ; char *allbuffer(&n_allocated,pagesize,minimum_pagecount) ; ; Input: 4(ap) Return the number of 'ted' buffers allocated ; 8(ap) Minimum number of 512 byte pages to allocate ; 12(ap) Maximum number of 512 byte pages to allocate ; Return: 4(ap) Number actually allocated ; r0 zero for error, else starting address ; ; This routine is called to let the editor's workfile cacher to ; dynamically allocate buffers for that work file. While on VMS ; we could allocate up to our pagefilequota less current size of ; buffers, this is not reasonable since we can likely do better ; than VMS regarding clustering of the buffers in cache. This is ; an external routine for portability in that each implementaion ; can make it's own decision on what to do about the size of the ; cache at run time. For VMS, it is (for now) simply the WSQUOTA ; divided by 10. Soon I will change this to be nonlinear since ; user's with large WSQUOTA are penalized by using a linear all- ; ocation function. ; ; Called from PAGEINIT() ; .psect rmsdata ws_quo: .long 500,750,1000,2000,0 bf_all: .long 10,4,3,2,2 ; last entry is max .psect code .entry allbuffer ^M clrl -(sp) ; allocate a buffer for later clrl -(sp) ; two words please movl sp ,r4 ; set a pointer to that buffer $getjpiw_s itmlst=wsquota ; allocate buffers based on WSQUOTA blbc r0 ,90$ ; getjpi can't fail for self now! movl @,r3 ; get the current wsquota now clrl r1 ; index 5$: tstl ws_quo[r1] ; end of the table ? beql 6$ ; yes cmpl r3 ,ws_quo[r1] ; no, find wsquota in the range? blequ 6$ ; yes incl r1 ; no, try next entry brb 5$ ; next please 6$: divl3 bf_all[r1],r3,r2 ; and get the size cmpw r2 ,8(ap) ; did we allocate enough pages? bgtru 10$ ; yes movzwl 8(ap) ,r2 ; no, make it the minimum please 10$: cmpw r2 ,12(ap) ; is the value too high ? blequ 20$ ; no movzwl 12(ap) ,r2 ; yes, fix it please 20$: mull3 r2,#512 ,4(r4) ; convert to a byte count pushal (r4) ; address of where to return size pushal 4(r4) ; size in bytes for the request calls #2 ,G^lib$get_vm ; and get some memory from VMS blbc r0 ,90$ ; failure, return zero movl r2 ,@4(ap) ; return the number allocated movl (r4) ,r0 ; return the starting address brb 100$ ; exit 90$: clrl r0 ; error exit clrl @4(ap) ; clear allocation count also 100$: tstl (sp)+ ; pop a buffer and exit ret ; bye .sbttl fixfilename remove version number ;+ FIXFILENAME(dst,src) fix filename (remove version number) ; ; FIXFILENAME will remove the version number from GETNEXT for ; the default answer to the output file, thus avoiding RMS32's ; lack of desire to supercede files. ; ; Passed: ; ; 4(ap) The address to return the filename, .asciz ; 8(ap) The address of the filename to parse, .asciz ; ; Returns: ; ; R0 1, always successful ;- .entry fixfilename ,^M movl 4(ap) ,r2 ; where to put the filename movl 8(ap) ,r1 ; where it comes from 10$: cmpb (r1) ,#^a/;/ ; stop on null or ';' beql 20$ ; found a semicolon movb (r1)+ ,(r2)+ ; not found keep going bneq 10$ ; next please 20$: clrb (r2) ; insure .asciz and exit movzbl #1 ,r0 ; success ret ; bye .sbttl get temp filename based on the process PID ;+ GETUNIQUEFILE(address(filename)) ; ; Input: 4(ap) address of where to return filename ; Return: @4(ap) asciz filename ; r0 zero -> failure ; r0 one -> success ; ; GETUNIQUEFILE is called by any routine that needs to create ; a small workfile, such as is done in the PARAGRAPH command ; and in the QUE command. The returned filename is based on ; the low word of the PID. ;- .entry getuniquefile ,^M $getjpiw_s itmlst = pid ; get our own process id movl 4(ap) ,r4 ; point to the destination movb #^A/T/ ,(r4)+ ; copy 'ted' into it movb #^A/E/ ,(r4)+ ; copy 'ted' into it movb #^A/D/ ,(r4)+ ; copy 'ted' into it movl #4 ,r0 ; loop and convert to hex movl #^X1000 ,r2 ; divide the low part of the PID 10$: bicl3 #^C^XFFFF,pidval,r3 ; get the low part of the pid please divl2 r2 ,r3 ; and get the next digit shifted bicl2 #^C^XF ,r3 ; mask off the higher digits left movb L^hexmap(r3),(r4)+ ; and copy the character divl2 #^X10 ,r2 ; divided by a little less next time sobgtr r0 ,10$ ; next please movb #^A/./ ,(r4)+ ; copy '.tmp' into it movb #^A/T/ ,(r4)+ ; copy '.tmp' into it movb #^A/M/ ,(r4)+ ; copy '.tmp' into it movb #^A/P/ ,(r4)+ ; copy '.tmp' into it clrb (r4) ret ret .sbttl user visible i/o routines for native mode ted .psect code ,lcl,con,exe,shr,rel,nowrt ; XINIT start things for the exec we are running on ;+ XINIT() do system dependent initialization ;+ SETTERMINAL() setup the terminal for screen editing ;+ RSTTERMINAL() restore the terminal from SETTER .entry xinit ,^M $dclexh_s desblk=terexit ; Insure terminal chars reset calls #0 ,open$tty clrl cctyped ; no control C's clrl exquota_flag ; we want to know if the image was $getjpiw_s itmlst=curpriv ; installed with EXQUOTA blbc r0 ,20$ ; it failed (?) bitl #1@PRV$V_EXQUOTA,@ beqlu 20$ ; no exqouta incl exquota_flag ; image installed with exquota 10$: $getjpiw_s itmlst=authpriv ; but if the user has exquota in sysuaf blbc r0 ,20$ ; then we could care less. bitl #1@PRV$V_EXQUOTA,@ beqlu 20$ ; no exqouta clrl exquota_flag ; has exquota, so we never drop it. 20$: cmpw #nam_maxsize,L^maxfilesize; insure C routines allocate space blss 30$ ; for the maximum length filename. halt ; no, die then 30$: movzbl #1 ,r0 ; return success and exit ret .entry forcevtedit ,^M<> clrl r0 ret .entry inqtermtype ,^M subl2 #20 ,sp ; allocate a buffer movl sp ,r2 ; point to the buffer allocated movl #2 ,r3 ; assume a VT100 today $qiow_s chan=tty_lun,- ; find out about the current settings func=#io$_sensemode,- ; p1=(r2),p2=#12 ; blbc r0 ,100$ ; assume vt100 on error bitl #TT2$M_DECCRT2,8(r2) ; is this a VT2xx series terminal? beqlu 100$ ; no incl r3 ; yes, return 3 (vt220) 100$: movl r3 ,r0 ; return result addl2 #20 ,sp ; pop stack and exit ret ; bye .entry setterminal ,^M<> $qiow_s chan=tty_lun,- ; we want to first off all get func=#io$_sensemode,- ; the old terminal characteristics p1=oldtermchar,- ; save it in OLDTERMCHAR p2=#12 ; we also want the extended chars movq oldtermchar,newtermchar ; get the first 8 bytes movl oldtermchar+8,newtermchar+8 ; and the next 4 bisl2 #TT2$M_DECCRT,newtermchar+8 ; set ter/dec bisl2 #TT$M_MECHTAB,newtermchar+4 ; set ter/tab bicl2 #TT$M_WRAP ,newtermchar+4 ; set ter/nowrap $qiow_s chan=tty_lun,- ; now actually set the new stuff up func=#io$_setmode,- ; so that the editor will function p1=newtermchar,- ; properly please p2=#12 ; incl terset ; Say we did this 100$: movzbl #1 ,r0 ; return success and exit ret .entry rstterminal ,^M<> tstl terset ; Ever set it? beql 10$ ; No $qiow_s chan=tty_lun,- ; now actually set the new stuff up func=#io$_setmode,- ; so that the editor will function p1=oldtermchar,- ; properly please p2=#12 ; bitl #TT2$M_APP_KEYPAD,oldtermchar+8 beql 10$ ; SET TER/NOAPP calls #0 ,kpapplication ; force keypad back on please 10$: movzbl #1 ,r0 ; return success and exit ret .entry noecho ,^M<> movzbl #1 ,r0 ; return success and exit ret .entry backup ,^M<> movzbl #1 ,r0 ret .sbttl suspend the image for a while ;+ SUSPEND(number_of_ seconds) ; ; Input: 4(ap) Number of seconds to suspend the image ; Return: r0 1, always successful ;- .entry suspend ,^M cmpb (ap) ,#1 ; passed the right stuff? movzwl #1 ,r2 ; assume 1 second wait please bneq 10$ ; no movzwl 4(ap) ,r2 ; get the amount to do it 10$: $schdwk_s daytim=second ; schedule it and wait $hiber_s ; take a nap sobgtr r2 ,10$ ; do it again? 100$: movzbl #1 ,r0 ; return success and exit ret .entry waittenth ,^M<> $schdwk_s daytim=tenthsecond ; wait one tenth of a second $hiber_s ; do it movzbl #1 ,r0 ; and return success please ret .entry settimerast ,^M ; SETTIMERAST(seconds,ast_addr) movq second ,-(sp) ; convert the passed time to movl sp ,r2 ; proper format, and a pointer tstl 4(ap) ; to it. Ignore if <= zero bleq 100$ ; exit mull2 4(ap) ,(r2) ; convert to vms time format $setimr_s daytim = (r2),- ; and schedule an ast efn = #11,- ; must use a unique event flag astadr = @8(ap) ; and the ast address 100$: addl2 #8 ,sp ; pop stack and exit ret .entry cantimerast ,^M<> $cantim_s ret .sbttl fast string copy,strlen and gettim ;+ STRLEN(stringaddress) return the length of .asciz string ; Note: STRLEN ept removed for VAX c version 2. ; ; Input: 4(ap) Address of asciz string ; Return: r0 The string length ; ; ;+ SCOPY(to,from,fromsize) use MOVC3 to copy a string ; ; Input: 4(ap) The destination string address ; 8(ap) The source string address ; 12(ap) The number of bytes to copy ; ; SCOPY uses whatever hardware features that are available to do ; a very fast string copy. On the VAX, we simply used MOVC3. On ; something like a PDP11, we would try to break the copy into a ; fast loop (by using multiple MOVB instructions or folding the ; MOVB's into a MOV). ;- ;- .entry strlen ,^M<> ; ; movl 4(ap) ,r1 ; get the string address ; clrl r0 ; the length to return ;10$: tstb (r1)+ ; end of the string yet? ; beql 20$ ; yes ; incl r0 ; no, count it ; brb 10$ ; next please ;20$: ret ; exit .entry scopy ,^M movc3 12(ap),@8(ap),@4(ap) ; copy it please ret ; and exit .sbttl get the date and time ;+ GETTIM(address(buffer)) ; ; Input: 4(ap) Address of 18 character buffer to return the time ; Return: @4(ap) Asciz string of the current date and time ; ; GETTIM is used by the GOLD T command to insert a time stamp into ; the text being edited. ;- .entry gettim ,^M $asctim_s timbuf=curtime ; get it please movl 4(ap) ,r1 ; get where we put it moval timebuffer,r0 ; where we just put it movl #17 ,r2 ; size to return 10$: movb (r0)+ ,(r1)+ ; copy it sobgtr r2 ,10$ ; copy the next one also clrb (r1) ; insure .asciz ret ; exit .sbttl getcommandline ;+ GETMCRCOMMAND(string) return the command line with imagename ; ; Input: 4(ap) Address of buffer to return the string ; Return: @4(ap) Asciz string of command name including image name ; r0 zero for failure, one for success ; ; Return the command line to the editor. Since LIB$GET_FOREIGN ; removes the command name we re-insert it by getting the image ; name and removing everything but the filename field of it. We ; then append to that the command line. ;- .entry getmcrcommand ,^M movl 4(ap) ,r7 ; we need the buffer address asap clrl r6 ; and the counter for the returned len $getjpiw_s itmlst=imagename ; get current process info, like blbc r0 ,60$ ; it failed ? movl @imagename+8,r3 ; get the length of the image name addl3 imagename+4,r3,r2 ; get a pointer to the end of string 10$: cmpb -(r2) ,#^A/./ ; go backwards until we find the start beqlu 15$ ; of the filetype field of the name sobgtr r3 ,10$ ; not found, continue looking for a dot brb 60$ ; not found (?) 15$: clrl r4 ; now count the characters of the name 20$: cmpb -(r2) ,#BIGA ; now scan until we find something that blssu 30$ ; is not an uppercase letter cmpb (r2) ,#BIGZ ; ge than 'A', so check for le 'Z' bgtru 30$ ; not a letter incl r4 ; count it into the length please sobgtr r3 ,20$ ; a letter, continue on please brb 60$ ; we just ran off the end of it (?) 30$: tstb (r2)+ ; get repositioned please 40$: movb (r2)+ ,(r7)+ ; copy it please incl r6 ; add into the string length sobgtr r4 ,40$ ; next please movb #SPACE ,(r7)+ ; a delimiter please incl r6 ; count the length please 60$: pushal commandlength ; onto the stack now pushl #0 ; no user prompt pushal commandline ; and the address of the string calls #3 ,G^lib$get_foreign blbc r0 ,90$ ; it failed for whatever reason movc3 commandlength,@commandline+4,(r7) 80$: addl3 commandlength,r6,r0 ; return the command line length brb 100$ ; and exit 90$: clrl r0 ; error exit, return nothing 100$: ret .sbttl save/restore the last filename edited ; SAVEFILENAME(filename_address) ; ; Input: 4(ap) Address if asciz string of name to save ; Output: r0 zero for failure, otherwise one ; ; SAVEFILENAME takes the filename passed and defines that name ; as a process logical name TED_LAST_FILE_EDITED. Thus at the ; start of the editor, if no filename was passed on the command ; line we can call RSTFILENAME to see if a valid translation of ; that logical name exists. ;- .entry SAVEFILENAME ,^M pushl 4(ap) ; yes,get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no movab fab_find,r4 ; setup to parse the name so we movab nam_find,r5 ; can get the full directory path movb r0 ,fab$b_fns(r4) ; and store it where we need it movl 4(ap) ,fab$l_fna(r4) ; and stuff the string address $parse fab=r4 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error movzbl nam$b_esl(r5),r2 ; get the expanded string's length movl nam$l_esa(r5),r3 ; get the expanded string's address clrl r4 ; count until we find a semicolon 10$: cmpb (r3)+ ,#^A/;/ ; look for the version number beql 20$ ; found it, exit incl r4 ; not found, increment the length sobgtr r2 ,10$ ; and do it again 20$: subl2 #8 ,sp ; allocate a string descriptor movl sp ,r2 ; and a pointer to it please movl nam$l_esa(r5),4(r2) ; insert string address into descr. movl r4 ,(r2) pushl r2 ; pass the value to assign pushal lastlogname ; and the equiv string to create calls #2 ,G^LIB$SET_LOGICAL blbc r0 ,90$ ; failure movzbl #1 ,r0 ; success, return(1) brb 100$ ; exit 90$: clrl r0 ; failure, return(0) 100$: addl2 #8 ,sp ; restore the stack and exit ret ;+ RSTFILENAME(filename_address) ; ; Input: 4(ap) Address of where to return the logical name translation ; Return: @4(ap) If successful, the translation in asciz else a null ; r0 zero for failure (no translation), otherwise one. ; ; RSTFILENAME is called from EDSTART if a filename was absent from the ; command line. When called, it will attempt a translation of the name ; TED_LAST_FILE_EDITED. ;- .entry RSTFILENAME ,^M clrl -(sp) ; where to return the length movl sp ,r2 ; save it please pushl 4(ap) ; push the buffer address pushl #128 ; and the maximum size of it movl sp ,r3 ; get the pointer to the descr. $trnlog_s - ; and try to xlate the ted saved name lognam = lastlogname ,- ; the name we wish to translate rsllen = (r2) , - ; where to return the length rslbuf = (r3) ; the descriptor to return to cmpl r0 ,#SS$_NOTRAN ; no equivalence name present? beqlu 90$ ; yes, exit with nothing then. blbc r0 ,90$ ; it failed, oops addl3 4(ap),(r2),r0 ; success, point to the end of the clrb (r0) ; string and make it .asciz please movzbl #1 ,r0 ; return(success) brb 100$ ; and exit 90$: movl 4(ap) ,r0 ; failure, return null string clrb (r0) ; and return(0) clrl r0 ; 100$: addl2 #4*3 ,sp ; pop the stack and exit ret ; and exit .sbttl return name of home directory name .entry gethomedir ,^M<> movab homedir ,r0 movl 4(ap) ,r1 10$: movb (r0)+ ,(r1)+ bneq 10$ movzbl #1 ,r0 ret .sbttl do a dcl command ;+ DCLCOMMAND(string) execute a DCL command line .entry dclcommand ,^M subl2 #10 ,sp ; allocate a string descriptor movl sp ,r1 ; and a pointer to it please movl 4(ap) ,r2 ; get the command line address clrl r0 ; now get the string length please 10$: tstb (r2)+ ; found the end of it yet? beql 20$ ; yes incl r0 ; no, keep going please brb 10$ ; and check the next one 20$: movl r0 ,(r1) ; stuff the length in movl 4(ap) ,4(r1) ; and the string address pushl r1 ; stuff the command line and get calls #1 ,G^lib$spawn ; it spawned blbs r0 ,100$ ; success pushl r0 ; failure, find out why calls #1 ,print_error ; simple 100$: movzbl #1 ,r0 ; always return success please addl2 #10 ,sp ; pop string descriptor ret ; exit .sbttl send a file to the printer ;+ QUEFILE(filename) send a file to SYS$PRINT .entry quefile ,^M pushl fab_find+fab$l_fop ; save old file options flag pushl 4(ap) ; get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no moval fab_find,r2 ; get the fab address please moval nam_find,r3 ; and the name block also movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 4(ap) ,fab$l_fna(r2) ; and stuff the string address clrw fab$w_ifi(r2) ; insure that internal fid is 0 $parse fab=r2 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error bisl2 #fab$m_spl,fab$l_fop(r2); set for spooling at file close $open fab=r2 ; try to find the file now blbc r0 ,90$ ; failure $close fab=r2 ; close up shop now movzbl #1 ,r0 ; success brb 100$ ; exit 90$: movl r0 ,tedsyserror ; save the error clrl r0 ; and flag as being not there 100$: popl fab_find+fab$l_fop ; save old file options flag ret .sbttl delete a file .entry delfile ,^M pushl 4(ap) ; get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no moval fab_find,r2 ; get the fab address please movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 4(ap) ,fab$l_fna(r2) ; and stuff the string address clrw fab$w_ifi(r2) ; insure that internal fid is 0 $parse fab=r2 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error $erase fab=r2 ; get rid of it now blbc r0 ,90$ ; success movzbl #1 ,r0 ; return(1) brb 100$ ; exit 90$: clrl r0 ; failure 100$: ret ; bye .sbttl directory lookup routines ;+ ISDIRECTORY(f) ; ; Passed: ; 4(ap) address of .asciz filename ; ; Returns: ; r0 zero if error or not a dir file ; one if a dir file ;- .entry isdirectory ,^M clrl uchar ; insure zeroed clrq -(sp) ; allocate an IOSB movl sp ,r10 ; simple clrq -(sp) ; allocate a descriptor movl sp ,r7 ; a pointer clrq -(sp) ; another descriptor movl sp ,r8 ; and a pointer to it also movc5 #0,(sp),#0,#FIB$C_LENGTH,fib pushl 4(ap) ; get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? bneq 10$ ; no brw 100$ 10$: moval fab_find,r2 ; get the fab address please moval nam_find,r6 ; and the name block also movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 4(ap) ,fab$l_fna(r2) ; and stuff the string address $parse fab=r2 ; and parse the filename blbc r0 ,20$ ; parse failed $search fab=r2 ; do a search in case version is blbs r0 ,30$ ; is missing. Succss 20$: brw 90$ ; failure 30$: movc3 #16,NAM$T_DVI(r6),dev_nam ; copy the device name over movzbl dev_nam ,(r7) ; setup a descriptor for it movab dev_nam+1,4(r7) ; counted string $assign_s - ; and assign a channel to device devnam = (r7) , - ; the device name chan = (r8) ; the channel is returned here blbc r0 ,90$ ; but please exit on errors movzbl NAM$B_TYPE(r6),r0 ; setup a descriptor for the movzbl NAM$B_VER(r6),r1 ; filename+type+version movzbl NAM$B_NAME(r6),r2 ; .... addl2 r0 ,r1 ; .... addl3 r1,r2,fil_dsc ; set the name+type+ver length movl NAM$L_NAME(r6),fil_dsc+4; set the filename address up movab FIB ,r9 ; point to the FIB now movl NAM$W_DID(r6),FIB$W_DID(r9) movw NAM$W_DID+4(r6),FIB$W_DID+4(r9) $qiow_s func = #IO$_ACCESS ,-; access the file please iosb = (r10) , - ; I/O status block chan = (r8) , - ; channel number p1 = fib_dsc , - ; FIB block p2 = #fil_dsc , - ; filename descriptor p5 = #atrlst ; attribute list that we want blbc r0 ,90$ ; qio failed movzwl (r10) ,r0 ; qio worked, see if the ACP blbc r0 ,90$ ; found the file bitl #FCH$M_DIRECTORY,uchar ; ok, see if directory bit is set beql 90$ ; no, return failure movzbl #1 ,r0 ; success brb 100$ ; exit 90$: movl r0 ,tedsyserror ; save the error clrl r0 ; and flag as being not there 100$: addl2 #8*3 ,sp ; pop the stack from data allocated pushl r0 ; save the return status movl (r8) ,r8 ; get the channel number beql 110$ ; zero if $assign never called $dassgn_s chan = r8 ; free the LUN now 110$: popl r0 ; pop register and exit ret ; bye .sbttl directory lookup routines ;+ FLOOKUP(filename) Find a file ; ; Passed: ; ; 4(ap) address of .asciz filename ; ; Returns: ; ; r0 zero if error, else one ;- .entry flookup ,^M pushl 4(ap) ; get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no moval fab_find,r2 ; get the fab address please moval nam_find,r3 ; and the name block also movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 4(ap) ,fab$l_fna(r2) ; and stuff the string address $parse fab=r2 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error $search fab=r2 ; try to find the file now blbc r0 ,90$ ; failure movzbl #1 ,r0 ; success brb 100$ ; exit 90$: movl r0 ,tedsyserror ; save the error clrl r0 ; and flag as being not there 100$: ret .sbttl get next wildcarded input file ;+ GETNEXT(resname,wildname,flag) Find the next wildcarded file ; ; Passed: ; ; 4(ap) address to return a .asciz name of the next file ; 8(ap) source wildcarded name ; 12(ap) parse flag, if zero, then start all over ; ; Returns: ; ; r0 2 for no more files, 1 for success, else 0 ;- .entry getnext ,^M moval fab_next,r2 ; get the fab address please moval nam_next,r3 ; and the name block also movzbl #1 ,r5 ; assume looking for next file tstl 12(ap) ; first time we have been called? bneq 5$ ; no clrl old_index ; yes, clear offset from directory top brb 10$ ; and proceed to the $parse 5$: cmpl 12(ap) ,old_index ; is the desired file the next one? bgequ 20$ ; yes, skip the $parse then addl2 old_index,r5 ; no, flag for looping on $search 10$: pushl 8(ap) ; yes,get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 8(ap) ,fab$l_fna(r2) ; and stuff the string address $parse fab=r2 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error 20$: movl 12(ap) ,old_index ; and the index also please 30$: $search fab=r2 ; try to find the file now blbc r0 ,90$ ; failure sobgtr r5 ,30$ ; we may have to look for a while movl 4(ap) ,r5 ; where to return the string at clrb (r5) ; start with .asciz please movzbl nam$b_rsl(r3),r1 ; get the resultant string size beql 100$ ; nothing movl nam$l_rsa(r3),r4 ; get the string to get 40$: movb (r4)+ ,(r5)+ ; and copy it byte by byte sobgtr r1 ,40$ ; and do the next one clrb (r5) ; must return .asciz please movzbl #1 ,r0 ; success brb 100$ ; exit 90$: movl r0 ,tedsyserror ; save the error cmpl r0 ,#RMS$_NMF ; NO MORE FILES ? bneq 95$ ; no movzwl #2 ,r0 ; yes, return such and exit brb 100$ ; exit 95$: clrl r0 ; and flag as being not there 100$: ret .sbttl check for wildcarding and parse a filename ;+ ISWILD(filename) See if a filename is wildcarded ; ; Passed: ; ; 4(ap) .asciz string of a filename to check for wildcarding ; ; Returns: ; ; r0 zero for no wildcarding (or error), else 1 for wildcards ;- .entry iswild ,^M<> pushl 4(ap) ; call parser to parse name calls #1 ,fss ; tstl r0 ; did it work? beql 100$ ; no clrl r0 ; assume not wildcarded bitl #NAM$M_WILDCARD,nam_find+nam$l_fnb beql 100$ ; no, it was not wildcarded incl r0 ; was wildcarded, return success 100$: ret ;+ CHKFILENAME(filename) Check a filename for validity ; ; Passed: ; ; 4(ap) .asciz string of the filename to check ; ; Returns: ; ; r0 zero for filename error, else 1 ;- .entry chkfilename ,^M<> pushl 4(ap) ; check to see if a filename calls #1 ,fss ; will parse ret ; exit .entry fss ,^M pushl 4(ap) ; get the string length calls #1 ,G^strlen ; may as well do it this way tstl r0 ; anything there ? beql 100$ ; no moval fab_find,r2 ; get the fab address please movb r0 ,fab$b_fns(r2) ; and store it where we need it movl 4(ap) ,fab$l_fna(r2) ; and stuff the string address $parse fab=r2 ; and parse the filename blbc r0 ,90$ ; failed, return 0 and save error movzbl #1 ,r0 ; success brb 100$ ; exit 90$: movl r0 ,tedsyserror ; save the error clrl r0 ; and flag as being not there 100$: ret .sbttl write pass all to the terminal and readpassall ;+ PUTBIN(buffer [,length]) Write to TT: without translation ; ; PUTBIN simply writes the passed buffer to TI:. If 'LENGTH' is ; omitted or zero, it is assumed that the string is .asciz. ; ; Passed: ; ; 4(ap) Buffer address ; 8(ap) Optional buffer length ;- .entry tedputbin ,^M clrl r0 ; assume length of zero cmpb (ap) ,#1 ; omitted the length arg ? beql 10$ ; yes movzwl 8(ap) ,r0 ; get the passed length bneq 20$ ; something was there 10$: pushl 4(ap) ; nothing, or zero length calls #1 ,G^strlen ; get the string length 20$: $qiow_s func=#io$_writevblk!io$m_noformat,- chan=tty_outlun,- p1=@4(ap),- p2=r0 movzbl #1 ,r0 ; no errors ret ; and exit .sbttl Getbin Read a character from SYS$INPUT ;+ GETBIN() Get the next character from terminal ; ; GETBIN reads one character from the terminal without translation. ; ; Passed: ; ; Nothing ; ; Returns: ; ; R0 NULL if error, otherwise the character just read ;- .entry getbin ,^M movaw prevchar,r2 ; check for internally stored type tstw (r2) ; ahead data from ast level routines. bleq 20$ ; nothing is present in that buffer. movzwl 2(r2) ,r0 ; get the offset now movzbl L^prevchar+4(r0),r0 ; and extract the desired character. incw 2(r2) ; fix the offset for the next time? decw (r2) ; fix the remaining character count bgtr 100$ ; something is left clrl (r2) ; all gone, fix count and offset. brb 100$ ; exit 20$: clrl (r2) ; nothing stored to fetch pushl tty_lun ; do a readpassall calls #1 ,ted$binread ; simple to do blbc r0 ,90$ ; error movl r1 ,r0 ; no error, return the character brb 100$ ; bye 90$: clrl r0 ; error, return a null (nop) 100$: ret .entry typeahead ,^M<> ; find out if anything is present in ; the typehead buffer. For systems that ; can not tell use without actually ; doing a read, save the character read pushl tty_lun ; in 'prevchar' so getbin will find it. calls #1 ,ted$typeahead ; for VMS, do a io$_sensemode ret ; bye .sbttl read from file/terminal ; GETLINE ;+ GETLINE(tedlun,buf,sizeaddr) Get a line from the terminal ; ; 4(ap) ted's LUN , if eq KBLUN then terminal else INPLUN for disk ; 8(ap) address of the user's byte buffer ; 12(ap) address of where to return the record size read .entry getline ,^M movzbl #chan_input,r2 ; assume disk input please cmpb 4(ap) ,inlun ; ted's input lun? beql 10$ ; yes movzbl #chan_ind,r2 ; no, assume @file cmpb 4(ap) ,indlun ; ted's command file lun beql 10$ ; yes movzbl #chan_terminal,r2 ; no, must be the terminal then 10$: pushl r2 ; construct the call list for pushl maxlen ; ted$getrecord. Push the max buffer pushl 8(ap) ; size and the buffer address calls #3 ,ted$getrecord ; simple enough to do clrl @12(ap) ; assume the read failed cmpl r0 ,#RMS$_RTB ; did we get a record too long? bnequ 20$ ; no movl r1 ,@12(ap) ; yes, return sys_toolong movzbl #SYS_TOOLONG,r0 ; and exit brb 100$ ; 20$: blbc r0 ,90$ ; error exit movl r1 ,@12(ap) ; success, return the read size movzbl #1 ,r0 ; and return success brb 100$ 90$: movl eoferror,r0 ; return failure 100$: ret ; exit ;+ GETPRM(buffer,prompt,maxlen) Get a line with prompting ;- .entry getprm ,^M ; get with prompt string pushl 8(ap) ; asciz, push the buffer address pushl #0 ; and the flag for asciz calls #2 ,type_ascii ; dump it out please pushl #chan_terminal ; reading from the terminal today pushl 12(ap) ; the max amout to do pushl 4(ap) ; the buffer address calls #3 ,ted$getrecord ; and read it in blbc r0 ,90$ ; error movl r1 ,r0 ; success, return(recordlength) brb 100$ ; and exit 90$: clrl r0 ; failure, return(0) 100$: ret ; and exit ;+ GETYESNO(prompt,default) return YES/NO for the prompt .entry getyesno ,^M pushl 4(ap) ; dump the prompt out please calls #1 ,putbin ; and then get the response subl2 #20 ,sp ; allocate a buffer now movl sp ,r2 ; and a pointer to it also pushl #20 ; get the response from the terminal pushl r2 ; stuff maximum read size and buffer pushl tty_lun ; the channel number to use calls #3 ,ted$ttread ; and get a line please blbc r0 ,80$ ; the read failed for whatever reason cmpb (r2) ,#CR ; a carriage return typed? bneq 10$ ; no movb @8(ap) ,(r2) ; yes, stuff the default response in 10$: cmpb (r2) ,#BIGY ; upper case 'Y' ? beql 20$ ; yes cmpb (r2) ,#SMALLY ; how about a lower case y bneq 90$ ; no, return failure 20$: movzbl #1 ,r0 ; yes, return(1) brb 100$ ; and exit 80$: movl #-1 ,r0 ; return (-1) on read errors brb 100$ ; exit 90$: clrl r0 ; return(0) 100$: addl2 #20 ,sp ; pop local buffer and exit ret .sbttl put a line to terminal or file ;+ PUTLINE(tedlun,buffer,length) write to passed internal LUN ; ; Write a line out to disk, stripping the trailing ; off in the process. ; ; 4(ap) ted's internal lun ; 8(ap) buffer address ; 12(ap) size of the record ;- .entry putline ,^M movzwl 12(ap) ,r3 ; the size of the write cmpw 4(ap) ,outlun ; writing to a disk file ? beql 20$ ; yes tstl r3 ; nothing to do ? beql 10$ ; exit with success then pushl 12(ap) ; no, simple dump in write passall pushl 8(ap) ; push both the buffer address calls #2 ,putbin ; and the size of the buffer 10$: movzbl #1 ,r0 ; assume it worked ok brb 100$ ; exit 20$: cmpl r3 ,#2 ; must have at least TWO characters blss 50$ ; zero or one character, skip it. addl3 r3,8(ap),r2 ; point to the end of the user buffer cmpb -(r2) ,#LF ; a line feed hanging at the end? bneq 50$ ; no, use the record as passed cmpb -(r2) ,#CR ; a carriage return next to the ? bneq 50$ ; no, forget it decl r3 ; yes, byte count is off by one now decl r3 ; yes, byte count is off by two now 50$: pushl #chan_output ; we are writing today pushl r3 ; the size of the write pushl 8(ap) ; the buffer address calls #3 ,ted$putrecord ; simple to do blbc r0 ,60$ ; success? movzbl #1 ,r0 ; yes brb 100$ ; exit 60$: pushl tedsyserror calls #1 ,print_error clrl r0 ; failure 100$: ret .sbttl misc routines .entry crlfout ,^M<> ; dump a sequence calls #0 ,print_crlf ; simple ret .entry cretm1 ,^M<> movzbl #1 ,r0 ; dummy routine, return success ret ; exit .entry cretm2 ,^M<> movzbl #1 ,r0 ; dummy routine, return success ret ; exit .sbttl open and close .psect rmscode ,exe,con,shr,nowrt,lcl,rel ;+ OPNHLP(address_helpfilename) open the passed help filename ; ;- open the passed help file .entry opnhlp ,^M<> subl #120 ,sp ; allocate a buffer movl sp ,r1 ; and a pointer to that buffer movab help$device,r0 ; now copy the device string in 10$: movb (r0)+ ,(r1)+ ; simple bnequ 10$ ; next please decl r1 ; backup to the null we copied movl 4(ap) ,r0 ; and copy it 20$: movb (r0)+ ,(r1)+ ; simple bnequ 20$ ; not done yet decl r1 ; backup over the null movab help$filetype,r0 ; add in a filetype please 30$: movb (r0)+ ,(r1)+ ; and copy it in bnequ 30$ ; next please movl sp ,r1 ; point back to the buffer pushl #chan_help ; the LUN pushl r1 ; the filename, .asciz calls #2 ,ted$open ; simple to do addl #120 ,sp ; pop the buffer and exit ret ;+ OPENFI(name,tedlun) open the passed filename for r or w ; ; open or create a sequential file based on 'channel' .entry openfi ,^M<> cmpb 8(ap) ,outlun ; if output then do it for output bneq 10$ ; must be for output pushl #chan_output ; map to our lun table pushl 4(ap) ; simple calls #2 ,ted$create ; do it and exit brb 100$ ; bye 10$: cmpb 8(ap) ,inlun ; input file ? bneq 20$ ; no (?) pushl #chan_input ; map to our lun table brb 30$ ; and open it 20$: cmpb 8(ap) ,indlun ; command file today? bneq 90$ ; no pushl #chan_ind ; yes, use correct internal lun 30$: pushl 4(ap) ; simple calls #2 ,ted$open ; do it and exit brb 100$ ; exit 90$: brb 100$ 100$: ret .sbttl external ept CLOSEF for closing disk files ;+ CLOSEF(tedlun) close the passed file .entry closef ,^M<> cmpb 4(ap) ,outlun bneq 10$ pushl #chan_output calls #1 ,ted$close brb 100$ 10$: cmpb 4(ap) ,inlun bneq 20$ pushl #chan_input calls #1 ,ted$close brb 100$ 20$: cmpb 4(ap) ,indlun bneq 30$ pushl #chan_ind calls #1 ,ted$close brb 100$ 30$: 100$: movzbl #1 ,r0 ret .sbttl read/write blocks ;+ GETTBLOCK(bufferadr,size,vbn,window) Read a workfile block ; ; Read a bucket from the main work file .entry gettblock ,^M<> movl 16(ap) ,r0 pushl tempmap[r0] ; the lun pushl 12(ap) ; the block number pushl 8(ap) ; the size of the read pushl 4(ap) ; the buffer address calls #4 ,ted$get_block ; simple tstl r0 bneq 100$ pushl tedsyserror ; yes, dump the error message calls #1 ,print_error ; and exit clrl r0 ; bye 100$: ret ;+ REAHLP(bufferaddress,vbn) Read a HELP buffer ; ; Read a block from the help file .entry reahlp ,^M<> pushl #chan_help ; the lun pushl 8(ap) ; the vbn to do pushl #512. ; the size of the read pushl 4(ap) ; the buffer address calls #4 ,ted$get_block ; and do it ret ; bye ; GETBLOCK ; ; input: 4(ap) byte record buffer address ; 8(ap) record size ; 12(ap) block number ; 16(ap) internal lun ; output: r0 rms sts ; r1 record length ; ; for the 'C' interface, return 1 if ok, else zero, saving ; the error code in TEDSYSERROR .entry ted$get_block ,^M movzwl 16(ap) ,r2 ; get the internal lun to use movl rablist[r2],r2 ; get the rab for this file movw 8(ap) ,rab$w_usz(r2) ; set the max record size in place movl 4(ap) ,rab$l_ubf(r2) ; and the user's buffer address movl 12(ap) ,rab$l_bkt(r2) ; and the vbn to read $read rab=r2 ; read the next record now clrl r1 ; presume error, set size eq 0 blbc r0 ,100$ ; error, exit please movzwl rab$w_rsz(r2),r1 ; it worked, get the amount read movzbl #1 ,r0 ; return success for 'C' brb 110$ ; exit 100$: movl r0 ,tedsyserror ; clrl r0 ; return failure 110$: ret ; exit ;+ PUTTBLOCK(bufferaddress,size,vbn,window) ; ; Write a bucket to the main work file .entry puttblock ,^M<> 10$: movl 16(ap) ,r0 pushl tempmap[r0] ; the lun pushl 12(ap) ; the block number pushl 8(ap) ; the size of the write pushl 4(ap) ; the buffer address calls #4 ,ted$put_block ; simple tstl r0 ; errors ? bneq 100$ ; no pushl tedsyserror ; yes, dump the error message calls #1 ,print_error ; and exit clrl r0 ; bye 100$: ret ; PUTBLOCK ; ; input: 4(ap) byte record buffer address ; 8(ap) size of record to write ; 12(ap) vbn ; 16(ap) internal lun ; output: r0 rms rst .entry ted$put_block ,^M tstl exquota_flag ; first of all, check to see if beql 10$ ; we should get EXQUOTA back for $setprv_s prvadr=exquota , - ; the workfile write. enbflg=#1 ; if so, go get it please 10$: jsb 200$ ; now try the write operation tstl r0 ; if it worked, exit, otherwise bneq 100$ ; we will have to retry the $PUT cmpl tedsyserror,#RMS$_EXT ; in case it was an ACP extend bnequ 100$ ; error. jsb 200$ ; It was, so retry the operation 100$: tstl exquota_flag ; now see if we should drop EXQUOTA beql 120$ ; no pushr r0 ; save error code flags $setprv_s prvadr=exquota , - ; yes, please drop it. enbflg=#0 ; and then exit popr r0 ; 120$: ret ; bye 200$: movzwl 16(ap) ,r2 ; get the internal lun to use movl rablist[r2],r3 ; get the rab for this file movw 8(ap) ,rab$w_rsz(r3) ; set the record size in place movl 4(ap) ,rab$l_rbf(r3) ; and the user's buffer address movl 12(ap) ,rab$l_bkt(r3) ; block number $write rab=r3 ; write the next record now pushr r0 $wait rab=r3 popr r0 blbc r0 ,210$ ; error exit movzbl #1 ,r0 ; success brb 220$ ; exit 210$: movl r0 ,tedsyserror clrl r0 220$: rsb ; exit .sbttl cut/paste i/o routines ;+ REACBU(bufferaddress,vbn) Read a cutpaste buffer in ; ; Read a block from the cut/paste buffer .entry reacbuffer ,^M jsb crecut ; insure the correct file is open tstl r0 ; did it work ? beql 100$ ; no movzwl 12(ap) ,r0 ; yes, map into internal routines pushl cutmap[r0] ; map the buffer # into channel pushl 8(ap) ; the vbn to do pushl #512. ; the size of the read pushl 4(ap) ; the buffer address calls #4 ,ted$get_block ; and do it 100$: ret ; bye ;+ WRICBU(bufferaddress,vbn) ; ; Write a block from the cut/paste buffer .entry wricbuffer ,^M jsb crecut ; insure the correct file is open tstl r0 ; did it work ? beql 100$ ; no movzwl 12(ap) ,r0 ; yes, map into internal routines pushl cutmap[r0] ; map the buffer # into channel pushl 8(ap) ; the vbn to do pushl #512. ; the size of the write pushl 4(ap) ; the buffer address calls #4 ,ted$put_block ; and do it 100$: ret ; bye crecut: movzbl #1 ,r0 ; assume success movl 12(ap) ,r2 ; get the paste buffer to use movl cutmap[r2],r3 ; map the cut/paste buffer number beql 110$ ; to an internal channel tstl cutopen[r2] ; is the cut buffer open yet? bneq 120$ ; file is already open movl fablist[r3],r4 $create fab=r4 ; create the work file for screen editor blbc r0 ,100$ ; it failed, exit then movl rablist[r3],r4 $connect rab=r4 ; get the access stream set up 100$: movl r0 ,tedsyserror ; save it blbc r0 ,110$ ; failure, return with r0 = zero movl #1 ,cutopen[r2] ; success, flag as being open now clrl tedsyserror ; success, clear saved error flag movzbl #1 ,r0 ; return(1) brb 120$ ; and exit 110$: pushl tedsyserror calls #1 ,print_error clrl r0 ; error return with status = 0 120$: rsb ; bye .sbttl create and close work files ;+ CRETMP() .entry cretmp ,^M<> pushab temp$devname ; try a logical name for size calls #1 ,G^strlen ; get the string length movab temp$devname,fab_work+fab$l_fna movb r0 ,fab_work+fab$b_fns $create fab=fab_work ; create the main work file blbs r0 ,10$ ; it worked pushab temp$name ; try a logical name for size calls #1 ,G^strlen ; get the string length movab temp$name,fab_work+fab$l_fna movb r0 ,fab_work+fab$b_fns $create fab=fab_work ; create the main work file blbc r0 ,110$ ; it failed, exit then 10$: $connect rab=rab_work ; get the access stream set up blbc r0 ,110$ ; it failed, exit then $create fab=fab_scwork ; create the main work file blbc r0 ,110$ ; it failed, exit then $connect rab=rab_scwork ; get the access stream set up blbc r0 ,110$ ; it failed, exit then clrl tedsyserror ; success, clear saved error flag movzbl #1 ,r0 ; return(1) brb 120$ ; and exit 110$: movl r0 ,tedsyserror clrl r0 ; error return with status = 0 120$: ret ; bye ;+ CLOTMP() .entry clotmp ,^M $disconnect rab=rab_work ; remove the access now $close fab=fab_work ; and close the file. $disconnect rab=rab_scwork ; remove the access now $close fab=fab_scwork ; and close the file. clrl r2 10$: movl cutmap[r2],r3 beql 100$ tstl cutopen[r2] beql 20$ movl rablist[r3],r4 $disconnect rab=r4 movl fablist[r3],r4 $close fab=r4 20$: incl r2 brb 10$ 100$: ret ; TED$CLOSE ; ; input: 4(ap) internal lun to use ; output: r0 rms sts .entry ted$close ,^M ; close a file movzwl 4(ap) ,r2 ; get the internal lun movl rablist[r2],r3 ; get the rab for this file $disconnect rab=r3 ; disconnect the access stream movl fablist[r2],r3 ; get the fab so we can close it $close fab=r3 ; simple ret ; bye ; ted$CREATE ; ; input: 4(ap) filename address, .asciz ; 8(sp) internal channel number ; output: r0 0 for error, else 1 .entry ted$create ,^M movzwl 8(ap) ,r2 ; get the internal channel number movl fablist[r2],r3 ; get the address of the fab movb #fab$m_put,fab$b_fac(r3); insure put access allowed movb #fab$c_seq,fab$b_org(r3); insure sequential files movb #fab$m_cr ,fab$b_rat(r3); implied carriage control movb #fab$c_var,fab$b_rfm(r3); variable length records movl 4(ap) ,r4 ; get the filename address movl r4 ,fab$l_fna(r3) ; and insert the filename address clrl r5 ; counter for number of characters 10$: tstb (r4)+ ; look for the null terminator beql 20$ ; found the null incl r5 ; did not find the null yet brb 10$ ; next please 20$: movb r5 ,fab$b_fns(r3) ; insert the filename size now clrw fab$w_ifi(r3) ; insure that internal fid is 0 clrb fab$b_rtv(r3) ; let the number of windows default cmpw 8(ap) ,#chan_output ; is this an output file? bneq 30$ ; no movb #255 ,fab$b_rtv(r3) ; yes, map the entire thing if so 30$: $create fab=r3 ; open the file up for reading now movl fab$l_stv(r3),r4 ; save the acp error code please blbc r0 ,100$ ; oops, better exit then movl rablist[r2],r3 ; get the rab address now $connect rab=r3 ; and connect to a record address stream blbs r0 ,110$ ; no errors movl rab$l_stv(r3),r4 ; save the acp error code please 100$: movl r0 ,tedsyserror ; error movl r4 ,acpsyserror ; save acp error if any cmpl r0 ,#RMS$_CRE ; acp create fail ? bneq 105$ ; no movl r4 ,tedsyserror ; yes, use the system error code 105$: clrl r0 ; return(0) brb 120$ ; bye 110$: movzbl #1 ,r0 ; success, return(1) clrl tedsyserror 120$: ret ; bye .sbttl get the next record ; GETRECORD ; ; input: 4(ap) byte record buffer address ; 8(ap) maximum record size allowed ; 12(ap) internal lun ; output: r0 rms sts ; r1 record length .entry ted$getrecord ,^M movzwl 12(ap) ,r2 ; get the internal lun to use cmpb r2 ,#chan_terminal ; the terminal? bneq 20$ ; no tstl tty_lun ; did we ever assign the terminal bneq 10$ ; yes calls #0 ,open$tty ; no, open it please 10$: pushl 8(ap) ; yes, use a qio to do it please pushl 4(ap) ; the buffer address is next pushl tty_lun ; and that also please calls #3 ,ted$ttread ; and get from the terminal brb 100$ ; exit with r0=status,r1=bytecount 20$: movl rablist[r2],r2 ; get the rab for this file movw 8(ap) ,rab$w_usz(r2) ; set the max record size in place movl 4(ap) ,rab$l_ubf(r2) ; and the user's buffer address $get rab=r2 ; read the next record now clrl r1 ; presume error, set size eq 0 movl r0 ,tedsyserror ; save the error code cmpl r0 ,#RMS$_RTB ; rtb errors are warnings only beqlu 25$ ; ok blbc r0 ,100$ ; error, exit please 25$: clrl tedsyserror ; save the error code movzwl rab$w_rsz(r2),r1 ; it worked, get the amount read addl3 4(ap),r1,r2 ; point to the end of the user's buffer tstl r1 ; a blank line (ie, only ) ? beql 30$ ; yes, insert CRLF cmpb -1(r2) ,#FF ; a form feed? beql 40$ ; yes, leave things as they stand cmpb -1(r2) ,#LF ; stream file and a line feed in it? (?) beql 40$ ; yes 30$: movb #CR ,(r2)+ ; need a crlf then movb #LF ,(r2)+ ; simple to do addl2 #2 ,r1 ; line is two characters longer now 40$: 100$: ret ; exit ; PUTRECORD ; ; input: 4(ap) byte record buffer address ; 8(ap) size of record to write ; 12(ap) internal lun ; output: r0 rms rst .entry ted$putrecord ,^M movzwl 12(ap) ,r2 ; get the internal lun to use cmpb r2 ,#chan_terminal ; the terminal? bneq 20$ ; no tstl tty_lun ; did we ever assign the terminal bneq 10$ ; yes calls #0 ,open$tty ; no, open it please 10$: print 4(ap) ,8(ap) ; and dump to the terminal brb 100$ ; and exit 20$: jsb 200$ ; try the write out for size movl r0 ,tedsyserror ; save the error please blbs r0 ,90$ ; success cmpl r0 ,#RMS$_EXT ; acp extend failure ? bneq 100$ ; no, simply exit then jsb 200$ ; extend failure, retry the operation movl r0 ,tedsyserror ; save the error, if any blbc r0 ,90$ ; error, exit 90$: clrl tedsyserror ; no errors, clear saved error code 100$: ret ; and exit 200$: movl rablist[r2],r3 ; get the rab for this file movw 8(ap) ,rab$w_rsz(r3) ; set the record size in place movl 4(ap) ,rab$l_rbf(r3) ; and the user's buffer address $put rab=r3 ; write the next record now rsb ; exit .sbttl internal open for OPENFI and OPNHLP ; TED$OPEN ; ; input: 4(ap) filename address, .asciz ; 8(sp) internal channel number ; output: r0 rms error code .entry ted$open ,^M movzwl 8(ap) ,r2 ; get the internal channel number movl fablist[r2],r3 ; get the address of the fab movl 4(ap) ,r4 ; address of the filename here movl r4 ,fab$l_fna(r3) ; and insert the filename address clrl r5 ; counter for number of characters 10$: tstb (r4)+ ; look for the null terminator beql 20$ ; found the null incl r5 ; did not find the null yet brb 10$ ; next please 20$: movb r5 ,fab$b_fns(r3) ; insert the filename size now clrw fab$w_ifi(r3) ; insure that internal fid is 0 clrb fab$b_rtv(r3) ; let window count default cmpw 8(ap) ,#chan_input ; but if this is an input file tell bneq 30$ ; rms to try to map the entire file movb #255 ,fab$b_rtv(r3) ; if it can 30$: $open fab=r3 ; open the file up for reading now blbc r0 ,100$ ; oops, better exit then movl rablist[r2],r4 ; get the rab address now $connect rab=r4 ; and connect to a record address stream 100$: blbs r0 ,110$ ; no errors movl r0 ,tedsyserror ; error clrl r0 ; return(0) brb 120$ ; bye 110$: movzbl #1 ,r0 ; success, return(1) movl fab$l_alq(r3),filesize ; save the file size please clrl tedsyserror 120$: ret ; bye .entry saveprotection ,^M<> movw L^in_proxab+xab$w_pro,L^in_filepro+xab$w_pro movl in_proxab+xab$l_uic,in_filepro+xab$l_uic ret .entry setprotection ,^M<> movw L^in_filepro+xab$w_pro,L^out_proxab+xab$w_pro clrl out_proxab+xab$l_uic $getjpiw_s itmlst=curpriv bitl #1@PRV$V_SYSPRV,@ beqlu 100$ movl in_filepro+xab$l_uic,out_proxab+xab$l_uic 100$: ret .entry setmbc ,^M<> ret .entry clrmbc ,^M<> ret .sbttl initialize the terminal .psect code .entry checkterminal ,^M<> ;+ CHECKTERMINAL ; ; Return 1 if SYS$OUTPUT is a terminal or mailbox ; Return 0 if it is not ;- devmask = <1@DEV$V_TRM> ! <1@DEV$V_MBX> $getdvi_s itmlst= getdevtyp , - efn = #20 , - devnam= tty_dev blbc r0 ,90$ $waitfr_s efn = #20 movzbl #1 ,r0 bitl #devmask,devchar bnequ 100$ 90$: clrl r0 100$: ret ; O P E N $ T T Y ; ; input: nothing ; output: r0 system service status ; r1 channel number assigned by sys$assign .entry open$tty, ^m movab tty_dev,r1 ; get the sys$command assigned jsb 200$ ; first. save the returned LUN blbc r0 ,100$ ; and then get a channel for movl r1 ,tty_lun ; sys$output next. movab tty_outdev,r1 ; setup for translation of jsb 200$ ; sys$output to the physical blbc r0 ,100$ ; equivalent. movl r1 ,tty_outlun ; save and exit 100$: ret 200$: subl #80. ,sp ; allocate a buffer for translated movl sp ,r2 ; logical name. use r2 as pointer movl #63 ,(r2) ; create a empty .ascid string movl r2 ,4(r2) ; and the address of the string addl #8 ,4(r2) ; skip over the length and type $trnlog_s lognam=(r1),- ; get sys$command tranlated first rslbuf=(r2) ; pointer to result name buffer blbc r0 ,210$ ; it failed clrl -(sp) ; must pass address for channel # movl sp ,r1 ; use r1 to point to it $assign_s chan =(r1),- ; get vms to allocate a channel devnam=(r2) movl (sp)+ ,r1 ; return channel number in r1 blbc r0 ,210$ movl #ss$_normal,r0 210$: addl #80. ,sp rsb ; bye .sbttl print ascii or .ascid string out to terminal ; T Y P E $ A S C I I ; ; Print either an ascii string with length passed or type ; an .ascid standard descripter ; ; ; input: 4(ap) if eq -1, assume .ascid ; if eq 0, assume .asciz ; if eq 1, assume .ascii ; ; @8(ap) addres of string or string descriptor ; 12(ap) length if not .ascid .entry type_ascii,^m ; print a string at 4(ap), len 8(ap) tstl 4(ap) ; if < 0 then assume .ascid bgtr 20$ ; if > 0 assume passed length and addr blss 10$ ; if = 0 assume .asciz movl 8(ap) ,r2 ; assume .asciz get address of string clrl r3 ; use r3 as a counter for length 5$: tstb (r2)+ ; hit the end of the string yet? beql 6$ ; yes incl r3 ; no, increment the length and test brb 5$ ; again please 6$: $qiow_s func=#io$_writevblk,- chan=tty_outlun,- p1=@8(ap),- p2=r3 brw 100$ 10$: movl 8(ap) ,r2 ; get address of string descriptor movzwl (r2) ,r3 $qiow_s func=#io$_writevblk,- chan=tty_outlun,- p1=@4(r2),- p2=r3 brw 100$ 20$: $qiow_S func=#io$_writevblk,- ; write virtual block to terminal chan=tty_outlun,- ; channel from $assign p1=@8(ap),- ; address of string to print p2=12(ap) ; length of the string to print 100$: movl #SS$_NORMAL,r0 ; return success ret ; bye ; T T W R I T E ; ; write a line to the terminal ; ; input: 4(ap) string address ; 8(ap) string length ; ; output: r0 system service completion code .entry ted$ttwrite ,^m<> pushl 8(ap) ; stuff string length and pushl 4(ap) ; string address pushl #1 ; flag to type_ascii for passed length calls #3,type_ascii ret .sbttl cancel control O ;+ ; RESUMEOUTPUT() ; ; Passed: nothing ; Return: nothing ;- .entry resumeoutput ,^M<> clrl -(sp) movl sp ,r1 $qiow_s func=#,- chan=tty_outlun,- p1=(r1),- p2=#0 tstl (sp)+ ret .sbttl read from the terminal ; T T R E A D ; ; ; read a line from the terminal ; ; input: 4(ap) channel number ; 8(ap) buffer address ; 12(ap) buffer size (defaults to 132) ; ; output: 8(ap) the line just read ; r0 completion status ; r1 size of the read .entry ted$ttread ,^m subl #10 ,sp ; allocate a iostatus block movl sp ,r4 ; and use r4 to point to it movl #132. ,r3 ; assume 132 character read cmpb (ap) ,#2 ; ommitted the buffer length? beql 10$ ; yes movzwl 12(ap) ,r3 ; no, use that which was passed 10$: $qiow_s chan = 4(ap),- ; do the read func = #io$_readvblk,- efn = #3,- iosb = (r4),- ; pusha is wierd p1 = @8(ap),- ; buffer address p2 = r3,- ; max buffer size p4 = #200$ ; allowed terminators clrl r1 ; clear returned length blbc r0 ,100$ ; error if (r0 and 1) = 0 movzwl 2(r4) ,r1 ; return the length of the read addl3 r1,8(ap),r2 ; point to the end of the buffer cmpb 4(r4) ,#CTRLZ ; control z typed today? bneq 20$ ; no clrl r0 ; yes, return an error then brb 100$ ; simple to do 20$: movb 4(r4) ,(r2) ; not control Z, copy the terminator cmpb (r2)+ ,#FF ; a form feed today? beql 30$ ; yes movb #LF ,(r2) ; no, must be a carriage return then incl r1 ; count it 30$: incl r1 ; count the previous character also 100$: addl2 #10 ,sp ; remove the iosb from the stack ret 200$: .long 0 .long ^b100000000000011010000000000 ; allow and .sbttl read binary (passall) ; T E D $ B I N R E A D ; ; input: 4(ap) channel number for terminal ; output: r0 system service code ; r1 one character just read binmode = io$_readvblk + io$m_noecho + io$m_nofiltr .entry ted$binread ,^M subl #10 ,sp ; allocate a iostatus block movl sp ,r3 ; and use r4 to point to it clrl -(sp) ; allocate a character buffer movl sp ,r2 ; and point to it $qiow_s chan = 4(ap),- ; do the read func = #binmode,- ; io$_readpassall reads ^C and ^Y iosb = (r3),- ; pusha is wierd p1 = (r2),- ; buffer address p2 = #1,- ; max buffer size p4 = #200$ movl (sp)+ ,r1 ; get the character now addl #10 ,sp ; remove the iosb from the stack ret 200$: .long 16 ; terminator block. allow all .address 210$ ; but control C to be one since ; we would like to be able to get 210$: .byte ^b11110111 ; control C ast's .rept 15 .byte ^b11111111 .endr .entry ted$typeahead ,^M clrq -(sp) ; clear a 4 word buffer movl sp ,r2 ; save the address $qiow_s chan = 4(ap),- ; do the read func = #, - p1 = (r2),- ; buffer address p2 = #8 ; max buffer size blbc r0 ,100$ ; failure, exit please tstw (r2) ; anything in the typeahead buffers? beql 100$ ; no movzbl #1 ,r0 ; yes, return success and exit brb 110$ ; bye 100$: clrl r0 ; failure or nothing waiting to be read 110$: addl2 #8 ,sp ; exit please ret .entry print_crlf ,^M<> pushl #2 pushal 200$ pushl #1 calls #3 ,type_ascii ret 200$: .byte 13,10 .sbttl error text .mcall $getmsg_s .entry geterror ,^M<> ; get error text from last error pushl 4(ap) ; push the buffer address pushl tedsyserror ; push the error number calls #2 ,sys_error ; and get the error text ret ; bye ; SYS_ERROR ; ; input: 4(ap) the message id value ; 8(ap) address of byte buffer for returned text ; output: r0 error code ; r1 text length (text is also .asciz) .entry sys_error ,^M movl 8(ap) ,r4 ; point to the buffer address movl r4 ,-(sp) ; allocate a string descriptor movl #79. ,-(sp) ; 80 bytes movl sp ,r2 ; point to it clrl -(sp) ; where to return the text length movl sp ,r3 ; point to it $getmsg_s msgid=4(ap),msglen=(r3),bufadr=(r2),flags=#15 blbs r0 ,100$ clrl r1 ; failure clrb (r4) ; clear first byte out brb 110$ ; exit 100$: movzwl (r3) ,r1 ; the length addl r1 ,r4 ; point to the last character clrb (r4) ; also make this .asciz 110$: addl #12 ,sp ; pop the stack and exit ret .entry print_error ,^M subl #80 ,sp ; allocate a buffer from the stack movl sp ,r2 ; and a pointer to it please pushl r2 ; push the address of the buffer pushl 4(ap) ; and the value of the error code calls #2 ,sys_error ; get the error text pushl r1 ; now get set to print it out pushl r2 ; push the length and address pushl #1 ; and type flag calls #3 ,type_ascii ; do it addl #80 ,sp ; restore stack to it's former state ret ; and exit .psect spdata ,noexe,noshr,rel,rd,wrt,long sp_flags: .long 1 ; no waiting for the spawned process mb_done: .long 0 ; set when spawn completion ast comes mb_phyname: .long 63 ; to translate the mailbox logical .address 10$ ; to the real device name, needed for 10$: .blkb 64 ; lib$spawn mb_logname: .ascid /TED_MAILBOX/ ; the logical name for the mailbox mb_size = 256 ; size in bytes of the mailbox buffer mb_buffer: .blkb mb_size ; the buffer for the mailbox .align long ; for safety mb_lun: .word 0 ; save the lun returned by crembx mb_iosb: .word 0,0,0,0 ; i/o status block for the mailbox mb_efn = 2 ; for the mailbox reads wf_efn = 3 ; for the waitfor efn call wf_mask = ^B0100 ; the bitmask for waitfor .psect code ;+ DOMBX(commandline,filename) ; ; Spawn a subproccess. ; ; If commandline is null, assume input will be from SYS$INPUT ; Output will be placed into 'FILENAME', which will be opened ; by the normal TED i/o system. ; ; Passed: 4(ap) Address of a command line, .asciz ; 8(ap) Address of a filename to create and write to ;- Return: R0 zero for failure, else 1 for success .entry dombx ,^M pushl #chan_output ; internal lun for writing pushl 8(ap) ; the .asciz filename to do calls #2 ,ted$create ; create the file please tstl r0 ; did this work ok? beql 110$ ; no, exit jsb create_mb ; get the mailbox created blbc r0 ,90$ ; oops jsb spawn ; spawn the process please blbc r0 ,90$ ; check for success clrl mb_done ; we are not done yet 50$: tstl mb_done ; did we get a completion ast? bneq 100$ ; yes, exit please jsb read_mb ; post a read for the mailbox blbc r0 ,90$ ; exit if it fails $wflor_s - ; now wait for the mailbox to efn = #wf_efn ,- ; get some data from the spawned mask = #wf_mask ; process tstl mb_done ; done yet ? bneq 100$ ; yes jsb read_mbfin ; no, post processing for the read blbs r0 ,50$ ; it worked ok 90$: movl r0 ,r2 ; save the error code pushl #chan_output ; close the file on error please calls #1 ,ted$close ; simple movl r2 ,tedsyserror ; save the error code clrl r0 ; exit with failure brb 110$ ; 100$: pushl #chan_output ; close the file on successful end calls #1 ,ted$close ; exit movzbl #1 ,r0 ; exit with success 110$: ret ; bye .entry exit_mb ,^M $setef_s efn = #mb_efn movl #1 ,mb_done ret spawn: subl2 #10 ,sp ; space to create string descr movl 4(ap) ,r1 ; get the command line to do tstb (r1) ; anything to do ? bnequ 10$ ; yes clrl r1 ; no, pass zero to lib$spawn brb 40$ ; 10$: movl sp ,r1 ; yes, so create string descripter movl 4(ap) ,r2 ; first, count the string length clrl r0 ; count the length here 20$: tstb (r2)+ ; loop until we find the end of it beqlu 30$ ; did we get the end? incl r0 ; no, count the length some more brb 20$ ; next please 30$: movl r0 ,(r1) ; stuff the length movl 4(ap) ,4(r1) ; and the string address 40$: pushal exit_mb ; here when the subproccess exits pushl #0 ; completeion efn value pushl #0 ; completion status pushl #0 ; pid of the created process pushl #0 ; no process name passed pushal sp_flags ; no wait pushal mb_phyname ; the mailbox name pushl #0 ; sys$input please pushl r1 ; either zero or a nonnull command calls #9 ,G^lib$spawn ; and spawn the subprocess addl2 #10 ,sp ; pop rsb .sbttl post a qio to mailbox, finish after completion read_mb: $qio_s efn = #mb_efn, - ; post a qio to the mailbox func = #io$_readvblk,- chan = mb_lun, - ; we will post one for the iosb = mb_iosb, - ; terminal also and then wait p1 = mb_buffer, - ; for the logical or of the p2 = #mb_size ; event flags. rsb read_mbfin: movaw mb_iosb ,r4 ; i/o status block address movzwl 2(r4) ,r1 ; return the length of the read movl r1 ,r2 ; save the actual length please movab mb_buffer,r3 ; the buffer address also please addl2 r1 ,r3 ; point to the end of the buffer cmpb 4(r4) ,#CTRLZ ; control z typed today? bneq 10$ ; no clrl r0 ; yes, return an error then brb 40$ ; simple to do 10$: cmpb 4(r4) ,#FF ; was there a form feed terminator bneq 20$ ; no movb 4(r4) ,(r3) ; yes, return it by itself and exit brb 30$ ; and fix the byte count also 20$: movb #CR ,(r3)+ ; otherwise insert a CRLF pair movb #LF ,(r3) ; no, must be a carriage return then incl r1 ; count it 30$: incl r1 ; count the previous character also 40$: pushl r1 ; write the data to sys$output pushab mb_buffer ; the buffer for the mailbox calls #2 ,ted$ttwrite ; and dump it to sys$output pushl #chan_output ; internal lun for writing pushl r2 ; the actual byte count pushab mb_buffer ; and the mailbox buffer address calls #3 ,ted$putrecord ; write the record out please rsb .sbttl create mailbox create_mb: $crembx_S - ; create the mailbox for the prmflg = #0, - ; the spawned process. It should chan = mb_lun, - ; be temporary of course. maxmsg = #mb_size, - ; max we can read at once lognam = mb_logname ; the name to use for it $trnlog_s lognam= mb_logname,- ; get sys$output tranlated first rslbuf= mb_phyname ; pointer to result name buffer rsb .sbttl declare ast for typeahead during screen refresh ; DCLINPAST(address(ast_flag) ; ; This routine will be called before the editor puts up a new ; page in response to a newpage command. If anything is typed ; during the screen update, the ast routine will take a look ; at what was typed, and if it was an escape character it will ; flag it by making the location passed to DCLINPAST non zero. ; Thus the page update code can then exit and GETBIN will get ; the escape character the ast routine read. ; Actually, the way the code now functions is at the time of ; the ast, the ast routine checks for the amout of typeahead. ; If there are two characters waiting after we find the first ; one to be an escape, we will assume that a function/pf key ; has been typed and then read the two characters. If the last ; character is a 'Q' then we have a PF2 key, thus set the flag ; and exit. In any case, any characters read here will be in ; the 'PREVCHAR' buffer for GETBIN to extract. ; The proper method to handle this would be to call a routine ; in the editor's command dispatched (SCCMD) to determine in a ; terminal/keypad definition independent way if the escape seq ; was a NEXTPAGE command. Later.... .entry dclinpast ,^M<> movl 4(ap) ,astflag ; get the address to set the flag at $qio_s chan = tty_lun , - ; post an asynch single character read func = #binmode , - ; ala io$m_noecho + io$m_nofiltr astadr = ted_read_ast,- ; set the ast entry point efn = #10 , - ; must use an unique event flag here p1 = ted_ast_buffer , - ; the read buffer p2 = #1 ; and the buffer size blbs r0 ,100$ ; if error then die clrl r0 ; error clrl astflag ; internal flag also please ret 100$: movzbl #1 ,r0 ; success flag ret .entry ted_read_ast ,^M clrq -(sp) ; allocate buffer for io$m_typeahdcnt movab ted_ast_buffer,r5 ; get the ast entry point buffer tstl astflag ; ensure we are primed for the ast bnequ 10$ ; we are not, ignore this ast then brw 100$ ; too far for byte branch 10$: movaw prevchar,r3 ; get address of buffer control info movab prevchar+4,r4 ; get address of actual char buffer. movzwl (r3) ,r0 ; get the current character count addl2 r0 ,r4 ; and point to the next free spot movb (r5) ,(r4)+ ; stuff the character read away now incw (r3) ; correct for character count cmpb (r5) ,#27 ; Was the character read an escape? bnequ 100$ ; If not, just exit with char stored. tstl astaction ; go ahead on any esc sequence ? bnequ 90$ ; yes movl sp ,r2 ; save the address $qiow_s chan = tty_lun ,- ; do the read func = #, - efn = #10 , - ; must use own event flag please p1 = (r2),- ; buffer address p2 = #8 ; max buffer size blbc r0 ,100$ ; nothing in typeahead, exit cmpw (r2) ,#3 ; we must have at least 3 characters blss 100$ ; no, just exit then please $qiow_s chan = tty_lun , - ; something is there, get the next func = #binmode , - ; character from vms typeahead buffer efn = #10 , - ; must use unique event flag p1 = (r5) , - ; the buffer address p2 = #2 ; must try for 2 characters this time blbc r0 ,100$ ; it failed movb (r5)+ ,(r4)+ ; copy the character movb (r5) ,(r4)+ ; likewise, the next one also addw2 #2 ,(r3) ; fix the byte count and exit cmpb (r5) ,#^A/5/ ; VT220 next or prev page ? beql 90$ ; yes cmpb (r5) ,#^A/6/ ; VT220 next or prev page ? beql 90$ ; yes cmpb (r5) ,#BIGQ ; If the third member of the esc seq bneq 100$ ; was a Q (ie, $OQ) then we have a PF2 90$: movzbl #1 ,@astflag ; We have it, flag for a newpage AST. 100$: clrb ted_ast_buffer ; clear out the ast buffer now addl2 #8 ,sp ; pop the stack ret ; generate the ast .entry clrinpast ,^M<> clrb ted_ast_buffer ; clear out the ast buffer now tstl astflag ; did we ever set the ast up ? beql 100$ ; no clrl astflag ; yes, it's off now $cancel_s chan = tty_lun ; cancel it 100$: ret ; and exit .entry xprintf ,^M movzbl (ap) ,r2 movzbl (ap) ,r3 beql 20$ mull3 #4,r3 ,r4 addl3 ap,#4 ,r1 addl2 r4 ,r1 10$: pushl -(r1) sobgtr r2 ,10$ 20$: calls r3 ,G^printf ret .entry sxprintf ,^M movzbl (ap) ,r2 movzbl (ap) ,r3 beql 20$ mull3 #4,r3 ,r4 addl3 ap,#4 ,r1 addl2 r4 ,r1 10$: pushl -(r1) sobgtr r2 ,10$ 20$: calls r3 ,G^sprintf ret .entry vms_trapper ,^M<> pushr #^M calls #0 ,trapper popr #^M ret .end