Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50527/utilty.bli
There is 1 other file named utilty.bli in the archive. Click here to see a list.
module util(entries=(rdtty,outdec,outprv,outoct,datout,inppn,innum,
gettab,echo,noecho,sixin,unique,lockchn,
outppn,sixout,error,xwd,datin,getfile,
where,node,runexit,outst,out2file,outpth,
infile,outfile,yesno),reserve(1,2,3,4))=
Begin
require machop.bli;
require macros.bli;
external ibufhdr,
inbuf,
otmphdr,
obufhdr,
tmpbuf,
filbuf;
external dattouni,
opnchn,
Lkpchn,
Entchn,
Bytein,
Byteout,
Clschn,
unitodat;
forward Xwd;
forward outdec;
forward Sixout;
forward Inppn;
forward Outoct;
forward Innum;
forward Sixin;
global routine rdtty(strptr,nchars)=
Begin
own i,
charcount;
Register char;
Charcount_0;
while true do
begin
inchwl(address(char));
select .char of
nset
"?G":begin
crlf;
ac1_"?G";
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
return(.charcount);
end;
"?J":begin
print('?M');
ac1_"?J";
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
return(.charcount);
end;
"?L":begin
crlf;
ac1_"?L";
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
return(.charcount);
end;
"?M":0;
0:0;
" ":Begin
If (.charcount NEQ 0) then
Begin
charcount _ .charcount + 1;
if (.charcount GTR .nchars) then
Begin
ac1 _ 0;
ac2 _ .strptr;
incr i from 0 to 9 do
replacei(strptr,0);
Clrbfi; ! Buffer overflow so clear typeahead
return(.charcount);
End;
replacei(strptr,.char);
End;
End;
"?Z":begin
crlf;
ac1_"?Z";
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
return(.charcount);
end;
esc:begin
crlf;
ac1_esc;
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
return(.charcount);
end;
otherwise:begin
charcount_.charcount+1;
if .charcount gtr .nchars then
begin
ac1_0;
ac2_.strptr;
incr i from 0 to 9 do
replacei(strptr,0);
Clrbfi; ! Buffer overflow so clear typeahead
return(.charcount);
end;
replacei(strptr,.char);
end;
tesn;
end;
end;
Global routine where=
Begin
!Return node number of physical node where terminal is located
ac1 _ sixbit'TTY';
Ifskip whereuuo(ac1) then return(.ac1<righthalf>)
else Print('?M?J?G??MAIWUF Where UUO failed?M?J');
Return(0);
End;
Global routine node=
Begin
!Return sixbit node name where terminal is located
Own Block[2];
Block[0] _ 2;
Block[1] _ where();
If .Block[1] EQL 0 then
Return sixbit'????';
ac1 _ Xwd(2,Address(Block));
Ifskip nodeuuo(ac1) then return(.ac1)
else Print('?M?J?G??MAINUF Node. UUO failed?M?J');
Return sixbit'????';
End;
Global routine lockchn(chan,level)=
Begin
Own Block[5],timeout;
Return (TRUE);
Block[0] _ Xwd(1,5);
Block[1] _ Xwd(0,.chan);
Block[2] _ Xwd(.level,.chan);
Block[3] _ Xwd(#500000,0);
Block[4] _ 0;
Timeout _ 15;
Until (.timeout LEQ 0) do
Begin
ac1 _ Xwd(0,Address(Block));
ifskip ENQ(ac1) then Return(TRUE);
if (.ac1 EQL 1) then sleep(ac1)
else
Begin
Print('?M?J?G ??MAIENQ Unexpected ENQ error (Code: ');
Outoct(.ac1);
Print(')?M?J');
Return (FALSE);
End;
timeout _ .timeout - 1;
End;
Print('?M?J?G ??MAIENQ Timed out waiting for resource?M?J');
Return(FALSE);
End;
Global routine xwd(lh,rh)=
Begin
return((.lh^18)+.rh<0,18>);
end;
Global Routine outdec(value)=
Begin
own num,
digits,
i;
routine mdiv=
begin
local r;
if .num eql 0 then
return( incr i from 1 to .digits do
outc("0"));
r_.num mod 10;
num_.num/10;
digits_.digits-1;
mdiv();
outc(.r+"0");
end;
num_abs(.value);
digits_2;
mdiv();
end;
global routine outprv(value)=
begin
own i;
decr i from 33 to 0 by 3 do
outc(.value<.i,3>+"0");
end;
global routine outoct(value)=
begin
own i;
i_33;
while (.value<.i,3> eql 0) and (.i geq 0) do
i_.i-3;
until .i lss 0 do
begin
outc(.value<.i,3>+"0");
i_.i-3;
end;
end;
global routine gettab(index,table)=
begin
register hold;
hold_xwd(.index,.table);
ifskip getab(hold) then
return .hold
else
print('?M?J??MAIGUF GETTAB error occured?M?J');
end;
global routine echo=
begin
own addr[3];
ac1_-1;
ifskip trmno(ac1) then
begin
addr[1]_.ac1;
ac1_xwd(3,address(addr));
addr[0]_#2007;
addr[2]_0;
ifskip trmop(ac1) then 0
else
print('?M?JTTY cannot be set echo?M?J');
end
else
print('?M?JTRMNO. error in routine ECHO?M?J');
end;
global routine noecho=
begin
own addr[3];
ac1_-1;
ifskip trmno(ac1) then
begin
addr[1]_.ac1;
ac1_xwd(3,address(addr));
addr[0]_#2007;
addr[2]_1;
ifskip trmop(ac1) then 0
else
print('?M?JTTY cannot be set no-echo?M?J');
end
else
print('?M?JTRMNOP. error in routine NOECHO?M?J');
end;
Global routine unique(six1,six2,num)=
Begin
Own flag,i,n;
Flag _ True;
if .six1 EQL 0 then return 0;
n _ 0;
I _ 30;
Until (.I LSS 0) OR (.Six1<.I,6> EQL 0) do
Begin
If (.six1<.i,6> NEQ .six2<.i,6>) then flag _ 0;
i _ .i - 6;
n _ .n + 1;
End;
if .n LSS .num then return 0;
return .flag;
End;
Global routine sixin(bytep,noch)=
begin
own tmp,
cntr,
word,
cnt,
aptr,
sptr,
chars;
if .bytep NEQ 0 then
if scann(bytep) EQL 0 then
Begin
ac1 _ ac2 _ ac3 _ 0;
.noch _ 0;
End;
Tmp _ 0;
if .bytep EQL 0 then tmp _ rdtty(byteptr(Address(Inbuf)),30);
word _ 0;
ac3 _ 0;
if (.tmp EQL 0) then ac1 _ -1;
if .tmp eql 0 and .bytep eql 0 then return (.word);
cntr _ 0;
sptr _ word<30,6>;
if .bytep eql 0 then aptr _ inbuf<29,7> else aptr _ .bytep;
tmp _ scann(aptr);
while true do
Begin
while .tmp EQL " " do tmp _ scani(aptr);
cnt _ (if .noch LEQ 0 then (0 - .noch) else .noch);
cnt _ (if .cnt LEQ 6 then .cnt else 6);
ac1 _ 0;
while (.tmp NEQ 0) and (.cntr lss .cnt) do
Begin
if .tmp LEQ "z" AND .tmp GEQ "a" then tmp _ .tmp - #40;
if ((.tmp EQL " ") OR (.tmp EQL ".") OR (.tmp EQL "_") OR (.tmp EQL "[") OR (.tmp EQL "]") OR
(.tmp EQL ",") OR (.tmp EQL ":") OR (.tmp EQL "-") OR (.tmp LSS " "))
then
Begin
cntr _ .cnt + 1;
ac1 _ .tmp;
End
else Begin
replacen(sptr,.tmp-#40);
scani(sptr); tmp _ scani(aptr);
cntr _ .cntr + 1;
End;
End;
if (.tmp EQL 0)OR(.tmp EQL "?J") then ac1 _ -1;
cntr _ ac2 _ 0;
sptr _ ac2<30,6>;
cnt _ .noch - 6;
if (.cntr leq .cnt)AND(.ac1 NEQ 0) then tmp _ scani(aptr);
while (.tmp EQL " ") do tmp _ scani(aptr);
while (.tmp NEQ 0) and (.cntr lss .cnt) do
Begin
if .tmp LEQ "z" AND .tmp GEQ "a" then tmp _ .tmp - #40;
if ((.tmp EQL " ") OR (.tmp EQL ".") OR (.tmp EQL "_") OR (.tmp EQL "[") OR (.tmp EQL "]") OR
(.tmp EQL ",") OR (.tmp EQL ":") OR (.tmp EQL "-") OR (.tmp LSS " "))
then
Begin
cntr _ .cnt + 1;
End
else Begin
replacen(sptr,.tmp-#40);
scani(sptr); tmp _ scani(aptr);
cntr _ .cntr + 1;
End;
End;
ac3 _ .aptr;
Return (.word);
End;
End;
global routine getfile(pntr)=
begin
Own Tmp,
a,
Flags;
Flags _ 0;
while true do
Begin
If (.pntr NEQ 0) then tmp _ Scann(pntr);
If (.tmp NEQ 0)AND(.tmp NEQ "?J") then Tmp _ Sixin(.pntr,-6)
else Begin
Tmp _ 0; Ac1 _ -1; Ac3 _ 0;
End;
Pntr _ .ac3;
If (.tmp NEQ -1) and (.pntr NEQ 0) then Scani(Pntr);
Select (.ac1) of
NSET
" ":If (.tmp NEQ 0) then Return -1;
":":Begin
If (.tmp EQL 0) then Return -1;
filbuf[ffdev] _ .Tmp;
If bittst(.flags,bfdev) then return -1;
Bitset(flags,bfdev) _ 1;
End;
".":Begin
filbuf[ffnam] _ .tmp;
If (.tmp EQL 0)OR bittst(.flags,bfnam) then return -1;
Bitset(flags,bfnam) _ 1;
Bitset(flags,bfdot) _ 1;
End;
"[":Begin
If (.tmp NEQ 0)AND NOT bittst(.flags,bfnam) then
Begin
filbuf[ffnam] _ .tmp;
If bittst(.flags,bfext) then return -1;
Bitset(flags,bfnam) _ 1;
End
else Begin
If (NOT bittst(.flags,Bfdot))AND (.tmp NEQ 0) then return -1;
If bittst(.flags,Bfdot)AND NOT bittst(.flags,Bfext) then
filbuf[ffext] _ .tmp;
If Bittst(.flags,bfext) then return -1;
If bittst(.flags,Bfdot) then Bitset(flags,bfext) _ 1;
Bitset(flags,Bfdot) _ 0;
End;
tmp _ inppn(.pntr,TRUE);
Pntr _ .ac2;
a _ ffsfd1;
filbuf[.a] _ 0;
filbuf[ffppn] _ .tmp;
If (.tmp EQL 0) then Return -1;
While(.ac1 EQL ",") do
Begin
tmp _ Sixin(.pntr,-6);
pntr _ .ac3;
If (.tmp EQL 0) then return -1;
If (.a GTR ffsfd5) then return -1;
filbuf[.a] _ .tmp;
a _ .a + 1;
filbuf[.a] _ 0;
scani(pntr);
End;
If (.ac1 NEQ "]") then return -1;
If bittst(.flags,bfppn) then return -1;
Bitset(flags,bfppn) _ 1;
End;
-1:Begin
If (.tmp NEQ 0)AND NOT bittst(.flags,bfnam) then
Begin
filbuf[ffnam] _ .tmp;
If bittst(.flags,bfext) then return -1;
Bitset(flags,bfnam) _ 1;
End
else Begin
If (NOT bittst(.flags,Bfdot))AND (.tmp NEQ 0) then return -1;
If bittst(.flags,Bfdot)AND NOT bittst(.flags,Bfext) then
filbuf[ffext] _ .tmp;
If bittst(.flags,Bfdot) then Bitset(flags,bfext) _ 1;
Bitset(flags,bfdot) _ 0;
End;
If (bittst(.flags,bfppn)) then filbuf[ffpth] _ Address(Filbuf[ffzer0]);
Return .flags;
End;
otherwise:Return -1;
TESN;
End;
End;
global routine outppn(ppn)=
begin
own a;
a_33;
while .ppn<.a,3> eql 0 and .a geq 0 do
Begin
a_.a-3;
!outc(" ");
end;
outc("[");
until .a lss 18 do
begin
outc(.ppn<.a,3>+"0");
a_.a-3;
end;
outc(",");
while .ppn<.a,3> eql 0 and .a geq 0 do
a_.a-3;
until .a lss 0 do
begin
outc(.ppn<.a,3>+"0");
a_.a-3;
end;
outc("]");
a _ 15;
while .ppn<.a,3> eql 0 and .a geq 0 do
begin
a_.a-3;
!outc(" ");
end;
end;
global routine outst(adrs,len)=
Begin
Own Ptr,byte,count;
Count _ 0;
Ptr _ byteptr(.adrs);
Byte _ Scani(ptr);
Until (.Byte EQL 0) do
Begin
Outc(.byte);
Count _ .Count + 1;
Byte _ Scani(ptr);
End;
Until (.Count GEQ .len) do
Begin
Outc(" ");
Count _ .Count + 1;
End;
Return .Count;
End;
global routine sixout(value,size)=
begin
own a;
if .size EQL -1 then
decr a from 30 to 0 by 6 do
if .value<.a,6> EQL 0 then return
else outc(.value<.a,6>+#40)
else decr a from 30 to 36-(.size*6) by 6 do
outc(.value<.a,6>+#40);
end;
global routine error(ercd)=
begin
print('?M?J?G??MAIUFE Unexpected file error: ');
if .ercd gtr 36 or .ercd lss 0 then
print('Unknown I/O error?M?J')
else
case .ercd of
set
print('File not found ?M?J');
print('Incorrect PPN?M?J');
print('Protection failure?M?J');
print('File being modified?M?J');
print('Already existing file name?M?J');
print('Illegal sequence of UUO''s?M?J');
print('Transmission error?M?J');
print('Not a save file?M?J');
print('Not enough core?M?J');
print('Device not available?M?J');
print('No such device?M?J');
print('Illegal UUO?M?J');
print('NO Room?M?J');
print('Write locked?M?J');
print('Not enough table space?M?J');
print('Partial allocation?M?J');
print('Block not free?M?J');
print('Can''t supersede a directory?M?J');
print('Can''t delete a non-empty directory?M?J');
print('SFD not found?M?J');
print('Search list empty?M?J');
print('SFD nest level too deep?M?J');
print('No create for all S/L?M?J');
print('Segment not on swap space?M?J');
print('Can''t update file?M?J');
print('Low seg overlaps high seg?M?J');
print('Not logged in?M?J');
print('File still has outstanding locks set?M?J');
print('Bad .EXE file directory?M?J');
print('Bad extension for .EXE file?M?J');
print('.EXE directory too big?M?J');
print('Exceeded network capacity?M?J');
print('Task not available?M?J');
print('Undefined network node?M?J');
print('SFD is in use?M?J');
print('File has an NDR block - Can''t delete?M?J');
print('Job count high?M?J');
tes;
end;
Global routine Datout(time,date,year)=
Begin
Outdec(.time/216000);
time _ .time MOD 216000;
Outdec(.time/3600);
Tab;
Outdec(.date<righthalf>);
Outc("-");
If (.date<lefthalf> GTR 12)OR(.date<lefthalf> LSS 0) then print('??????') ELSE
Case .date<lefthalf> of
Set
0;
Print('Jan');
Print('Feb');
Print('Mar');
Print('Apr'); ! Or is it CPU?
Print('May');
Print('Jun');
Print('Jul');
Print('Aug');
Print('Sep');
Print('Oct');
Print('Nov');
Print('Dec');
Tes;
Outc("-");
Outdec(.year);
End;
Global routine Datin(pntr)=
Begin
!
! Returns the typed in date in Internal format.
!
! The following input forms are legal:
! Month Day, Year
! dd-mmm-yy
! mm/dd/yy
! xx:xx:xx
! xx:xx
! xx:xxzz (zz= AM/PM)
!
Own Mypntr,Dat,Tim,Intval,Sixval,Brk,Intptr,Sixptr;
Routine Month(sixbt)=
Begin
If Unique(.sixbt,sixbit'JANUAR',3) then Return(1);
If Unique(.sixbt,sixbit'FEBUAR',3) then Return(2);
If Unique(.sixbt,sixbit'MARCH',3) then Return(3);
If Unique(.sixbt,sixbit'APRIL',3) then Return(4);
If Unique(.sixbt,sixbit'MAY',3) then Return(5);
If Unique(.sixbt,sixbit'JUNE',3) then Return(6);
If Unique(.sixbt,sixbit'JULY',3) then Return(7);
If Unique(.sixbt,sixbit'AUGUST',3) then Return(8);
If Unique(.sixbt,sixbit'SEPTEM',3) then Return(9);
If Unique(.sixbt,sixbit'OCTOBE',3) then Return(10);
If Unique(.sixbt,sixbit'NOVEMB',3) then Return(11);
If Unique(.sixbt,sixbit'DECEMB',3) then Return(12);
Print('?M?J?G??MAIURM Unrecognized month: ');
Sixout(.sixbt,-1);
Crlf;
Return(0);
End;
Routine Dodate(Mon,day,year)=
Begin
Own value;
If (.Mon LSS 1)OR(.Mon GTR 12)OR
(.Day LSS 1)OR(.Day GTR 31)
Then Begin
Print('?M?J?G??MAIIVD Invalid date?M?J');
Return(0);
End;
If (.Year EQL 0) then Year _ GETTAB(#56,#11);
If (.Year LSS 100) then Year _ .Year + 1900;
Value _ (.year - 1964);
Value _ 12 * .value;
Value _ .value + .mon - 1;
Value _ 31 * .value;
Value _ .value + .day - 1;
Return(.Value);
End;
Routine Time(value)=
Begin
Own Seconds,temp;
If (.value GTR 23) then
Begin
Print('?G?M?J??MAIILT Illegal time specified?M?J');
Return (0);
End;
Seconds _ .Value * 3600;
Scani(Mypntr);
Temp _ Innum(.Mypntr,10);
If (.temp GTR 59) then
Begin
Print('?M?J???GMAIILT Illegal time specified?M?J');
return 0;
End;
Seconds _ .Seconds + (.temp * 60);
Mypntr _ .ac2;
Scani(Mypntr);
Temp _ 0;
If (.ac1 EQL ":") then Temp _ Innum(.Mypntr,10);
If (.temp GTR 59) then
Begin
Print('?M?J???GMAIILT Illegal time specified');
return 0;
End;
Seconds _ .Seconds + .Temp;
Mypntr _ .ac2;
If (.ac1 EQL "P")OR(.ac1 EQL "A") then
Begin
If (.Seconds GTR (13*3600)) then
Begin
Print('?M?J???GMAIMTF Mixed 12/24 hour time formats?M?J');
Return 0;
End;
Scani(Mypntr);
If (.ac1 EQL "P") then Seconds _ .Seconds + (12 * 3600);
End;
Return(.Seconds*1000);
End;
Routine Date1(value)=
Begin
! Date in mm/dd/yy format
Own Month,Day,Year;
Month _ .Value;
Scani(Mypntr);
Day _ Innum(.Mypntr,10);
Mypntr _ .ac2;
Scani(Mypntr);
If (.ac1 EQL "/") then Year _ Innum(.Mypntr,10)
else year _ 0;
Mypntr _ .ac2;
Return(Dodate(.Month,.Day,.Year));
End;
Routine Date2(value)=
Begin
! Date in dd-mmm-yy format
Own Mon,Day,Year;
Day _ .Value;
Mon _ Month(Sixin(.Mypntr,-6));
If (.mon EQL 0) then Return(0);
Mypntr _ .ac2;
Scani(Mypntr);
If (.ac1 EQL " ") then
Begin
Year _ Innum(.Mypntr,10);
If (.ac1 EQL ":") then
Begin
Tim _ Time(.Year);
Year _ 0;
End;
End;
If (.ac1 EQL "-") then Year _ Innum(.Mypntr,10)
else Year _ 0;
Mypntr _ .ac2;
Return(Dodate(.Mon,.Day,.Year));
End;
Routine Date3(value)=
Begin
! Date in Month dd,yyyy
Own Mon,Day,Year;
Mon _ Month(.Value);
If (.mon EQL 0) then Return(0);
Scani(Mypntr);
Day _ Innum(.Mypntr,10);
Mypntr _ .ac2;
If (.ac1 EQL ",") then Scani(Mypntr);
If (.ac1 EQL ",") then Year _ Innum(.Mypntr,10)
else year _ 0;
If (.ac1 EQL ":") then
Begin
Tim _ Time(.Year);
Year _ 0;
End;
Mypntr _ .ac2;
return(Dodate(.Mon,.Day,.Year));
End;
! Main routine
Tim _ Dat _ 0;
Mypntr _ .Pntr;
Intval _ Innum(.Mypntr,10);
Intptr _ .ac2;
Brk _ .ac1;
Sixval _ Sixin(.Mypntr,-6);
Sixptr _ .ac3;
If (.Brk LSS "A") then
Select (.Brk) of
NSET
Always: Mypntr _ .Intptr;
":":Tim _ Time(.Intval);
"/":Dat _ Date1(.Intval);
"-":Dat _ Date2(.Intval);
" ":Dat _ Date2(.Intval);
TESN
Else
Begin
Mypntr _ .Sixptr;
Dat _ Date3(.Sixval);
End;
If (.DAT EQL 0)AND(.TIM EQL 0) then
If (.Brk EQL "?J")OR(.Brk EQL 0) then Return(0)
else
Begin
Print('?M?J?G??MAIUDF Unrecognized date format?M?J');
Return(0);
End;
Intval _ Innum(.Mypntr,10);
Intptr _ .ac2;
Brk _ .ac1;
Sixval _ Sixin(.Mypntr,-6);
Sixptr _ .ac3;
If (.Brk LSS "A") then
Select (.Brk) of
NSET
Always: Mypntr _ .Intptr;
":":Tim _ Time(.Intval);
"/":Dat _ Date1(.Intval);
"-":Dat _ Date2(.Intval);
" ":Dat _ Date2(.Intval);
TESN
Else
Begin
Mypntr _ .Sixptr;
Dat _ Date3(.Sixval);
End;
If (.DAT EQL 0)AND(.TIM EQL 0) then Return(0);
ac1 _ .tim;
ac2 _ .dat;
Dattouni();
Return(.ac3);
End;
global routine innum(pntr,base)=
Begin
!
! This routine parses a number from the terminal
! or a string specified by the user. If a string
! is specified by the user the AC2 contains the
! updated pointer. AC1 always contains the byte
! which terminated the string. Base is the numeric
! value for the base to be used (2, 8, 10 etc.).
! This routine returns the value parsed.
!
! The string may be proceeded by spaces, as these
! will be ignored.
Own topbyte,value,buff[10],byte;
If (.pntr EQL 0) then
Begin
pntr _ byteptr(address(buff));
While (Rdtty(.pntr,40) EQL 0) do Print('?G%Expected a number?M?J');;
End;
Topbyte _ (.base-1) + "0";
Value _ 0;
byte _ Scann(pntr);
While (.byte EQL " ") do byte _ Scani(pntr);
While (.byte GEQ "0")AND(.byte LEQ .Topbyte) do
Begin
Value _ .Value * .base;
Value _ .Value + (.byte - "0");
Byte _ Scani(pntr);
End;
Ac1 _ .byte;
Ac2 _ .pntr;
Return (.value);
End;
Global routine Inppn(pntr,parsed)=
Begin
!
! If a byte pointer is used for the call then we
! parse the string for a PPN which may contain
! a SFD however these are not parsed by this routine.
! If the byte pointer is zero then only a PPN is
! accepted and if a SFD is included then an error
! is generated.
!
! If parsed EQL TRUE then the '[' has been parsed.
! AC1 = Byte which terminated the PPN (Either ',' or ']')
! AC2 = Updated byte pointer
! Return value = PPN or 0 on errors
!
! If an error occurs, the value is zero and a message has
! been output.
Own Buff[40],myppn,Value,byte,nosfd;
Nosfd _ FALSE;
Ifskip Getppn(ac1) then myppn _ .ac1 else myppn _ .ac1;
If (.pntr EQL 0) then
Begin
pntr _ byteptr(address(buff));
While ( rdtty(.pntr,40) EQL 0) do Print('?G%Expected PPN in the form of [xx,xx]?M?J');
Nosfd _ TRUE;
End;
value _ 0;
If (NOT .parsed) then (byte _ Scani(pntr); Scani(pntr))
else byte _ "[";
While (.byte EQL " ") do Byte _ Scani(pntr);
If (.byte EQL "?J")OR(.byte EQL 0) then return(0);
If (.byte NEQ "[") then
Begin
Print('?M?J?G??MAIILP Illegal PPN - Expected a PPN in the form of [xx,xx');
If (.nosfd) then Print(']?M?J')
else Print(',...]?M?J');
Return (0);
End;
value<lefthalf> _ innum(.pntr,8);
pntr _ .ac2;
If (.ac1 NEQ ",") then
Begin
Print('?M?J?G??MAIILS Illegal seperator in PPN - Expected a '','' but found: ''');
Outc(.ac1);Print('''?M?J');
Return(0);
End;
If (.value<Lefthalf> EQL #777777) then
Begin
Print('?M?J?G??MAIILP Illegal PPN - Value may not be 777777?M?J');
Return(0);
End;
If (.value<lefthalf> EQL 0) then
Begin
value<lefthalf> _ .myppn<lefthalf>;
End;
Scani(pntr); ! Get past the ','
value<righthalf> _ innum(.pntr,8);
pntr _ .ac2;
If (.ac1 NEQ (if (.nosfd) then #777 else ","))AND(.ac1 NEQ "]") then
Begin
Print('?M?J?G??MAIILS Illegal seperator in PPN - Expected a '']''');
If (.nosfd) then crlf
else Print(' or '',''?M?J');
Return(0);
End;
If (.value<righthalf> EQL #777777) then
Begin
Print('?M?J?G??MAIILP Illegal PPN - Value may not be 777777?M?J');
Return(0);
End;
If (.value<righthalf> EQL 0) then value<righthalf> _ .myppn<righthalf>;
Scani(ac2); ! Skip break character
Return(.value);
End;
global routine outpth=
begin
Own a,tmp;
Outc("[");
Outoct(.filbuf[ffppn]<lefthalf>);
Outc(",");
Outoct(.filbuf[ffppn]<righthalf>);
a _ ffsfd1;
While (.filbuf[.a] NEQ 0) do
Begin
Outc(",");
Sixout(.filbuf[.a],-1);
a _ .a + 1;
End;
Outc("]");
End;
global routine batch=
Begin
Own stats;
Stats _ Gettab(-1,#40);
If (.Stats<25,1> EQL 1) then return true;
Return 0;
End;
global routine infile(ch)=
begin
own data,hold;
select .ch of
nset
"IN":while (ibufhdr[2]_.ibufhdr[2]-1) lss 0 do
ifskip input(in) then return "EOF" else 0;
"AUX":while (tmpbuf[2]_.tmpbuf[2]-1) lss 0 do
ifskip input(3) then return "EOF" else 0;
otherwise:Print('?M?J??MAIIPF Infile: Invalid parameter!?M?J');
tesn;
data_(if .ch eql "IN" then scani(ibufhdr[1]) else scani(tmpbuf[1]));
hold_.data<25,11>;
data_.data^11;
data<0,11>_.hold<0,11>;
return .data;
end;
Global routine runexit(tmpcrname)=
Begin
Own Buffer[30],Argblk[2],runblk[6],runname,pntr;
Argblk[0]<lefthalf>_.tmpcrname<lefthalf>;
Argblk[1]_Xwd(-30,(address(buffer)-1));
Ac1 _ Xwd(2,Address(Argblk));
Ifskip Tmpcor(ac1) then
Begin
Pntr _ Byteptr(Address(Buffer));
Scani(Pntr);
Runname _ Sixin(.Pntr,6);
End
Else While TRUE do MONITOR();
Runblk[0] _ Sixbit'SYS';
Runblk[1] _ .Runname;
Runblk[2] _ 0;
Runblk[3] _ 0;
Runblk[4] _ 0;
Runblk[5] _ 0;
Ac1 _ Xwd(1,Address(Runblk[0]));
Ifskip Run(ac1) then 0;
Print('?M?J?G??MAILER: Run UUO failed for SYS:');
Sixout(.runname,-1);
Crlf;
End;
Global routine outfile(data)=
begin
own hold,a;
while (obufhdr[2]_.obufhdr[2]-1) lss 0 do
ifskip output(out) then
return print('?M?JOutput error on device dsk:?M?J')
else 0;
hold_.data<0,11>;
data_.data^(-11);
data<25,11>_.hold<0,11>;
replacei(obufhdr[1],.data);
end;
Global routine out2file(data)=
begin
own hold,a;
while (otmphdr[2]_.otmphdr[2]-1) lss 0 do
ifskip output(out2) then
return print('?M?JOutput error on device dsk:?M?J')
else 0;
hold_.data<0,11>;
data_.data^(-11);
data<25,11>_.hold<0,11>;
replacei(otmphdr[1],.data);
end;
global routine yesno=
Begin
Own answer;
while true do
Begin
answer _ sixin(0,6);
if unique(.answer,sixbit'YES',1) then answer _ sixbit'YES';
if unique(.answer,sixbit'NO',1) then answer _ sixbit'NO';
select .answer of
nset
sixbit'YES':begin
return true;
end;
sixbit'NO':begin
return 0;
end;
otherwise:print('?M?J?G%Answer yes or no?M?J');
tesn;
end;
end;
end
eludom