Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0110/prcwrk.sai
There are 2 other files named prcwrk.sai in the archive. Click here to see a list.
Entry;
COMMENT
.SOSPAGE_1
.SEC(PRCWRK - PROC10 worker routine support package)
.index(PRCWRK - PROC10 worker routine support package)
.;
Begin "PRCWRK.SAI"
COMMENT
P. LEMKIN, B. SHAPIRO, R. GORDON, L. LIPKIN
IMAGE PROCESSING UNIT
DIVISION OF CANCER BIOLOGY AND DIAGNOSIS
NATIONAL CANCER INSTITUTE
NATIONAL INSTITUTES OF HEALTH
BETHESDA, MD 20014
301-496-2394
Revised May 25, 1976 - Lemkin, fix GET!BOUNDARY props field
Revised May 21, 1976 - Lemkin, fix DEL!(PIX, BOUNDARY)
Revised May 19, 1976 - Lemkin, make GET!BOUNDARY SAFE
Revised May 17, 1976 - Lemkin, increased args to SIP6
Revised April 27, 1976 - Lemkin, only DEL!OMNI on Pi, Bi if exists
Revised April 23, 1976 - Lemkin, Shapiro fixing GET!BOUNDARY
Revised April 20, 1976 - Shapiro fixing sips for CIRCLET
Revised April 12, 1976 - Lemkin, Shapiro GET!OMNI!NUMBER
Revised April 9, 1976 - Lemkin GET!OMNI!NUMBER
Revised April 10, 1976 - Lemkin GET/DEL!OMNI!NUMBER
Revised April 7, 1976 - Lemkin DEL!OMNI!NUMBER
Revised April 6, 1976 - Lemkn GET!TRANSFORM
Revised March 30, 1976 - Lemkin DEL!TRANSFORM deletes
transform type triple
Revised March 26, 1976 - Lemkin added GET!TRANSFORM/DEL!TRANSFORM
;
COMMENT
.next page
.SS(REQUIRE files)
.INDEX(REQUIRE files)
.;
Comment
" ================================"
" = R E Q U I R E ="
" ================================"
" The following files are required for use by PROC10.
They all reside in the Image Processing Unit's common user area
";
Comment Permanent REQ's;
Require "DEFINE.REQ" source!file;
Require "SYS:DISPRM.SAI" source!file;
Require "PPAK.REQ" source!file;
Require "BOUND.REQ" source!file;
Require "PRCMAX.REQ" source!file;
Require "PRCINV.REQ" source!file;
COMMENT
.next page
.SS(Procedure START!TIMER)
.INDEX(Procedure START!TIMER)
.;
Internal Procedure START!TIMER ;
"----------------------------------------"
Begin "START!TIMER"
If not tim!switch Then return;
smsg_"START!TIMER";
DEBUG(smsg);
"Remember the current times"
t!runtime_call(0,"MSTIME");
t!cputime_call(0,"RUNTIM");
End "START!TIMER";
COMMENT
.next page
.SS(Procedure STOP!TIMER)
.INDEX(Procedure STOP!TIMER)
.;
Internal Procedure STOP!TIMER ;
"----------------------------------------"
Begin "STOP!TIMER"
Integer p,q;
Real run,cpu;
Getformat(p,q);
Setformat(0,3);
If not tim!switch Then return;
smsg_"STOP!TIMER";
DEBUG(smsg);
outstr("Real TIME =" &
CVG(run_(call(0,"MSTIME")-t!runtime)/1000) &
" SECONDS" & crlf);
outstr("CPU TIME =" & CVG(cpu_(call(0,"RUNTIM")-t!cputime)/1000) &
" SECONDS, " & CVF((cpu/run)*100.0) & "%" & crlf);
Setformat(p,q);
End "STOP!TIMER";
COMMENT
.next page
.SS(Procedure GET!IMAGE)
.INDEX(Procedure GET!IMAGE)
;
Internal Integer Array Itemvar Procedure GET!IMAGE(String pix!name);
Begin "GET!IMAGE"
String ss;
" Return the item of the picture corresponding to the
named image if it exists, also return with the picture index in
p!index. If it is not legal then return the item NONE."
" check if Pi exists"
pix!name_GUESSER(pix!name,lgl!pnames);
If Equ(pix!name,null) Then
Begin "Bad pix"
Outstr("Bad picture name:"&pix!name&crlf);
" return the false item"
Return (none);
End "Bad pix";
" get the pix index"
p!index_Intscan((ss_pix!name[2 to inf]),flag);
" lookup the item (to see if used before)."
iname_CVSI(pix!name,flag);
" Create an image for the legal pix name since
the image does not exist so far."
If flag Then
Begin "create image"
iname_PMAKIMAGE(pix!name);
pix!in!use[p!index]_true;
pix!title[p!index]_null;
End "create image";
Return (iname);
End "GET!IMAGE";
COMMENT
.next page
.SS(Procedure GET!MASK)
.INDEX(Procedure GET!MASK)
.;
Internal Integer Array Itemvar Procedure GET!MASK(String mask!name);
Begin "GET!MASK"
String ss;
Integer i;
" Return the item of the picture corresponding to the
named MASK if it exists, also return with the picture index in
m!index. If it is not legal then return the item NONE."
" check if Pi exists"
mask!name_GUESSER(mask!name,lgl!mnames);
If Equ(mask!name,null) Then
Begin "Bad mask"
Outstr("Bad picture name:"&mask!name&crlf);
" return the false item"
Return (none);
End "Bad mask";
" get the mask index"
m!index_Intscan((ss_mask!name[2 to inf]),flag);
" lookup the item (to see if used before)."
iname_CVSI(mask!name,flag);
" Create an MASK for the legal mask name since
the MASK does not exist so far."
If flag Then
Begin "create MASK"
iname_PMAKMASK(mask!name);
mask!in!use[m!index]_true;
mask!title[m!index]_null;
End "create MASK"
Else
If imsiz neq
(i_Sqrt(36*(ARRINFO(Datum(iname),0)-1)))-1
Then
Begin "wrong size"
Outstr("Wrong mask size "&CVS(i)&crlf);
Return(none);
End "wrong size";
Return (iname);
End "GET!MASK";
COMMENT
.next page
.SS(Procedure GET!BOUNDARY)
.INDEX(Procedure GET!BOUNDARY)
.;
Internal Integer Array Itemvar Procedure
GET!BOUNDARY(String boundary!name);
Begin "GET!BOUNDARY"
String ss;
Integer ibsave;
Safe Integer Array ib[0:1023];
" Return the item of the corresponding to the
named BOUNDARY if it exists, also return with the index in
b!index. If it is not legal then return the item NONE."
" check if Bi exists"
boundary!name_GUESSER(boundary!name,lgl!bnames);
If Equ(boundary!name,null) Then
Begin "Bad BOUNDARY"
Outstr("Bad boundary name:"&boundary!name&crlf);
" return the false item"
Return (none);
End "Bad BOUNDARY";
" get the BOUNDARY index"
ibsave_1;
For b!index_1 step 1 until max!number!boundaries Do
If Equ(boundary!name,(ss_lgl!bnames[b!index]))
Then Done
Else
If ss=null and ibsave neq 1
Then ibsave_b!index;
If b!index=max!number!boundaries
Then
b!index_ibsave;
" lookup the item (to see if used before)."
iname_CVSI(boundary!name,flag);
" Create an BOUNDARY for the legal BOUNDARY name since
the BOUNDARY does not exist so far."
If flag Then
Begin "create BOUNDARY"
iname_NEW(ib);
New!pname(iname,boundary!name);
PROPS(iname)_0;
bnd!in!use[b!index]_true;
bnd!title[b!index]_null;
End "create BOUNDARY";
Return (iname);
End "GET!BOUNDARY";
COMMENT
.next page
.SS(Procedure GET!TRANSFORM)
.INDEX(Procedure GET!TRANSFORM)
.;
Internal Real Array Itemvar Procedure
GET!TRANSFORM(String t!name);
Comment
Note the number of coefficients in a transform is
stored in the PROPS field of the transform datum. This is put
in the PROPS field by BINTRP.;
Begin "GET!TRANSFORM"
String ss;
Real Array b[0:1024];
" Return the item of the corresponding to the
named TRANSFORM if it exists, also return with the index in
t!index. If it is not legal then return the item NONE."
" check if Ti exists"
t!name_GUESSER(t!name,lgl!tnames);
If Equ(t!name,null) Then
Begin "Bad TRANSFORM"
Outstr("Bad transform name:"&t!name&crlf);
" return the false item"
Return (none);
End "Bad TRANSFORM";
" get the TRANSFORM index"
For t!index_1 step 1 until max!number!boundaries Do
If Equ(t!name,lgl!tnames[t!index])
Then Done;
" lookup the item (to see if used before)."
iname_CVSI(t!name,flag);
" Create an TRANSFORM for the legal TRANSFORM name since
the TRANSFORM does not exist so far."
If flag Then
Begin "create TRANSFORM"
iname_NEW(b);
New!pname(iname,t!name);
trn!in!use[t!index]_true;
trn!title[t!index]_null;
End "create TRANSFORM";
Return (iname);
End "GET!TRANSFORM";
COMMENT
.next page
.SS(Procedure GET!OMNI!NUMBER)
.INDEX(Procedure GET!OMNI!NUMBER)
.;
Internal Integer Procedure
GET!OMNI!NUMBER(String omni!name);
Begin "GET!OMNI!NUMBER"
Itemvar iv!name,iv!omni!number;
Integer i;
" Return the OMNI number corresponding to the string
argument. If none exists, create one and enter the string in
the item list omni!active. If the omni!free list is empty then
return 0"
" lookup the item (to see if used before)."
iv!name_CVSI(omni!name,flag);
If flag or omni!name=null
Then
Begin "Bad OMNI!number"
Outstr("Bad name:"&omni!name&crlf);
" return the false number"
Return (0);
End "Bad OMNI!number";
If omni!free=PHI
Then
Begin "Blew OMNI numbers"
Outstr("OMNI free store empty!"&crlf);
Return(0);
End "Blew OMNI numbers";
" item exists, look it up in omni!active list"
If a!active XOR iv!name EQV Bind iv!omni!number
Then
Begin "Lookup"
i_PROPS(iv!omni!number);
Return(i);
End "Lookup";
" It is ok, return new number"
iv!omni!number_Lop(omni!free);
Put iv!omni!number in omni!active;
Make a!active Xor iv!name Eqv iv!omni!number;
i_PROPS(iv!omni!number);
Return(i);
End "GET!OMNI!NUMBER";
COMMENT
.next page
.SS(Procedure DEL!OMNI!NUMBER)
.INDEX(Procedure DEL!OMNI!NUMBER)
.;
Internal Boolean Procedure DEL!OMNI!NUMBER (String S);
"----------------------------------------"
Begin "DEL"
Integer i;
Itemvar iv!name,iv!omni!number;
String sss,ss;
" test for output OMNI name and try and delete it"
iv!name_CVSI(s,flag);
If flag or not(
a!active Xor iv!name Eqv Bind iv!omni!number)
Then Begin "not OMNI name"
OUTSTR(s&" does not have an OMNI name!"
&crlf);
Return(true);
End "not OMNI name";
If iv!name In omni!post or iv!name In omni!unpost
Then
DKILL(PROPS(iv!omni!number));
Remove iv!omni!number From omni!active;
Remove iv!name From omni!post;
Remove iv!name From omni!unpost;
Remove ALL iv!name From movie;
Put iv!omni!number In omni!free;
Erase a!active Xor iv!name Eqv iv!omni!number;
Return (false);
End "DEL";
COMMENT
.next page
.SS(Procedure DEL!PIX)
.INDEX(Procedure DEL!PIX)
.;
Internal Boolean Procedure DEL!PIX (String S);
"----------------------------------------"
Begin "DEL"
Own Boolean ok;
Itemvar
p!item,
b!item,
s!item;
String sss,ss;
smsg_"DELETE <Pi picture name>";
If db neq 0
Then
Begin "print debug"
Outstr(smsg&crlf);
If db=2 Then Return (false);
End "print debug";
If not Equ(cmd,"DELETE")
Then
Begin "Ask if delete"
LBOUND(ok,"Delete pix?","Delete pix?");
If not ok Then Return (true);
End "Ask if delete";
" also delete omni number"
p!item_CVSI(s,flag);
" Delete segment triple Pi*Bq=seglist if exists"
If p!item XOR Bind b!item EQV Bind s!item
Then
Begin "Kill it"
Erase p!item XOR b!item EQV s!item;
Delete(s!item);
End "Kill it";
If not flag And (p!item In omni!post Or p!item In omni!unpost)
Then
DEL!OMNI!NUMBER(s);
" test for output picture name and try and delete it"
If Equ((sss_GUESSER(s,lgl!pnames)),null) or
PDELIMAGE(s)
Then Begin "not pix name"
OUTSTR(s&" is not a picture name!"&crlf);
Return (true);
End "not pix name";
" get the pix index"
p!index_Intscan((ss_sss[2 to inf]),flag);
pix!in!use[p!index]_false;
" deactivate the title"
pix!title[p!index]_null;
Return (false);
End "DEL";
COMMENT
.next page
.SS(Procedure DEL!MASK)
.INDEX(Procedure DEL!MASK)
.;
Internal Boolean Procedure DEL!MASK (String S);
"----------------------------------------"
Begin "DEL"
Own Boolean ok;
String sss,ss;
smsg_"DELETE <Mi mask name>";
If db neq 0
Then
Begin "print debug"
Outstr(smsg&crlf);
If db=2 Then Return (false);
End "print debug";
If not Equ(cmd,"DELETE")
Then
Begin "Ask if delete"
LBOUND(ok,"Delete mask?","Delete mask?");
If not ok Then Return(true);
End "Ask if delete";
" test for output mask name and try and delete it"
If Equ((sss_GUESSER(s,lgl!mnames)),null) or
PDELIMAGE(s)
Then Begin "not MASK name"
OUTSTR(s&" is not a mask name!"&crlf);
Return(true);
End "not MASK name";
" get the MASK index"
m!index_Intscan((ss_sss[2 to inf]),flag);
" Deactivate the image"
mask!in!use[m!index]_false;
" Deactivate the segment list"
" deactivate the title"
mask!title[m!index]_null;
Return(false);
End "DEL";
COMMENT
.next page
.SS(Procedure DEL!BOUNDARY)
.INDEX(Procedure DEL!BOUNDARY)
.;
Internal Procedure DEL!BOUNDARY (String S);
"----------------------------------------"
Begin "DEL"
Itemvar b!item,
p!item,
s!item;
Own Boolean ok;
String sss,ss;
smsg_"DELETE <Bi boundary name>";
DEBUG(smsg);
If not Equ(cmd,"DELETE")
Then
Begin "Ask if delete"
LBOUND(ok,"Delete boundary?","Delete boundary?");
If not ok Then Return;
End "Ask if delete";
" test for output boundary name and try and delete it"
bnd3_CVSI(s,flag);
If Equ((sss_GUESSER(s,lgl!bnames)),null) or flag
Then Begin "not boundary name"
OUTSTR(s&" is not a boundary name!"&crlf);
Return;
End "not boundary name";
b!item_CVSI(s,flag);
If Bind p!item XOR b!item EQV Bind s!item
Then
Begin "Kill it"
Erase p!item XOR b!item EQV s!item;
Delete(s!item);
End "Kill it";
" Delete the omni number"
If Not flag And (b!item In omni!post Or b!item in omni!unpost)
Then
DEL!OMNI!NUMBER(s);
" delete the PNAME then the item"
DEL!PNAME(bnd3);
Delete(bnd3);
" get the boundary index"
b!index_Intscan((ss_sss[2 to inf]),flag);
" Deactivate the image"
bnd!in!use[b!index]_false;
" Deactivate the segment list"
" deactivate the title"
bnd!title[b!index]_null;
End "DEL";
COMMENT
.next page
.SS(Procedure DEL!TRANSFORM)
.INDEX(Procedure DEL!TRANSFORM)
.;
Internal Procedure DEL!TRANSFORM (String S);
"----------------------------------------"
Begin "DEL"
Own Boolean ok;
String sss,ss;
smsg_"DELETE <Ti transform name>";
DEBUG(smsg);
If not Equ(cmd,"DELETE")
Then
Begin "Ask if delete"
LBOUND(ok,"Delete transform?",null);
If not ok Then Return;
End "Ask if delete";
" test for output transform name and try and delete it"
trn3_CVSI(s,flag);
If Equ((sss_GUESSER(s,lgl!tnames)),null) or flag
Then Begin "not transform name"
OUTSTR(s&" is not a transform name!"&crlf);
Return;
End "not transform name";
" delete the transform triples"
Foreach iname Such That a!transform XOR trn3 EQV iname Do
Erase a!transform XOR trn3 EQV iname ;
" delete the PNAME then the item"
DEL!PNAME(trn3);
Delete(trn3);
" get the transform index"
t!index_Intscan((ss_sss[2 to inf]),flag);
" Deactivate the image"
trn!in!use[t!index]_false;
" Deactivate the segment list"
" deactivate the title"
trn!title[t!index]_null;
End "DEL";
COMMENT
.next page
.SS(Procedure ANALYZE!CMD)
.INDEX(Procedure ANALYZE!CMD)
.;
Internal String Procedure ANALYZE!CMD( String str;
Reference String sout, sip1, sip2, sip3, sip4,
sip5, sip6, proj!programmer, dev!name);
Begin "ANALYZE!CMD"
Define supspc = "13";
Define ident = "14";
Integer i,j,k,l,assignment!switch;
String cmd,sss,ss,s;
Label uop,bop;
Comment Scans the input String str for three object identifiers
after picking up the first symbol to be returned.
The input String has the objects separated by commas.
If an identifier is not present, its corresponding String
variable Returns null.;
Setbreak(SUPSPC, "_+*/!' , ", null, "XKR");
Setbreak(IDENT, "_+*/!' , ", null, "IKR");
" [A.1] Look for '[' in the str as part of a file spec.
Then extract all characters between and including the ']' into
proj!programmer."
proj!programmer_null;
ss_str;
str_null;
cmd_null;
While length(ss) > 0 Do
If (s_Lop(ss)) = "["
Then
Begin "get PP"
proj!programmer_s;
While (s_Lop(ss)) neq "]" Do
Begin "append"
If length(ss)=0 or s=" "
Then Done;
proj!programmer_proj!programmer&s;
End "append";
"ok, now terminate"
proj!programmer_proj!programmer&"]";
End "get PP"
Else str_str&s;
" [A.2] Look for ':' in the str as part of a file spec.
Then extract the device name without the ':'"
dev!name_null;
For i_1 step 1 until length(str) Do
If Equ(str[i for 1],":") Then done;
If i < length(str)
Then
Begin "get device name"
" scan backwards picking out the string and resplicing the str"
j_i;
While ( (j>0) and
(not Equ(str[j for 1]," ")) and
(not Equ(str[j for 1],"_")) )
Do
Begin "extract"
dev!name_str[j for 1]&dev!name;
j_j-1;
End "extract";
" ok, done extracting now fix up str"
str_str[0 to j]&str[i+1 to inf];
End "get device name";
" turn off the assignment!switch "
assignment!switch_false;
ss_null;
" [A.3] Get the command out of the String."
cmd_Scan(str,supspc,i);
cmd_Scan(str,ident,i);
If i="_" Then assignment!switch_True;
" [A.3.1] Get the first identifier out of the String."
uop: sout_Scan(str,supspc,j);
" check for unary break codes"
If not Equ((s_GUESSER(" "&sout[inf for 1],lgl!pops)),
null)
Then ss_s;
If not Equ((s_GUESSER(" "&sout[inf for 1],lgl!bops)),
null)
Then ss_s;
If not Equ((s_GUESSER(" "&sout[inf for 1],lgl!mops)),
null)
Then ss_s;
sout_Scan(str,ident,j);
" Test for multicharacter operators"
If not Equ((s_GUESSER(sout,lgl!pops)),null) or
not Equ((s_GUESSER(sout,lgl!mops)),null) or
not Equ((s_GUESSER(sout,lgl!bops)),null)
Then Begin "Trap unary operator"
ss_s;
Goto uop;
End "Trap unary operator";
" [A.3.2] get the second identifier out of the String."
bop: sip1_Scan(str,supspc,j);
" If a single character, Then break it by concatinating a
single space in front of it so that the GUESSER will
be able to parse it."
If not Equ((s_GUESSER(" "&sip1[inf for 1],lgl!pops)),
null)
Then ss_s;
If not Equ((s_GUESSER(" "&sip1[inf for 1],
lgl!mops)), null)
Then ss_s;
sip1_Scan(str,ident,j);
" Look for a binary class multicharacter operator"
If not Equ((s_GUESSER(sip1,lgl!pops)), null) or
not Equ((s_GUESSER(sip1,lgl!mops)),null) or
not Equ((s_GUESSER(sip1,lgl!bops)),null)
Then Begin "Trap binary operator"
ss_s;
Goto bop;
End "Trap binary operator";
" [A.3.3] get the third identifier out of the String."
sip2_Scan(str,supspc,k);
sip2_Scan(str,ident,k);
" [A.3.4] get the fourth identifier out of the String."
sip3_Scan(str,supspc,k);
sip3_Scan(str,ident,k);
" [A.3.5] get the fifth identifier out of the String."
sip4_Scan(str,supspc,k);
sip4_Scan(str,ident,k);
" [A.3.6] get the sixth identifier out of the String."
sip5_Scan(str,supspc,k);
sip5_Scan(str,ident,k);
" [A.3.7] get the 7'th identifier out of the String."
sip6_Scan(str,supspc,k);
sip6_Scan(str,ident,k);
" [A.4] Swap the identifiers if an assignment statement"
If assignment!switch Then Begin "swap"
sip6_sip5;
sip5_sip4;
sip4_sip3;
sip3_sip2;
sip2_sip1;
sip1_sout;
sout_cmd;
cmd_ss;
End "swap";
Return(cmd);
End "ANALYZE!CMD";
End "PRCWRK.SAI";