Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/recin.sai
There is 1 other file named recin.sai in the archive. Click here to see a list.
COMMENT    VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY RREAD
C00005 00003	SIMPROC SETFLD(INTEGER TYPPOINTER FLDINTEGER VAL)
C00007 00004	STRING SIMPROC CVASTR(INTEGER WD)
C00009 00005	PROCEDURE ARRRD(POINTER FIXUPINTEGER CHN)
C00011 00006	INTERNAL RPTR(ANYCLASS) PROCEDURE RREAD(INTEGER CHNBOOLEAN PROCEDURE PRED)
C00015 ENDMK
C;

ENTRY RREAD;

BEGIN "RECIN"

REQUIRE "PROLOG.HDR[SYS,PDQ]" SOURCEFILE;
REQUIRE "LIB.HDR[SYS,PDQ]" SOURCEFILE;

DEFINE RING=INTEGER;

EXTERNAL RECORDCLASS $CLASS(RPTR($CLASS) RECRNGS;PROCEDURE HNDLER;INTEGER RECSIZ;
				INTEGER ARRAY TYPARR;STRING ARRAY TXTARR);

EXTERNAL RPTR(ANYCLASS) PROCEDURE $REC$(INTEGER OP;RPTR($CLASS) R);

INTEGER DISKLOC;
EXTERNAL POINTER RECCHN;
POINTER RECARR;
DEFINE BSIZ=128;

PROCEDURE DSKPOS(INTEGER CHN,ADR);
BEGIN	INTEGERARRAY FOO[1:BSIZ];
	INTEGER N,S;
	IF (N_ADR-DISKLOC)<4*BSIZ THEN 
	 WHILE N>0 DO 
		 S_BSIZ MIN N;N_N-S;ARRYIN(CHN,FOO[1],S)
	 ELSE  USETI(CHN,ADR DIV BSIZ+1);
		ARRYIN(CHN,FOO[1],ADR MOD BSIZ);;
	DISKLOC_ADR;
END;
	 
SIMPROC FIXUP(RPTR(ANYCLASS) REC;REFERENCE RPTR(ANYCLASS) L);
 STARTCODE
	LABEL AGAIN,XIT;
	DEFINE A=1,B=2,R=3;
	MOVE A,L;MOVE R,REC;HRRZM R,L;
	JUMPE A,XIT;
 AGAIN:	MOVE B,(A);MOVEM R,(A);MOVE A,B;JUMPN A,AGAIN;
 XIT:
 END;


DEFINE MEMLOC(X)=MEMORY[LOCATION(X)];

DEFINE RINGHD(X)=(LOCATION(X)+2);

RPTR(ANYCLASS) SIMPLE PROCEDURE RINGRT(REFERENCE POINTER R;POINTER HD);
STARTCODE LABEL XIT;
	SKIPN 1,R;
	JRST XIT;		! NULL RECORD -- RETURN(NIL);
	HRRZ 2,HD;
	HRRZ 1,-1(1);		! RING POINTER;
	CAIN 1,(2);		! POINTER TO HEAD;
	MOVEI 1,0;
XIT:	MOVEM 1,R;
END;

RPTR($CLASS) PROCEDURE FINDREC(STRING S);
 BEGIN
   POINTER CLSHD,CLSPT;
   RPTR($CLASS) CLS;
   CLSPT_CLSHD_RINGHD($CLASS);
   WHILE (CLS_RINGRT(CLSPT,CLSHD))NIL DO
	IF EQU($CLASS:TXTARR[CLS][0],S) THEN RETURN(CLS);
   STRIN("CAN'T FIND RECORD="&S&CRLF);
   RETURN(NIL);
 END;


SIMPROC SETFLD(INTEGER TYP;POINTER FLD;INTEGER VAL);
 STARTCODE
	DEFINE SP='16,A=1,B=2,T=3,R=4,V=5,S=6;
	LABEL FX,F0,ST1,F2S,ARR,FS,STRNG;
	MOVE V,VAL;
	MOVE R,FLD;
	SKIPN S,(R);		! DON'T CLOBBER DEFINED FIELDS;
	MOVEM V,(R);		! THIS WORKS FOR SIMPLE CASES;
	JUMPE V,FX;		! NULL FIELDS NEED NO MORE WORK;
	HLRZ T,TYP;
	LSH T,-5;
	TRNE T,'20;		! ARRAY?;
	JRST ARR;		! YES, ARRAY;
	CAIN T,3;		! STRING?;
	JRST STRNG;
	CAIE T,'15;		! RECORD?;
	JRST FX;		! NO, MUST BE SIMPLE TYPE ... DONE;
	MOVE A,RECARR;		! RECORD ARRAY BASE;
	ADD A,V;		! PLUS RECORD NUMBER;
	SKIPG B,(A);	
	HRROM R,(A);		! CHAIN THE UNDEFINED RECORD POINTER;
	MOVEM B,(R);		! POINT TO DEFINED RECORD OR FIXUP CHAIN;
	JRST FX;
	
