Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0002/recout.sai
There is 1 other file named recout.sai in the archive. Click here to see a list.
COMMENT    VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY RECOUT
C00004 00003	INTEGER SIMPROC FLDVAL(INTEGER FLD,TYP)
C00007 00004	SIMPROC STAOUT(POINTER IOWINTEGER CHN)
C00009 00005	SIMPROC ARROUT(POINTER ARRINTEGER CHN)
C00011 00006	INTEGER SIMPLE PROCEDURE RECSW0
C00015 00007		! OUTPUT ALL STRINGS AND ARRAYS
C00017 ENDMK
C;

ENTRY RECOUT;

BEGIN "RECOUT"

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

INTEGER DISKLOC;
EXTERNAL POINTER RECCHN;
POINTER RECS1,RECS1P1;
INTEGER RECNUM,TOTNUM;
DEFINE RING=INTEGER;

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

RPTR($CLASS) PROCEDURE RECCLS(RPTR(ANYCLASS) R);
 STARTCODE MOVE 1,R;HRRZ 1,(1);END;

INTERNAL INTEGER PROCEDURE RECLEN(RPTR(ANYCLASS) R);
		RETURN($CLASS:RECSIZ[RECCLS(R)]);

INTERNAL STRING PROCEDURE CVRTS(RPTR(ANYCLASS) REC);
RETURN(IF REC=NIL THEN "NIL"
	ELSE $CLASS:TXTARR[RECCLS(REC)][0]);

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

INTEGER SIMPROC FLDVAL(INTEGER FLD,TYP);
 STARTCODE
	DEFINE SP='16;
	LABEL FX,F0,ST1,F2S,ARR,FS;
	SKIPN 1,FLD;
	JRST FX;		! NOTHING TO DO FOR NULL FIELD;
	HLRZ 3,TYP;
	LSH 3,-5;		! ADJUST TYPE BITS;
	TRNE 3,'20;		! ARRAY?;
	SOJA 1,ARR;		! YES;

	CAIN 3,'15;		! RECORD?;
	HLRZ 1,(1);		! GET RECORD #;
	CAIE 3,3;		! STRING?;
	JRST FX;		! NO, DONE;
	HRLI 1,-1;		! STRING POINTER HAS -1 IN LEFT HALF;
	PUSH SP,1;		! PUSH POINTER TO STRING DESC;
	HRRZ 4,-1(1);		! LENGTH OF STRING;
	ADDI 4,1;		! EXTRA NULL AT END OF STRING;
	IDIVI 4,5;
	SKIPE 5;
	ADDI 4,1;		! # WORDS FOR STRING;
	JRST FS;		! ALLOCATE SPACE;

ARR:	HRLI 1,0;		! ZERO LEFT HALF;
	CAIE 3,'27;		! COMPLICATED CASE OF ARRAY;
	AOJA 1,F0;
				! HERE WE HAVE A STRING ARRAY;
				! WE MUST COMPUTE THE SPACE IT WILL TAKE;
	HRLZ 2,-1(1);		! LENGTH;
	MOVNS 2;
	HRR 2,1;		! IOWD TO ARRAY;
	MOVEI 4,0;

