|
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: 28160 (0x6e00)
Types: TextFile
Names: »WT.SA«
└─⟦311ba069f⟧ Bits:30009789/_.ft.Ibm2.50006625.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »WT.SA«
└─⟦49237ce80⟧ Bits:30009789/_.ft.Ibm2.50006627.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »WT.SA«
└─⟦714bbb381⟧ Bits:30009789/_.ft.Ibm2.50006595.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »WT.SA«
æ*****************************************************************
Copyright 1984 by
NCR Corporation
Dayton, Ohio U.S.A.
All Rights Reserved
******************************************************************
EOS Software produced by:
NCR Systems Engineering - Copenhagen
Copenhagen
DENMARK
*****************************************************************å
æ$Eå
OBJECT PROGRAM windowterm;
æ$H=0å
æ **************************************************************
*********************************************************************** å
æ$L-å
æ$F=family.univ.idå
æ$F=family.objdir.idå
æ$Eå
æ$F=family.knel.idå
PROCEDURE PrintText (text: fullid); FORWARD;
PROCEDURE PrintVar (text: fullid; univ v: blockPtr); FORWARD;
æ$Eå
æ****** E X P O R T D E S C R I P T I O N ******å
æ*************************************************å
æ$F=family.iosys.idå
æ$F=private.windowfs.idå
æ$Eå
æ****** I M P O R T D E S C R I P T I O N ******å
æ*************************************************å
æ$F=family.alloc.idå
æ$Eå
æ$F=family.sched.idå
æ$Eå
æ****** E X T E R N A L P R O C E D U R E S ******å
æ***************************************************å
æNONEå
æ$L+å
æ$Eå
æ The program is implementing a window terminal system for a NCR 7900
terminal. The screej is separated in two parts horizontal. Each part
of the window is wrapped around separately. It is not allowed to use
the cursor position control keys on the keyboard when the window
system is running.
Shifting among the two window parts is done by typing BRK 1/2. BRK 0
is a break to the running process in the active window part. When
BRK is typed the current active window part is shown to the right on
the separation line.
The program maintains an internal buffer for each window part, so the
Unix typing ahead is allowed.
The program contains an unarchitectured EOS entry INITWTSYS with a terminal
name, topline and bottomline as parameters. å
æ$Eå
æ****** C O N S T A N T S A N D T Y P E S ******å
æ***************************************************å
CONST
maxIdLength = 48;
orgNo = 00;
orgSys = 4008;
reject = -1;
status = 1;
space = ' ';
NoControl = 0;
passive = 0;
active = 1;
tab = 09;
nl = 10;
ctrlD = 4;
cr = 13;
esc = 27;
ers = 12;
unixmode = 1;
formatted = 2;
Type
TermData = RECORD
TerminalName : arrayÆ1..maxIdLengthÅ of char;
termnr: integer;
Namelength: integer;
lineupper,linelower: integer;
actwindow: integer;
attcount: integer;
initcur : arrayÆ-1..4Å of char;
END;
WaoData = RECORD
break : boolean;
upperline, lowerline : integer;
cursorline, position : integer;
mystate : integer;
windowpart : integer;
curpos : arrayÆ-1..10Å of char;
firstbyte,lastbyte : integer;
readbuf : arrayÆ1..81Å of char;
spacebuf : arrayÆ1..8Å of char;
END;
æ$Eå
æ****** G L O B A L P R O C E D U R E S ******å
æ***********************************************å
FUNCTION MakeRes (main, family, auxcause, argno: integer)
: ResultType;
var
r: resultType;
BEGIN
r.main := main;
r.family := family;
r.argno := argno;
r.auxcause := auxcause;
r.orgno := orgno;
r.orgsys := orgsys;
MakeRes := r;
END; æMakeReså
FUNCTION checkname (length: integer; univ dest, source: blockPtr): boolean;
VAR i: integer;
found : boolean;
BEGIN
found := length = elements(source);
checkname := found;
IF found THEN
BEGIN
FOR i:= 1 to length DO
IF sourceÆiÅ <> destÆiÅ THEN
checkname:= false;
END;
END;
æ$D- : this assignment is only valid for the first part of the program. å
æ pascal statement numbers are heavily used during debugging. å
FUNCTION Statement : integer; FORWARD; æ UNIPSEXT ASSEMBLER å
PROCEDURE PS (hint : fullId); æprint statement numberå
VAR s : integer;
BEGIN s:=statement; PrintVar(hint,s); END;
PROCEDURE PSS(hint : fullId; l : Long); æprint statement number and Longå
VAR v : RECORD s : Long; l : Long; END;
BEGIN v.s:= statement; v.l:= l; PrintVar(hint,v); END;
PROCEDURE PR ( res : ResultType); æprint Resultå
VAR OutPut : RECORD
StatNo : integer;
result : ResultType;
END;
BEGIN
OutPut.StatNo:= statement;
OutPut.result:= res;
PrintVar('WTFS: Number OrgSy Au Ar OrgNo Fa Ca',OutPut);
END;
æ$Eå
PROCEDURE SCheck ( R : ResultType);
BEGIN
IF R.main <> ok THEN
BEGIN printText('***SCheck E R R O R *** '); PR(R) END ELSE
;
END;
PROCEDURE NoCheck ( R : ResultType);
BEGIN
æ#ALRES# PR(R) &ALRES&å ; æ#BTRES# PR(R) &BTRES&å ;
END;
PROCEDURE RCheck ( R : ResultType);
BEGIN
æ PR(R); å
IF R.main <> ok THEN BEGIN
æ#BTRES# PR(R) &BTRES&å ; ObjReturn(R);
END;
END;
PROCEDURE XCheck ( R : ResultType);
BEGIN
æ PR(R); å
IF R.main <> ok THEN BEGIN
æ#BTRES# PR(R) &BTRES&å ; exception(R);
END;
END;
FUNCTION Call ( R : ResultType) : ResultType;
BEGIN
æ#ALRES# PR(R) &ALRES&å æ#BTRES# PR(R) &BTRES&å ;
Call := R ;
END;
FUNCTION univRes (m : byte) : ResultType;
VAR r : ResultType;
BEGIN r.family:=0; r.main:= -m; r.orgNo:=statement; univRes:=r; END;
æ$K+å
æ$Eå
PROCEDURE Check (res: resultType);
BEGIN
IF res.main <> OK THEN printVar ('*** WTFS check *** res = ',res);
æprintvar ('*** WTFS CHECK *** RES = ',res); å
IF res.main <> OK THEN Exception (res);
END;
PROCEDURE CopyBytes (univ source, dest: blockPtr);
var i, max: integer;
BEGIN
max := elements(source);
if max > elements (dest) then max := elements (dest);
for i := 1 to max do destÆiÅ := sourceÆiÅ;
END;
PROCEDURE FillBytes (univ b: byte; univ dest: blockPtr);
var i: integer;
BEGIN
for i := 1 to elements (dest) do destÆiÅ := b;
END;
æ$Eå
æ****** L O C A L P O I N T E R S ******å
æ*************************************************å
TYPE
refwao = ^^waolocals;
refwtsys = ^^wtsyslocals;
wtsyslocals = RECORD
tdata : ^^termdata;
termgate : ^^Gate;
attwait : ^^Condition;
rdcond : arrayÆ1..2Å of ^^Condition;
attproc : ^^;
ipctao : ^^;
waoptr : arrayÆ1..2Å of ^^refwao;
wptrdata : arrayÆ1..2Å of ^^waodata;
iosysobj : ^^;
END;
InitLocals = RECORD
code : ^^;
allocref : ^^Allocate;
schedref : ^^Scheduler;
objdirref : ^^Objdir;
wtptr : ^^wtsyslocals;
wtown : ^^;
waoman : ^^;
egoEnv : ^^;
egoObj : ^^;
END;
waoLocals = RECORD
code : ^^;
wdata : ^^waodata;
wtref : ^^wtsyslocals;
waoFifo : ^^Gate;
breakcond : ^^Condition;
END;
æ$Eå
æ****** I M P L E M E N T W A O ******å
æ***************************************å
PROGRAM waoimplement OBJECT fao WITH waolocals;
PROCEDURE setpos (VAR w : waodata);
VAR i : integer;
BEGIN
if w.cursorline = w.lowerline THEN
w.curposÆ4Å := chr (w.upperline)
ELSE
w.curposÆ4Å := chr (w.cursorline + 1);
w.curposÆ9Å := chr (w.position);
w.curposÆ10Å := chr (w.cursorline);
Xcheck (wtref^^.ipctao.writeseq (VAR IN w.curpos; OUT i, formatted));
END;
PROCEDURE updatecursor (VAR w : waodata);
BEGIN
IF w.cursorline = w.lowerline THEN
w.cursorline := w.upperline
ELSE
w.cursorline := w.cursorline + 1;
w.position := 0;
END;
æ$Eå
æ******** R E A D E N T R Y **********å
æ***************************************å
ENTRY readseq
æ segment; OUT bytecount å
WITH RECORD
t : ^^;
END;
VAR res : resulttype;
i,j,l : integer;
c : char;
noioerror : boolean;
BEGIN
æ PrintText ('--- wt.readseq ---'); å
scheck (waofifo.lock);
IN
scheck (wtref^^.termgate.lock);
IN
WITH w = wdata^^ do
BEGIN
IF w.break THEN
Exception( MakeRes (reject*breakPending,iofamily,0,0));
REPEAT
noioerror := true;
IN
bytecount := 0;
IF w.firstbyte = (w.lastbyte + 1) THEN æ readbuf is empty å
BEGIN
IF w.mystate = passive THEN
BEGIN
æ PrintText ('--- wt.read.wait');å
NoCheck (wtref^^.rdcondÆw.windowpartÅ.wait);
END;
setpos (w);
j := 80 - w.position;
xcheck (wtref^^.ipctao.readseq (VAR IN OUT w.readbufÆ1..jÅ;
OUT w.lastbyte));
w.lastbyte := w.lastbyte + 1;
w.firstbyte := 1;
w.readbufÆw.lastbyteÅ := chr (nl);
updatecursor (w);
END;
WITH dest = segment^^ DO
BEGIN
REPEAT
c := w.readbufÆw.firstbyteÅ;
IF c = chr (cr) THEN c := chr (nl);
IF c <> chr (ctrlD) THEN
BEGIN
bytecount := bytecount + 1;
destÆbytecountÅ := ord (c);
END;
w.firstbyte := w.firstbyte + 1;
UNTIL (c = chr (ctrlD)) OR (c = chr (nl)) OR
(bytecount >= elements(dest)) OR (w.firstbyte = (w.lastbyte +1 ));
END; æwithå
res := OkResult;
DO BEGIN
æ PrintText ('--- wt.readexcp ---');å
res := Getexception;
IF (res.main = reject*breakPending) AND (res.family = iofamily) THEN
BEGIN
noioerror := false;
w.firstbyte := 1;
w.lastbyte := 0;
with t = wtref^^.tdata^^ do
t.attcount := t.attcount + 1;
Scheck (wtref^^.attwait.wait);
END;
END;
UNTIL noioerror;
END; æwith å
DO
res := GetException;
Scheck (wtref^^.termgate.open);
DO
res := GetException;
Scheck (waofifo.open);
ObjReturn (res);
END;
æ$Eå
æ****** W R I T E E N T R Y ******å
æ***********************************å
ENTRY writeseq
æsegment; OUT bytecountå
WITH RECORD
T : ^^;
END;
VAR res: resultType;
j,l,i,k : integer;
firstindex : integer;
lastpos : integer;
lastline : integer;
noioerror : boolean;
spaceok : boolean;
setok : boolean;
PROCEDURE excppos;
VAR excpcur : arrayÆ-1..4Å of char;
i : integer;
BEGIN
excpcurÆ-1Å := chr (0);
excpcurÆ0Å := chr (6);
excpcurÆ1Å := chr (esc);
excpcurÆ2Å := '1';
excpcurÆ3Å := chr (lastpos);
excpcurÆ4Å := chr (lastline);
Xcheck (wtref^^.ipctao.writeseq (VAR IN excpcur; OUT i,formatted));
END;
BEGIN
æ PrintText ('--- wt.writeseq ---'); å
Scheck (waofifo.lock);
IN
Scheck (wtref^^.termgate.lock);
IN
noioerror := true;
spaceok := true;
setok := true;
æ analyse the contents of the buffer å
WITH S = segment^^ do
L := elements (S);
firstIndex := 1;
J := 1;
WITH w = wdata^^ do
BEGIN
IF w.break THEN
Exception (MakeRes (reject*breakPending,iofamily,0,0));
lastpos := w.position;
lastline := w.cursorline;
REPEAT
IF NOT noioerror THEN
excppos
ELSE
setpos(w);
noioerror := true;
IN
WITH S = segment^^ do
BEGIN
WHILE J <= L DO
BEGIN
IF SÆJÅ = NL THEN
BEGIN
Xcheck (wtref^^.ipctao.writeseq (VAR IN OUT SÆfirstindex..JÅ;OUT i,
unixmode));
IF setok THEN
BEGIN
updatecursor (w);
setok := false;
END;
Setpos (w); æ to clear next line å
setok := true;
lastpos := 0;
lastline := w.cursorline;
firstindex := J+1;
END
ELSE
IF SÆJÅ = TAB THEN
BEGIN
IF j > firstindex THEN
Xcheck (wtref^^.ipctao.writeseq (VAR IN OUT SÆfirstindex..J-1Å;
OUT i,unixmode));
IF spaceok THEN
BEGIN
i := w.position;
w.position := (w.position div 8) * 8 + 8;
k := w.position - i;
spaceok := false;
END;
Xcheck (wtref^^.ipctao.writeseq (VAR IN OUT w.spacebufÆ1..kÅ;
OUT i,unixmode));
spaceok := true;
lastpos := w.position;
firstindex := J + 1;
END
ELSE
IF w.position >= 79 then
BEGIN
Xcheck (wtref^^.ipctao.writeseq (VAR IN OUT SÆfirstindex..JÅ;OUT i,
unixmode));
IF setok THEN
BEGIN
updatecursor (w);
setok := false;
END;
Setpos (w);
setok := true;
lastpos := 0;
lastline := w.cursorline;
firstindex := J+1;
END
ELSE
w.position := w.position + 1;
J := J + 1;
END; æ while å
IF J > firstindex THEN æ write last line å
Xcheck (wtref^^.ipctao.writeseq ( VAR IN OUT SÆfirstindex..J-1Å;
OUT i,unixmode));
bytecount := L;
res := OkResult;
END; æ with S å
DO BEGIN
æ PrintText ('--- wt.writeexcp ---'); å
res := Getexception;
IF (res.main = reject*breakPending) AND (res.family = iofamily) THEN
BEGIN
noioerror := false;
WITH t = wtref^^.tdata^^ do
t.attcount := t.attcount + 1;
Scheck (wtref^^.attwait.wait);
END;
END;
UNTIL (res.main <> reject*breakPending) OR (res.family <> iofamily) AND
(res = OkResult);
END; æ with w å
DO
res := GetException;
Scheck (wtref^^.termgate.open);
DO
res := GetException;
Scheck (waofifo.open);
ObjReturn (res);
END;
æ$Eå
æ****** E N T R Y S E E K *********å
æ************************************å
ENTRY seek
æ;basemode, offset, OUT pos å
WITH RECORD
t : ^^;
END;
VAR res : resulttype;
BEGIN
æPrintText ('--- wt.seek ---'); å
Scheck (waofifo.lock);
IN
Scheck (wtref^^.termgate.lock);
IN
IF (basemode <> 2) OR (offset <> 0) THEN
Exception (Makeres (reject*DataValueIllegal,Universal,0,0));
WITH w = wdata^^ do
BEGIN
IF w.break THEN
Exception (MakeRes (reject*breakpending,iofamily,0,0));
IF w.firstbyte <> (w.lastbyte + 1) THEN æ readbuf is not empty å
BEGIN
pos := w.lastbyte - w.firstbyte + 1;
w.firstbyte := 1;
w.lastbyte := 0;
END;
res := Okresult;
END; æ with å
DO
res := Getexception;
Scheck (wtref^^.termgate.open);
DO
res := Getexception;
Scheck (waofifo.open);
ObjReturn (res);
END;
æ$Eå
æ***** E N T R Y G E T F I L E I N F ******å
æ*********************************************å
ENTRY getfileinf
æOUT iosys; OUT localId, OUT filename, OUT devclass,
OUT bytesallocated, OUT databytes, OUT minbufsize, OUT cylsize å
WITH RECORD
t : ^^;
END;
VAR res : resulttype;
BEGIN
æ PrintText ('--- wt.getfileinf ---'); å
Scheck (waofifo.lock);
IN
Scheck (wtref^^.termgate.lock);
IN
Scheck (copy (wtref^^.iosysobj,iosys));
WITH w = wdata^^, t = wtref^^.tdata^^ do
BEGIN
localId := t.termnr * 10 + w.windowpart;
copybytes (t.terminalname,filename);
devclass := 1;
bytesallocated := 81;
databytes := w.lastbyte - w.firstbyte + 1;
minbufsize := 1;
cylsize := 0;
END; æ with å
res := Okresult;
DO
res := GetException;
Scheck (wtref^^.termgate.open);
DO
res := GetException;
Scheck (waofifo.open);
ObjReturn (res);
END;
æ$Eå
æ****** E N T R Y W A I T B R E A K ******å
æ*******************************************å
ENTRY waitbreak
WITH RECORD
t :^^;
END;
BEGIN
æ PrintText ('--- wt.waitbreak ---');å
Scheck (wtref^^.termgate.lock);
Scheck (breakcond.wait);
Scheck (wtref^^.termgate.open);
END;
æ$Eå
æ****** E N T R Y W A I T R E A D Y ******å
æ*******************************************å
ENTRY waitready
WITH RECORD
t : ^^;
END;
BEGIN
æ PrintText ('--- wt.waitready ---');å
scheck (waofifo.lock);
Scheck (wtref^^.termGate.lock);
WITH w = wdata^^ do
w.break := false;
Scheck (wtref^^.termGate.open);
Scheck (waofifo.open);
END;
OTHERWISE waoother
WITH RECORD
t : ^^;
END;
BEGIN
Exception (MakeRes (reject*entryIllegal,universal,0,0));
END; æ otherwise å
END; æ waoimplement å
æ$Eå
æ****** I M P L E M E N T W I N D O W T E R M S Y S T E M ******å
æ********************************************************************å
PROGRAM wtsysimplement OBJECT windowfs WITH initlocals;
æ****** E N T R Y I N I T W T S Y S ******å
æ*******************************************å
PRIVATE atthandler ( wtptr : refwtsys);
ENTRY initwtsys
æ IN termname : fullId;
IN topline, bottomline : integerå
WITH RECORD
t : ^^;
wtEnv : refwtsys;
tempMan : ^^;
ipcref : ^^iosys;
END;
VAR res,ignore : resulttype;
size : sizetype;
i : integer;
used : integer;
BEGIN
æ PrintText ('--- wt.init ---'); å
æ check the lines å
IF (topline < 1) OR (bottomline > 24) OR (bottomline < topline + 8) OR
(elements(termname) > MaxIdLength) THEN
Exception (MakeRes (reject*DataValueIllegal,Universal,0,0));
IN
æ create shared envelope å
Scheck (clearsize (size));
Scheck (addEnv (size,refs (wtsyslocals)));
Scheck (addEmbseg (size,bytes(termdata)));
Xcheck (allocref.newobj (OUT wtOwn; IN size,OUT i));
Xcheck (declEnv (wtOwn,tempMan,wtEnv,refs(wtsyslocals),0,makesize(0,0),
makesize(-1,-1)));
Xcheck (NewSeg (wtEnv^^.tdata, bytes (termdata)));
æ initialize termdata å
WITH t = wtEnv^^.tdata^^ do
BEGIN
fillbytes (' ', t.terminalname);
copybytes (termnameÆ1..elements(termname)Å, t.terminalname);
t.namelength := elements (termname);
t.lineupper := topline;
t.linelower := bottomline;
t.actwindow := 1;
t.attcount := 0;
END;
æ create access to a terminal object å
Xcheck (ObjDirref.GetRef (OUT ipcref; termname, OUT used, OUT i));
Xcheck (ipcref.assign(OUT wtEnv^^.ipctao;
termnameÆused+1..elements(termname)Å,readwrite));
æ create gate object and conditions å
Scheck (schedref.NewGate (OUT wtEnv^^.termGate));
Scheck (wtEnv^^.termGate.NewCond (OUT wtEnv^^.rdcondÆ1Å));
Scheck (wtEnv^^.termGate.NewCond (OUT wtEnv^^.rdcondÆ2Å));
Scheck (wtEnv^^.termGate.NewCond (OUT wtEnv^^.attwait));
Scheck (MakeReentrant (egoEnv));
Scheck (copy (egoObj,wtenv^^.iosysObj));
æ create attention process å
size.user := 13000; size.kernel := 1000;
Scheck (schedref.NewProc (OUT wtEnv^^.attproc; size));
Xcheck (DeclProc (wtEnv^^.attproc, atthandler, wtEnv));
Xcheck (MoveMan (tempMan,wtptr));
DO BEGIN
ignore := DelEnv (tempMan,tempMan);
Objreturn (Getexception);
END;
END; æinit å
æ$Eå
æ****** E N T R Y A S S I G N ******å
æ*************************************å
PRIVATE close;
ENTRY assign
æOUT ownedfao; IN filename, IN iorightså
WITH RECORD
t : ^^;
TempEnv : ^^;
Tenv : refwao;
dummyPtr: ^^;
TempPtr : refwtsys;
END;
VAR res : resulttype;
nullsize,voidsize,size : sizetype;
i : integer;
found : boolean;
PROCEDURE INITUPPER (VAR TEnv : refwao);
VAR sepline : arrayÆ1..80Å of char;
erase : char;
i : integer;
BEGIN
æ PrintText ('--- wt.initupper ---'); å
erase := chr(ers);
WITH t = wtptr^^.tdata^^, w = TEnv^^.wdata^^ do
BEGIN
w.upperline := t.lineupper -1;
w.lowerline := ((t.linelower - 4) div 2 );
w.break := false;
w.cursorline := w.upperline;
w.position := 0;
w.mystate := active;
w.windowpart := 1;
æ the cursor is positioned by esc 1 position line å
w.curposÆ-1Å := chr (0);
w.curposÆ0Å := chr (12);
w.curposÆ1Å := chr(esc);
w.curposÆ2Å := '1';
w.curposÆ3Å := chr (0);
w.curposÆ5Å := chr(esc);
w.curposÆ6Å := 'K'; æ clear line å
w.curposÆ7Å := chr(esc);
w.curposÆ8Å := '1';
w.firstbyte := 1;
w.lastbyte := 0;
æ init spacebuf å
for i := 1 to 8 do
w.spacebufÆiÅ := ' ';
æ clear the screen å
xcheck (wtptr^^.ipctao.writeseq (VAR IN erase; OUT i, 1));
æ set cursor and write a separation line å
t.initcurÆ-1Å := chr (0);
t.initcurÆ0Å := chr (6);
t.initcurÆ1Å := chr(esc);
t.initcurÆ2Å := '1';
t.initcurÆ3Å := chr (0);
t.initcurÆ4Å := chr (w.lowerline + 1);
for i := 1 to 80 do
seplineÆiÅ := '-';
Xcheck (wtptr^^.ipctao.writeseq (VAR IN t.initcur; OUT i,formatted));
Xcheck (wtptr^^.ipctao.writeseq (VAR IN sepline; OUT i, 1));
æ set cursor position to home å
t.initcurÆ3Å := chr (0);
t.initcurÆ4Å := chr (w.upperline);
Xcheck (wtptr^^.ipctao.writeseq (VAR IN t.initcur; OUT i,formatted));
t.initcurÆ4Å := chr (w.lowerline + 1); æ reset initcur to sepline å
END; æ with å
END;
PROCEDURE INITLOWER (VAR Tenv : refwao);
VAR i : integer;
BEGIN
æ PrintText ('--- wt.initlower ---'); å
WITH t = wtptr^^.tdata^^, w = Tenv^^.wdata^^ do
BEGIN
w.upperline := ((t.linelower - 4) div 2) + 2;
w.lowerline := t.linelower - 2;
w.break := false;
w.cursorline := w.upperline;
w.position := 0;
w.mystate := passive;
w.windowpart := 2;
w.curposÆ-1Å := chr (0);
w.curposÆ0Å := chr (12);
w.curposÆ1Å := chr(esc);
w.curposÆ2Å := '1';
w.curposÆ3Å := chr (0);
w.curposÆ5Å := chr(esc);
w.curposÆ6Å := 'K';
w.curposÆ7Å := chr(esc);
w.curposÆ8Å := '1';
w.firstbyte := 1;
w.lastbyte := 0;
for i := 1 to 8 do
w.spacebufÆiÅ := ' ';
END;
END;
BEGIN
æ PrintText ('--- wt.assign ---'); å
æ this entry creates a wao and a data segment. The data segment
is initialized according to whether it is the upper or lower
part of the window. The first assigned is always the upper part å
æ find the corresponding wtsyslocals å
i := 1;
res := FirstInSet (wtptr,tempptr);
WHILE (res.main = OK) AND NOT found do
BEGIN
WITH t = tempptr^^.tdata^^ do
BEGIN
t.termnr := i;
i := i + 1;
found := checkname (t.namelength,t.terminalname,filename);
END;
IF NOT found THEN
res := NextInSet (wtptr,tempptr);
END; æ while å
IF NOT found THEN
Exception (Makeres (reject*FileNotFound,iofamily,0,0));
æ create a wao å
Scheck ( clearsize (size));
Scheck (addGen (size, refs (waolocals)));
Scheck (addEmbSeg (size, bytes (waodata)));
Rcheck (allocref.Newobj (OUT ownedfao; IN size, OUT i));
æ make wao a generel object å
scheck (clearsize (nullsize));
voidsize.user := -1; voidsize.kernel := -1;
Rcheck (DeclGen (ownedfao, waoman, Tenv,
refs (waolocals), close, nullsize, voidsize,
refs (waoImplement), bytes (waoImplement),
noControl, addr (waoImplement), nullsize, true));
æ create data segment å
Scheck (NewSeg (TEnv^^.wdata, bytes (waodata)));
æ create gates and condition å
Scheck (wtptr^^.termgate.Newcond (OUT Tenv^^.breakcond));
Scheck (schedref.NewGate (OUT TEnv^^.waofifo));
æ copy code pointer å
Scheck ( copy (code, TEnv^^.code));
Scheck (copy (tempptr,TEnv^^.wtref));
Scheck (makereentrant (Tenv));
æ check if lower or upper part of the window å
Res := RefEqual (void,tempptr^^.waoptrÆ1Å);
IF res.main = ok THEN
BEGIN
initupper (Tenv);
Scheck (copy (Tenv, tempptr^^.waoptrÆ1Å));
Scheck (copy (tenv^^.wdata, tempptr^^.wptrdataÆ1Å));
END
ELSE
BEGIN
initlower (Tenv);
Scheck (copy (tenv, tempptr^^.waoptrÆ2Å));
Scheck (copy (tenv^^.wdata, tempptr^^.wptrdataÆ2Å));
END;
END; æ assign å
æ$Eå
æ****** A T T E N T I O N P R O C E S S ******å
æ**********************************************å
PRIVATE atthandler
æ wtptr : refwtsyså
WITH RECORD
t : ^^;
TempEnv : refwao;
END;
VAR i : integer;
attstate : arrayÆ1..2Å of char;
c : byte;
OK : boolean;
PROCEDURE signalatt(VAR T : termdata);
BEGIN
WHILE t.attcount > 0 do
BEGIN
t.attcount := t.attcount - 1;
Scheck (wtptr^^.attwait.signal);
END;
END;
BEGIN
æ PrintText ('--- wt.attproc ---');å
Xcheck (wtptr^^.ipctao.waitready);
REPEAT
OK := false;
Xcheck (wtptr^^.ipctao.waitbreak);
Scheck (wtptr^^.termgate.lock);
REPEAT
IN
WITH t = wtptr^^.tdata^^ do
BEGIN
c := t.actwindow + ord ('0');
t.initcurÆ3Å := chr (72);
Xcheck (wtptr^^.ipctao.waitready);
Xcheck (wtptr^^.ipctao.writeseq (VAR IN OUT t.initcur; OUT i,formatted));
Xcheck (wtptr^^.ipctao.writeseq (VAR IN OUT c; OUT i,
unixmode));
Xcheck (wtptr^^.ipctao.readseq (VAR IN OUT attstate; OUT i,1));
CASE attstateÆ1Å OF
'0': æ break to active windowpart å
BEGIN
æ PrintText ('--- wt.break0 ---');å
WITH w = wtptr^^.wptrdataÆt.actwindowÅ^^ do
w.break := true;
signalatt(t);
Scheck (copy (wtptr^^.waoptrÆt.actwindowÅ,TempEnv));
Scheck (TempEnv^^.breakcond.signal);
END; æ break å
'1': æ shift to upper window å
BEGIN
æ PrintText ('--- wt.break1 ---'); å
IF t.actwindow = 2 THEN
BEGIN
WITH w = wtptr^^.wptrdataÆ1Å^^ do
w.mystate := active;
WITH w = wtptr^^.wptrdataÆ2Å^^ do
w.mystate := passive;
t.actwindow := 1;
signalatt(t);
scheck (wtptr^^.rdcondÆ1Å.signal);
END
ELSE
signalatt(t);
END;
'2': æ shift to lower window å
BEGIN
æ PrintText ('--- wt.break2 ---'); å
IF t.actwindow = 1 THEN
BEGIN
WITH w = wtptr^^.wptrdataÆ1Å^^ do
w.mystate := passive;
WITH w = wtptr^^.wptrdataÆ2Å^^ do
w.mystate := active;
t.actwindow := 2;
signalatt(t);
Scheck (wtptr^^.rdcondÆ2Å.signal);
END
ELSE
signalatt(t);
END;
OTHERWISE
signalatt(t);
END; æ case å
END; æ with t å
OK := true;
DO æ nothing å ;
UNTIL OK;
Scheck (wtptr^^.termgate.open);
UNTIL FALSE
END;
OTHERWISE wtsysother
WITH RECORD
t : ^^;
END;
BEGIN
Exception (MakeRes (reject*EntryIllegal,Universal,0,0));
END;
END; æ wtsys å
INITIALIZE
wtsysimplement 'windowfs':
allocref 'allocate',
schedref 'scheduler',
ObjDirref 'ObjDir',
egoEnv '**',
egoObj '*'
END.
«eof»