STRNG:	MOVEM V,(S);		! FIXUP INFO PLACED IN STRING DESCR;
ARR:	HRL R,T;		! PUT ARRAY (OR STRING) TYPE IN LEFT HALF;
	PUSH SP,R;		! REMEMBER LOCATION TO FIXUP (WHICH CONTAINS IOWD);
    FX:
  END;



STRING SIMPROC CVASTR(INTEGER WD);
IF WD=0 THEN RETURN(NULL)
ELSE 
BEGIN	STRING S;
	S_CVSTR(WD);
	WHILE S[ FOR 1]=0 DO S_S[1:-1];
	RETURN(S);
END;

SIMPROC STRRD(POINTER F;INTEGER CHN);
BEGIN	INTEGER I,N,FIX;
	STRING S;
	FIX_MEMORY[F];
	IF RTHALF(FIX)DISKLOC THEN OUTSTR("DISK ORDERING ERROR");
	STARTCODE HLRE 1,FIX;MOVNM 1,N;END;
	S_NULL;
	FOR I_1 STEP 1 UNTIL N-1 DO
	 S_S&CVSTR(WORDIN(CHN));
	S_S&CVASTR(WORDIN(CHN));	! SUPPRESS TRAILING NULLS AT END OF LAST WORD;
	MEMORY[F-1]_MEMORY[LOCATION(S)-1];
	MEMORY[F]_MEMORY[LOCATION(S)];
	! COPY STRING DESCR;
	DISKLOC_DISKLOC+N;
END;

SIMPROC STARRRD(INTEGER CHN;POINTER ARR);
 BEGIN	INTEGER I,WD,XOPT,N,PT,C,SIZ;
	STRING S;
	STARTCODE MOVE 1,ARR;HRRZ 1,-2(1);MOVEM 1,SIZ;END;
	XOPT_POINT(7,WD,-1);
	N_0;
	FOR I_1 STEP 2 UNTIL SIZ DO
	 BEGIN
	  S_NULL;
	  WHILE TRUE DO
	    BEGIN
		IF N=0 THEN 
		  BEGIN WD_WORDIN(CHN);N_5;PT_XOPT;DISKLOC_DISKLOC+1;END;
		C_ILDB(PT);N_N-1;
		IF C=NULL THEN DONE;
		S_S&C;
	    END;
	  MEMORY[ARR+I-2]_MEMORY[LOCATION(S)-1];
	  MEMORY[ARR+I-1]_MEMORY[LOCATION(S)];
	 END;
 END;		


PROCEDURE ARRRD(POINTER FIXUP;INTEGER CHN);
BEGIN	INTEGER I,LOC,T,N,DIM,CHNL,SIZ;
	EXTERNAL PROCEDURE ARMAK;
	POINTER ARR;
	DIM_WORDIN(CHNL_CHN);
	STARTCODE 
		HLRE 1,DIM;MOVMM 1,I;HRR 1,I;MOVEM 1,N;
	END;
	
	I_2*I;
	
	DISKLOC_DISKLOC+I+1;
	STARTCODE
	 DEFINE P='17;
	 LABEL AGAIN;
AGAIN:	 PUSH P,CHNL;PUSHJ P,WORDIN;PUSH P,1;	! BOUNDS;
	 SOSLE I;JRST AGAIN;
	 PUSH P,N;				! N NEGATIVE FOR STRING ARRAY;
	 PUSHJ P,ARMAK;
	 MOVEM 1,ARR;				! ALLOCATE THE ARRAY;
	 HRRZ 1,-1(1);
	 MOVEM 1,SIZ;				! NO GOOD FOR STRING ARRAYS;
	END;
	MEMORY[FIXUP]_ARR;
	T_LTHALF(FIXUP);
	IF T='41 THEN 				! RECORD ARRAY;
	 FOR I_1 STEP 1 UNTIL SIZ DO
	  	MEMORY[ARR+I-1]_MEMORY[RECARR+WORDIN(CHNL)]
	ELSE IF T='27 THEN			! STRING ARRAY;
		STARRRD(CHN,ARR)
	ELSE STARTCODE 			! SIMPLE TYPE ARRAY;
		DEFINE P='17;
		PUSH P,CHNL;PUSH P,ARR;PUSH P,SIZ;PUSHJ P,ARRYIN;
	     END;
	IF T'27 THEN DISKLOC_DISKLOC+SIZ;
