|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12288 (0x3000)
Types: TextFile
Names: »TERMTOOL.SA«
└─⟦909f4eb2b⟧ Bits:30009789/_.ft.Ibm2.50006622.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »TERMTOOL.SA«
└─⟦ddcd65152⟧ Bits:30009789/_.ft.Ibm2.50006617.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »TERMTOOL.SA«
æ$Eå
æ****** mik's terminal handling tools package ********å
æ*****************************************************å
type
lineType=array Æ1..85Å of char; æenough to accomodate a complete
line incl. a newline recordå
threeLines=array Æ1..255Å of char; æenough to accomodate three lineså
tagMode=(wordMode,byteMode);
convInt=record
fill: byte;
case tag: tagMode of
wordMode: (w: word);
byteMode: (u1,u2: byte);
end;
function getLength
(line: shortId)
: integer;
label 0;
var conv: convInt;
begin
conv.tag:=byteMode;
conv.u1:=ord(lineÆ1Å);
0: æ//////////////////////////////pascal error 83-06-22////////////å
conv.u2:=ord(lineÆ2Å);
conv.tag:=wordMode;
getLength:=conv.w;
if false then goto 0; æ/////////pascal error 83-06-22////////////å
end;
procedure putLength
(line: shortId;
length: integer);
var conv: convInt;
begin
conv.tag:=wordMode;
conv.w:=length;
conv.tag:=byteMode;
lineÆ1Å:=chr(conv.u1); lineÆ2Å:=chr(conv.u2);
end;
procedure clearText
(line: shortId);
var i: integer;
begin
for i:=1 to elements(line) do lineÆiÅ:=chr(0);
putLength(line,2);
end;
procedure putNL
(line: shortId);
const nlLength=-3; nlCom=13;
var length: integer;
begin
length:=getLength(line);
putLength(lineÆlength+1..length+2Å, nlLength);
lineÆlength+3Å:=chr(nlCom);
end;
procedure putText
(line: shortId;
text: shortId);
var pos, i: integer;
begin
pos:=getLength(line);
i:=0;
while (i<elements(text)) and ((pos+i)<elements(line)) do begin
i:=i+1; lineÆpos+iÅ:=textÆiÅ;
end;
putLength(line,pos+i);
end;
procedure align
(line: shortId);
æmakes a text record's length odd (so that the text record followed
by a NL record adds up to an even number of bytes)å
begin
if (getLength(line) mod 2)=0 then putText(line,' ');
end;
procedure putInt
(line: shortId;
val: integer;
width: integer);
æconverts an integer to text in 'line'. The integer is
right-justified in a field of 'width' characterså
var digit, i, pos, tenToWidth, sign: integer;
begin
pos:=getLength(line);
if val<0 then sign:=1 else sign:=0;
val:=abs(val);
tenToWidth:=1;
for i:=1 to width-sign do tenToWidth:=tenToWidth*10;
if ((val div tenToWidth) > 0) or
(pos+width>elements(line)) then begin
for i:=pos+1 to elements(line) do lineÆiÅ:='*';
width:=elements(line)-pos;
end else begin
i:=0;
repeat
digit:=val mod 10;
lineÆpos+width-iÅ:=chr(ord('0')+digit);
val:=val div 10;
i:=i+1;
until val=0;
if sign>0 then begin
lineÆpos+width-iÅ:='-';
i:=i+1;
end;
for i:=pos+width-i downto pos+1 do lineÆiÅ:=' ';
end;
putLength(line,pos+width);
end;
function hex
(val: byte)
: char;
begin
if val<10 then hex:=chr(ord('0')+val)
else hex:=chr(ord('A')+val-10);
end æ***hex***å;
procedure putHex
(line: shortId;
val: integer;
width: integer);
æprints one byte right justified in a field of width chars (hex format) å
var pos, i: integer;
begin
pos:=getLength(line);
case width of
0: æokå;
1: begin
lineÆpos+1Å:='*';
pos:=pos+1;
end;
otherwise begin
for i:=1 to width-2 do begin
lineÆpos+1Å:=' '; pos:=pos+1;
end;
if val<0 then val:=val+256;
lineÆpos+1Å:=hex(val div 16);
lineÆpos+2Å:=hex(val mod 16);
pos:=pos+2;
end;
end;
putLength(line,pos);
end æ***putHex***å;
procedure putError
(line: shortId;
res: resultType;
text: shortId;
val: integer);
æwrites two error lines into 'line'å
type byteArray8=array Æ1..8Å of byte;
var pos: integer;
i: integer;
crLf: array Æ1..2Å of char;
begin
if res.main<>ok then begin
crLfÆ1Å:=chr(13);
crLfÆ2Å:=chr(10);
(* removed by VIR 83-10-12
if res.orgSys=0 then begin æconvert old kernel resultså
if res.family=18 then res.family:=22;
if res.family<=17 then res.family:=res.family+1;
if res.main=3 then res.main:=-res.family
else res.main:=res.family;
res.family:=0;
end;
*)
clearText(line);
putText(line,crLf);
putText(line,'***');
case res.OrgSys div 1000 of
Universal: putText(line,'Program');
AllocFamily: putText(line,'Allocate');
SchedFamily: putText(line,'Scheduler');
3: putText(line,'Security');
IoFamily: case res.OrgSys mod 1000 of
1: putText(line,'Disc driver');
2: putText(line,'Line driver');
3: putText(line,'VERSAdos FileSys');
4: putText(line,'Optimizing FileSys');
5: putText(line,'UNIX FileSys');
end;
ObjDirFamily: putText(line,'ObjectDir');
6: putText(line,'Job Handler');
7: putText(line,'Application');
8: putText(line,'Clock');
otherwise putText(line,'Unknown System');
end;
if res.main<0 then putText(line,' reject: ')
else putText(line,' status: ');
case res.family of
Universal:
begin
case abs(res.main) of
AddressIllegal: putText(line,'address illegal');
EntryIllegal: putText(line,'entry illegal');
PointerScopeIllegal: putText(line,'pointer scope illegal');
PointerValueIllegal: putText(line,'pointer value illegal');
ReturnPointerIllegal: putText(line,'return pointer illegal');
ObjectStateIllegal: putText(line,'object state illegal');
DataValueIllegal: putText(line,'data value illegal');
CapabilityViolation: putText(line,'capability violation');
ConcurrentEntry: putText(line,'concurrent entry');
SelfDeletion: putText(line,'self deletion');
ObjectSpaceLimited: putText(line,'object space limited');
ProcessSpaceLimited: putText(line,'process space limited');
OwnerEnvelopeLimit: putText(line,'owner envelope limit');
OwnerContextLimit: putText(line,'owner context limit');
æSpeedUp: putText(line,'speed up'); å
TimeOut: putText(line,'time out');
Dummyfied: putText(line,'aborted');
GiveUp: putText(line,'give up');
ArgumentsMissing: putText(line,'arguments missing');
ValueParamsMissing: putText(line,'value params missing');
NotInSet: putText(line,'not in set');
NoResources: putText(line,'no resources');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
AllocFamily:
begin
case abs(res.main) of
TooManyResourceNames: putText(line,'too many resource names');
ResourceNameExists: putText(line,'resource name exists');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
SchedFamily:
begin
case abs(res.main) of
FractionTooLarge: putText(line,'fraction too large');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
IoFamily:
begin
case abs(res.main) of
NoVolumeSpace: putText(line,'no volume space');
NoDirectorySpace: putText(line,'no directory space');
FileNotFound: putText(line,'file not found');
FileNameExists: putText(line,'file name exists');
VolumeNotFound: putText(line,'volume not found');
RightsOccupied: putText(line,'rights occupied');
PosOutsideRange: putText(line,'pos outside range');
PhysIoError: putText(line,'physical i/o error');
VolumeFormatError: putText(line,'volume format error');
BreakPending: putText(line,'device not ready');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
ObjDirFamily:
begin
case abs(res.main) of
SourceNotFound: putText(line,'load module not found');
ObjectNameExists: putText(line,'system name exists');
HeaderFormatError: putText(line,'header format error');
ExtRefNotFound: putText(line,'system not found');
ExtRefProtected: putText(line,'system protected');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
6:
begin
case abs(res.main) of
1: putText(line,'param error');
otherwise begin putText(line,'unknown cause=');
putInt(line,abs(res.main),8);
end;
end;
end;
otherwise begin
end;
end;
pos:=getLength(line);
for i:=pos+1 to 67 do lineÆiÅ:=' '; æpad with blankså
putLength(line,67);
with r=res: byteArray8 do
for i:=1 to 8 do putHex(line,rÆiÅ,2);
align(line);
putNL(line);
(* /////////////////////////////////////////////////////////////////
pos:=getLength(line)+3;
if elements(text)>0 then begin
with line2=lineÆpos+1..elements(line)Å do begin
clearText(line2);
putText(line2,'*** ');
putText(line2,text);
putText(line2,' ');
putInt(line2,val,8);
align(line2);
putNL(line2);
pos:=pos+getLength(line2)+3;
end;
end;
with line3=lineÆpos+1..elements(line)Å do begin
clearText(line3);
putText(line3,'*** cause='); putInt(line3,res.main ,4);
putText(line3,' fam=');
case res.family of
Universal: putText(line3,'Univ ');
AllocFamily: putText(line3,'Alloc ');
SchedFamily: putText(line3,'Sched ');
IoFamily: putText(line3,'Io ');
ObjDirFamily:putText(line3,'ObjDir');
6: putText(line3,'JobSys');
otherwise putInt(line3,res.family,6);
end;
putText(line3,' argNo='); putInt(line3,res.argNo,4);
putText(line3,' orgSys='); putInt(line3,res.orgSys,6);
putText(line3,' orgNo='); putInt(line3,res.orgNo,5);
putText(line3,' auxCause='); putInt(line3,res.auxCause,4);
putNL(line3);
end;
/////////////////////////////////////////////////*)
end;
end æ***putError***å;
function termIo
(var ptr: ref;
entryNo: integer;
buf: shortId)
: resultType;
var attention: boolean;
count: integer;
mode: integer;
buflength, pos: integer;
res: resultType;
begin
buflength:=elements(buf);
if entryNo=WriteSeq then begin
mode:=Image;
in
pos:=1;
repeat
with rec=bufÆpos..buflengthÅ do begin
count:=getLength(rec);
recÆ1Å:=chr(0);
if count>0 then recÆ2Å:=chr(0) else recÆ2Å:=chr(10);
count:=abs(count);
end;
pos:=pos+count;
until (count=0) or (pos>=buflength);
do ænothing: end of buf?!å
printVar('+++++exception in termIo++++++++,pos= ',pos);
end else begin
mode:=Formatted æReadSeqå;
pos:=buflength+1; æslamkode!!!!!!!!!!å
end;
repeat
res:=ptr.entryNo(var in out bufÆ1..pos-1Å;out count,mode);
attention:=(res.family=IoFamily) and (res.main=-BreakPending);
if attention then res:=ptr.WaitReady;
until not attention or (res.main<>ok);
termIo:=res;
end; æ***termIo***å
«eof»