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";