Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/cms.pcl
There are no other files named cms.pcl in the archive.
!
! COPYRIGHT (c) 1982, 1983 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!
COMMAND CMS;
!
! This PCL has been entirely rewritten for implementing version V1.0 on
! TOPS20. The previous PCL was for STEP and many changes have occurred
! since that time.
!
! Each command has the current (as long as it continues to be updated!)
! format including all of the qualifiers.
!
! The PCL documentation that I worked from can be found (on the 20)
! in <DOCUMENTATION>PCL.* . It includes what little documentation there
! is, a mail file, and a notes file. Much of the coding in this module
! becomes more familiar with a careful study of the PARSE command.
!
! Marie McLane - June 7, 1982
begin
integer keyval;
string subcmd;
external procedure excmd, oricmd;
external procedure ann, cop, crcls, crele, dlcls, dlele, dif, fet, hel;
external procedure ini, ins, rem, rep, res, satt, scls, slib;
external procedure shanc, shcla, shdes, shele, unr, ver;
external procedure shgen, shhis, shlib, shres, shver;
Parse(keyword(words
(annotate:1,
copy:2,
create:3,
delete:4,
differences:5,
fetch:6,
help:7,
initialize:8,
insert:9,
remove:10,
replace:11,
reserve:12,
set:13,
show:14,
unreserve:15,
verify:16)):keyval = $value;
otherwise:
parse(eol:
begin
keyval = 0;
subcmd = "cms.exe ";
end;
text:
begin
keyval = 17;
subcmd = "cms" + $atom;
end));
! dispatch to the proper command processor
case keyval from 0 to 17 of
begin
[0]: call excmd(subcmd);
[1]: call ann;
[2]: call cop;
[3]: parse(keyword(words(class:1,
element:2)):
case $value from 1 to 2 of
begin
[1]:call crcls;
[2]:call crele;
end;
otherwise:
begin
parse(field:subcmd = $atom);
subcmd = "cms.exe create " + subcmd;
call excmd(subcmd);
end);
[4]: parse(keyword(words(class:1,
element:2)):
case $value from 1 to 2 of
begin
[1]:call dlcls;
[2]:call dlele;
end;
otherwise:
begin
parse(field:subcmd = $atom);
subcmd = "cms.exe delete " + subcmd;
call excmd(subcmd);
end);
[5]: call dif;
[6]: call fet;
[7]: call hel;
[8]: call ini;
[9]: call ins;
[10]: call rem;
[11]: call rep;
[12]: call res;
[13]: parse(keyword(words(attribute:1,
class:2,
library:3)):
case $value from 1 to 3 of
begin
[1]: call satt;
[2]: call scls;
[3]: call slib;
end;
otherwise:
begin
parse(field:subcmd = $atom);
subcmd = "cms.exe set " + subcmd;
call excmd(subcmd);
end);
[14]: parse(keyword(words(ancestors:1,
class:2,
descendants:3,
element:4,
generation:5,
history:6,
library:7,
reservations:8,
version:9)):
case $value from 1 to 9 of
begin
[1]:call shanc;
[2]:call shcla;
[3]:call shdes;
[4]:call shele;
[5]:call shgen;
[6]:call shhis;
[7]:call shlib;
[8]:call shres;
[9]:call shver;
end;
otherwise:
begin
parse(field:subcmd = $atom);
subcmd = "cms.exe show " + subcmd;
call excmd(subcmd);
end);
[15]: call unr;
[16]: call ver;
[17]: call oricmd(subcmd);
end;
end;
!UTILITY PROCEDURES
PROCEDURE CLNAME(string clsnam);
!
! A class name may be a maximum of 31 characters, the first of
! which must be alphabetic. The remaining characters consist of the
! character set including: A - Z, 0 - 9, "$", ".", "_" .
!
! I realize that the algorithm looks unecessarily tedious, but this part
! took the longest in the whole module. The parse types of TEXT and
! FIELD do not behave like the remainder of the types and therefore had
! to be done the long way around. Specifically, TEXT will include
! EVERYTHING that follows it (I couldn't find a delimiter) and FIELD
! does not seem to move the parse pointer along to allow you to parse
! the next field.
begin
! a class name must begin with at least one alphabetic, if this routine
! was called by genexp then it parsed the first field and clsnam is not
! blank
if clsnam eql "" then
parse(field(help "Class Name"): clsnam = $atom);
part1: ! more may, but doesn't have to follow. Another field CANNOT
! go here, it would have been included in the previous parse.
parse(token "."(help "to continue class name: ",stdhelp):
clsnam = clsnam + ".";
token "_": clsnam = clsnam + "_";
token "$": clsnam = clsnam + "$";
otherwise: goto fin);
part2: ! Again, more may follow. This time FIELD is included because it
! can follow the previous tokens. Also, the tokens may follow each
! other. If a FIELD is detected, we have to go back to part1, if
! another token, the opportunity for a FIELD still exists. In order
! to exit, we go back to part1 and leave through the otherwise.
parse(token "."(help "an alphanumeric, or ",stdhelp):
clsnam = clsnam + ".";
token "_": clsnam = clsnam + "_";
token "$": clsnam = clsnam + "$";
otherwise:
begin
parse(field(help "Class Name"): clsnam = clsnam + $atom);
goto part1;
end);
goto part2;
fin:
end;
PROCEDURE GENEXP(string gennum);
!
! A generation expression can consist of:
!
! 1) a simple integer: 6
!
! 2) a variant generation, a combination of numbers
! and letters, always leading with a number: 4A2B4
!
! 3) a class name, always leading with a letter: VERSION9
!
! 4) any of the above followed by a "+": 4A2B4+, 6+, VERSION9+
! (indicating the latest generation of THAT generation's
! line of descent)
!
!
begin
string chkchr;
integer found, number;
external procedure clname;
gennum = "";
parse(field(help "Generation Expression"): gennum = $atom);
! this generation expression could be either a class name or
! a generation number and either could have more information
! following. In either case, we have to preserve the first
! field that was parsed.
! get the first character, if an integer, it's a generation
! if an alphabetic, it's a class name
chkchr = gennum[1:1];
number = 1;
loop:
found = $search(chkchr,$string(number));
if found neq 0 then
goto fin;
number = number + 1;
if number eql 10 then
goto fin;
goto loop;
fin:
if found eql 0 then ! it's a classname
call clname(gennum);
parse(token "+"(help "plus operator if required"):
gennum = gennum + "+" + " ";
otherwise: nop);
end;
PROCEDURE GETEL (string elname);
!
! Parses the element name where "filename." is required but
! the extension is optional
!
begin
parse(field(help "Element Name"):
begin
elname = " " + $atom;
parse(token ".":elname = elname + ".");
parse(field(help "Extension if required"):elname = elname + $atom;
otherwise:nop);
end);
end;
PROCEDURE GETE2 (string elname, namprt); !Get element and save the name part
!
! Parses the element name where "filename." is required but
! the extension is optional
!
! This routine differs from the previous in that it saves the filename
! in the parameter NAMPRT and returns it for later use in the calling
! routine (currently for building default file names in ANN.
!
begin
parse(field(help "Element Name"):
begin
namprt = $atom;
elname = " " + $atom;
parse(token ".":elname = elname + ".");
parse(field(help "Extension if required"):elname = elname + $atom;
otherwise:nop);
end);
end;
PROCEDURE EXCMD(string commnd); !execute command and exit
begin
! display commnd; Execute the command
docommand commnd;
exit;
end;
PROCEDURE ORICMD(string commnd);
!
! execute the command as the original command bypassing the PCL
!
begin
! display commnd;
docommand original commnd;
exit;
end;
PROCEDURE REQUOT(string qstrng);
! When CMS quoted strings contain embedded ", they must be doubled ("").
! Strings where this occurs are remarks, format strings, notes strings,
! and history strings. BUT, when PCL parses them it reduces the double
! "" to a single ". So this routine converts the singles back to doubles,
! and encloses the entire string in a pair of " ".
!
begin
string nustrg, ! the new string containing doubles
oldstg, ! the old string containing singles
quote; ! the character we're looking for
integer found, ! whether a " exists in the old string
index; ! where to start searching for it
quote = """";
oldstg = qstrng;
nustrg = "";
index = 1;
loop:
found = $search(oldstg,quote,index);
if found = 0 then
goto fin;
nustrg = nustrg + oldstg[index:found-index+1] + """";
index = found + 1;
goto loop;
fin:
nustrg = """" + nustrg + oldstg[index:*] + """";
qstrng = nustrg;
end;
!command processing procedures
PROCEDURE ANN;
!
! CMS ANNOTATE element-name
!
! Qualifiers: /APPEND
! > /NOAPPEND
! > /LOG
! /NOLOG
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /GENERATION
!
begin
string commnd, elname, gennum, filnam, namprt, switchval;
integer annval;
external procedure gete2, genexp, excmd;
commnd = "cms.exe annotate";
elname = "";
loop:
if elname eql "" then
parse(switch(words( append:1,
noappend:2,
log:3,
nolog:4,
output::5,
nooutput:6,
generation::7)):
begin
annval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call gete2(elname, namprt);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words(append:1,
noappend:2,
log:3,
nolog:4,
output::5,
nooutput:6,
generation::7)):
begin
annval = $value;
switchval = $atom;
end;
eol:goto fin);
case annval from 1 to 7 of
begin
[5]: begin
parse(file(help "Output File Name",
parseonly, default_nam namprt, default_ext "ANN" ):filnam=$files);
commnd = commnd + " /output:" + filnam + " ";
end;
[7]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE COP;
!
! CMS COPY ELEMENT old-element-name
! filename.typ [filename.typ ...] "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string commnd, commnt, elname, filenm, switchval;
integer gotone, remflg;
external procedure excmd, getel, requot;
gotone = 0;
remflg = 0;
commnt = "";
!Set up command
commnd = "cms.exe copy ";
parse(keyword(words(element:1)): commnd = commnd + "element ";
otherwise: parse(field:commnd = commnd + $atom));
!Get the element name
Guide "Old Element Name";
parse(eol(help "Old Element Name"): goto fin;
otherwise: call getel(elname));
commnd = commnd + elname + " ";
filenm = "";
loop:
switchval = "";
if gotone eql 0 then !Get the new element name
begin
Guide "First File/New Element Name";
parse(eol(help "First File/New Element Name"): goto fin;
switch(words(log:1,
nolog:2)): switchval = $atom;
otherwise:
begin
call getel(filenm);
commnd = commnd + filenm + " ";
gotone = 1;
end);
end;
if gotone eql 1 then
parse(quotedstring(help "Remark, or another file name if needed"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
switch(words(log:1,
nolog:2)): switchval = $atom;
eol: goto fin;
otherwise:
begin
call getel(filenm);
commnd = commnd + filenm + " ";
end);
if switchval neq "" then
commnd = commnd + "/" + switchval + " ";
goto loop;
fin:
if remflg eql 1 then
begin
parse(eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
call excmd(commnd);
exit;
end;
PROCEDURE CRCLS;
!
! CMS CREATE CLASS class-name "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string clsnam, commnd, commnt, switchval;
integer remflg;
external procedure clname, excmd, requot;
commnd = "cms.exe create class ";
clsnam = "";
remflg = 0;
loop:
switchval = "";
if clsnam eql "" then
parse(switch(words(log:1,
nolog:2)): switchval = $atom;
eol(help "Class Name"): goto fin;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words( log:1,
nolog:2)): switchval = $atom;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol:goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop ;
fin:
!Assemble the command
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE CRELE;
!
! CMS CREATE ELEMENT filename.typ
! [,filename.typ ... ] "remark"
!
! Command Qualifiers:
! /KEEP
! > /NOKEEP
! > /LOG
! /NOLOG
! /RESERVE
! > /NORESERVE
! File Qualifiers:
! /HISTORY:"string"
! > /NOHISTORY
! /NOTES:"string"
! > /NONOTES
! /POSITION:n
!
begin
string commnd, commnt, elname, hisstg, notstg, posnum, switchval;
integer comval, gotone, remflg;
external procedure getel, excmd, requot;
remflg = 0;
elname = "";
gotone = 0;
!Start to assemble the command line
commnd = "cms.exe create element ";
loop:
switchval = "";
comval = 0;
if elname eql "" then
parse(switch(words(keep:1,
nokeep:2,
log:3,
nolog:4,
reserve:5,
noreserve:6)):
begin
comval = $value;
switchval = $atom;
end;
eol(help "A file name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + " " + elname + " ";
gotone = 1;
end);
if elname neq "" then
parse(switch(help "Another file name, or",stdhelp,
words(
keep:1,
nokeep:2,
log:3,
nolog:4,
reserve:5,
noreserve:6,
history::7,
nohistory:8,
notes::9,
nonotes:10,
position::11)):
begin
comval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
eol:goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + " " + elname + " ";
end);
case comval from 0 to 11 of
begin
[0]: nop;
[7]: begin
parse(quotedstring(help "History format"):hisstg = $atom);
call requot(hisstg);
commnd = commnd + "/history:" + hisstg + " ";
end;
[9]: begin
parse(quotedstring(help "Note format"): notstg = $atom);
call requot(notstg);
commnd = commnd + "/notes:" + notstg + " ";
end;
[11]: begin
parse(number(help "Column number"): posnum = $atom);
commnd = commnd + "/position:" + posnum + " ";
end;
[INRANGE]: commnd = commnd + "/" + switchval + " ";
end;
goto loop;
fin:
if remflg eql 1 then !finish the command line (only put on comment if one exists)
begin
parse(eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
call excmd(commnd); !Now execute the command
end;
PROCEDURE DIF;
!
! CMS DIFFERENCES file1 file2
!
! Qualifiers: /APPEND
! > /NOAPPEND
! > /LOG
! /NOLOG
! /OUTPUT:file3
! > /NOOUTPUT
! /PARALLEL
! > /NOPARALLEL
! /WIDTH:n
!
begin
string commnd, widnum, filnam, namprt, switchval;
integer difval, gotfiles;
external procedure excmd;
filnam = "";
gotfiles = 0;
commnd = "cms.exe differences ";
loop:
switchval = "";
if gotfiles lss 2 then
parse(eol(help ""): goto fin;
file(help "A File Name"):
begin
filnam = $filel;
commnd = commnd + filnam + " ";
gotfiles = gotfiles + 1;
if gotfiles eql 1 then
namprt = $file_nam($parse);
goto loop;
end;
switch(words(append:1,
noappend:2,
log:3,
nolog:4,
output::5,
nooutput:6,
parallel:7,
noparallel:8,
width::9)):
begin
difval = $value;
switchval = $atom;
end);
if gotfiles geq 2 then
parse(switch(words(append:1,
noappend:2,
log:3,
nolog:4,
output::5,
nooutput:6,
parallel:7,
noparallel:8,
width::9)):
begin
difval = $value;
switchval = $atom;
end;
eol: goto fin);
case difval from 1 to 9 of
begin
[5]: begin
parse(file(help "Output File Name", default_nam namprt,
default_ext "DIF"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[9]: begin
parse(number(help "Column Width"):widnum = $atom);
commnd = commnd + " /width:" + widnum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE DLCLS;
!
! CMS DELETE CLASS class-name "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string clsnam, commnd, commnt, switchval;
integer remflg;
external procedure clname, excmd, requot;
! Begin to assemble the command string
commnd = "cms.exe delete class ";
clsnam = "";
remflg = 0;
loop:
switchval = "";
if clsnam eql "" then
parse(eol(help "Class Name"): goto fin;
switch(words( log:1,
nolog:2)): switchval = $atom;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words( log:1,
nolog:2)): switchval = $atom;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol:goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop ;
fin:
if remflg = 1 then
begin
parse(eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE DLELE;
!
! CMS DELETE ELEMENT /ALL element-name "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string commnd, commnt, elname, switchval;
integer remflg;
external procedure getel, excmd, requot;
elname = "";
remflg = 0;
commnd = "cms.exe delete element ";
loop:
switchval = "";
if elname eql "" then
parse (switch(words(log:1,
nolog:2,
all:3)): switchval = $atom;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse( switch(words(log:1,
nolog:2,
all:3)): switchval = $atom;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol: goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!Assemble the command
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE FET;
!
! CMS FETCH element-name "remark"
!
! Qualifiers:
! /GENERATION
! /MERGE
! > /NOMERGE
! /NOHISTORY
! > /LOG
! /NOLOG
! /NONOTES
!
begin
string commnd, commnt, elname, gennum, filnam, mrgnum, switchval;
integer fetval, remflg;
external procedure genexp, getel, excmd, requot;
commnd = "cms.exe fetch ";
elname = "";
loop:
switchval = "";
if elname eql "" then
parse(switch(words(merge::1,
generation::2,
nohistory:3,
nonotes:4,
log:5,
nolog:6,
nomerge:7)):
begin
fetval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname;
end);
if elname neq "" then
parse(switch(words(merge::1,
generation::2,
nohistory:3,
nonotes:4,
log:5,
nolog:6,
nomerge:7)):
begin
fetval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
eol: goto fin);
case fetval from 1 to 7 of
begin
[1]: begin
call genexp(mrgnum);
commnd = commnd + " /merge:" + mrgnum + " ";
end;
[2]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
if remflg eql 1 then ! Only append comment if one exists
begin
parse(eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE HEL;
!
! Help for CMS is provided with the on-line help system,
! accessed by HELP CMS.
!
begin
parse(eol);
display "Please use HELP CMS";
exit;
end;
PROCEDURE INI;
!
! CMS INITIALIZE directory-spec "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string commnd, commnt, dirspc, switchval;
integer remflg;
external procedure excmd, requot;
commnd = "cms.exe initialize ";
dirspc = "";
loop:
switchval = "";
if dirspc eql "" then
parse(eol (help ""): goto fin;
switch(words(log:1,
nolog:2)): switchval = $atom;
directory(parseonly,help "Directory"):
begin
dirspc = $atom;
commnd = commnd + dirspc + " ";
end);
if dirspc neq "" then
parse(switch(words(log:1,
nolog:2)): switchval = $atom;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol:goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!assemble the command
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE INS;
!
! CMS INSERT element-name class-name "remark"
!
! Qualifiers:
! /IF-ABSENT
! > /LOG
! /NOLOG
! /SUPERSEDE
! > /NOSUPERSEDE
! /GENERATION
!
begin
string clsnam, commnd, commnt, elname, gennum, filnam, switchval;
integer insval, remflg;
external procedure clname, genexp, getel, excmd, requot;
clsnam = "";
elname = "";
commnd = "cms.exe insert ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( generation::1,
if_absent:2,
log:3,
nolog:4,
supersede:5,
nosupersede:6)):
begin
insval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
begin
if clsnam eql "" then
parse(switch(words( generation::1,
if_absent:2,
log:3,
nolog:4,
supersede:5,
nosupersede:6)):
begin
insval = $value;
switchval = $atom;
end;
eol(help "Class Name"): goto fin;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words( generation::1,
if_absent:2,
log:3,
nolog:4,
supersede:5,
nosupersede:6)):
begin
insval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol : goto fin);
end;
case insval from 1 to 6 of
Begin
[1]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE REM;
!
! CMS REMOVE element-name class-name "remark"
!
! Qualifiers: /IF-PRESENT
! > /LOG
! /NOLOG
!
begin
string clsnam, commnd, commnt, elname, gennum, filnam, switchval;
integer remflg;
external procedure clname, getel, excmd, requot;
elname = "";
commnd = "cms.exe remove ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words(if_present:1,
log:2,
nolog:3)): switchval = $atom;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
begin
if clsnam eql "" then
parse(eol(help "Class Name"): goto fin;
switch(words(if_present:1,
log:2,
nolog:3)): switchval = $atom;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words(if_present:1,
log:2,
nolog:3)): switchval = $atom;
quotedstring(help "Remark"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
eol:goto fin);
end;
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE REP;
!
! CMS REPLACE element-name "remark"
!
! Qualifiers: /KEEP
! > /NOKEEP
! > /LOG
! /NOLOG
! /RESERVE
! > /NORESERVE
! /VARIANT:variant-letter
! > /NOVARIANT
!
begin
string commnd, commnt, elname, switchval, varnum;
integer repval, remflg;
external procedure getel, excmd, requot;
remflg = 0;
elname = "";
commnd = "cms.exe replace ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( keep:1,
nokeep:2,
log:3,
nolog:4,
reserve:5,
noreserve:6,
variant::7,
novariant::8)):
begin
repval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
goto loop;
end);
if elname neq "" then
parse(switch(words( keep:1,
nokeep:2,
log:3,
nolog:4,
reserve:5,
noreserve:6,
variant::7,
novariant::8)):
begin
repval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
eol : goto fin);
case repval from 1 to 8 of
begin
[7]: begin
parse(field(help "Variant letter"):varnum = $atom);
commnd = commnd + " /variant:" + varnum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE RES;
!
! CMS RESERVE element-name "remark"
!
! Qualifiers: /GENERATION
! /NOHISTORY
! > /LOG
! /NOLOG
! /MERGE
! > /NOMERGE
! /NONOTES
!
begin
string commnd, commnt, elname, gennum, mrgnum, switchval;
integer resval, remflg;
external procedure genexp, getel, excmd, requot;
elname = "";
commnd = "cms.exe reserve ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( generation::1,
nohistory:2,
log:3,
nolog:4,
merge::5,
nomerge::6,
nonotes:7)):
begin
resval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
goto loop;
end);
if elname neq "" then
parse(switch(words( generation::1,
nohistory:2,
log:3,
nolog:4,
merge::5,
nomerge::6,
nonotes:7)):
begin
resval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol : goto fin);
case resval from 1 to 7 of
begin
[1]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[5]: begin
call genexp(mrgnum);
commnd = commnd + " /merge:" + mrgnum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
call requot(commnt);
commnd = commnd + " " + commnt;
parse(eol);
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SATT;
!
! CMS SET ATTRIBUTE filename.typ "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
! /HISTORY
! > /NOHISTORY
! /NOTES:"string"
! > /NONOTES
! /POSITION:n
!
begin
string commnd, commnt, elname, hisstg, notstg, posnum, switchval;
integer satval, remflg;
external procedure getel, excmd, requot;
remflg = 0 ;
elname = "";
commnd = "cms.exe set attribute ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words(history::1,
nohistory:2,
nonotes:3,
notes::4,
position::5,
log:6,
nolog:7)):
begin
satval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words( history::1,
nohistory:2,
nonotes:3,
notes::4,
position::5,
log:6,
nolog:7)):
begin
satval = $value;
switchval = $atom;
end;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol : goto fin);
case satval from 1 to 7 of
begin
[1]: begin
parse(quotedstring(help "History string"):hisstg = $atom);
call requot(hisstg);
commnd = commnd + " /history:" + hisstg + " ";
end;
[4]: begin
parse(quotedstring(help "Note string"):notstg = $atom);
call requot(notstg);
commnd = commnd + " /notes:" + notstg + " ";
end;
[5]: begin
parse(number(help "Column number"):posnum = $atom);
commnd = commnd + " /position:" + posnum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
call requot(commnt);
parse (eol);
commnd = commnd + " " + commnt;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SCLS;
!
! CMS SET CLASS classname /[NO]READ-ONLY "remark"
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string commnd, commnt, clsnam, switchval;
integer remflg;
external procedure getel, clname, excmd, requot;
remflg = 0 ;
clsnam = "";
commnd = "cms.exe set class ";
loop:
switchval = "";
if clsnam eql "" then
parse(switch(words( read_only:1,
noread_only:2,
log:3,
nolog:4)): switchval = $atom;
eol(help "Class Name"): goto fin;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words( read_only:1,
noread_only:2,
log:3,
nolog:4)): switchval = $atom;
quotedstring(help "Remark"):
begin
commnt = $atom;
remflg = 1;
goto fin;
end;
eol : goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!assemble the command line
if remflg eql 1 then
begin
parse (eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SLIB;
!
! CMS SET LIBRARY directory-spec
!
! Qualifiers:
! > /LOG
! /NOLOG
!
begin
string commnd, dirspc, switchval;
external procedure excmd;
commnd = "cms.exe set library ";
dirspc = "";
loop:
switchval = "";
if dirspc eql "" then
parse(eol(help ""): goto fin;
switch(words(log:1,
nolog:2)): switchval = $atom;
directory(parseonly,help "Directory"):
begin
dirspc = $atom;
commnd = commnd + dirspc + " ";
end);
if dirspc neq "" then
parse(switch(words(log:1,
nolog:2)): switchval = $atom;
eol:goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHANC;
!
! CMS SHOW ANCESTORS element-name
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /CLASS
! > /NOCLASS
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /FROM:generation expression
! /GENERATION
!
begin
string commnd, elname, fronum, gennum, filnam, switchval;
integer shaval;
external procedure genexp, getel, excmd;
elname = "";
commnd = "cms.exe show ancestors ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( append:1,
noappend:2,
class:3,
noclass:4,
from::5,
generation::6,
log:7,
nolog:8,
output::9,
nooutput:10)):
begin
shaval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words(append:1,
noappend:2,
class:3,
noclass:4,
from::5,
generation::6,
log:7,
nolog:8,
output::9,
nooutput:10)):
begin
shaval = $value;
switchval = $atom;
end;
eol:goto fin);
case shaval from 1 to 10 of
begin
[5]: begin
guide "From";
call genexp(fronum);
commnd = commnd + " /from:" + fronum + " ";
end;
[6]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[9]: begin
parse(file(help "Output file", parseonly, default_nam "SHOW", default_ext "SHO"):filnam=$files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHCLA;
!
! CMS SHOW CLASS [class-name]
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /OUTPUT[:filespec]
! > /NOOUTPUT
!
begin
string commnd, clsnam, filnam, switchval;
integer shaval;
external procedure clname, excmd;
clsnam = "";
commnd = "cms.exe show class ";
loop:
switchval = "";
if clsnam eql "" then
parse(switch(help "Class Name, or", stdhelp,
words(append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin;
otherwise:
begin
call clname(clsnam);
commnd = commnd + clsnam + " ";
end);
if clsnam neq "" then
parse(switch(words( append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol:goto fin);
case shaval from 1 to 4 of
begin
[3]: begin
parse(file(help "Output file",parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHDES;
!
! CMS SHOW DESCENDANTS element name
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /CLASS
! > /NOCLASS
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /GENERATION
!
begin
string commnd, elname, gennum, filnam, switchval;
integer shaval;
external procedure genexp, getel, excmd;
elname = "";
commnd = "cms.exe show descendants";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( append:1,
noappend:2,
class:3,
noclass:4,
generation::5,
output::6,
nooutput:7)):
begin
shaval = $value;
switchval = $atom;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words( append:1,
noappend:2,
class:3,
noclass:4,
generation::5,
output::6,
nooutput:7)):
begin
shaval = $value;
switchval = $atom;
end;
eol:goto fin) ;
case shaval from 1 to 7 of
begin
[5]: begin
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[6]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHELE;
!
! CMS SHOW ELEMENT [element-name or *.*]
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /FORMAT:"string"
! > /NOFORMAT
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /GENERATION:class-name (w/ *.*)
!
begin
string commnd, elname, fornum, gennum, filnam, switchval;
integer shaval, genflg, wldflg;
external procedure genexp, getel, excmd, requot;
genflg = 0;
wldflg = 0;
elname = "" ;
commnd = "cms.exe show element ";
loop:
switchval = "";
if elname eql "" then
parse(switch(help "Element Name, or",stdhelp,
words( append:1,
noappend:2,
format::3,
noformat::4,
generation::5,
output::6,
nooutput:7)):
begin
shaval = $value;
switchval = $atom;
end;
token "*.*":
begin
elname = "*.*";
wldflg = 1;
commnd = commnd + elname + " ";
goto loop;
end;
eol: goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname+ " ";
goto loop;
end);
if elname neq "" then
parse(switch(words( append:1,
noappend:2,
format::3,
noformat::4,
generation::5,
output::6,
nooutput:7)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
case shaval from 1 to 7 of
begin
[3]: begin
parse(quotedstring(help "Format specification"):
fornum = $atom);
call requot(fornum);
commnd = commnd + " /format:" + fornum + " ";
end;
[5]: begin
genflg = 1;
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[6]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
! check for syntax
if genflg eql 1 then
if wldflg eql 0 then
begin
display "*.* is required with /GENERATION";
exit;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHGEN;
!
! CMS SHOW GENERATION element-name
!
! CMS SHOW GENERATION *.* /BRIEF /GENERATION:class-name
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /BRIEF
! /CLASS
! > /NOCLASS
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /GENERATION:generation expression
!
begin
string commnd, elname, gennum, filnam, switchval;
integer shaval, briflg, genflg, wldflg;
external procedure genexp, getel, excmd;
briflg = 0;
genflg = 0;
wldflg = 0;
elname = "";
commnd = "cms.exe show generation ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( append:1,
noappend:2,
brief:3,
class:4,
noclass:5,
generation::6,
output::7,
nooutput::8)):
begin
shaval = $value;
switchval = $atom;
end;
token "*.*":
begin
elname = "*.*";
commnd = commnd + elname + " ";
wldflg = 1;
goto loop;
end;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words( append:1,
noappend:2,
brief:3,
class:4,
noclass:5,
generation::6,
output::7,
nooutput::8)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
Case shaval from 1 to 8 of
begin
[3]: begin
commnd = commnd + " /brief ";
briflg = 1;
end;
[6]: begin
genflg = 1;
call genexp(gennum);
commnd = commnd + " /generation:" + gennum + " ";
end;
[7]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
! Check for required qualifier
if wldflg eql 1 then
begin
if briflg eql 0 then
begin
display "/BRIEF and /GENERATION: are required with *.*";
exit;
end;
if genflg eql 0 then
begin
display "/BRIEF and /GENERATION: are required with *.*";
exit;
end;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHHIS;
!
! CMS SHOW HISTORY [element-name]
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /OUTPUT[:filespec]
! > /NOOUTPUT
! /SINCE:date
! /UNUSUAL
! > /NOUNUSUAL
!
begin
string commnd, elname, datnum, filnam, switchval;
integer shaval;
external procedure getel, excmd;
commnd = "cms.exe show history ";
elname = "";
loop:
if elname eql "" then
parse(switch(help "Element Name, or",stdhelp,
words( append:1,
noappend:2,
output::3,
nooutput:4,
since::5,
unusual:6,
nounusual:7)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
goto loop;
end);
if elname neq "" then
parse(switch(words( append:1,
noappend:2,
output::3,
nooutput:4,
since::5,
unusual:6,
nounusual:7)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
case shaval from 1 to 7 of
begin
[3]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[5]: begin
parse(daytime(date):datnum = $atom);
commnd = commnd + " /since:" + datnum + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHLIB;
!
! CMS SHOW LIBRARY
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /OUTPUT[:filespec]
! > /NOOUTPUT
!
Begin
string commnd, filnam, switchval;
integer shaval;
external procedure excmd;
commnd = "cms.exe show library ";
loop:
switchval = "";
parse(switch(words(append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
case shaval from 1 to 4 of
begin
[3]: begin
parse(file(help "Output file",parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHRES;
!
! CMS SHOW RESERVATIONS [element-name]
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /OUTPUT[:filespec]
! > /NOOUTPUT
!
begin
string commnd, elname, filnam, switchval;
integer shaval;
external procedure getel, excmd;
elname = "";
commnd = "cms.exe show reservations ";
loop:
switchval = "";
if elname = "" then
parse(switch(help "Element Name, or",stdhelp,
words(append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
goto loop;
end);
if elname neq "" then
parse(switch(words(append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
case shaval from 1 to 4 of
begin
[3]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE SHVER;
!
! CMS SHOW VERSION
!
! Qualifiers:
! /APPEND
! > /NOAPPEND
! /OUTPUT[:filespec]
! > /NOOUTPUT
!
begin
string commnd, filnam, switchval;
integer shaval;
external procedure excmd;
commnd = "cms.exe show version ";
loop:
switchval = "";
parse(switch(words(append:1,
noappend:2,
output::3,
nooutput:4)):
begin
shaval = $value;
switchval = $atom;
end;
eol: goto fin);
case shaval from 1 to 4 of
begin
[3]: begin
parse(file(help "Output file", parseonly,
default_nam "SHOW", default_ext "SHO"):filnam = $files);
commnd = commnd + " /output:" + filnam + " ";
end;
[INRANGE]: commnd = commnd + " /" + switchval + " ";
end;
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;
PROCEDURE UNR;
!
! CMS UNRESERVE element-name "remark"
!
! Qualifiers:
! /DELETE
! > /NODELETE
! > /LOG
! /NOLOG
!
begin
string commnd, commnt, elname, switchval;
integer remflg;
external procedure getel, excmd, requot;
remflg = 0;
elname = "";
commnd = "cms.exe unreserve ";
loop:
switchval = "";
if elname eql "" then
parse(switch(words( delete:1,
nodelete:2,
log:3,
nolog:4)): switchval = $atom;
eol(help "Element Name"): goto fin;
otherwise:
begin
call getel(elname);
commnd = commnd + elname + " ";
end);
if elname neq "" then
parse(switch(words( delete:1,
nodelete:2,
log:3,
nolog:4)): switchval = $atom;
quotedstring(help "Remark"):
begin
remflg = 1;
commnt = $atom;
goto fin;
end;
eol : goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
if remflg eql 1 then
begin
parse(eol);
call requot(commnt);
commnd = commnd + " " + commnt;
end;
!Now execute the command
call excmd(commnd);
end;
PROCEDURE VER;
!
! CMS VERIFY
!
! Qualifiers:
! > /LOG
! /NOLOG
! /RECOVER
! > /NORECOVER
! /REPAIR
! > /NOREPAIR
!
begin
string commnd, switchval;
external procedure excmd;
commnd = "cms.exe verify ";
loop:
switchval = "";
parse(switch(words(log:1,
nolog:2,
recover:3,
norecover:4,
repair:5,
norepair:6)): switchval = $atom;
eol: goto fin);
if switchval neq "" then
commnd = commnd + " /" + switchval + " ";
goto loop;
fin:
!Now execute the command
call excmd(commnd);
end;