{Notes for Tops-10 users. This file is intended to be included in your program. It defines the procedures used to support the Tops-20 COMND jsys. These procedures are included in PASLIB, so all you have to do to use them is include this file in your source file. PASLIB also includes routines that simulate the Tops-20 COMND jsys. You should probably have a copy of Tops-20 Monitor Calls to use this to its fullest. At the moment, the following restrictions exist: - not all of these things are implemented. You will get an appropriate error message if you try to use one that isn't. So far implementation includes the following: cmkey, cmnum, cmnum8, cmnoi, cmswi, cmifi, cmofi, cmfil, cmfld, cmcfm, cmdir, cmusr, cmcma, cmini Also the support routines needed for switches and files are finished (TBMAK, TBADD, and the GJxxx routines). - the options involving files do not cause files to be looked up. That is, you can do CMIFI and give it a file name that has no corresponding file. Obviously the system will notice this when it tries to open the file, but it will not be noticed by this package. On Tops-20, the COMND jsys actually looks to make sure the file exists. - recognition is not done on file names. That is, you can't type part of a name and have it completed if there is only one file starting with that. However if you default an entire field (e.g. there is a default extension), will still show you that. - wildcard file names are not allowed (because Pascal does not implement them on tops-10). - ? works only at the beginning of fields. On Tops-20, you can say /F? and get the names of all switches beginning with F. - note that you can't rubout over an . This scanner operates in the normal line activation mode (i.e. it uses INCHWL). So once you type , , or , any characters up to that can't be backed over. You can use ^G (bell) to kill the entire command line. It will echo as XXX and reissue the prompt for the line. On a more positive note, here is what is implemented: Interaction with the user is via INCHWL. So normal ^U, ^R, etc. work. However they only work on data since the last , , or . And ^U and ^R redo the line without the prompt. You may find ^G more useful than ^U, as explained below. In a pinch ? can sometimes be used as a more intelligent ^R. ^G is defined by this code as an additional editing character. It kills the entire "logical line", that is the whole command. This is useful in case was used in the middle of a line for recognition. ^G echoes as XXX, and causes the prompt to be retyped. Because of this reissuing of the prompt, it is slightly nicer than ^U. - is defined as a continuation character. If typed immediately before a terminator (, , ), both it and the terminator are ignored. ? will tell you what kind of input is being looked for. It must be typed at the beginning of a field. That is, don't try typing it in the middle of a file name or a switch. In most cases a single phrase will be given for each option, but for switches and keywords, all legal switches and keywords will be listed. After listing the options, Pascal will retype the command line up to the ?, so that the context of your typein will be visible. will do the following things: if typed at the beginning of a field, and there is a default value for the field, the default value will be supplied. It will be typed out in place of the . if typed at the end of a switch or keyword that you abbreviated, it will be "completed". I.e. the rest of the name will be typed. if typed at the end of a file spec, any default values that come after what you typed will be shown. Note that this doesn't affect what happens: the default values would be used anyway - you just get to see them. if any field is ended with an and there is "noise" after it, you see the noise. E.g. deleTE (FILES) The (FILES) is noise. Here are my interpretations of Tops-20 objects that are not obvious: directory name - this is a [p,pn,sfd...]. The [] is required. If only a PPN is given, that PPN is returned. Otherwise NEW is used to get a small block of memory and the path is put there. What is returned is the address of this block. This can be used by lookup and enter as if it were a PPN. user name - this is a [p,pn]. The [] is required. The PPN is returned. } type t=array[0:100]of integer; table=^t; tadrec=packed record year:0..777777B; month:0..777777B; dayofmonth:0..777777B; dayofweek:0..777777B; zoneused:boolean; daylightsavings:boolean; zoneinput:boolean; julianday:boolean; dum:0..377B; zone:0..77B; seconds:0..777777B end; cmmodes=(normal,rescan); procedure cmini(prompt:string);extern; {Use this procedure first. It will issue the prompt, and set things up for reparsing in case of errors. Beware that if an error occurs in any of the other CM functions, control may be returned to the statement after the CMINI. Effectively this is done with a non-local GOTO. Thus the code between the CMINI and the end of the parse must be designed so that it can be restarted. Also, you must not exit the block in which the CMINI is issued until the entire parse is done. Since control will be returned to the CMINI in case of an error, it would cause serious troubles if that block was no longer active. } procedure cminir(prompt:string);extern; {Special version of CMINI to be used when you want to read a rescanned command from the EXEC. If this is done in a loop, the second time it is done, the program exits.} function cmmode:cmmodes;extern; {Says what "mode" we are running in. At the moment normal or rescan. Rescan means that a CMINIR succeeded in finding valid rescanned data.} {The following two procedures are used in making up tables of commands and switches. Note that tables and their contents are stored in the heap. So you can use MARK and RELEASE to release them.} function tbmak(size:integer):table;extern; {Issue this one first. It allocates space for a table with the specified number of entries. It returns a table pointer, which is used for the other functions that operate on tables.} procedure tbadd(t:table;value:integer;key:string;bits:integer);extern; {Issue this once for each entry to go in the table. T - the value return by the call to TBMAK that allocated the table. VALUE - This is the value that will be returned when this entry in the table is found. KEY - This string is the name of the table entry. BITS - as documented in the JSYS manual. Normally zero. For example, one entry in a table of terminal types might be tbadd( termtable, 6, 'I400', 0) This entry will be matched by the string 'I400' (or any unique abbreviation), and will return the value 6, presumably the internal code for the I400 terminal.} {WARNING: You must issue these in reverse alphabetical order, i.e. the last entry in the table must be done first. This may be a monitor bug.} {The following procedures are used to parse individual fields in a command. They should be issued in the same order that the user is expected to type the fields.} function cmkey(t:table):integer;extern; {Expects the user to type one of the keywords in the table. It returns the value that was specified by TBADD when the keyword was put in the table. E.g. if the user typed I400, this would return 6 if the table had the entry shown above.} function cmswi(t:table):integer;extern; {Similar to cmkey, except the table is of switches. The slash should not be part of the name in the table. If the user ended the switch with a colon (i.e. you can expect a value after the switch), the negative of the value normally returned will be returned.} procedure cmifi(var f:file);extern; {Expects the user to type an input file name. The argument should be a Pascal file. That file will be preset to use the file specified. E.g. if you say CMIFI(INPUT), you can then use RESET(INPUT) and INPUT will be open on the file that the user specified. This function actually gets a jfn for the file specified by the user. That jfn is then stored in the file's file control block.} procedure cmofi(var f:file);extern; {Expects an output file name.} procedure cmfil(var f:file);extern; {Expects a general file spec. You must set up an extended gtjfn block appropriately to read the file spec. This is done with the gjxxx procedures below. At least gjgen must be used.} function cmnum:integer; extern; {Get a decimal number.} function cmnum8:integer; extern; {Get an octal number.} function cmnux:integer; extern; {Get a decimal number, ends with any non-numeric} function cmnux8:integer; extern; {Get an octal number, ends with any non-numeric} function cmflt:real; extern; {Get a real number} procedure cmnoi(stuff:string);extern; {Puts out a noise word if the user types altmode. Note that the parentheses are not part of the noise word.} procedure cmcfm; extern; {Expects the user to type a carriage return. This would usually be the last call made for parsing a command.} procedure cmcma; extern; {Expects the user to type a comma. If this is for an optional field, you should set CMAUTO(false) first, to prevent an error trap if there isn't one.} procedure cmtok(stuff:string);extern; {Expects the user to type that particular thing. See cmcma.} function cmdir:integer; extern; {Expects a directory name: returns the 36-bit dir. number. To see the text, use CMATOM.} function cmdirw:integer; extern; {as above, but allows wildcards} function cmusr:integer; extern; {Expects a user name: returns a 36-bit user number.(CMATOM for text)} function cmdev:integer; extern; {Expects a device name: returns a device designator (CMATOM for text)} {The following functions parse date and/or time. We have the following method: TAD - both date and time null - returns internal form T - time only N - puts unconverted form into a record D - date only} function cmtad:integer; extern; function cmt:integer; extern; function cmd:integer; extern; procedure cmtadn(var r:tadrec); extern; procedure cmtn(var r:tadrec); extern; procedure cmdn(var r:tadrec); extern; {The following procedures all return strings where you specify, and a count indicating how many characters were actually seen. Any extra characters in the destination array are filled with blanks. If there is not enough space, an error message is given and a reparse triggered.} function cmatom(var s:string):integer; extern; {This returns the contents of the "atom buffer". It is useful when you want to see what the user actually typed for the last field. It not cause any extra parsing, the data comes from the last field parsed.} function cmfld(var s:string):integer; extern; {Field delimited by first non-alphanumeric} function cmtxt(var s:string):integer; extern; {To next end of line} function cmqst(var s:string):integer; extern; {String in double quotes. Quotes not returned.} function cmact(var s:string):integer; extern; {Account string. Not verified for legality} function cmnod(var s:string):integer; extern; {network node name. Not verified for legality} {The following procedures are used to set up the extended gtjfn block for cmfil. They must be given before the cmfil call. gjgen must always be used, and must be the first one of these to be called, as it clears the rest of the block. These procedures simply set the corresponding words in the gtjfn block, so see the jsys manual for details.} procedure gjgen(flags_and_generation:integer);extern; procedure gjdev(default_device:string);extern; procedure gjdir(default_directory:string);extern; procedure gjnam(default_name:string);extern; procedure gjext(default_extension:string);extern; procedure gjpro(default_protectin:string);extern; procedure gjact(default_account:string);extern; procedure gjjfn(try_to_use_this_jfn:integer);extern; {The following procedures are only needed for more complex parsers. They allow one to turn off various of the features that are normally supplied by default.} procedure cmauto(useauto:Boolean);extern setzm fdb+.cmdef setzm fdb+.cmhlp popj p, ;setcom ; This is the first half of DOCOM, for mult mode ; a - function code ; b - contents of .cmdat, if any ; d,e - data for evaluation routine if this FDB is chosen setcom: move c,mulnxt ;next position inside MULFDB to use cail c,mulend ;if haven't run out of space jrst mulser ;out of space movem d,m.loc(c) ;save data for continuation movem e,m.loc+1(c) lsh a,33 ;move function code to proper position skipe d,fdb+.cmhlp ;if user gave help message tlo a,(cm%hpp!cm%sdh) ;then tell comnd to use his and not its movem d,.cmhlp(c) ;and copy current into real FDB setzm fdb+.cmhlp skipe d,fdb+.cmdef ;if user gave default tlo a,(cm%dpp) ;then tell comnd movem d,.cmdef(c) ;and copy current into real FDB setzm fdb+.cmdef hrri a,m.size(c) ;pointer to next FDB movem a,.cmfnp(c) movem b,.cmdat(c) pop p,m.disp(c) ;save return addr for later continue addi c,m.size ;advance to next FDB movem c,mulnxt popj p, ;return to our caller's caller ifn tops10,< mulser: outstr [asciz / ? Too many options after CMMULT /] exit > ;ifn tops10 ife tops10,< mulser: hrroi a,[asciz /Too many options after CMMULT /] jrst fatal > ;ife tops10 ;< ;cmdo --> which FDB was done cmdo: move c,mulnxt ;clear next pointer of last FDB hllzs -m.size(c) setzm erseen ;assume no errors movei a,state ;now do the COMND movei b,mulfdb ifn simcom, ife simcom, setzm fdb+.cmdef ;forget user def and hlp from this one setzm fdb+.cmhlp setzm mulnxt ;and turn off multiple mode tlne a,(cm%nop) ;if errors jrst mulerr ;process them hrrz d,c ;d = FDB used subi d,mulfdb ;d _ offset into MULFDB idivi d,m.size ;e _ FDB index no. addi d,1 ;should be indexed off 1 push p,d ;save as final return value move f,m.disp(c);a _ dispatch addr move d,m.loc(c);d _ data saved at setup move e,m.loc+1(c) pushj p,(f) move a,2(p) ;value he tried to return movem a,mulret ;save for later pop p,(p) ;now set up our return value (saved by PUSH above) popj p, ;and return ;cmint and cmreal just return the saved-away return value cmint: cmreal: move a,mulret ;get saved value movem a,1(p) ;and return popj p, mulerr: setzm 1(p) ;give zero return aos erseen ;say saw error skipe erOK ;if error OK popj p, ;return to him jrst parerr ;else give error message and reparse ; ;End of special section for multiple alternatives ; ;cmauto(boolean) ; if on, we automatically handle errors, else he an one line, just call cmhlp several times. Each call will add a line to the message. (Thus cmhlp is vaguely like writeln.) Note that the help message stays in effect only for the next field parsed.} procedure cmdef(default:string); extern; {Used to supply a default value for the next field parsed. This default stays in effect only for the next field.} {In some cases you may want to allow a choice of several alternatives. To do this, issue CMMULT, to go into "multiple choice mode". Once in this mode, issue CMxxx calls as usual. Instead of being done immediately, these calls store away specifications of the legal alternatives. For those that are functions, the values returned are garbage. Once you have specified all the alternatives, call CMDO. This returns an integer, 1..the number of alternatives, telling you which (if any) succeeded, 0 if none did. For alternatives that return values, you can then do CMINT to get the returned value if it is an integer, or CMREAL if it is real. Alternatives that return values in variables passed by reference will do so, using the variable passed when the original CMxxx was called. (Needless to say, that variable has better still be accessible.)} procedure cmmult; extern; {Enter multiple choice mode. All CMxxx procedures until the next CMDO are interpreted as specifications, rather than done immediately.} function cmdo:integer; extern; {Do a COMND jsys, specifying the alternatives stored up since the last CMMULT. Returns a code indicating which succeeded, or 0 if none did. Since the return value is used to indicate which alternative was found, there is a possible question: how do we get the returned value, if there is one (i.e. if the alternative found is a Pascal function that returns some value)? The answer to this is that the value returned is stored away internally and is available by CMINT or CMREAL, depending upon its type. Note that files and strings are returned through variables passed by reference. They do not need this mechanism, since that will be set automatically. (What happens is that the addresses of all reference variables are stored away when the alternative is first set up, and the appropriate one is set when we find out which alternative is actually there.)} function cmint:integer; extern; {Return a value from the last CMDO, if the alternative that succeeded was an integer} function cmreal:real; extern {Return a value from the last CMDO, if the alternative that succeeded was a real} . p,a ;a _ value hrl a,b ;a _ arg addr,,value pop p,b ;b _ table addr exch a,b ;jsys wants a and b reversed ife simcom,< jtbadd popj p, > ;ife simcom ifn simcom,< ;tbadd simulation ; a - addr of header ; b - arg addr,,value ; c - current number of entries ; d - offset into table we are looking at now hlrz c,(a) ;c _ max offset existing hrrz e,(a) ;see if too big for table caige e,1(c) jrst tbaddb ;too big movs e,b ;e _ byte ptr to string to compare hrli e,000700 movei d,1 ;d _ current offset tbaddl: camle d,c ;if new offset .GT. end jrst tbaddn ;then add to end pushj p,tbaddc ;now compare new with table jumpl t,tbaddh ;less - add here jumpe t,tbaddo ;same - old elt aoja d,tbaddl ;here to add elt at offset d tbaddh: addi c,1 ;table now 1 bigger hrlm c,(a) ;so update count field add d,a ;d _ addr of last elt to move add a,c ;a _ addr of new end elt tbadhl: move t,-1(a) ;now shift things movem t,(a) cail d,-1(a) ;if last to move still not moved jrst tbadhx ;it has soja a,tbadhl ;no, then do next tbadhx: movem b,(d) ;now have place for new data popj p, ;here to add to end tbaddn: addi c,1 ;table now 1 bigger hrlm c,(a) ;so update count field in table add a,c ;compute addr of new elt movem b,(a) ;put it there popj p, ifn tops10,< tbaddo: outstr [asciz / ? New elt. was already there - TBADD /] exit tbaddb: outstr [asciz / ? Table too small - TBADD /] exit > ;ifn tops10 ife tops10,< tbaddo: hrroi a,[asciz /New elt. was already there - TBADD/] jrst fatal tbaddb: hrroi a,[asciz /Table too small - TBADD/] jrst fatal > ;ife tops10 ;tbaddc - compare string with table entry ; a - addr of table header ; e - byte pointer to string to compare ; d - offset into table ; returns in t - +1, 0, -1 if string gt, eq, lt tbaddc: move f,h ;f _ compare byte ptr move g,a ;g _ table byte ptr add g,d movs g,(g) hrli g,000700 tbadcl: ildb t,f ;get comp byte cail t,141 ;make upper case caile t,172 jrst .+2 subi t,40 ildb h,g ;get table byte cail h,141 ;make upper case caile h,172 jrst .+2 subi t,40 came t,h ;now compare jrst tbadcx ;found difference - stop jumpn t,tbadcl ;same, if non-null, go back for more popj p, ;same - complete match tbadcx: caml t,h jrst tbadcg ;greater seto t, ;less popj p, tbadcg: movei t,1 ;greater popj p, > ;ifn simcom ;< ;cmkey(table) --> value ; parse a keyword - return the value from the table for it < ;cmswi(table) --> value ; parse a switch - return the value from the table for it cmswi: skipa a,[exp .cmswi] cmkey: movei a,.cmkey ;b already has contents of .cmdat pushj p,docom ;b _ addr of table entry found hrrz t,(b) ;get value from table entry tlne a,(cm%swt) ;if switch ended in colon movn t,t ;then negate the value movem t,1(p) ;return it popj p, subttl CMCFM, CMNUM, CMNUM8, CMNUX, CMNUX8, CMNOI ;cmcfm ; wait for CR ;cmcma ; look for comma cmcma: skipa a,[exp .cmcma] cmcfm: movei a,.cmcfm setz b, pushj p,docom popj p, ;cmnum ; number, base 10 ;cmnum8 ; number, base 8 cmnum8: skipa b,[exp ^D8] cmnum: movei b,^D10 movei a,.cmnum pushj p,docom movem b,1(p) popj p, ;cmnux ; number, base 10, term on first non-numeric ;cmnux8 ; number, base 8, term on first non-numeric cmnux8: skipa b,[exp ^D8] cmnux: movei b,^D10 movei a,.cmnux pushj p,docom movem b,1(p) popj p, subttl functions that take string arguments starg: cail c,argsiz*5 ;be sure string is not too long jrst argovr ;is too long hrli b,440700 ;b _ source move a,[point 7,argbuf] ;a _ destination jumpe c,starg2 ;now copy starg1: ildb t,b idpb t,a sojg c,starg1 starg2: setz t, ;null idpb t,a move b,[point 7,argbuf] ;b _ pointer to argument popj p, ife tops10,< argovr: hrroi a,[asciz /Argument too large for buffer /] jrst fatal > ;ife tops10 ifn tops10,< argovr: outstr [asciz / ? Argument too large for buffer /] exit > ;ifn tops10 ;cmnoi(string) ; noise words cmnoi: pushj p,starg ;puts string into argument area movei a,.cmnoi pushj p,docom popj p, ;cmtok(string) ; match specified thing cmtok: pushj p,starg movei a,.cmtok pushj p,docom popj p, subttl functions that return the atom buffer ;cmatom(var string):count; ; copies the atom buffer into the string cmatom: movei a,0 ;a _ count hrli b,440700 ;b _ destination ;c _ size of destination move d,[point 7,atbuf] ;d _ source jumpe c,atmovr ;now copy until null or space runs out cmatm1: ildb t,d jumpe t,cmatm2 sojl c,atmovr ;[2] if no more room to copy, post message idpb t,b ;[2] aoja a,cmatm1 ;[2] cmatm2: jumpe c,cmatm4 ;clear rest of destination to blanks movei t,40 ;clear rest of destination to blanks cmatm3: idpb t,b sojg c,cmatm3 cmatm4: movem a,1(p) ;return count of char's copied popj p, atmovr: hrroi a,[asciz /Field too big /] jrst nonfat ;cmfld(var string):count ; scan arbitrary field ;cmtxt(var string):count ; scan rest of line as one field cmtxt: skipa a,[exp .cmtxt] cmfld: movei a,.cmfld cmfl: move d,b move e,c setz b, pushj p,docom move b,d move c,e jrst cmatom ;return the data and count ;cmqst(var string):count ; quoted string (quotes not returned) cmqst: movei a,.cmqst jrst cmfl ;cmact(var string):count ; account string cmact: movei a,.cmact jrst cmfl ;cmnod(var string):count ; node name cmnod: movei a,.cmnod jrst cmfl subttl routines that just return a scalar ;cmdir:integer ; get directory number ;cmdirw:integer ; allow wildcard cmdirw: skipa b,[exp cm%dwc] cmdir: setz b, movei a,.cmdir pushj p,docom movem b,1(p) popj p, ;cmusr:integer ; get user number ;cmflt:real ; get floating point number cmflt: skipa a,[exp .cmflt] cmusr: movei a,.cmusr cmx: setz b, pushj p,docom movem b,1(p) popj p, ;cmdev:integer ; get device designator cmdev: movei a,.cmdev jrst cmx subttl time and day stuff ;cmtad:integer ; time and date in internal format ;cmd:integer ; date in internal format cmd: skipa b,[exp cm%ida] cmtad: movsi b,(cm%ida!cm%itm) cmtadx: movei a,.cmtad pushj p,docom movem b,1(p) popj p, ;cmt:integer ; time in internal format cmt: movsi b,(cm%itm) jrst cmtadx ;cmtadn(var tadrec); ; time and date not converted cmtadn: hrli b,(cm%ida!cm%itm!cm%nci) cmtnx: movei a,.cmtad pushj p,docom popj p, ;cmdn(var tadrec); ; date not converted cmdn: hrli b,(cm%ida!cm%nci) jrst cmtnx ;cmtn(var tadrec); ; time not converted cmtn: hrli b,(cm%itm!cm%nci) jrst cmtnx ifn simcom,< subttl COMND jsys ;AC usage: ;a - state block ;b - 1st ftn block, will be used for return ;c - LH = orig ftn block, RH = cur ftn block ;d - data from caller (FCB in case of files) ;e - bptr to current input char ;f - # chars left in input comnd: push p,e ;don't touch e hrl c,b ;once-only inits - cur ftn to first hrr c,b move t,.cmflg(a) hrrzs .cmflg(a) ;clear flags movsi g,(cm%pfe);set prev field esc tlne t,(cm%esc) ;if esc was on iorm g,.cmflg(a) ;main loop - here once for each function cmlop: trnn c,777777 ;any function to do? jrst retnop ;no - return with CM%NOP move e,.cmptr(a);restore input scanner move f,.cminc(a) ldb g,[point 9,(c),8] ;ftn code caile g,maxftn ;see if valid jrst illftn pushj p,@ftntab(g) ;returns value in B, skip if fails, sets flags jrst gotit jrst ftnfai jrst ftnhlp jrst nulhlp jrst killin ftnfai: hrr c,(c) ;failed, go to next ftn jrst cmlop ftnhlp: hrr c,(c) ;help - if there is another function trnn c,777777 jrst hlpend outstr [asciz / or/] ;then say OR and go do it jrst cmlop ;nulhlp - for function which don't output a help message - no "OR" nulhlp: hrr c,(c) trnn c,777777 jrst hlpend jrst cmlop hlpend: move t,e ;clear the ? setz g, idpb g,t ;to null ;now put out prompt if any skipn g,.cmrty(a) jrst hlpret hlprom: ildb h,g jumpe h,hlpret outchr h jrst hlprom ;now retype the line and go try again hlpret: move g,.cmbfp(a) ;start of buffer hlprtl: ildb h,g jumpe h,hlpxit outchr h jrst hlprtl hlpxit: hlr c,c ;restart with first function jrst cmlop gotit: movem e,.cmptr(a) ;save state in state block movem f,.cminc(a) hll a,.cmflg(a) ;return flags to user pop p,e popj p, retnop: movsi t,(cm%nop) ;set no-parse bit iorm t,.cmflg(a) hll a,.cmflg(a) pop p,e popj p, ;killin - respond to bell - clear line and reprompt killin: outstr [asciz / XXX /] pushj p,doini movem e,.cmptr(a) movem f,.cminc(a) hrrz g,.cmflg(a) ;see if he supplied a reparse addr jumpn g,kilrep ;yes, use it movsi t,(cm%rpt) ;no - set need reparse iorm t,.cmflg(a) hll a,.cmflg(a) pop p,e popj p, kilrep: pop p,e pop p,(p) ;go to reparse jrst (g) illftn: movei t,[asciz /Unimplemented function code in call to COMND/] movem t,errstr jrst retnop doini: hlrz t,.cmrty(a) ;normalize pointers cain t,777777 movei t,440700 hrlm t,.cmrty(a) hlrz t,.cmbfp(a) cain t,777777 movei t,440700 hrlm t,.cmbfp(a) hlrz t,.cmabp(a) cain t,777777 movei t,440700 hrlm t,.cmabp(a) skipn g,.cmrty(a) ;put out prompt jrst noprom proml: ildb h,g jumpe h,noprom outchr h jrst proml noprom: setz f, ;f (.cminc) nothing here now move e,.cmbfp(a) ;e (.cmptr) start of text is start of buf setz t, ;clear first char as sign of empty buf idpb t,e move e,.cmbfp(a) ;get e back again hrrzs .cmflg(a) ;clear flags popj p, subttl COMND function table ;To work with this, a function must obey the following: ;preserves A, C, D ;updates E and F if it reads char's ;returns value in B, if any (else preserves it) ;skips if it fails ;sets any appropriate flags in in .CMFLG maxftn==14 ftntab: exp dokey ;0 exp donum ;1 exp donoi ;2 exp doswi ;3 exp doifi ;4 exp doofi ;5 exp dofil ;6 exp dofld ;7 exp docfm ;10 exp dodir ;11 exp dousr ;12 exp docma ;13 exp doini ;14 ;The normal prolog for a function is as follows: ; pushj p,getskp ;or getatm if you don't want to skip blanks ; jrst givhelp ; pushj p,copyxxx ;routine to copy atom into atom buffer ;The routine should return ; nonskip if it parsed the thing requested ; skip 1 if it didn't ; skip 2 if it did help ;The help routine normally starts with ; pushj p,chkhlp ;CHKHLP checks for user help, and outputs it, aborting the caller, and ; returning +2 ; If no user help, it sets up its caller to return +2, and returns to ; its caller ;Getskp does the following: ; clear atom buffer ; skip blanks ; if null, read a line from the terminal and go skip blanks again ; if ^G, abort caller and make him return +4 ; if ?, non-skip ret ; if lf, copy default to atom buffer and skip 2 ; if no default, skip 1 (user will copy LF to buffer) ; if esc, copy default to atom buffer, output, and line buffer and skip 2 ; if no default, wipe out the esc, beep, and treat as a null ending ; else skip 1 getskp: move g,.cmabp(a) ;clear atom buffer setz t, idpb t,g ;null in first char is enough ;skip blanks doskip: move t,e ;peek ildb t,t cain t,11 ;tab is like blank movei t,40 caie t,40 ;if not blank jrst endskp subi f,1 ;it is, gobble it ildb t,e jrst doskip ;and try again ;if null, read a line from the terminal endskp: jumpn t,chkbel ;if not a null, go on ifn tops10,< getmor: move g,.cmcnt(a) ;g _ last legal position in buffer adjbp7 g,.cmbfp(a) ;normalize tlnn g,400000 ;if 440700 jrst endskx ;not tlc g,450000 ;change to 010700 subi g,1 ;in previous word endskx: move h,e ;h _ place to put new char's readl: inchwl t ;get a char idpb t,h ;put it down camn h,g ;see if at end of buffer jrst cmtool ;yes - line too long addi f,1 ;now have one more char aos .cminc(a) cain t,15 ;cr is special jrst [ inchwl t dpb t,h ;put down lf jrst readx] caie t,33 cain t,12 jrst readx ;stop on term's jrst readl readx: move i,h ;look at prev char subi i,1 repeat 4, ldb t,i cain t,"-" ;if -, this is continuation jrst readcn setz t, ;make asciz idpb t,h > ;ifn tops10 ife tops10, jrst doskip ;now go skip blanks in new line readcn: subi i,1 ;now backup over - and lf repeat 4, move h,i subi f,2 sos .cminc(a) sos .cminc(a) jrst readl chkbel: caie t,7 jrst chkqes ;if not bel, go on pop p,(p) ;abort caller movei t,4 ;make him return +4 addm t,(p) popj p, ; if ?, non-skip ret chkqes: caie t,"?" ;do we have question mark jrst chklf ;no - go on popj p, ;yes - return without advancing anything ; if lf, copy default to atom buffer and skip 2 ; if no default, skip 1 (user will copy LF to buffer) chklf: caie t,12 ;do we have a line feed? jrst chkesc ;no - go on move t,.cmfnp(c) ;get function flags aos (p) ;will skip at least once tlnn t,(cm%dpp) ;is there a default? popj p, ;no, skip 1 pushj p,copydf ;copy default to atom buffer aos (p) ;skip 2 popj p, copydf: hlrz g,.cmdef(c) ;g - source of copy cain g,-1 ; normalize bpt movei g,440700 hrl g,g hrr g,.cmdef(c) move h,.cmabp(a) ;h - dest of copy move i,.cmabc(a) ;i - size of dest cpydfl: jumpe i,dftool ;copy loop ildb t,g jumpe t,cpydfx ;done at null idpb t,h soja i,cpydfl cpydfx: setz t, ;make asciz idpb t,h popj p, ; if esc, copy default to atom buffer, output, and line buffer and skip 2 ; if no default, ignore it and read more. chkesc: caie t,33 ;do we have an esc? jrst chknor ;no - go on move t,.cmfnp(c) ;get function flags tlnn t,(cm%dpp) ;is there a default? jrst nodflt ;no default - read more movsi t,(cm%esc) ;say we say esc, for noise iorm t,.cmflg(a) pushj p,copydf ;copy default to atom buffer ;copy default to text buffer and output hlrz g,.cmdef(c) ;g - source of copy cain g,-1 ; normalize bpt movei g,440700 hrl g,g hrr g,.cmdef(c) move i,.cmcnt(a) ;i _ last legal position in buffer adjbp7 i,.cmbfp(a) ;normalize tlnn i,400000 ;if 440700 jrst chkes1 ;not tlc i,450000 ;change to 010700 subi i,1 ;in previous word chkes1: outchr [exp 10] ;note that this loop uses e - that is, it appends to the buffer and ;also advances the current pointer. This is because we are going ;to do a skip return, having copied into the atom buffer already. ;this is also why we don't incr F, since these characters aren't ;available for future reading in this pass (though they are in the ;buffer, so .CMINC is incr'ed) appdfl: ildb t,g ;append to buffer jumpe t,appdfx idpb t,e outchr t camn e,i ;if went too far jrst cmtool ;complain aos .cminc(a) ;now have one more char jrst appdfl appdfx: setz t, ;make asciz move h,e idpb t,h ;skip 2 aos (p) aos (p) popj p, ;here if no default. Ignore the esc and read more, except that ;if it is .CMFIL and there is a default device or name, allow it, ;because GTJFN will supply the default. nodflt: ldb g,[point 9,(c),8] ;ftn rmally COPYxx will adjust E and F as it copies from ;the buffer into the atom buffer. But with a file, only ;PARSE knows the syntax well enough to be sure when the ;string is empty. So COPFIL just fills the atom buffer. ;PARSE then tells us how many of these characters were really ;part of the file name. Here we adjust E and F to show that ;only those characters were copied. G tells us whether we ;have to do this. if the file name was defaulted, then ;we didn't get it from the text buffer, so there is nothinng ;to skip. Note that PARSE makes the atom buffer ASCIZ. ;It puts the null at the end of the full file spec, including ;anything it added due to recognition. jumpe g,filrec ;if copied from input move i,h ;adjust E and F to skip right num of char's adjbp7 i,e movem i,e sub f,h ;here to do recognition on file names (if any). What we do is check ;to see if there are any characters in the atom buffer beyond the ;number returned in H. filrec: move i,h ;adjust to end of original str. in atom buf adjbp7 i,.cmabp(a) move t,i ildb t,t jumpe t,filnrc ;nothing more - no completion movsi g,(cm%esc) ;say we did completion (for noise) iorm g,.cmflg(a) outchr [exp 10] ;back over esc move g,.cmcnt(a) ;g _ last legal position in buffer adjbp7 g,.cmbfp(a) ;normalize tlnn g,400000 ;if 440700 jrst endskx ;not tlc g,450000 ;change to 010700 subi g,1 ;in previous word ;i - source (set up above) ;start of copy loop filrcl: ildb h,i jumpe h,filrcx idpb h,e ;now copy to text outchr h ;and terminal camn e,g ;see if at end of buffer jrst cmtool ;yes - line too long aos .cminc(a) ;one more thing in buf jrst filrcl ;now loop for more ;end of loop - make asciz filrcx: move t,e ;use copy of bpt since this is one ahead idpb h,t camn t,g ;see if this went too far jrst cmtool ;recognition finished. Check for errors filnrc: skipn fileof(d) ;if error popj p, movei t,[asciz /invalid syntax in file specification/] movem t,errstr aos (p) popj p, dofits: movei t,[asciz /file specification too long for internal working space/] movem t,errstr aos (p) popj p, hlpfil: pushj p,chkhlp ;see if use gave help msg move g,.cmgjb(a) ;look at flags move g,.gjgen(g) movei h,[asciz / output filespec /] ;assume input tlnn g,(gj%old) ;but if OLD is on tlnn g,(gj%fou) ;or NEW is off movei h,[asciz / input filespec /] ;then it is input outstr (h) popj p, copyfi: move g,.cmabp(a) ;g _ ptr to at buf move h,.cmabc(a) ;h _ cntr to at buf move i,e ;i _ ptr to input move j,f ;j _ cntr to input copyfl: jumpe h,copyfx ;test for done jumpe j,copyfx soj h, soj j, ildb t,i ;copy char idpb t,g jrst copyfl copyfx: popj p, > ;ifn tops10 ife tops10, subttl Switches and keywords doswi: pushj p,getskp jrst hlpswi pushj p,copysw skipa jrst cpopj1 move g,.cmabp(a) ildb t,g ;get slash (we hope) caie t,"/" jrst dosnsw ;no - not a switch push p,g ;pass pointer to keywd part pushj p,dokey1 ;now treat as keyword skipa jrst [ pop p,g jrst cpopj1] pop p,g ;adj stack move k,.cmabc(a) ;count of space in atom buf subi k,1 ;already beyond / pushj p,swcomp ;completion if appropriate skipa jrst cpopj1 move g,.cmabp(a) ;now see if atom buffer ended in colon doswl: ildb t,g caie t,0 cain t,":" ;see if term with colon jrst .+2 jrst doswl caie t,":" popj p, ;no - nothing special movsi t,(cm%swt) ;say found a colon iorm t,.cmflg(a) popj p, dokey: pushj p,getskp jrst hlpkey pushj p,copykw skipa jrst cpopj1 move g,.cmabp(a) push p,g pushj p,dokey1 skipa jrst [ pop p,g jrst cpopj1] pop p,g move k,.cmabc(a) ;space in at buf pushj p,swcomp popj p, jrst cpopj1 dokey1: move t,-1(p) ;make sure we have something ildb t,t caie t,0 cain t,":" jrst dosnul ; g - aobjn pointer into table ; h - 0 if no match so far, else value (addr in table) of match move g,.cmdat(c) ;g _ aobjn pointer into table - this is table hlrz h,(g) ; this is number of entries movn h,h ; negative hrl g,h ; in LH of G addi g,1 ; now have our AOBJN setz h, jumpge g,dosnom ;if table is empty, no match doswil: move i,-1(p) ;look up thing in at buf pushj p,lookc jumpg t,doswie ;exact match jumpl t,doswia ;abbrev doswii: aobjn g,doswil ;try again ;here if we fall out of the loop jumpe h,dosnom ;if no possibilities, no match move g,h ;exactly one, do it ;jrst doswie ;same as exact ;here for exact match doswie: hrrz b,g ;return addr of table entry popj p, doswia: jumpn h,dosamb ;already have one possibility - ambig move h,g ;save this as first poss jrst doswii ;now try again ;lookc - compare string with table entry ; g - addr of table entry ; i - byte pointer to string to compare (can be changed) ; returns in t - -1=abbr, +1=exact, 0=none lookc: movs j,(g) ;j - bpt to string in table hrli j,000700 lookcl: ildb t,i ;get comp byte cail t,141 ;make upper case caile t,172 jrst .+2 subi t,40 ildb k,j ;get table byte cail k,141 ;make upper case caile k,172 jrst .+2 subi k,40 came t,k ;now compare jrst lookcx ;found difference - stop jumpn t,lookcl ;same, if non-null, go back for more movei t,1 popj p, ;same - complete match lookcx: caie t,0 cain t,":" jrst lookca ;comp ran out - abbrev setz t, ;just plain failure - say so popj p, lookca: seto t, ;say abbrev popj p, hlpkey: pushj p,chkhlp movei i,0 jrst hlpsw0 hlpswi: movei i,1 ;i - 1 if switches pushj p,chkhlp ;see if user gave help hlpsw0: outstr [asciz / one of the following:/] move g,.cmdat(c) ;get switch table hlrz h,(g) ;make aobjn word in H movn h,h hrl h,h hrri h,1(g) jumpge h,hlpswx ;nothing to do ;first we figure out the maximum length of the switches hlpsw1: move j,h ;use copy movei l,2 ;l will get max len jumpge j,hlpsw5 hlpsw2: hlrz g,(j) ;start of this one hrli g,010700 movei k,2(i) ;start with 0 for key, 1 for swi, +2 hlpsw3: ildb t,g ;get next char, and count char's in K jumpe t,hlpsw4 aoja k,hlpsw3 ;next char in this switch hlpsw4: camle k,l ;l = l max k move l,k aobjn j,hlpsw2 ;next switch hlpsw5: movei j,.towid ;get terminal width seto k, trmno. k, ;find our term's udx jrst use72 ;can't - assume 72 wide move t,[xwd 2,j] trmop. t, use72: movei t,^D72 ;can't - assume 72 wide hrl j,t hrr j,l setz l, ;loop to print out things ;g - ildb addr in string ;h - aobjn addr in table ;i - flag is switch ;j - LH - line length, RH - object len ;k - char's left in this object ;l - char's left in line hlpswl: hlrz g,(h) ;get the string address cail l,(j) ;room for one obj on this line? jrst hlpsw6 outstr [asciz / /] ;no - go to new one hlrz l,j ;and reinit line hlpsw6: hrrz k,j ;init object size ctr outchr [exp " "] subi l,1 subi k,1 skipe i ;put out / only if switches outchr [exp "/"] sub l,i sub k,i hrli g,010700 ;make byte pointer to string ;loop on string hlpsw7: ildb t,g jumpe t,hlpsw8 outchr t subi l,1 ;and count soja k,hlpsw7 ;now put out trailing blanks if any hlpsw8: outchr [exp " "] subi l,1 ;count sojg k,hlpsw8 ;go to next item aobjn h,hlpswl hlpswx: outstr [asciz / /] popj p, ;copy switch into atom buffer copysw: jumpe f,cpopj ;make sure there is something there move g,.cmabp(a) ;get place to put it move h,.cmabc(a) subi f,1 ildb t,e ;get the slash (one assumes) caie t,"/" ;if slash popj p, ; not - done idpb t,g ;copy it subi h,1 ;and count it pushj p,cpykw1 ;copy rest of keyword skipa jrst cpopj1 move t,e ;see if have a term : ildb t,t skipe f caie t,":" popj p, ;no - done ildb t,e ;yes - copy it subi f,1 dpb t,g subi h,1 jumpe h,copyks ;and make asciz setz t, idpb t,g cpopj: popj p, ;copy keyword into atom buffer copykw: move g,.cmabp(a) ;g _ ptr to at buf move h,.cmabc(a) ;h _ cntr to at buf cpykw1: move i,e ;i _ ptr to input move j,f ;j _ cntr to input copykl: jumpe h,copyks ;test for done jumpe j,copykx ildb t,i ;copy char ;now stop unless it is alphanumberic cain t,"-" ;- is alph jrst copyko caige t,"0" jrst copykx ;below numbers caig t,"9" jrst copyko ;is a number, ok caige t,"A" jrst copykx ;between numbers and letters caig t,"Z" jrst copyko ;is a letter, ok caige t,"a" jrst copykx ;between upper and lower case caig t,"z" jrst copyko ;lower case, ok jrst copykx ;above lower case ;here if it is alphnumeric copyko: soj h, soj j, move e,i ;make permanent move f,j idpb t,g jrst copykl copykx: setz t, ;make at buf asciz idpb t,g popj p, ;swcomp - completion for switches - g has bpt to user's string in atbuf, ; k has space in at buf. swcomp: jumpe f,cpopj ;see if esc is next move t,e ;peek ildb t,t caie t,33 popj p, ;no escape ;now see whether user's string or switch ends first movs j,(b) ;j - bpt to string in table hrli j,000700 compl: move t,g ;peek at next user's char ildb t,t ;t - user's char ildb h,j ;h - match char caie t,":" ;no compl if user ends with : cain h,0 ;or if match ends first popj p, ;nothing to complete cain t,0 ;user ends without match ending jrst docomp ;that's when we complete ibp g ;advance source - G and K subi k,1 jrst compl ;no end, keep going ;here we actually do the completion docomp: movsi t,(cm%esc) ;say we did completion (for noise) iorm t,.cmflg(a) outchr [exp 10] ;back over esc move i,.cmcnt(a) ;i _ last legal position in buffer adjbp7 i,.cmbfp(a) ;normalize tlnn i,400000 ;if 440700 jrst endskx ;not tlc i,450000 ;change to 010700 subi i,1 ;in previous word ;start of copy loop docmpl: jumpe k,copyks ;out of space? idpb h,e ;now copy to text idpb h,g ;and atom outchr h ;and terminal camn e,i ;see if at end of buffer jrst cmtool ;yes - line too long aos .cminc(a) ;one more thing in buf ildb h,j ;get next char skipe h ;if something there soja k,docmpl ;now loop for more ;end of loop - make asciz jumpe k,copyks ;make outputs asciz move t,e ;use copy of bpt since this is one ahead idpb h,t camn t,g ;see if this went too far jrst cmtool idpb h,g ;and in atom buffer popj p, dosnom: movei b,[asciz /does not match switch or keyword/] movem b,errstr cpopj1: aos (p) popj p, dosamb: skipa b,[exp [asciz /ambiguous switch or keyword/]] copyks: movei b,[asciz /switch too long for internal working space/] movem b,errstr aos (p) popj p, dosnul: skipa b,[exp [asciz /null switch or keyword given/]] dosnsw: movei b,[asciz /not a switch - does not begin with a slash/] movem b,errstr aos (p) popj p, subttl numbers ;This parses a number and stops on first non-digit donux: pushj p,getskp jrst hlpnum pushj p,numcpy skipa jrst cpopj1 move i,.cmabp(a) ;i - source move h,.cmdat(c) ;h - radix cail h,2 caile h,^D10 jrst donumr ;bad radix ildb g,i ;and it had better be a digit cail g,"0" caile g,"0"(h) ;in the proper radix jrst donumd ;not a digit subi g,"0" move b,g ;init b to first digit ;now loop as long as there are more digits donuxl: ildb g,i cain g,0 ;done if nothing more popj p, subi g,"0" ;turn g into number pushj p,.%adgb## ;add digit (in pasnum to avoid overflow) jrst donumo ;overflow jrst donuxl ;This parses a number, and requires that the whole atom form a legal number donum: pushj p,getskp jrst hlpnum pushj p,copykw ;copy whole atom skipa jrst cpopj1 move i,.cmabp(a) ;i - source move h,.cmdat(c) ;h - radix cail h,2 caile h,^D10 jrst donumr ;bad radix setz b, ;start with zero ;now loop as long as there are more digits donuml: ildb g,i cain g,0 ;done if nothing more popj p, cail g,"0" caile g,"0"(h) ;in the proper radix jrst donmnd ;not a digit subi g,"0" ;turn g into number pushj p,.%adgb## ;add digit (in pasnum to avoid overflow) jrst donumo ;overflow jrst donuml hlpnum: pushj p,chkhlp ;check for user help move g,.cmdat(c) ;get radix cail g,2 ;make sure it is valid caile g,^D10 jrst [ outstr [asciz / illegal radix for input number /] popj p,] cain g,^D8 jrst [ outstr [asciz / octal number /] popj p,] cain g,^D10 jrst [ outstr [asciz / decimal number /] popj p,] outstr [asciz / a number in base /] addi g,"0" outchr g outstr [asciz / /] popj p, numcpy: move g,.cmabp(a) ;g - dest move h,.cmabc(a) ;h - dest count move i,.cmdat(c) ;i - radix cail i,2 caile i,^D10 jrst donumr ;bad radix numcpl: jumpe f,numcpx ;if nothing there, done jumpe h,numtol ;if no space left, error move t,e ;peek ildb t,t cail t,"0" caile t,"0"(i) jrst numcpx ;not legal - done ildb t,e ;done, copy it subi f,1 idpb t,g subi h,1 jrst numcpl numcpx: jumpe h,numtol ;done, make asciz setz t, idpb t,g popj p, donmnd: movei b,[asciz /invalid character in number/] movem b,errstr aos (p) popj p, numtol: skipa b,[exp [asciz /number too long for internal working space/]] donumr: movei b,[asciz /radix is not in range 2 to 10/] movem b,errstr aos (p) popj p, donumo: skipa b,[exp [asciz /overflow (number is greater than 2**35)/]] donumd: movei b,[asciz /first nonspace character is not a digit/] movem b,errstr aos (p) popj p, subttl Simple COMND functions ;cpyone - copy one char into atom buffer cpyone: jumpe f,cpopj ildb t,e subi f,1 move g,.cmabp(a) idpb t,g setz t, idpb t,g popj p, ;hlpnul - default help is nothing hlpnul: pushj p,chkhlp ;check for user help aos (p) ;return +3 (chkhlp did +2) popj p, docfm: pushj p,getskp jrst hlpcfm pushj p,cpyone move g,.cmabp(a) ildb t,g cain t,12 ;better be LF popj p, ;yes docfmn: movei t,[asciz /not confirmed/] movem t,errstr aos (p) popj p, hlpcfm: pushj p,chkhlp ;check for user help outstr [asciz / confirm with carriage return /] popj p, docma: pushj p,getskp jrst hlpcma pushj p,cpyone move g,.cmabp(a) ildb t,g cain t,"," ;better be comma popj p, ;yes movei t,[asciz /comma not given/] movem t,errstr aos (p) popj p, hlpcma: pushj p,chkhlp ;check for user help outstr [asciz / comma /] popj p, ;Noise is very odd, because usually no input is to be read. Output ; is triggered by an escape in the previous. The current code will ; not recognize noise if input, and will not respond to help. The ; problem is that ? is almost certainly for the next field, not this ; one. Probably the code should go ; put out noise if requested ; skip any noise in input donoi: move g,.cmflg(a) tlnn g,(cm%pfe) ;only do this is prev field was escape popj p, outstr [asciz / (/] move g,.cmdat(c) donoil: ildb t,g jumpe t,donoix outchr t jrst donoil donoix: outstr [asciz /) /] popj p, dofld: pushj p,getskp jrst hlpnul pushj p,copykw skipa jrst cpopj1 popj p,