ST1:	HRRZ 3,(2);		! GET LENGTH OF STRING;
	ADDI 4,1(3);		! SUM(LENGTH(I)+1);
	ADD 2,['1000001];
	AOBJN 2,ST1;

	IDIVI 4,5;		! TOTAL WORDS NEEDED FOR STRINGS;
	SKIPE 5;
	ADDI 4,1;		! +1;
	MOVE 2,4;
	HLL 2,-1(1);		! # DIMS;
	JRST F2S;		! IOWD FOR DISK VERSION OF STRING ARRAY;

F0:	CAIN 3,'41;
	HRLI 1,1;		! RECORD ARRAY - INDICATE IN LEFT HALF;
	MOVE 2,-1(1);		! #DIMS,,LENGTH;

F2S:	PUSH SP,1;		! REMEMBER POINTER TO ARRAY;
	HLRE 4,2;		! #DIMS;
	MOVMS 4;
	ADDI 4,1(4);		! 2*#DIMS+1;
	ADDI 4,(2);		! TOTAL LENGTH OF OUTPUT;

FS:	MOVN 1,4;
	MOVSS 1;
	HRR 1,DISKLOC;		! RETURN IOWD TO ARRAY ON DISK;
	ADDM 4,DISKLOC;		! ACCUMULATE ARRAY LENGTHS;
    FX:
  END;



SIMPROC STAOUT(POINTER IOW;INTEGER CHN);
! OUTPUT A STRING ARRAY;
BEGIN	INTEGER XOPT,WD,CHNL;
	XOPT_POINT(7,WD,-1);
	CHNL_CHN;
	STARTCODE
		LABEL NW,NC,DC,STX,NXT,NXTS,NCEND;
		DEFINE A=1,OPT=2,PT=3,N=4,C=5,P='17;
		MOVE A,IOW;			! IOWD TO LIST OF STRINGS;
		MOVE OPT,XOPT;

	NXTS:	MOVE PT,(A);			! STRING POINTER;
		HRRZ N,-1(A);			! LENGTH;
	NCEND:	PUSH P,A;
NW:	NC:	 JUMPLE N,STX;
		 ILDB C,PT;
 	DC:	 IDPB C,OPT;
		 TLNE OPT,'760000;
		 SOJA N,NC;		! WORD FILLED;
		 PUSH P,N;
		 PUSH P,PT;
		 PUSH P,CHNL;
		 PUSH P,WD;
		 PUSHJ P,WORDOUT;	! OUTPUT THE WORD;
		 POP P,PT;
		 POP P,N;
		 MOVE OPT,XOPT;
		 SOJA N,NW;
		 
	 STX:	 JUMPL N,NXT;
		 MOVEI C,0;
		 SOJA N,DC;		! END WITH A NULL CHAR;

	 NXT:	 POP P,A;
		 ADD A,['2000002];
		 JUMPL A,NXTS;		! AGAIN WITH NEXT STRING;
		 MOVEI N,3;
		 MOVEI PT,0;
		 TLNN A,-1;
		 JRST NCEND;		! DEPOSIT 4 NULLS TO FLUSH LAST WORD;

	END;
END "STAOUT";

SIMPROC STOUT(POINTER ST;INTEGER CHN);
! OUTPUT A SINGLE STRING;
 STARTCODE MOVEI 1,-2;HRLM 1,-2('17);JRST STAOUT;END;


SIMPROC ARROUT(POINTER ARR;INTEGER CHN);
! OUTPUT ALL KINDS OF ARRAYS;
BEGIN
  DEFINE P='17;
  INTEGER DIM,WDS,DIMWD;
  POINTER AR,RA,IOW;
   STARTCODE
	MOVE 1,ARR;
	HRRZM 1,AR;
	HLRZM 1,RA;
	MOVE 2,-1(1);		! #DIMS,,LENGTH;
	MOVEM 2,DIMWD;
	HLRE 3,2;		! #DIMS;
	MOVMS 3;
	MOVEM 3,DIM;
	HRRZM 2,WDS;
	MOVNS 2;
	HRL 1,2;
	MOVEM 1,IOW;		! IOWD TO ARRAY;
   END;

BEGIN
 INTEGER L,W;
 WORDOUT(CHN,DIMWD);
 FOR L_1 STEP 1 UNTIL DIM  DO
  BEGIN	 WORDOUT(CHN,MEMORY[W_AR-1-3*L]);	! LOWER BOUND;
	 WORDOUT(CHN,MEMORY[W+1]);	! UPPER BOUND;
  END;
END;

IF RA=1 THEN	
  STARTCODE 				! OUTPUT THE RECORD ARRAY;
	LABEL L1;
	MOVE 1,IOW;			! IOWD TO ARRAY;
 L1:	MOVE 2,(1);			! ARRAY ELEMENT;
	HLRZ 2,(2);			! RECORD#;
	PUSH P,1;
	PUSH P,CHN;
	PUSH P,2;
	PUSHJ P,WORDOUT;
	POP P,1;
	AOBJN 1,L1;
  END
 
 ELSE IF DIMWD0 THEN			! OUTPUT SIMPLE ARRAY;
  STARTCODE PUSH P,CHN;PUSH P,AR;PUSH P,WDS;PUSHJ P,ARRYOUT;END 

 ELSE STAOUT(IOW+1,CHN);		! OUTPUT STRING ARRAY;
END "ARROUT";

INTEGER SIMPLE PROCEDURE RECSW0;
! DETERMINE NUMBER OF MARKED RECORDS: LENGTH OF CHAIN;
STARTCODE
	DEFINE N=1,A=2;
	LABEL L,LX;
	MOVEI N,0;
	HLRZ A,RECCHN;
L:	CAIN A,-1;	! END OF CHAIN?;
	JRST LX;	! YES, DONE;
	HLRZ A,(A);	! NO, FOLLOW CHAIN;
	AOJA N,L;
LX: END;
	

EXTERNAL PROCEDURE $RMARK;

INTERNAL PROCEDURE RECOU2(RPTR(ANYCLASS) HANDLE;INTEGER CHN);
BEGIN
	RPTR(ANYCLASS) R;
	POINTER LST,SPSAV,SPTOP;
	INTEGER I;

	PROCEDURE OUTREC(RPTR(ANYCLASS) R;INTEGER CHN);
	 BEGIN
		INTEGER N,I,NAM;
		POINTER LR,LC;
		RPTR($CLASS) RCL;
		RCL_RECCLS(R);
		N_$CLASS:RECSIZ[RCL];
		NAM_CVSIX($CLASS:TXTARR[RCL][0]);
		LC_MEMLOC($CLASS:TYPARR[RCL]);	! POINTER TO TYPARR;
		LR_MEMLOC(R);			! POINTER TO RECORD;

		WORDOUT(CHN,NAM);		! OUTPUT RECORD CLASS ID;
		FOR I_1 STEP 1 UNTIL N DO
		   WORDOUT(CHN,FLDVAL(MEMORY[LR+I],MEMORY[LC+I]));	! EACH FIELD;
	 END "OUTREC";

	STARTCODE
	 MOVE 1,HANDLE;HRROS (1);HRROM 1,RECCHN;! MARK ALL ACCESSIBLE FROM HANDLE;
	 MOVEM '16,SPSAV;			! REMEMBER STRING STACK POINTER;
	END;
	$RMARK;			! MARK ALL RECORDS ACCESSABLE FROM REC;
	RECNUM_RECSW0;		! DETERMINE NUMBER OF RECORDS;
				! 1ST SWEEP PASS - ASSIGN RECORD #S;
	BEGIN
	 RPTR(ANYCLASS) ARRAY RECARR[1:RECNUM];
	 STARTCODE
		DEFINE RECSIZ=3,TYPARR=4,TXTARR=5;
		DEFINE A=1,L=2,H=3,N=4,S=5,B=7;
		LABEL L1,L2,LX;
		MOVE S,RECNUM;		! SIZE_RECNUM+SUM(RECSIZ(I));
		MOVEI N,2;
		MOVE L,RECARR;
		HLRZ A,RECCHN;
		MOVE H,HANDLE;
		MOVE B,(H);		! CLASS;
		ADD S,RECSIZ(B);	! SIZE OF HANDLE;
		MOVEM H,(L);		! RECARR[1]_HANDLE;
		AOJA L,L2;

 	L1:	HLRZ A,(A);
	L2:	CAIN A,-1;
		JRST LX;		! DONE;
		CAMN A,H;		! DON'T INDEX HANDLE AGAIN;
		JRST L1;
		MOVEM A,(L);
		MOVE B,(A);		! CLASS;
		MOVE B,RECSIZ(B);	! SIZE OF RECORD;
		ADD S,B;		! ACCUMULATE RECORD SIZES;
		HLRZ B,(A);		! FOLLOW CHAIN;
		HRLM N,(A);		! INSERT RECORD INDEX;
		MOVE A,B;
		AOS L;
		AOJA N,L2;
	 LX:	MOVEI N,1;
		HRLM N,(H);		! INDEX HANDLE;
		MOVEM S,TOTNUM;
	  END;
	DISKLOC_1+TOTNUM;
	WORDOUT(CHN,RECNUM);
	FOR I_1 STEP 1 UNTIL RECNUM DO
	 OUTREC(RECARR[I],CHN);			! OUTPUT ALL RECORDS;

	! OUTPUT ALL STRINGS AND ARRAYS;
	 STARTCODE
		DEFINE SP='16,P='17;
		LABEL L,LX;
		MOVEM SP,SPTOP;
		MOVE SP,SPSAV;
	 L:	CAMN SP,SPTOP;
		JRST LX;			! DONE;
		ADD SP,['1000001];
		PUSH P,(SP);
		PUSH P,CHN;
		SKIPL (SP);
		PUSHJ P,ARROUT;			! ARRAY;
		SKIPGE (SP);
		PUSHJ P,STOUT;			! STRING;
		JRST L;

	 LX:	MOVE SP,SPSAV;
	 END;

	! LAST PASS TO UNMUNG RECORD INDEX (MARK) FIELDS;
	FOR I_1 STEP 1 UNTIL RECNUM DO
	 BEGIN	R_RECARR[I];
		QUICKCODE MOVE 1,R;HRRZS (1);END;
	 END;
    END;
END "RECOU2";


INTERNAL PROCEDURE RECOUT(RPTR(ANYCLASS) R;STRING FILE);
BEGIN
	INTEGER CHN;
	RPTR(IO) ODEV;
	CHN_MKIODEV(FILE);
	ODEV_IOCHANS[CHN];
	IO:MODE[ODEV]_'14;
	FILEOP("E",CHN);
	RECOU2(R,CHN);
	FILEOP("R",CHN);
END;

END "RECOUT";