Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/comnd.sai
There is 1 other file named comnd.sai in the archive. Click here to see a list.
COMMENT
These procedures comprise a complete package interfacing
the SAIL programming language with the COMND jsys. They were
written in 1978 and 1979 by Andrew R. Lowry and David S. Millman
of the Columbia University Center for Computing Activities, User
Services Group. Many thanks go to Frank da Cruz, Chris Ryland and
Norman Kincl of the CUCCA Systems Group and to Ted Markowitz, Ken
Rossman, Harry Yudenfriend and Jeffrey Slavitz of the CUCCA User
Services Group for their assistance and many suggestions.
;
entry CM!SIZE;
entry CM!IOJ;
entry CM!TAKE;
entry CM!RETRY;
entry CM!GETATM;
entry CM!TBUILD;
entry CM!INI;
entry CM!KEY;
entry CM!CFM;
entry CM!NUM;
entry CM!NOI;
entry CM!IFI;
entry CM!OFI;
entry CM!FIL;
entry CM!CMA;
entry CM!SWI;
entry CM!FLD;
entry CM!USR;
entry CM!DIR;
entry CM!FLT;
entry CM!DEV;
entry CM!TXT;
entry CM!NUX;
entry CM!TOK;
entry CM!UQS;
entry CM!QST;
entry CM!TAD;
entry CM!ACT;
entry CM!NOD;
entry CM#KEY;
entry CM#CFM;
entry CM#NUM;
entry CM#NOI;
entry CM#IFI;
entry CM#OFI;
entry CM#CMA;
entry CM#SWI;
entry CM#FLD;
entry CM#USR;
entry CM#DIR;
entry CM#FLT;
entry CM#DEV;
entry CM#TXT;
entry CM#ACT;
entry CM#TOK;
entry CM#FIL;
entry CM#NOD;
entry CM#NUX;
entry CM#TAD;
entry CM#UQS;
entry Cm#QST;
entry CM#RESET;
entry CM#CALL;
begin "comnd"
require "{}{}" delimiters;
define ! = {comment};
! Macro Definitions
=================
;
! *** Data Manipulations;
define ison(word,mask) = {((word land (mask)) neq 0)};
define isoff(word,mask) = {((word land (mask)) = 0)};
define right(word) = {(word land '777777)};
define left(word) = {((word land '777777000000) rot 18)};
define bpoint(word) = {(word lor '777777000000)};
define memloc(str) = {memory[location(str),integer]};
define hiord(word) = {(word lsh 27)};
! *** Jsys Codes;
define Comnd = {jsys '544};
define Geter = {jsys '12};
define Stcmp = {jsys '540};
! *** Comnd Jsys Function Codes;
define #CmKey = {hiord('0)};
define #CmNum = {hiord('1)};
define #CmNoi = {hiord('2)};
define #CmSwi = {hiord('3)};
define #CmIfi = {hiord('4)};
define #CmOfi = {hiord('5)};
define #CmFil = {hiord('6)};
define #CmFld = {hiord('7)};
define #CmCfm = {hiord('10)};
define #CmDir = {hiord('11)};
define #CmUsr = {hiord('12)};
define #CmCma = {hiord('13)};
define #CmIni = {hiord('14)};
define #CmFlt = {hiord('15)};
define #CmDev = {hiord('16)};
define #CmTxt = {hiord('17)};
define #CmTad = {hiord('20)};
define #CmQst = {hiord('21)};
define #CmUqs = {hiord('22)};
define #CmTok = {hiord('23)};
define #CmNux = {hiord('24)};
define #CmAct = {hiord('25)};
define #CmNod = {hiord('26)};
! *** Command State Block;
define CmFlg = {cm!csb['0]};
define CmIoj = {cm!csb['1]};
define CmRty = {cm!csb['2]};
define CmBfp = {cm!csb['3]};
define CmPtr = {cm!csb['4]};
define CmCnt = {cm!csb['5]};
define CmInc = {cm!csb['6]};
define CmAbp = {cm!csb['7]};
define CmAbc = {cm!csb['10]};
define CmGjb = {cm!csb['11]};
! *** Function Descriptor Block;
define CmFnp = {cm!fdb[0]};
define CmDat = {cm!fdb[1]};
define CmHlp = {cm!fdb[2]};
define CmDef = {cm!fdb[3]};
define CmBrk = {cm!fdb[4]};
! *** Multiple Function Descriptor Block;
define CmMFnp = {cm#fdb[cm#level,0]};
define CmMDat = {cm#fdb[cm#level,1]};
define CmMHlp = {cm#fdb[cm#level,2]};
define CmMDef = {cm#fdb[1,3]};
define CmMBrk = {cm#fdb[cm#level,4]};
! *** Components of CmFnp;
define Cm$Fnc = {((CmFnp land '777000000000) rot 9)};
define Cm$Ffl = {((CmFnp land '000777000000) rot 18)};
define Cm$Lst = {( CmFnp land '000000777777)};
! *** Address of GTJFN argument block;
define Cm$Gjb = {(CmGjb land '777777)};
! *** Components of GTJFN argument block;
define GjGen = {cm!gtbuf[0]};
define GjSrc = {cm!gtbuf[1]};
define GjDev = {cm!gtbuf[2]};
define GjDir = {cm!gtbuf[3]};
define GjNam = {cm!gtbuf[4]};
define GjExt = {cm!gtbuf[5]};
define GjPro = {cm!gtbuf[6]};
define GjAct = {cm!gtbuf[7]};
define GjJfn = {cm!gtbuf[8]};
define GjF2 = {cm!gtbuf[9]};
define GjCpp = {cm!gtbuf[10]};
define GjCpc = {cm!gtbuf[11]};
define GjRty = {cm!gtbuf[12]};
define GjBfp = {cm!gtbuf[13]};
! *** Flags in CmFlg;
define Cm$Esc = {'400000000000};
define Cm$Nop = {'200000000000};
define Cm$Eoc = {'100000000000};
define Cm$Rpt = {'040000000000};
define Cm$Swt = {'020000000000};
define Cm$Pfe = {'010000000000};
define Cm$Rai = {'004000000000};
define Cm$Xif = {'002000000000};
define Cm$Wkf = {'001000000000};
define RetFlags = {'770000000000}; ! Mask for flags returned by COMND;
! *** Flags in CmFnp;
define Cm$Brk = {'000020000000};
define Cm$Po = {'000010000000};
define Cm$Hpp = {'000004000000};
define Cm$Dpp = {'000002000000};
define Cm$Sdh = {'000001000000};
! Flag for CmDir function;
define Cm$Dwc = {'400000000000};
! *** Flags for CmTad function;
define Cm$Ida = {'400000000000};
define Cm$Itm = {'200000000000};
define Cm$Nci = {'100000000000};
! *** Flags in Keyword table (first word of string if B0-6 - 0);
define Cm$Inv = {'000000000001};
define Cm$Nor = {'000000000002};
define Cm$Abr = {'000000000004}; ! Nonstandard abbreviations are not
! implemented in these routines. How-
! ever, the user is free to modify the
! keyword lookup tables created by
! tbuild or to build his own in order
! to use this feature;
define Cm$Fw = {'002000000000}; ! Must always be on if other flags on.
! Otherwise first word of entry should
! actually be beginning of ASCIZ string;
! *** Input/Output Channels;
define priin = {'000100};
define priou = {'000101};
define nulio = {'377777};
define ttdes = {'400000};
define ttdes1 = {'777777400000};
define dvdes = {'600000000000};
! *** Self-process handle;
define FhSlf = {'400000};
! *** Error Codes found in AC2 upon unparsable field (returned in cm!err)
! for CmKey and CmSwi;
define NPXAMB = {'602044};
define NPXNSW = {'602045};
define NPXNOM = {'602046};
define NPXNUL = {'602047};
define NPXINW = {'602050};
define NPXNC = {'602051};
define NPXICN = {'602052};
define NPXIDT = {'602053};
define NPXNQS = {'602054};
define NPXNMT = {'602055};
define NPXNMD = {'602056};
define NPXCMA = {'602057};
define COMX18 = {'602134};
define COMX19 = {'602135};
! *** Error codes causing Illegal Instruction Interrupts (not including
! errors caused by jsyses called by COMND);
define COMNX1 = {'601257};
define COMNX2 = {'601260};
define COMNX3 = {'601261};
define COMNX5 = {'601265};
define COMNX8 = {'601321};
define COMNX9 = {'601413};
define IOX4 = {'600220}; ! Mon Call Ref lied - EOF gives this, not COMNX9;
define COMX10 = {'601767};
define COMX11 = {'602035};
define COMX12 = {'602036};
define COMX13 = {'602037};
define COMX14 = {'602040};
define COMX15 = {'602041};
define COMX16 = {'602042};
define COMX17 = {'602043};
! *** End of Macro Definitions;
! Outer Block Declarations
========================
;
internal integer array cm!csb[0:'11];
internal integer array cm!fdb[0:4];
internal integer array cm!gtbuf[0:13];
internal integer array cm!buffer[0:99];
internal integer array cm!atom[0:99];
internal integer array cm#fdb[1:10,0:4];
internal integer array cm!datime[2:4];
internal boolean cm!major,cm!minor,cm!fatal,cm!eof,cm!abort;
internal boolean cm!reparse,cm!colon;
internal integer cm!err;
internal integer cm#int;
internal string cm#str;
internal real cm#real;
internal integer cm#level;
external integer !skip!;
record!class jfnstack (integer ichan, ochan;
boolean errpop;
record!pointer(jfnstack) next);
record!pointer(jfnstack) jfnhead;
string array cm#hlp,cm#nze[1:10],cm#token[1:10];
integer csbad,fdbad;
integer array break!tables[0:10,0:3];
boolean minor;
string promptz,devz,dirz,namz,extz,protz,acctz;
! *** End of Outer Block Declarations;
! Procedure Definitions
=====================
;
internal integer procedure cm!size
(string array strarr);
COMMENT
This procedure computes a generous allocation for a lookup
table to contain the elements of strarr. The strings must all be
copied into such a lookup table since the TBLUK jsys requires all
entries to be alligned on word boundaries, and this is not generally
the case with SAIL strings.
;
begin "size"
integer i,sum,len;
sum := 1;
for i := arrinfo(strarr,1) step 1 until arrinfo(strarr,2) do
begin "add"
len := length(strarr[i]);
sum := sum+1+((len+5) div 5);
end "add";
sum := sum+2+arrinfo(strarr,2)-arrinfo(strarr,1);
return(sum);
end "size";
integer procedure compare
(string a,b);
COMMENT
This procedure compares two character strings a and b,
and returns -1 if a < b alphabetically, 1 if a > b, and 0 if
a = b.
;
begin "compare"
integer result,loca,locb;
loca := memloc(a);
locb := memloc(b);
start!code "stcmp"
move 1,loca;
move 2,locb;
stcmp;
movem 1,result;
end "stcmp";
if result=0 then return(0)
else if result='100000000000 then return(1)
else return(-1);
end "compare";
procedure tagsort
(string array scrmbld;
reference integer array tag);
COMMENT
This procedure does a tag sort on the strings in array
scrmbld. The string array is left unchanged, but indexing it through
the tag array will result in accessing the strings in ascending alpha-
betical order. The two arrays should both have the same number of
elements, and the lower bound on the indices for tag should be 1.
Also, then indices for the scrmbld array should initially be stored
in ascending order in the tag array.
;
begin "tagsort"
integer i,j,temp;
boolean changed;
for i := 1 step 1 until arrinfo(tag,2)-1 do
begin "pass"
changed := false;
for j := 1 step 1 until arrinfo(tag,2)-1 do
if compare(scrmbld[tag[j]],scrmbld[tag[j+1]])=1 then
begin "switch"
temp := tag[j];
tag[j] := tag[j+1];
tag[j+1] := temp;
changed := true;
end "switch";
if not changed then done;
end "pass";
return;
end "tagsort";
internal procedure cm!retry
(string errmsg);
COMMENT
This procedure allows the user to try again on the current
field. The procedure prints out the error message, then retypes
the command line, including the prompt, up to the unparsable field,
and the user may retype that field. The procedure also resets CMINC
(cm!csb[6]) so that COMND will not think that anything is in the field
yet.
;
begin "retry"
integer ptr,char;
print(errmsg&'15&'12);
CmInc := 0;
ibp(ptr := CmPtr);
if ldb(ptr)=" " then
begin
ibp(CmPtr);
CmCnt := CmCnt-1;
end;
ptr := CmRty;
while true do
begin "print prompt"
char := ildb(ptr);
if char=0 then done;
print(char&null);
end "print prompt";
ptr := CmBfp;
while true do
begin "print cm!buffer";
if ptr=CmPtr then done;
char := ildb(ptr);
print(char&null);
end "print cm!buffer";
return;
end "retry";
procedure prepare;
COMMENT
This procedure sets up the various pointers in the cm!csb,
and also the pointers to the cm!csb and the cm!fdb. This procedure should
be used before every call to COMND to minimize the possibility of the
SAIL runtime system moving the various arrays and strings without their
pointers being updated.
;
begin "prepare"
integer count,loc;
count := 5*arrinfo(cm!buffer,0)-CmCnt;
loc := location(cm!buffer[0])+((count-1) div 5);
if count=0 then CmPtr := bpoint(location(cm!buffer[0]))
else CmPtr := right(loc) +
(7 lsh 24) +
((29-7*((count-1) mod 5)) lsh 30);
CmRty := memloc(promptz);
CmBfp := bpoint(location(cm!buffer[0]));
CmAbp := bpoint(location(cm!atom[0]));
CmGjb := location(cm!gtbuf[0]);
CmIoj := (jfnstack:ichan[jfnhead] lsh 18) lor jfnstack:ochan[jfnhead];
csbad := location(cm!csb[0]);
fdbad := location(cm!fdb[0]);
return;
end "prepare";
procedure make!break(integer tabno; string chars);
COMMENT
Builds a table of break characters by setting the bits
in the table corresponding to the characters in chars. The
first 32 bits of each table word are used, spanning the complete
ASCII collating sequence in ascending order.
;
begin "make!break"
integer char,indx,num;
for indx := 0 step 1 until 3 do
break!tables[tabno,indx] := 0;
while length(chars) neq 0 do
begin "load"
char := lop(chars);
indx := char div 32;
num := char-32*indx;
break!tables[tabno,indx] :=
break!tables[tabno,indx] lor (1 rot (35-num));
end "load";
end "make!break";
internal simple procedure cm!ioj;
COMMENT
Sets up the initial jfn chain, consisting of a single
entry containing priio.
;
begin "cm!ioj"
jfnhead := new!record(jfnstack);
jfnstack:ichan[jfnhead] := priin;
jfnstack:ochan[jfnhead] := priou;
end "cm!ioj";
internal procedure cm!take(integer ichan, ochan(nulio);
boolean errpop(true));
COMMENT
This procedure facilitates the redirection of input and output
from COMND. The name is derived from its similarity to the 'take'
command of the EXEC. The files represented by ichan and ochan,
which should not be open before the call, are first opened, and
then they are made the current input and output jfns for COMND
calls. The old jfns are pushed onto a stack. When the new input
file is finished, the old jfns are popped back and the finished
file is closed, along with the associated output file. If a parsing
error occurs during the reading of the new file, then if errpop is
true, the old jfns are popped back, and a message printed. If errpop
is false, then only the normal minor error procedures are followed.
;
begin "cm!take"
record!pointer(jfnstack) newjfn;
integer errchan;
procedure open!error(integer chan,error; string mode);
begin "open!error"
cprint (errchan,"?",('15&'12),
"Fatal error using SAIL-COMND interface package");
cprint (errchan,"?",('15&'12),
"Could not open ",jfns(chan,0)," for ",mode,('15&'12));
cprint(errchan,"?",erstring(error, FhSlf));
start!code
haltf;
end;
end "open!error";
errchan := jfnstack:ochan[jfnhead];
define jfnok(jfn) =
{(jfn neq nulio) and (jfn neq priin) and
(jfn neq priou) and
((jfn land ttdes1) neq ttdes) and
((jfn land dvdes) neq dvdes)};
if jfnok(ichan) then openf(ichan,0);
if !skip! then
if cm!major then open!error(ichan,!skip!,"input")
else begin
cm!fatal := true;
cm!err := !skip!;
return;
end;
if jfnok(ochan) then openf(ochan,1);
if !skip! then
if cm!major then open!error(ochan,!skip!,"output")
else begin
cm!fatal := true;
cm!err := !skip!;
cfile(ichan);
return;
end;
newjfn := new!record(jfnstack);
jfnstack:ichan[newjfn] := ichan;
jfnstack:ochan[newjfn] := ochan;
jfnstack:errpop[newjfn] := errpop;
jfnstack:next[newjfn] := jfnhead;
jfnhead := newjfn;
end "cm!take";
procedure err!handle;
COMMENT
This procedure handles all errors that arise during operation
of the COMND jsys. When an error is detected upon return from the
jsys call, control is transfered to this procedure, which determines
the nature of the error and takes appropriate action, which is
as follows:
If the error would have caused an illegal instruction interrupt
had it not been caught (e.g. input buffer overflow), it is termed a
"major" error. Otherwise it is a "minor" error (e.g. input did not
correspond to a valid keyword in cm!key).
When a minor error occurs, the cm!minor flag is checked. If
the flag is true, an appropriate error message is printed. Otherwise
no message is printed. In either case, control returns to the user's
program with the error code in cm!err.
When a major error occurs, the cm!major flag is checked. If
the flag is true, an error message is printed and the program halts.
If the flag is false, no action is taken, the error code is put in
cm!err, and cm!fatal is set to true. The user's program may then
take whatever action it desires.
There is one major error which is not signalled in any case,
that is, coming to the end of the input file when that file was opened
due to a call to the take procedure. In that case, the cm!eof variable
is set to true, the old jfns are popped back into the CSB, and the
program is continued silently. Note that the call in progress is
not automatically reissued.
When the program is started, both cm!minor and cm!major
are set to true.
;
begin "err!handler"
integer chan;
start!code "geter"
hrrzi 1,FhSlf;
Geter;
hrrzm 2,cm!err;
end "geter";
if cm!err=COMNX9 or cm!err=IOX4 then
begin "eof"
cm!eof := true;
if jfnstack:next[jfnhead] neq null!record then
define jfnok(jfn) =
{(jfn neq nulio) and (jfn neq priin) and
(jfn neq priou) and
((jfn land ttdes1) neq ttdes) and
((jfn land dvdes) neq dvdes)};
begin "popjfn"
if jfnok(jfnstack:ichan[jfnhead]) then
cfile(jfnstack:ichan[jfnhead]);
if jfnok(jfnstack:ochan[jfnhead]) then
cfile(jfnstack:ochan[jfnhead]);
jfnhead := jfnstack:next[jfnhead];
return;
end "popjfn";
end "eof";
chan := jfnstack:ochan[jfnhead];
if minor then
begin
if cm!minor then
begin
if isoff(CmFlg,Cm$Eoc) then cprint (chan,'15&'12);
cprint(chan,"?");
cprint(chan,erstring(cm!err,FhSlf));
end;
if jfnstack:errpop[jfnhead] then
begin
if jfnok(jfnstack:ichan[jfnhead]) then
cfile(jfnstack:ichan[jfnhead]);
if jfnok(jfnstack:ochan[jfnhead]) then
cfile(jfnstack:ochan[jfnhead]);
jfnhead := jfnstack:next[jfnhead];
chan := jfnstack:ochan[jfnhead];
if cm!minor then cprint(chan,
('15&'12),"?Error detected while reading commands from ",
"external file - file aborted",('15&'12));
cm!abort := true;
end;
end
else if cm!major then
begin
if isoff(CmFlg,Cm$Eoc) then cprint (chan, '15&'12);
cprint(chan, "?Fatal error using SAIL-COMND interface package");
cprint(chan,('15&'12&"?"),erstring(cm!err,FhSlf));
start!code
haltf;
end;
end
else
begin
if jfnstack:errpop[jfnhead] then
begin
cm!abort := true;
if jfnok(jfnstack:ichan[jfnhead]) then
cfile(jfnstack:ichan[jfnhead]);
if jfnok(jfnstack:ichan[jfnhead]) then
cfile(jfnstack:ochan[jfnhead]);
jfnhead := jfnstack:next[jfnhead];
end;
cm!fatal := true;
end;
return;
end "err!handler";
internal string procedure cm!getatm;
COMMENT
This procedure returns a SAIL-type string containing the
current contents of the cm!atom cm!buffer, with the final null character
stripped off.
;
begin "getatm"
integer ptr,char,i;
string atmstr;
ptr := CmAbp;
atmstr := null;
while true do
begin "transfr"
char := ildb(ptr);
if char=0 then done;
atmstr := atmstr&char;
end "transfr";
return(atmstr);
end "getatm";
internal integer procedure cm!tbuild
(string array keys;
reference integer array table);
COMMENT
This procedure facilitates the setting up of a keyword table
to be used with the CmKey and CmSwi COMND jsys funcion calls. The
procedure returns a zero if there is room in the table array to
store the entire keyword table (including all keyword strings alligned
on word boundaries), and -1 if not. In the latter case the table
will probably not be in an acceptable format for the TBLUK jsys. One
convenient way of declaring a suitable size for the table is by using
the size procedure (above).
The keys parameter is a string array containing the keywords
to be included in the table, and does not have to be alphabetized.
Tbuild will not insert duplicate entries, and if two elements of keys
are identical it will place the index of the last duplicate entry found
in the cm!err variable. Each string in keys may be prefixed by either
or both of two punctuation characters. If a "%" character appears
within the first two characters of a string the Cm$Inv bit will be
turned on for the corresponding table entry. If a "#" character is
found the Cm$Nor bit will be turned on. In either case the punctuation
character will be stripped before the keyword is entered into the table.
;
begin "tbuild"
integer array tags[1:1+arrinfo(keys,2)-arrinfo(keys,1)];
string array copy[arrinfo(keys,1):arrinfo(keys,2)];
integer first,i,j,k,strip,thistag,last;
string trans;
boolean array nor,inv[arrinfo(keys,1):arrinfo(keys,2)];
first := arrinfo(table,1);
last := arrinfo(table,2);
for i := 1 step 1 until arrinfo(tags,2) do
begin "initialize"
thistag := (tags[i] := i+arrinfo(keys,1)-1);
strip := 1;
nor[thistag] := (inv[thistag] := true);
if (keys[thistag] = "#") or (keys[thistag][2 for 1] = "#") then
strip := strip+1 else nor[thistag] := false;
if (keys[thistag] = "%") or (keys[thistag][2 for 1] = "%") then
strip := strip+1 else inv[thistag] := false;
copy[thistag] := keys[thistag][strip to inf]&0;
end "initialize";
table[first] := arrinfo(tags,2);
tagsort(copy,tags);
j := first+arrinfo(tags,2)+1;
if j > last then return (-1);
k := first+1;
for i := 1 step 1 until arrinfo(tags,2) do
begin "insert"
thistag := tags[i];
if i > 1 then
if 0=compare(copy[thistag],copy[tags[i-1]]) then
begin "duplicate"
cm!err := thistag;
continue "insert";
end "duplicate";
table[k] := (right(location(table[j])) lsh 18) + thistag;
k := k+1;
table[j] := Cm$Fw +
(if nor[thistag] then Cm$Nor else 0) +
(if inv[thistag] then Cm$Inv else 0);
j := j+1;
if j > last then return(-1);
trans := copy[thistag];
while length(trans) > 0 do
begin "transfer"
table[j] := cvasc(trans[1 for 5]);
trans := trans[6 to inf];
j := j+1;
if j > last then return(-1);
end "transfer";
table[first] := table[first]+'1000000;
end "insert";
return(0);
end "tbuild";
internal integer procedure cm!key
(integer array table;
string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false);
string brchars(null));
COMMENT
This procedure performs the COMND jsys CmKey function for
parsing keywords. The keyword table is ordinarily set up by using
the tbuild procedure. Upon successful parsing of a keyword cm!key
returns the index of the parsed keyword in the array passed to tbuild
containing the keyword strings. If the input was unparsable a 0 is
returned and the cm!err variable is set to the error condition returned
by COMND in AC2. If reparsing is required (the user deleted into a
previous field) a -1 is returned, and cm!reparse is set to true. In
this case the entire command line must be reparsed from the beginning.
The parameters and their defaults are as follows:
table - Contains a keyword table in the format required by the TBLUK
jsys. See tbuild procedure. No default.
help - Contains a help string to be typed when the user types a ques-
tion mark at the keyboard. This will precede the standard help
message if that message is not suppressed (see sup$help) -
default is null.
def - Contains the default value for this field, which will be used
if the user enters no value for this field. If def is null,
no default value will be recognized for this field. Default
is null string.
sup$help - If true this will suppress the printing of the standard
error message when the user types a question mark. Default
is false.
raise$input - If true the user's input will be converted to upper
case, although he will not see the conversion. Default is false.
no$indirect - If this is true the user will not be allowed to use an
indirect file to supply this field value. An at-sign (@) will
be taken as just another punctuation character. Default false.
wake$always - If this is true each field will be parsed immediately,
instead of waiting for an activation character to be typed.
This is useful for changing terminal characteristics according
to input, e.g. turning off terminal echo before a password is
typed in. It requires greater overhead, however. Default false.
brchars - An optional string of characters on which to break the
input field. If this is not specified it defaults to null,
and the standard break table is used. There is no way for
the condition mentioned in the Monitor Calls Reference Manual
to occur wherein the field breaks on no character, and input
simply continues until the input buffer is full.
;
begin "CmKey"
string helpz,defz;
integer index,ac2;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmKey+
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0)+
(if length(def) > 0 then Cm$Dpp else 0)+
(if sup$help then Cm$Sdh else 0);
CmDat := location(table[arrinfo(table,1)]);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0)+
(if no$indirect then Cm$Xif else 0)+
(if wake$always then Cm$Wkf else 0);
if length(brchars) > 0 then
begin
make!break(0,brchars);
CmBrk := location(break!tables[0,0]);
end;
prepare;
start!code "call$CmKey"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,ac2;
end "call$CmKey";
if isoff(CmFlg,Cm$Nop) then
start!code "getindex"
move 2,ac2;
hrrz 1,0(2);
movem 1,index;
end "getindex";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(-1);
end;
return(index);
end "CmKey";
internal integer procedure cm!num
(string help(null),def(null);
boolean sup$help(false);
integer radix(10);
boolean no$indirect(false),
wake$always(false));
COMMENT
This procedure will parse an integer number field. The
number parsed is returned. If the field cannot be parsed then cm!err
will be set to the error code returned in AC2, else it will be zero.
If the command line must be reparsed, then cm!reparse will be set to
true. Paramters are as in the cm!key procedure, except for optional
paramter radix, which specifies the radix from 2 to 10 in which the
input is to be interpreted. The default is 10.
;
begin "CmNum"
string helpz,defz;
integer num;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmNum +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := radix;
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if no$indirect then Cm$Xif else 0) +
(if wake$always then cm$Wkf else 0);
prepare;
start!code "call$CmNum"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,num;
end "call$CmNum";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(-1);
end;
return(num);
end "CmNum";
internal integer procedure cm!noi
(string noise);
COMMENT
This procedure will put out a guide word using the CmNoi
function call to the COMND jsys. The guide word is usually printed
if the previously parsed field was terminated by an ESC and was
recognized. Guide words are not output if the caller hasn't started
parsing the next field yet.
The noise parameter is the guide word string without the
surrounding parentheses that always accompany guide words when they
are typed. If the user deletes into a previous field, cm!reparse will
be set to true before the return.
If the guide word is parsed correctly a 1 is returned. If a
reparse is needed, -1 is returned. If the guide word could not be
parsed, 0 is returned.
;
begin "CmNoi"
string noisez;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
noisez := noise&0;
CmFnp := #CmNoi;
CmDat := memloc(noisez);
prepare;
start!code "call$CmNoi"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmNoi";
if ison(CmFlg,Cm$Nop) then
begin
err:err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
return(if cm!reparse then -1 else 1);
end "CmNoi";
internal integer procedure cm!swi
(integer array table;
string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false);
string brchars(null));
COMMENT
This procedure performs the COMND jsys CmSwi function call
for parsing a switch field. All parameters and returns are exactly
as in the cm!key procedure except that if the field is terminated
by a colon (indicating that a value is to follow), the variable cm!colon
will be set to true. Note that the keywords making up the keyword table
for this call should not include slashes, although they may end in
colons if values are desired upon recognition.
;
begin "CmSwi"
string helpz,defz;
integer index,ac2;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmSwi +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := location(table[arrinfo(table,1)]);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
if length(brchars) > 0 then
begin
make!break(0,brchars);
CmBrk := location(break!tables[0,0]);
end;
prepare;
start!code "call$CmSwi"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,ac2;
end "call$CmSwi";
if isoff(CmFlg,Cm$Nop) then
start!code "getindex"
move 2,ac2;
hrrz 1,0(2);
movem 1,index;
end "getindex";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(-1);
end;
cm!colon := ison(CmFlg,Cm$Swt);
return(index);
end "CmSwi";
internal integer procedure cm!ifi
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure parses an input file specification using
the CmIfi function call of the COMND jsys. No special options
are permitted. The JFN of the file is returned. Parameters are
as in the cm!key procedure. If the field is unparsable cm!err is
set to the error code returned in AC2. If the user deletes into
a previous field, cm!reparse will be set to true indicating that
a reparse is needed.
;
begin "CmIfi"
integer ac2;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmIfi +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := 0;
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmIfi"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,ac2;
end "call$CmIfi";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end
else cm!err := 0;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
if not cm!reparse then ac2 := setchan(ac2,cm!gtbuf[0],0);
return(ac2);
end "CmIfi";
internal integer procedure cm!ofi
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
Same as cm!ifi, but for an output file specification.
;
begin "CmOfi"
integer ac2;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmOfi +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := 0;
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmOfi"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,ac2;
end "call$CmOfi";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end
else cm!err := 0;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
if not cm!reparse then ac2 := setchan(ac2,cm!gtbuf[0],0);
return(ac2);
end "CmOfi";
internal integer procedure cm!fil
(string help(null),def(null);
integer flag$gen('440004000000);
string device(null),
directory(null),
name(null),
extension(null),
protection(null),
account(null);
integer jfn(0);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure parses an arbitrary file specification
using the CmFil function call of the COMND jsys. The flag$gen
parameter gives the contents to be set in the first word (.GTGEN)
of the GTJFN block. See the description of the GTJFN jsys in
the Monitor Calls Reference Manual. The device, directory, name,
extension, protection and account parameters give the defaults
which are to be given to the appropriate fields of the file
specification. Note that any fields present in the def parameter
will take precedence over these parameters. The jfn parameter
specifies a jfn to be associated with the file. See the GJ%JFN
bits (9 & 10) of the .GJGEN word in the description of GTJFN in
Monitor Calls Reference Manual.
All other parameters are as in cm!key. If the parse is successful,
the SAIL channel number is returned (the file is not opened).
Otherwise cm!err is set to the TOPS-20 error code. If a reparse
is needed, cm!reparse is set to true.
;
begin "CmFil"
integer ac2;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
devz := device&0;
dirz := directory&0;
namz := name&0;
extz := extension&0;
protz := protection&0;
acctz := account&0;
CmFnp := #CmFil +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := 0;
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0)+
(if no$indirect then Cm$Xif else 0)+
(if wake$always then Cm$Wkf else 0);
GjGen := flag$gen;
GjDev := if length(device) > 0 then memloc(devz) else 0;
GjDir := if length(directory) > 0 then memloc(dirz) else 0;
GjNam := if length(name) > 0 then memloc(namz) else 0;
GjExt := if length(extension) > 0 then memloc(extz) else 0;
GjPro := if length(protection) > 0 then memloc(protz) else 0;
GjAct := if length(account) > 0 then memloc(acctz) else 0;
GjJfn := jfn;
prepare;
start!code "call$CmFil"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,ac2;
end "call$CmFil";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end
else cm!err := 0;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
if not cm!reparse then ac2 := setchan(ac2,GjGen,0);
return(ac2);
end "CmFil";
internal string procedure cm!fld
(string help(null),def(null);
boolean raise$input(false),
no$indirect(false),
wake$always(false);
string brchars(null));
COMMENT
This procedure parses an arbitrary field up to the first non-
alphanumeric character. Anything goes here, and the data typed, not
including the terminator is returned by the procedure. the input
is also available in ASCIZ form for those who want it in integer
array cm!atom[0:99], but will remain there only until the next field is
parsed. Parameters are as in cm!key, but note that since COMND hasn't
the foggiest idea what you are looking for in this field, there is no
standard help message, so no sup$help parameter. You are free to supply
you own help message.
;
begin "CmFld"
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmFld +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
if length(brchars) > 0 then
begin
make!break(0,brchars);
CmBrk := location(break!tables[0,0]);
end;
prepare;
start!code "call$CmFld"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmFld";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
return(cm!getatm);
end "CmFld";
internal integer procedure cm!cfm
(string help(null);
boolean sup$help(false));
COMMENT
This procedure performs the COMND jsys CmCfm function,
which merely waits for the user to confirm the command line by
typing a carriage return. The parameters are as in the cm!key
procedure. If proper confirmation is given a 1 is returned.
Otherwise, cm!err is set to the error code returned in AC2 and a 0
is returned. If the user deletes into a previous field, cm!reparse is
set to true and a -1 is returned.
;
begin "CmCfm"
string helpz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
CmFnp := #CmCfm +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
prepare;
start!code "call$CmCfm"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmCfm";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(-1);
end;
return(1);
end "CmCfm";
internal integer procedure cm!dir
(string help(null),def(null);
boolean sup$help(false),
allow$wild(false),
raise$input(false),
no$indirect(false),
wake$always(false),
parse$only(false));
COMMENT
This procedure performs the CmDir function call of the COMND
jsys for parsing direct names. The 36-bit direct number associated with
the parsed name is returned. The directory name may be obtained from
this using the DIRST built-in Sail function. Parameters are as in the
cm!key procedure, with one addition: if parse$only is true, the field
will be parsed, but not verified. The default is false.
One additional feature is the allow$wild parameter which, if
true, will allow the user to use wild card characters in the directory
name. The default is false.
Values returned are exactly as in the cm!usr procedure.
;
begin "CmDir"
integer direct;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmDir +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0) +
(if parse$only then Cm$Po else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmDat := (if allow$wild then Cm$Dwc else 0);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmDir"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,direct;
end "call$CmDir";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0);
end;
return(direct);
end "CmDir";
internal integer procedure cm!usr
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false),
parse$only(false));
COMMENT
This procedure performs the CmUsr function call of the COMND
jsys for parsing user names. The 36-bit user number associated with
the parsed name is returned. The user name may be obtained from this
using the DIRST built-in Sail function. Parameters are as in the cm!key
procedure, with one addition: if parse$only is true, the field will
be parsed, but not verified. The default is false. If the field
was unparsable (even if parse$only was true), then cm!err will contain
the error code returned in AC2. If a reparse is required then cm!reparse
will be set to true.
;
begin "CmUsr"
integer user;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmUsr +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0) +
(if parse$only then Cm$Po else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmUsr"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,user;
end "call$CmUsr";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0);
end;
return(user);
end "CmUsr";
internal procedure cm!cma
(string help(null);
boolean sup$help(false));
COMMENT
This procedure parses a comma. Blanks can appear on either
side of it. cm!err is set to true if a comma is not found. cm!reparse
is set to true if a reparse is needed.
;
begin "CmCma"
label err;
string helpz;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
CmFnp := #CmCma+
(if length(help) > 0 then Cm$Hpp else 0)+
(if sup$help then Cm$Sdh else 0);
CmDat := 0;
prepare;
start!code "call$CmCma"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmCma";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
end
else cm!err := 0;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
return;
end "CmCma";
internal boolean procedure cm!ini
(string prompt;
boolean newcomm(true));
COMMENT
This procedure gives a call to the COMND jsys with function
code CmIni. This function sets up the command status block and prints
the supplied prompt string. This function should be used to start
the parsing of all command lines. If the user types a ctrl/h as the
first character after the prompt, and the CSB is in a proper state,
the call will automatically cause all the correct fields of the
previous command line to be re-used, up to a bad field. In this
case, although no special attention is actually required in the
following calls, the cm!ini procedure returns the value true. Other-
wise it returns false. If the newcomm parameter is true, the
entire CSB will be reset as for a new command. This will cause the
ctrl/h feature to fail, so this is normally not done when reinitiating
a command line after a parse error.
;
begin "cmini"
label ctrl$h;
promptz := prompt&0;
if newcomm then
begin
CmFlg := 0;
CmCnt := 5*arrinfo(cm!buffer,0);
CmInc := 0;
CmAbc := 5*arrinfo(cm!atom,0);
end;
CmFlg := (CmFlg land '777777000000) lor location(ctrl$h);
CmFnp := #CmIni;
CmDat := 0;
CmHlp := 0;
CmDef := 0;
prepare;
start!code "call$cmini";
move 1,csbad;
move 2,fdbad;
Comnd;
end "call$cmini";
return(false);
ctrl$h: return(true);
end "cmini";
internal real procedure cm!flt
(string help(null),def(null);
boolean sup$help(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure uses COMND to parse a real number from the
keyboard. Parameters are as in the cm!key procedure, but there
is no raise$input parameter, since, of course, no alphabetic
data is expected anyway. Successful parsing returns the number
typed as the value of the function. If the field could not be
parsed, cm!err is set to the error code returned in AC2. If
reparsing is needed, cm!reparse is set to true.
;
begin "CmFlt"
real num;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmFlt +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmFlt"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,num;
end "call$CmFlt";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0.0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0.0);
end;
return(num);
end "CmFlt";
internal integer procedure cm!dev
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false);
string brchars(null));
COMMENT
This procedure uses the CmDev function call of the COMND jsys
to parse a device name. Parameters are as in the cm!key procedure,
and the procedure normally returns the device designator. If reparsing
is needed cm!reparse is set to true, and if the field is unparsabel as
a device name, cm!err will contain the error code returned in AC2.
;
begin "CmDev"
integer devdeg;
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmDev +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
if length(brchars) > 0 then
begin
make!break(0,brchars);
CmBrk := location(break!tables[0,0]);
end;
prepare;
start!code "call$CmDev"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,devdeg;
end "call$CmDev";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0);
end;
return(devdeg);
end "CmDev";
internal string procedure cm!txt
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false);
string brchars(null));
COMMENT
This procedure does the CmTxt function call on the COMND jsys.
It will return all text typed until the next carriage return. The
text is also available in ASCIZ representation in integer array cm!atom
[0:99], but only until the next field is parsed. If a reparse is
required, cm!reparse will be set to true. There is no such thing as
not being able to parse this field.
;
begin "CmTxt"
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmTxt +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
if length(brchars) > 0 then
begin
make!break(0,brchars);
CmBrk := location(break!tables[0,0]);
end;
prepare;
start!code "call$CmTxt"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmTxt";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
return(cm!getatm);
end "CmTxt";
internal integer procedure cm!tad
(string help(null),def(null);
boolean sup$help(false),
date(true),time(true),
no$convert(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure does the CmTad function call of the COMND
jsys, which parses a date and/or time. If date is true, the date
is parsed, and if time is true, the time is parsed. Both default
to true. If no$convert is false (the default), then the date/time
is returned in internal format. Otherwise a zero is returned, and
the date and time information are stored in integer array cm!datime
(dimensioned [2:4] so as to agree with accumulator assignments in
the IDTNC monitor call return). cm!datime[2] contains the year
in the left half and the month (0=Jan) in the right half. cm!datime[3]
contains the day of the month (0=first day) in the left half and
the day of the week (0=Mon) in the right half. The right half of
cm!datime[4] contains the time as seconds from midnight, and the left
half contains the following flag bits:
B0 - on if a time zone was input
B1 - on if daylight savings time was input
B2 - on if a time zone was input
B3 - on if a number in Julian day format was input
B12-B17 - time zone if one was specified or the local time
if none was specified.
;
begin "CmTad"
string helpz,defz;
integer intern;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmTad +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmDat := (if date then Cm$Ida else 0) +
(if time then Cm$Itm else 0) +
(if no$convert then Cm$Nci else 0) +
location(cm!datime[2]);
prepare;
start!code "call$CmTad"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,intern;
end "call$CmTad";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0);
end;
return(if no$convert then 0 else intern);
end "CmTad";
internal string procedure cm!qst
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure does the CmQst function call to the COMND
jsys. It returns the contents of a quoted string (not included
the double quotes which must delimit the string). This is useful
for obtaining strings which may include action characters (ESC, ?,
^F). A carriage return is an illegal character and will cause cm!err
to be set. A double quote may be entered in the string as two con-
secutive double quotes.
;
begin "CmQst"
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&null;
CmFnp := #CmQst +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
prepare;
start!code "call$CmQst"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmQst";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
return(cm!getatm);
end "CmQst";
internal string procedure cm!uqs
(string brchars,
help(null),def(null);
boolean raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure executes the CMUQS function call of the COMND
jsys. It is used for parsing a field with arbitrary break characters.
The characters to be used as break characters are supplied in the
string parameter brchars. The procedure will return all characters
typed up to, but not including the first of these characters typed.
Note that in this call all action characters lose their significance
unless they are included in the brchars string.
;
begin "CmUqs"
integer ptr;
string result,helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmUqs+
(if length(help) > 0 then Cm$Hpp else 0)+
(if length(def) > 0 then Cm$Dpp else 0);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0)+
(if no$indirect then Cm$Xif else 0)+
(if wake$always then Cm$Wkf else 0);
make!break(0,brchars);
CmDat := location(break!tables[0,0]);
ptr := CmPtr;
prepare;
start!code "call$CmUqs"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmUqs";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
result := null;
while ptr neq CmPtr do
result := result&ildb(ptr);
return(result);
end "CmUqs";
internal boolean procedure cm!tok
(string token,
help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure performst the CMTOK function call of the COMND
jsys. It returns true if what is typed by the user matches the token
parameter, false otherwise.
;
begin "CmTok"
string tokenz,helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
tokenz := token&0;
CmFnp := #CmTok +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmDat := memloc(tokenz);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmTok"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmTok";
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(false);
end;
if ison(CmFlg,Cm$Nop) then return(false)
else return(true);
err: err!handle;
return(false);
end "CmTok";
internal integer procedure cm!nux
(string help(null),def(null);
boolean sup$help(false);
integer radix(10);
boolean no$indirect(false),
wake$always(false));
COMMENT
This procedure will parse an integer number field. The
difference between cm!nux and cm!num is that cm!nux will terminate
on the first non-numeric character, without giving a minor error if
that character is not one of the valid terminators for cm!num. The
number parsed is returned. If the field cannot be parsed then cm!err
will be set to the error code returned in AC2, else it will be zero.
If the command line must be reparsed, then cm!reparse will be set to
true. Paramters are as in the cm!key procedure, except for optional
paramter radix, which specifies the radix from 2 to 10 in which the
input is to be interpreted. The default is 10.
;
begin "CmNux"
string helpz,defz;
integer num;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmNux +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmDat := radix;
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if no$indirect then Cm$Xif else 0) +
(if wake$always then cm$Wkf else 0);
prepare;
start!code "call$CmNux"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,num;
end "call$CmNux";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(0);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(0);
end;
return(num);
end "CmNux";
internal string procedure cm!act
(string help(null),def(null);
boolean sup$help(false),
raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure does the CmAct function call of the COMND
jsys. It returns the account string up to, but not including, the
first non-alphanumeric character typed. No verification is done,
so cm!err is never set. cm!reparse is set to true if a reparse is
needed.
;
begin "CmAct"
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmAct +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0) +
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
prepare;
start!code "call$CmAct"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmAct";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
return (cm!getatm);
end "CmAct";
internal string procedure cm!nod
(string help(null),def(null);
boolean sup$help(false),
no$indirect(false),
wake$always(false));
COMMENT -
This procedure performs the CMNOD function of the COMND jsys.
It parses a network node name. A node name consists of 1 to 6 alpha-
numeric characters. Lowercase characters are always converted to upper
case (hence no raise$input parameter). The node name, as delimited
by the first non-alphanumeric character, is returned as the value of
the function. No verification is done to ensure that the named node
actually exists. If a reparse is needed, the variable cm!reparse
will be set to true. Any errors will be returned in the variable
cm!err, which will otherwise be zero.
;
begin "CmNod"
string helpz,defz;
label err;
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
helpz := help&0;
defz := def&0;
CmFnp := #CmNod +
(if length(help) > 0 then Cm$Hpp else 0) +
(if length(def) > 0 then Cm$Dpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmHlp := memloc(helpz);
CmDef := memloc(defz);
CmFlg := (CmFlg land RetFlags)+
(if no$indirect then Cm$Xif else 0) +
(if wake$always then Cm$Wkf else 0);
prepare;
start!code "call$CmNod"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
end "call$CmNod";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
return(null);
end;
cm!err := 0;
if ison(CmFlg,Cm$Rpt) then
begin
cm!reparse := true;
return(null);
end;
return(cm!getatm);
end "CmNod";
internal procedure cm#reset;
COMMENT -
This procedure resets the multiple fdb block by setting
the level indicator to zero and zeroing the cm#fdb array.
;
begin "cm#reset"
integer i,j;
cm#level := 0;
for i := 1 step 1 until 10 do
for j := 0 step 1 until 3 do
cm#fdb[i,j] := 0;
end "cm#reset";
internal integer procedure cm#call
(string def(null);
boolean raise$input(false),
no$indirect(false),
wake$always(false));
COMMENT
This procedure makes a call to COMND using the multiple fdb
blocks, which should previously have been set up using the various
cm#... procedures. If the blocks have not been set up since the
last call to cm#reset, the procedure returns -1. Otherwise, it returns
the position in the cm#fdb array corresponding to the function that
was actually used. This would also correspond to the order in which
you called the cm#... procedures. For instance, supposed you set
up the fdb blocks by calling first cm#key, then cm#cma, then cm#num,
then cm#flt. Then if cm#call returned 3 as a value, it would mean
that the user had typed in an integer, since cm#num was the call that
eventually succeeded. A zero is returned if all functions fail.
The value actually returned by the succeeding function can be
found in either cm#int, cm#real, or cm#str, according to whether
that value is supposed to be an integer, real or string value,
respectively. It is up to the user program to find the correct
value on the basis of which function succeeded.
;
begin "cm#call"
label err;
integer i,loc,row,fnc,ptr;
string defz;
if cm#level=0 then return(-1);
minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
defz := def&0;
if length(def) > 0 then cm#fdb[1,0] := cm#fdb[1,0] lor Cm$Dpp;
cm#str := null;
CmFlg := (CmFlg land RetFlags)+
(if raise$input then Cm$Rai else 0)+
(if no$indirect then Cm$Xif else 0)+
(if wake$always then Cm$Wkf else 0);
for i := 1 step 1 while i < cm#level do
begin
cm#fdb[i,0] := cm#fdb[i,0]+right(location(cm#fdb[i+1,0]));
cm#fdb[i,2] := memloc(cm#hlp[i]);
end;
CmMHlp := memloc(cm#hlp[cm#level]);
CmMDef := memloc(defz);
ptr := CmPtr;
prepare;
fdbad := location(cm#fdb[1,0]);
start!code "call$mult"
move 1,csbad;
move 2,fdbad;
Comnd;
jump '16,err;
setom minor;
movem 2,cm#int;
movem 2,cm#real;
hrrzm 3,loc;
end "call$mult";
if ison(CmFlg,Cm$Nop) then
begin
err: err!handle;
end;
if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
if ison(CmFlg,Cm$Rpt lor Cm$Nop) then
begin
cm#int := 0;
cm#real := 0.0;
return(0);
end;
row := 1+((loc-location(cm#fdb[1,0])) div 4);
fnc := cm#fdb[row,0] land '777000000000;
if fnc = #CmTok then cm#int := true;
if (fnc = #CmKey) or (fnc = #CmSwi) then
start!code "getindex"
move 2,cm#int;
hrrz 1,0(2);
movem 1,cm#int;
end "getindex";
if fnc = #CmSwi then cm!colon := ison(CmFlg,Cm$Swt);
if fnc = #CmFlt then cm#int := 0 else cm#real := 0;
if (fnc = #CmFld) or (fnc = #CmTxt) or (fnc = #CmAct) or
(fnc = #CmNod) or (fnc = #CmQst) then
begin
cm#int := 0;
cm#str := cm!getatm;
end;
if fnc = #CmUqs then
begin "Get uqs string"
cm#int := 0;
while ptr neq CmPtr do
cm#str := cm#str & ildb(ptr);
end "Get uqs string";
if (fnc = #CmIfi) or (fnc = #CmOfi) or (fnc = #CmFil) then
cm#int := setchan(cm#int,cm!gtbuf[0],0);
if fnc = #CmCma then cm#int := 0;
if (fnc = #CmCfm) or (fnc = #CmNoi) then cm#int := 1;
if fnc = #CmTad and ison(cm#fdb[row,1],Cm$Nci) then cm#int := 0;
return(row);
end "cm#call";
internal integer procedure cm#key
(integer array table;
string help(null);
boolean sup$help(false);
string brchars(null));
COMMENT
This procedure is the multiple fdb counterpart to cm!key
;
begin "CmMKey"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
make!break(cm#level,brchars);
CmMBrk := location(break!tables[cm#level,0]);
CmMFnp := #CmKey+
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0)+
(if sup$help then Cm$Sdh else 0);
CmMDat := location(table[arrinfo(table,1)]);
return(0);
end "CmMKey";
internal integer procedure cm#cfm
(string help(null);
boolean sup$help(false));
COMMENT
This procedure is the multiple fdb counterpart to cm!cfm
;
begin "CmMCfm"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmCfm +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMCfm";
internal integer procedure cm#num
(string help(null);
boolean sup$help(false);
integer radix(10));
COMMENT
This is the multiple fdb counterpart to cm!num
;
begin "CmMNum"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmNum +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmMDat := radix;
return(0);
end "CmMNum";
internal integer procedure cm#noi
(string noise);
COMMENT
This is the multiple fdb counterpart to cm!noi
;
begin "CmMNoi"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#nze[cm#level] := noise&0;
CmMFnp := #CmNoi;
CmMDat := memloc(cm#nze[cm#level]);
return(0);
end "CmMNoi";
internal integer procedure cm#ifi
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!ifi
;
begin "CmMIfi"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmIfi +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmMDat := 0;
return(0);
end "CmMIfi";
internal integer procedure cm#ofi
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!ofi
;
begin "CmMOfi"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmOfi +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmMDat := 0;
return(0);
end "CmMOfi";
internal integer procedure cm#cma
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!cma
;
begin "CmMCma"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmCma +
(if length(help) > 0 then Cm$Hpp else 0)+
(if sup$help then Cm$Sdh else 0);
CmMDat := 0;
return(0);
end "CmMCma";
internal integer procedure cm#swi
(integer array table;
string help(null);
boolean sup$help(false);
string brchars(null));
COMMENT
This is the multiple fdb counterpart to cm!swi
;
begin "CmMSwi"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
make!break(cm#level,brchars);
CmMBrk := location(break!tables[cm#level,0]);
CmMFnp := #CmSwi +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmMDat := location(table[arrinfo(table,1)]);
return(0);
end "CmMSwi";
internal integer procedure cm#fld
(string help(null),
brchars(null));
COMMENT
This is the multiple fdb counterpart to cm!fld
;
begin "CmMFld"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
make!break(cm#level,brchars);
CmMBrk := location(break!tables[cm#level,0]);
CmMFnp := #CmFld +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0);
return(0);
end "CmMFld";
internal integer procedure cm#usr
(string help(null);
boolean sup$help(false),
parse$only(false));
COMMENT
This is the multiple fdb counterpart to cm!usr
;
begin "CmMUsr"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmUsr +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0) +
(if parse$only then Cm$Po else 0);
return(0);
end "CmMUsr";
internal integer procedure cm#dir
(string help(null);
boolean sup$help(false),
allow$wild(false),
parse$only(false));
COMMENT
This is the multiple fdb counterpart to cm!dir
;
begin "CmMDir"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmDir +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0) +
(if parse$only then Cm$Po else 0);
CmMDat := (if allow$wild then Cm$Dwc else 0);
return(0);
end "CmMDir";
internal integer procedure cm#flt
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!flt
;
begin "CmMFlt"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmFlt +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMFlt";
internal integer procedure cm#dev
(string help(null);
boolean sup$help(false);
string brchars(null));
COMMENT
This is the multiple fdb counterpart to cm!dev
;
begin "CmMDev"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
make!break(cm#level,brchars);
CmMBrk := location(break!tables[cm#level,0]);
CmMFnp := #CmDev +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMDev";
internal integer procedure cm#txt
(string help(null);
boolean sup$help(false);
string brchars(null));
COMMENT
This is the multiple fdb counterpart to cm!txt
;
begin "CmMTxt"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
make!break(cm#level,brchars);
CmMBrk := location(break!tables[cm#level,0]);
CmMFnp := #CmTxt +
(if length(brchars) > 0 then Cm$Brk else 0) +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMTxt";
internal integer procedure cm#act
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!act
;
begin "CmMAct"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMFnp := #CmAct +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMAct";
internal integer procedure cm#tok
(string token,
help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!tok;
begin "CmMTok"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
cm#token[cm#level] := token&0;
CmMDat := memory[location(cm#token[cm#level])];
CmMFnp := #CmTok +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMTok";
internal integer procedure cm#fil
(string help(null);
integer flag$gen('440004000000);
string device(null),
directory(null),
name(null),
extension(null),
protection(null),
account(null);
integer jfn(0);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!tok;
begin "CmMFil"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
devz := device&0;
dirz := directory&0;
namz := name&0;
extz := extension&0;
protz := protection&0;
acctz := account&0;
CmMFnp := #CmFil +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
CmMDat := 0;
GjGen := flag$gen;
GjDev := if length(device) > 0 then memloc(devz) else 0;
GjDir := if length(directory) > 0 then memloc(dirz) else 0;
GjNam := if length(name) > 0 then memloc(namz) else 0;
GjExt := if length(extension) > 0 then memloc(extz) else 0;
GjPro := if length(protection) > 0 then memloc(protz) else 0;
GjAct := if length(account) > 0 then memloc(acctz) else 0;
GjJfn := jfn;
return(0);
end "CmMFil";
internal integer procedure cm#nod
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!nod;
begin "CmMNod"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMDat := 0;
CmMFnp := #CmNod +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMNod";
internal integer procedure cm#nux
(string help(null);
boolean sup$help(false);
integer radix(10));
COMMENT
This is the multiple fdb counterpart to cm!nux;
begin "CmMNux"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMDat := radix;
CmMFnp := #CmNux +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMNux";
internal integer procedure cm#tad
(string help(null);
boolean sup$help(false),
date(true),time(true),
no$convert(false));
COMMENT
This is the multiple fdb counterpart to cm!tad;
begin "CmMTad"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMDat := (if date then Cm$Ida else 0) +
(if time then Cm$Itm else 0) +
(if no$convert then Cm$Nci else 0) +
location(cm!datime[2]);
CmMFnp := #CmTad +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMTad";
internal integer procedure cm#uqs
(string brchars,help(null));
COMMENT
This is the multiple fdb counterpart to cm!uqs;
begin "CmMUqs"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help & 0;
make!break(cm#level,brchars);
CmMDat := location(break!tables[cm#level,0]);
CmMFnp := #CmUqs +
(if length(help) > 0 then Cm$Hpp else 0);
return(0);
end "CmMUqs";
internal integer procedure cm#qst
(string help(null);
boolean sup$help(false));
COMMENT
This is the multiple fdb counterpart to cm!qst;
begin "CmMQst"
if cm#level = 10 then return(-1);
cm#level := cm#level+1;
cm#hlp[cm#level] := help&0;
CmMDat := 0;
CmMFnp := #CmQst +
(if length(help) > 0 then Cm$Hpp else 0) +
(if sup$help then Cm$Sdh else 0);
return(0);
end "CmMQst";
end "comnd"