Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0068/tprin.iml
There are 2 other files named tprin.iml in the archive. Click here to see a list.
CALL ME !PRN.!;
#FILE: TPRIN.I10#

SUBR !PRN.!(Z) IS (
  !OL.!               IS COMMON;
  !OC.!, !PSW.!      ARE COMMON;
  !LC.!,!FM.!,!FL.!  ARE COMMON;
  !.JBREN!            IS COMMON;
  B IS 128 LONG;
 Q_14R AND 777777B;
 !PSW.!=0=>(!PSW.!_1; !OL.![1]_0; BN_127; !.JBREN!_LOC(REENT);
            (520B AND 1 LS [Q] RS 24)=0=>!OBIN.!(0,0,!OC.!,!OL.!));
 TD: T_[Q] RS 24; N_!PADR.!(Q);
 T NE 0 => (T=5=>(!POUT.!(15B); !POUT.!(12B); !LC.![!OC.!]_0; GO TO TZ);
            T=4=>(!OBIN.! (Q,0,!OC.!,!OL.!); GO TO TZ);
            T=6=>(!OBIN.! (!FBLK.!(Q),0,!OC.!,!OL.!); GO TO TZ);
            T=7=>(!PTR.![!OC.!]_4400000000B OR 777777B
                        AND !PTR.![!OC.!];
                  !PTE.![!OC.!]_4400000000B OR 777777B
                        AND !PTE.![!OC.!]);
              T=8=>(!DEV.!([N],0); GO TO TZ);
              T=9=>(TAB: !LC.![!OC.!]+1<[N]=>(
				!LC.![!OC.!]_!LC.![!OC.!]+1;
				!POUT.!(40B); GO TO TAB);
                    GO TO TZ);
	    T=10=>(FILLER_[N] RS 29; GO TO TZ); REMOTE FILLER: DATA(40B);
            T>11=>GO TO TV;
            !FM.![!OC.!]_T; !FL.![!OC.!]_[N]; GO TO TZ);
 F_!FM.![!OC.!]; G_!FL.![!OC.!]<R>-1;
 F=3=>(I_-1;S_P_010677777777B+N;
       TC: I<BN=>(ILDB(P)=>((I_I+1) NE G=>GO TO TC));
       I GE 0=>((B[J]_ILDB(S)) FOR J FROM I);
       GO TO TX);
 F=11=>(#FLOATING POINT OUTPUT - GET NR DECIMAL PLACES #
	D_!FL.![!OC.!] ARS 18;
	# SCALE TO RANGE [0.1,1) #
	ZZ_[N]; ZZ IS REAL;
	ZZ<0=>ZZ_-ZZ; EXP_0;
	ZZ=0=>(B_R'0'; I_0; GO TO TX);
	WHILE ZZ<0.1 DO (EXP_EXP-10; ZZ_ZZ*1.0"10);
	WHILE ZZ GE 1.0"10 DO (EXP_EXP+10; ZZ_ZZ*1.0"-10);
	WHILE ZZ GE 1.0 DO (EXP_EXP+1; ZZ_ZZ*0.1);
	# CHECK FOR FIT IN FIELD #
	SCI_1;
	# G NEG MEANS FORCE SCI NOT. #
	G>0=>G AND 400000B=>(G_-1-((G+1) LS 18) ARS 18;
			D_D+1; SCI_0);
	J_(EXP>0=>SCI*EXP ELSE 0);
	I_J+(D=>D+1 ELSE 0);
	G GE 0=>I GE G=>(SCI_0;
		(D_G-6) LE 1=>(D_2;
			G_-1); I_D+1);
	D=0=>I_I+1;
	FLT3: # ROUND #
	RND IS REAL; RND_0.5;
	I>1=>(RND_RND*0.1) FOR II FROM I-2;
	WHILE (ZZ+RND) GE 1.0 DO (RND_RND*0.1);
	ZZ_ZZ+RND;
	XP_SCI*EXP;
	I_-1; [N]<0=>B[127-I_I+1]_R'-';
	WHILE XP>0 DO(II_ZZ_10.0*ZZ; B[127-I_I+1]_R'0'+II//10; XP_XP-1);
	D>0=>(B[127-I_I+1]_R'.';
		((I_I+1) GE G=>G GE 0=>GO TO FLT1;
		 XP<0=>(B[127-I]_R'0'; XP_XP+1; GO TO LL7);
		 II_ZZ_10.0*ZZ; B[127-I]_R'0'+II//10;
		 LL7: 0) FOR J FROM D-1);
	FLT1: J_0;
	SCI=0=>(J_-1; XP_(EXP GE 0=>EXP ELSE -EXP);
		FLT2: B[J_J+1]_R'0'+XP//10;
		(XP_XP/10)=>GO TO FLT2;
		EXP<0=>B[J_J+1]_R'-';
		B[J_J+1]_R'"';
		J_J+1);
	(B[J+K]_B[127+K-I]) FOR K TO I;
	I_I+J;
	GO TO TX);

 F=7=>(!POUT.!([N]); GO TO TZ);
 I_0; X_[N];
 F=2=>(	X<0=>9R_-X ELSE 9R_X;
	TA: 9R_9R/10; B[I]_10R+60B; 9R=>(I_I+1; GO TO TA);
       X<0=>(I_I+1; B[I]_55B);
       GO TO TX);
 F=1=>(TB: B[I]_(X AND 7)+60B; (X_X RS 3)=>(I_I+1; GO TO TB);
       TL: I<G=>(I<11=>(I_I+1; B[I]_60B; GO TO TL)));

 TX: (J_G)>I=>T_J  ELSE  T_I;
 !LC.![!OC.!] _ !LC.![!OC.!] + T + 1;
 TE: J>I=>(J_J-1; !POUT.!(FILLER); GO TO TE);
 (!POUT.!(B[J])) FOR J FROM I;
 TZ: Q_Q+1; GO TO TD;
 TV: 14R<R>_(Q-1) AND 777777B;
 RETURN !LC.![!OC.!];
 REENT: FINI(0);
0);


SUBR !POUT.!(V) IS (
 !OC.!<0=>(EXECUTE 051040000000B+LOC(V); RETURN 0);
 !PTR.!, !PTE.! ARE COMMON;
 IDPB(V,!PTR.![!OC.!]);
 V=12B=>!OL.!>0=>(IDPB(0,!PTR.![!OC.!]);
                  !PTR.![!OC.!]_!PTE.![!OC.!]; GO TO TYPIT);
 !PTR.![!OC.!]=!PTE.![!OC.!]=>(
      TYPIT: !OL.!>0=>(!TYP.!(!PTR.![!OC.!],!OL.!); X_16)
               ELSE (OUTPUT(!OC.!+14B,!OL.!); X_128);
                !PTR.![!OC.!]_!PTR.![!OC.!]-X);
0);


SUBR !TYP.!(P,A) IS ( X_P; IDPB(0,X); OUTSTR([A]))%%