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