Google
 
Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/iomod.sai
There is 1 other file named iomod.sai in the archive. Click here to see a list.
COMMENT    VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY WRITE,OPENFILE,REQSTR,ASK,REQINT,WRITEON,
C00007 ENDMK
C;


ENTRY WRITE,OPENFILE,REQSTR,ASK,REQINT,WRITEON,
	TYFSET,FLFSET;

BEGIN "IOMOD"

REQUIRE "ABBREV[S,RHT]" SOURCEFILE;
REQUIRE "IOMOD.HDR[S,RHT]" SOURCEFILE;

INTERNAL STRING SIMPLE PROCEDURE REQSTR(STRING REQ);
	BEGIN
	OUTSTR(REQ);
	RETURN(INCHWL);
	END;

INTERNAL BOOLEAN SIMPLE PROCEDURE ASK(STRING S);
	BEGIN
	OUTSTR(S);OUTSTR("?");
	RETURN((INCHWL LAND '137)="Y"); COMMENT turn off '40 bit;
	END;

INTERNAL INTEGER SIMPLE PROCEDURE REQINT(STRING S);RETURN(CVD(REQSTR(S)));

INTERNAL PROCEDURE OPENFILE(REFERENCE INTEGER CH;VALUE STRING FIDREQ;
		INTEGER  M,IB,OB;REFERENCE INTEGER EOFF);
	BEGIN
	INTEGER BRKR;
	INTEGER SCCT;
	SCCT_1000;
	OPEN(CH_GETCHAN,"DSK",M,IB,OB,SCCT,BRKR,EOFF);
	IF IB > 0 THEN
		BEGIN
		LOOKUP(CH,FIDREQ,EOFF);
		WHILE EOFF DO LOOKUP(CH,
			REQSTR("LOOKUP FAILED FOR  "&FIDREQ&"  FILE ="),EOFF);
		END;
	IF OB>0 THEN 
		BEGIN
		ENTER(CH,FIDREQ,EOFF);
		WHILE EOFF DO ENTER(CH,
			REQSTR("ENTER FAILED FOR "&FIDREQ&"   FILE ="),EOFF);
		END;
	END;

INTERNAL INTEGER OUCH,OEOF;
INTERNAL SIMPLE PROCEDURE WRITEON(STRING S;INTEGER OPF(0));
	BEGIN
	$PRINT(S,OPF);
	END;

INTERNAL SIMPLE PROCEDURE WRITE(STRING S;INTEGER OPF(0));
	BEGIN
	$PRINT(S,OPF);
	$PRINT(CRLF,OPF);
	END;

INTERNAL INTEGER SIMPLE PROCEDURE ISOPEN(INTEGER CH);
	STARTCODE
	EXTERNAL INTEGER CDBLOC,GOGTAB;
	LABEL XIT;
	DEFINE USER "<>"=<'15>;
	MOVE	USER,GOGTAB;
	HRRZ	1,CDBLOC(USER);
	JUMPE	1,XIT;
	ADD	1,CH;
	MOVE	1,(1);
XIT:	END;

INTERNAL SIMPLE PROCEDURE INIOUTPUT(INTEGER CTL(0);STRING FID(NULL));
	BEGIN
	INTEGER UCTL;
	EXTERNAL INTEGER PRNINF;
	USERCON(PRNINF,UCTL,0);
	IF CHNSPCON(UCTL) THEN RELEASE(UCTL LAND '777777);
	IF (CTL LAND (TTYYES+TTYNOT)) THEN
		CTL_CTL LOR (IF ASK("Output to tty") THEN TTYYES ELSE TTYNOT);
	IF (CTL LAND (CHNSPC+CHNNOT)) THEN
		BEGIN
		IF LENGTH(FID)  ASK("Output to a file") THEN
			CTL_((CTL LOR CHNSPC) LAND '777777000000)
				+ (GETCHAN LAND '777777)
		ELSE
			CTL_CTL LOR CHNNOT;
		END;
	IF CHNSPCON(CTL) THEN
		BEGIN
		IF  LENGTH(FID) THEN 
			FID_REQSTR("Output file id =");
		OUCH_CTL LAND '777777;
		OEOF_0;
		IF ISOPEN(OUCH) THEN
			OPEN(OUCH,"DSK",0,0,3,0,0,OEOF)
		ELSE
			CLOSE(OUCH);
		IF OEOF THEN USERERR(1,1,"COULDNT OPEN CHANNEL");
		ENTER(OUCH,FID,OEOF);
		WHILE OEOF DO 
			BEGIN
			OUTSTR("
Enter failed on file """&fid&"""
");
			FID_REQSTR("Output file =");
			END;
		END;
	USERCON(PRNINF,CTL,1);
	END;

INTERNAL SIMPLE PROCEDURE CLOUTPUT;
	BEGIN
	EXTERNAL INTEGER PRNINF;
	INTEGER UCTL;
	USERCON(PRNINF,UCTL,0);
	IF CHNSPCON(UCTL) THEN RELEASE(UCTL LAND '777777);
	END;

END "IOMOD"