perm filename IOP.SAI[S,AIL] blob
sn#086458 filedate 1974-02-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00005 ENDMK
C⊗;
ENTRY;
BEGIN "IOP"
REQUIRE "ABBREV.SAI[S,RHT]" SOURCE_FILE;
DEFINE CHNMAX='17;
INTEGER ARRAY IDSTACK,CDBSTACK[0:CHNMAX];
INTEGER TOP;
EXTERNAL INTEGER CHANS;
SIMPLE PROCEDURE INIIOP;
BEGIN
TOP←-1;
END;
REQUIRE INIIOP INITIALIZATION[0];
INTERNAL SIMPLE PROCEDURE IOPUSH(INTEGER CH,ID);
BEGIN
LABEL PSHERR,XIT;
INTEGER CHXX;
IF (TOP←TOP+1) > CHNMAX THEN GO TO PSHERR;
CDBSTACK[TOP]←CHNCDB(CH)+(CH LSH 18);
IDSTACK[TOP]←ID LAND '777777;
IF ID LAND '777777000000 THEN
USERERR(1,1,"WARNING: IOPUSH ID > 18 BITS");
START_CODE
MOVE 1,CH;
ADD 1,GOGTAB;
SETZM CHANS(1);
HRLZ 1,CH;
LSH 1,5;
TLO 1,(_IOPSH)
HRR 1,ID;
XCT 1;
JRST PSHERR
JRST XIT;
END
PSHERR: USERERR(1,1,"IOPUSH LOST MISERABLY");
XIT: END;
SIMPLE INTEGER PROCEDURE IDFIND(INTEGER ID);
BEGIN
INTEGER CDBVAL,CIX;
FOR CIX←TOP STEP -1 UNTIL 0 DO
BEGIN
IF ID=IDSTACK[CIX] THEN
BEGIN
INTEGER I;
CDBVAL←CDBSTACK[CIX];
TOP←TOP-1;
FOR I←CIX STEP 1 UNTIL TOP DO
BEGIN
IDSTACK[I]←IDSTACK[I+1];
CDBSTACK[I]←CDBSTACK[I+1];
END;
RETURN(CDBVAL);
END;
END;
RETURN(-1);
END;
INTERNAL SIMPLE PROCEDURE IOPOP(INTEGER CH,ID);
BEGIN
INTEGER CDBVAL;
RELEASE(CH);
IF ID=0 THEN
BEGIN
CDBVAL←CDBSTACK[TOP];
TOP←TOP-1;
END
ELSE
CDBVAL←IDFIND(ID);
IF CDBVAL<0 THEN
USERERR(1,1,"IOPOP LOSES BIG");
START_CODE
HRLZ 1,CH;
LSH 1,5;
TLO 1,(_IOPOP);
HRR 1,ID;
XCT 1;
JRST 4,;
MOVE 2,GOGTAB;
ADD 2,CH;
HRRZ 3,CDBVAL;
MOVEM 3,CHANS(2);
END;
END;
INTERNAL SIMPLE PROCEDURE IOPDL(INTEGER C,ID);
BEGIN
INTEGER CDBVAL;
CASE C OF
BEGIN
[0] BEGIN
WHILE TOP≥0 DO IOPOP(CDBSTACK[TOP] LSH -18,0);
END;
[1] BEGIN
WHILE TOP≥0 DO
BEGIN