,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 commandlDISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf12 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 ofDISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddflease 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$geDISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfing 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 wDISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf0 ; 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$ ;DISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf 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 DISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfab=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 ,DISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfslated 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 ^b1000000000000110100000000DISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf ; 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 cDISKIOMAR[.050036]DISKIO.MAR[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfpage 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 .end DISKIOMAR[.050036]DISKIO.MAR[.050036],   X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>