END;
	

INTERNAL RPTR(ANYCLASS) PROCEDURE RREAD(INTEGER CHN;BOOLEAN PROCEDURE PRED);
BEGIN
	INTEGER RECNUM;
	RPTR(ANYCLASS) HANDLE;
	INTEGER SPSAV,SPTOP;
	
	STARTCODE MOVEM '16,SPSAV;END;		! REMEMBER INITIAL STRING STACK;
	
	RECNUM_WORDIN(CHN);
	DISKLOC_1;
	 BEGIN
		INTEGER I,J,NAM,SIZ,SPNUM;
		RPTR($CLASS) CLS;
		RPTR(ANYCLASS) ARRAY RECS[0:RECNUM];
		RPTR(ANYCLASS) REC;

		STARTCODE MOVE 1,RECS;MOVEM 1,RECARR;END;
		
		FOR I_1 STEP 1 UNTIL RECNUM DO
		 BEGIN
			NAM_WORDIN(CHN);		! SIXBIT RECORD CLASS NAME;
			CLS_FINDREC(CV6STR(NAM));	! FIND RECORD CLASS;
			REC_$REC$(1,CLS);		! ALLOCATE RECORD;
			SIZ_$CLASS:RECSIZ[CLS];
			DISKLOC_DISKLOC+SIZ+1;
			
			FOR J_1 STEP 1 UNTIL SIZ DO	! READ ALL FIELDS;
			   SETFLD($CLASS:TYPARR[CLS][J],MEMLOC(REC)+J,WORDIN(CHN));

			FIXUP(REC,RECS[I]);		! FIXUP ALL FORWARD REFERENCES;
		 END;

		HANDLE_RECS[1];
				! WE NOW HAVE ALL RECORDS;
				! STRING STACK CONTAINS FIXUP INFO FOR ARRAYS AND STRINGS;
		STARTCODE
		 MOVE 1,'16;SUB 1,SPSAV;HRRZM 1,SPNUM;
		END;		! DETERMINE NUMBER OF FIXUPS;

		IF SPNUM>0 THEN
		BEGIN "FIXES"
		 INTEGERARRAY FIXUP[1:SPNUM];
		 INTEGER L,F,I,TOTSIZ,VIRTLOC,TYP;
		 FOR I_SPNUM STEP -1 UNTIL 1 DO
		  BEGIN 
			STARTCODE POP '16,F;END;	! WIND DOWN STRING STACK;
			FIXUP[I]_F;			! STORE FIXUPS;
		  END;
		 VIRTLOC_DISKLOC;
		 FOR I_1 STEP 1 UNTIL SPNUM DO
		  BEGIN	F_FIXUP[I];
			L_MEMORY[F];			! PROCESS FIXUPS;
			TYP_LTHALF(F);
			TOTSIZ_-(MEMORY[F] ASH -18);
			IF PRED(TOTSIZ,TYP) THEN
			  MEMORY[F]_0;VIRTLOC_VIRTLOC+TOTSIZ;
			ELSE 
			 BEGIN	IF VIRTLOC>DISKLOC THEN DSKPOS(CHN,VIRTLOC);
				IF TYP=3 THEN STRRD(L,CHN)
				 ELSE ARRRD(F,CHN);
				VIRTLOC_DISKLOC;
			 END;
		  END;
		END "FIXES";
	 END;
	RETURN(HANDLE);
END "RREAD";


INTERNAL RPTR(ANYCLASS) PROCEDURE RECIN(STRING FILE;BOOLEAN PROCEDURE PRED);
 BEGIN	INTEGER CHN;
	RPTR(ANYCLASS) REC;
	RPTR(IO) INP;
	CHN_MKIODEV(FILE);
	INP_IOCHANS[CHN];
	IO:MODE[INP]_'14;
	FILEOP("L",CHN);
	REC_RREAD(CHN,PRED);
	FILEOP("R",CHN);
	RETURN(REC);
 END;
	
END "RECIN";