Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
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 DIMWD 0 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";