X7$ ?BOOT-U-No boot on volume ߋtv @i9g&9g& SRT11A DECRT11A ~wZ.IcNf>`K լ,<5ohZ Gs#_q]ܱS~`A~"2}V)3T\c վu)&Zƛ :zҔi0뒰^s骰"X8m<s!%ܭ~sKԂ>czI`Ϫ/k~ 0cTFzSZ"-XU^jGܭ>''i \:.Vbޥ,{V}iЫisCOQ;n恭h N236oX睛 ay%bL\JM2ounfC`<`du9qg6QpT9O& KI—p+Ѻ ӺȜ4aP29tLt+bJ(@}牜Z Xc\=d~voqKW)ivɒ4v]9QnI*RSo=j6 %ۍh^K7ƨHx2U q;?^.Ŭě49,9|$mA I$%\eD\vJn>aTaY+e|A&4^pOv-j1;*'= p޳ X QNvm%8/0<0-_>@tCq#6 ,Hy?91Bbќ&AĊdz4cNV_&d,5yɉx<՟&V+ѩ+haq 4y6S?8;W2If52r2IwkJ8tѾ([h_2Jr |@vd;tٗĒtJlW+- h"):qEp|y^*G3"nf[0-,YVS#ܤŕ+b !~  l: ion.HT ߰H_~G 8^l애 N׋ A㤇 ("#Ę24ELCHf^Ͷ,,d"]GQ$0|vhqɇo&\Ώ|:ncC"KebGAQ{ o|]UإX'@Kv>rFeVG|tw JsbJ)\ЧWŹ ֫\~іC.^mr:EDVONwM}u1\z&/gg`* w1C2+Œn;9g tЈ%1"m'ATi .Ӳo_ gnU@DnH⼄3I' jGVA;;8Jr w\A1ʋ[s@FAߛ:F(<N*ĨH V`gF60Zn 42K me@}Њ:ˀ7Wk+]А ?#Mr ~OC,{a16 -6jCϏVϊ(icE#eOl9.# ONLY IN RESPONSE TO A REQUEST FOR INPUT',/) 20 CALL ERASEL WRITE(5,3) 3 FORMAT('+','DEMO: ',$) READ(5,4)ID 4 FORMAT(I5) CALL CURSOR(-1,0) IF(ID.EQ.0)GOTO 999 IF(ID.LT.1.OR.ID.GT.6)GOTO 20 CALL ERASE GOTO(5,6,7,8,9,10),ID 5 CALL INTRO GOTO 1 6 CALL WIDGET GOTO 1 7 CALL RLC GOTO 1 8 CALL HOSP GOTO 1 9 CALL SPEC GOTO 1 10 CALL BALL GOTO 1 999 STOP END SUBROUTINE BOX REAL X(4),Y(4),XV(4),YV(4) COMMON /DPYBUF/ IDBUF(2000) C C C DATA X/-5.,-5.,5.,5./,Y/-4.,-6.,4.,6./, + XV/.2,-.2,.16,-.1/,YV/.1,-.3,.15,.13/ C C C INIT CALL SCAL(-13.4375,-10.,13.4375,16.7) CALL APNT(-10.,-10.,0,-5) CALL LVECT(0.,20.) CALL LVECT(20.,0.) CALL LVECT(0.,-20.) CALL LVECT(-20.,0.) C C C DO 100 I=1,500 CALL SUBP(1) CALL APNT(X(1),Y(1),0,-5) CALL LVECT(X(2)-X(1),Y(2)-Y(1)) CALL LVECT(X(3)-X(2),Y(3)-Y(2)) CALL LVECT(X(4)-X(3),Y(4)-Y(3)) CALL LVECT(X(1)-X(4),Y(1)-Y(4)) CALL LVECT(X(3)-X(1),Y(3)-Y(1)) CALL APNT(X(2),Y(2),0,-5) CALL LVECT(X(4)-X(2),Y(4)-Y(2)) CALL ESUB DO 40 J=1,4 X(J) = X(J) + XV(J) Y(J) = Y(J) + YV(J) IF (X(J).LE.-10.) GOTO 10 IF (X(J).LT.10.) GOTO 20 X(J) = 9.999 15 XV(J) = -XV(J) GOTO 20 10 X(J) = -9.999 GOTO 15 20 IF (Y(J).LE.-10.) GOTO 30 IF (Y(J).LT.10.) GOTO 5 Y(J) = 9.999 50 YV(J) = -YV(J) GOTO 5 30 Y(J) = -9.999 GOTO 50 5 CONTINUE 40 CONTINUE CALL ERAS(1) CALL CMPRS KVAL = IPOT0() IF (KVAL.NE.0) CALL SLEEP(0,0,0,KVAL) 100 CONTINUE RETURN END SUBROUTINE DSPLAY(M1,N1,K1,L1,I1,I2,ROOTR,ROOTI,M,KNO,LAG) COMMON A(10),D(10),B(5),C(5),E(5),F(5),OLR(4,10),RROT(50,10), IRIOT(50,10) DIMENSION ROOTR(1),ROOTI(1) DATA ISN1/1/ GO TO (1,60),I2 1 CALL SCALE(SCAX,SCAY) 2 IF(M1.EQ.0)GO TO 10 DO 5 I=1,M1 IX=OLR(1,I)*SCAX IY=0. CALL OSCP(IX,IY) 5 CONTINUE 10 IF(N1.EQ.0)GO TO 20 DO 15 I=1,N1 IX=OLR(3,I)*SCAX IY=OLR(3,I+5)*SCAY CALL OSCP(IX,IY) IX=OLR(3,I)*SCAX IY=-OLR(3,I+5)*SCAY CALL OSCP(IX,IY) 15 CONTINUE 20 IF(K1.EQ.0)GO TO 30 DO 25 I=1,K1 IX=OLR(2,I)*SCAX IY=0. CALL OSCP(IX,IY) 25 CONTINUE 30 IF(L1.EQ.0)GO TO 40 DO 35 I=1,L1 IX=OLR(4,I)*SCAX IY=OLR(4,I+5)*SCAY CALL OSCP(IX,IY) IX=OLR(4,I)*SCAX IY=-OLR(4,I+5)*SCAY CALL OSCP(IX,IY) 35 CONTINUE 40 IF(I1.EQ.0)GO TO 50 DO 45 I=1,I1 IX=0. IY=0. CALL OSCP(IX,IY) 45 CONTINUE 50 CALL SSWTCH(ISN1,IS1) IF(IS1.EQ.2)GO TO 2 RETURN 60 DO 80 J=1,KNO LLAG=LAG*100 DO 70 I=1,M IX=RROT(J,I)*SCAX IY=RIOT(J,I)*SCAY CALL OSCP(IX,IY) 70 CONTINUE 75 LLAG=LLAG-1 IF(LLAG.GT.0) GO TO 75 80 CONTINUE CALL SSWTCH(ISN1,IS1) IF(IS1.EQ.2) GO TO 60 RETURN END  }}}   }} SUBROUTINE LINCON C LINEAR CONTROL ANALYSIS COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN 2 DO 5 I=1,10 A(I)=0. D(I)=0. 5 CONTINUE DO 8 I=1,5 B(I)=0. C(I)=0. E(I)=0. F(I)=0. 8 CONTINUE DO 9 I=1,4 DO 9 J=1,10 WB(I,J)=0. 9 CONTINUE CALL READ IF(M1.EQ.0) GO TO 15 DO 10 I=1,M1 WRITE(5,107) READ(5,108)A(I) 10 WB(1,I)=1./A(I) 15 IF(N1.EQ.0)GO TO 25 DO 20 I=1,N1 WRITE(5,109) READ(5,108)B(I) WRITE(5,110) READ(5,108)C(I) 20 WB(2,I)=SQRT(C(I)) 25 IF(K1.EQ.0) GO TO 35 DO 30 I=1,K1 WRITE(5,111) READ(5,108)D(I) 30 WB(3,I)=1./D(I) 35 IF(L1.EQ.0) GO TO 45 DO 40 I=1,L1 WRITE(5,112) READ(5,108)E(I) WRITE(5,113) READ(5,108)F(I) 40 WB(4,I)=SQRT(F(I)) 45 CALL MAXMIN(WMAX,WMIN) 60 WRITE(5,114) READ(5,108)RK ZMIN=ALOG(WMIN/10.) ZMAX=ALOG(WMAX*10.) YINC=(ZMAX-ZMIN)/50. CALL WRITE(YINC,ZMIN) RETURN 107 FORMAT(' A = '$) 108 FORMAT(F12.4) 109 FORMAT(' B = '$) 110 FORMAT(' C = '$) 111 FORMAT(' D = '$) 112 FORMAT(' E = '$) 113 FORMAT(' F = '$) 114 FORMAT(' GAIN,K = '$) END SUBROUTINE POLRT(XCOF,COF,M,ROOTR,ROOTI,IER)  DIMENSION XCOF(1),COF(1),ROOTR(1),ROOTI(1)  DOUBLE PRECISION XO,YO,X,Y,XPR,YPR,UX,UY,V,YT,XT,U,XT2,YT2,SUMSQ,  1 DX,DY,TEMP,ALPHA,DABS  IFIT=0  N=M  IER=0  IF(XCOF(N+1))10,25,10  10 IF(N) 15,15,32  15 IER=1  20 RETURN  25 IER=4  GO TO 20  30 IER=2  GO TO 20  32 IF(N-36) 35,35,30  35 NX=N  NXX=N+1  N2=1  KJ1=N+1  DO 40 L=1,KJ1  MT=KJ1-L+1  40 COF(MT)=XCOF(L)  45 XO=.00500101  Y0=.01000101  IN=0  50 X=XO  XO=-10.0*YO  YO=-10.0*X  X=XO  Y=YO  IN=IN+1  GO TO 59  55 IFIT=1  XPR=X  YPR=Y  59 ICT=0  60 UX=0.0  UY=0.0  V =0.0  YT=0.0  XT=1.0  U=COF(N+1)  IF(U) 65,130,65  65 DO 70 I=1,N  L = N-I+1  TEMP=COF(L)  XT2=X*XT-Y*YT  YT2=X*YT+Y*XT  U=U+TEMP*XT2  V=V+TEMP*YT2  FI=I  UX=UX+FI*XT*TEMP  UY=UY-FI*YT*TEMP  XT=XT2  70 YT=YT2  SUMSQ=UX*UX+UY*UY  IF(SUMSQ) 75,110,75  75 DX=(V*UY-U*UX)/SUMSQ  X=X+DX  DY=-(U*UY+V*UX)/SUMSQ  Y=Y+DY  78 IF(DABS(DY)+DABS(DX)-1.0D-05) 100,80,80  80 ICT=ICT+1  IF(ICT-500) 60,85,85  85 IF(IFIT) 100,90,100  90 IF(IN-5) 50,95,95  95 IER=3  GO TO 20  100 DO 105 L=1,NXX  MT=KJ1-L+1  TEMP=XCOF(MT)  XCOF(MT)=COF(L)  105 COF(L)=TEMP  ITEMP=N  N=NX  NX=ITEMP  IF(IFIT) 120,55,120  110 IF(IFIT) 115,50,115  115 X=XPR  Y=YPR  120 IFIT=0  122 IF(DABS(Y)-1.0D-4*DABS(X)) 135,125,125  125 ALPHA=X+X  SUMSQ=X*X+Y*Y  N=N-2  GO TO 140  130 X=0.0  NX=NX-1  NXX=NXX-1  135 Y=0.0  SUMSQ=0.0  ALPHA=X  N=N-1  140 COF(2)=COF(2)+ALPHA*COF(1)  145 DO 150 L=2,N  150 COF(L+1)=COF(L+1)+ALPHA*COF(L)-SUMSQ*COF(L-1)  155 ROOTI(N2)=Y  ROOTR(N2)=X  N2=N2+1  IF(SUMSQ) 160,165,160  160 Y=-Y  SUMSQ=0.0  GO TO 155  165 IF(N) 20,20,45  END  $0  $END  SUBROUTINE PLYMUL(A,B,NDA,NDB,C,NDC) DIMENSION A(1),B(1),C(1) NDC=NDA+NDB NDCP1=NDC+1 DO 10 I=1,NDCP1 10 C(I)=0.0 NDAP1=NDA+1 NDBP1=NDB+1 DO 20 I=1,NDAP1 DO 20 J=1,NDBP1 IPJ=I+J-1 20 C(IPJ)=C(IPJ)+A(I)*B(J) RETURN END  }}}   }} SUBROUTINE REGAIN(RKMIN,RKINC,ND,NN,KNO) KBR=ND-NN KNO=50/KBR WRITE(1,100) READ(1,101)RKMIN WRITE(1,102) READ(1,101)RKMAX RKINC=(ALOG(RKMAX)-ALOG(RKMIN))/FLOAT(KNO) RETURN 100 FORMAT(14H MIN. GAIN = ) 101 FORMAT(F12.4) 102 FORMAT(14H MAX. GAIN = ) END  }}}   }} C CONTROL MASTER : START PROGRAM, MAKES IS=0 IN CNTRL!! REAL*4 PROGNM REAL*4 PROG COMMON IS DATA PROGNM,PROG/6RRK0CNT,6RRL SAV/ IS=0 CALL CHAIN(PROGNM,IS,1) END C ROOT LOCUS METHOD COMMON A(10),D(10),B(5),C(5),E(5),F(5),OLR(4,10),RROT(50,10), IRIOT(50,10) DIMENSION DNOM(16),RNUM(16),XCOF(16),COF(16),ROOTR(15), IROOTI(15),RRNUM(15),RDNOM(15),RK(100) 2 DO 5 I=1,10 A(I)=0. D(I)=0. 5 CONTINUE I2=1 DO 8 I=1,5 B(I)=0. C(I)=0. E(I)=0. F(I)=0. 8 CONTINUE DO 9 I=1,4 DO 9 J=1,10 OLR(I,J)=0. 9 CONTINUE CALL READ(M1,N1,K1,L1,I1) IF(M1.EQ.0)GO TO 15 DO 10 I=1,M1 WRITE(1,107) READ(1,108)A(I) 10 OLR(1,I)=-A(I) 15 IF(N1.EQ.0)GO TO 25 DO 20 I=1,N1 WRITE(1,109) READ(1,108)B(I) WRITE(1,110) READ(1,108)C(I) OLR(3,I)=-B(I)/2. 20 OLR(3,I+5)=(SQRT(4.*C(I)-B(I)**2))/2. 25 IF(K1.EQ.0)GO TO 35 DO 30 I=1,K1 WRITE(1,111) READ(1,108)D(I) 30 OLR(2,I)=-D(I) 35 IF(L1.EQ.0)GO TO 45 DO 40 I=1,L1 WRITE(1,112) READ(1,108)E(I) WRITE(1,113) READ(1,108)F(I) OLR(4,I)=-E(I)/2. 40 OLR(4,I+5)=(SQRT(4.*F(I)-E(I)**2))/2. 45 CALL DSPLAY(M1,N1,K1,L1,I1,I2,ROOTR,ROOTI,M,KNO,LAG) CALL CHEQ(M1,N1,K1,L1,I1,RNUM,NN,NUM,DNOM,ND,IDEN) NN1=NN+1 DO 55 I=1,NN1 NNN=NN1+1-I RRNUM(I)=RNUM(NNN) 55 CONTINUE NN2=NN+2 DO 60 I=NN2,16 RRNUM(I)=0.0 60 CONTINUE IF(NUM.EQ.1)GO TO 62 GO TO 64 62 RRNUM(1)=1. 64 ND1=ND+1 DO 65 I=1,ND1 NDD=ND1+1-I J=I+I1 RDNOM(J)=DNOM(NDD) 65 CONTINUE ND2=ND+2+I1 DO 70 I=ND2,16 RDNOM(I)=0.0 70 CONTINUE DO 72 I=1,I1 RDNOM(I)=0.0 72 CONTINUE M=1 XCOF(1)=1. XCOF(2)=2. CALL POLRT(XCOF,COF,M,ROOTR,ROOTI,IER) ND=ND+I1 IF(NN.GT.ND)GO TO 75 M=ND GO TO 80 75 M=NN 80 MP1=M+1 50 CALL REGAIN(RKMIN,RKINC,ND,NN,KNO) DO 88 J=1,KNO RK(J)=EXP(ALOG(RKMIN)+FLOAT(J-1)*RKINC) DO 85 I=1,MP1 XCOF(I)=RK(J)*RRNUM(I)+RDNOM(I) 85 CONTINUE CALL POLRT(XCOF,COF,M,ROOTR,ROOTI,IER) DO 88 I=1,M RROT(J,I)=ROOTR(I) RIOT(J,I)=ROOTI(I) 88 CONTINUE WRITE(1,115) READ(1,108)RLAG LAG=RLAG I2=2 CALL DSPLAY(M1,N1,K1,L1,I1,I2,ROOTR,ROOTI,M,KNO,LAG) GO TO 50 106 FORMAT(I4) 107 FORMAT(10H A = ) 108 FORMAT(F12.4) 109 FORMAT(10H B = ) 110 FORMAT(10H C = ) 111 FORMAT(10H D = ) 112 FORMAT(10H E = ) 113 FORMAT(10H F = ) 114 FORMAT(10H GAIN,K = ) 115 FORMAT(10H DELAY = ) END  }}}   }} SUBROUTINE CHEQ(M1,N1,K1,L1,I1,RNUM,NN,NUM,DNOM,ND,IDEN) COMMON A(10),D(10),B(5),C(5),E(5),F(5),OLR(4,10),RROT(50,10), IRIOT(50,10) DIMENSION A1(6),B1(2),A2(11),B2(3),A3(6),B3(2),A4(11),B4(3), IC1(6),D1(11),E1(6),F1(11),RNUM(1),DNOM(1) NUM=0 IDEN=0 KA1=0 KA2=0 KA3=0 KA4=0 IF(M1.EQ.0)GO TO 25 A1(1)=A(1) A1(2)=1. IF(M1.EQ.1)GO TO 27 B1(1)=A(2) B1(2)=1. NDA1=1 NDB1=1 DO 20 J=2,M1 CALL PLYMUL(A1,B1,NDA1,NDB1,C1,NDC) NDA1=NDC NDA11=NDA1+1 DO 10 I=1,NDA11 A1(I)=C1(I) 10 CONTINUE B1(1)=A(J) B1(2)=1. 20 CONTINUE GO TO 28 25 KA1=1 GO TO 28 27 NDC=1 28 IF(N1.EQ.0)GO TO 45 A2(1)=1. A2(2)=B(1) A2(3)=C(1) IF(N1.EQ.1)GO TO 47 B2(1)=1. B2(2)=B(2) B2(3)=C(2) NDA2=2 NDB2=2 DO 40 J=2,N1 CALL PLYMUL(A2,B2,NDA2,NDB2,D1,NDD) NDA2=NDD NDA21=NDA2+1 DO 30 I=1,NDA21 A2(I)=D1(I) 30 CONTINUE B2(1)=1. B2(2)=B(J) B2(3)=C(J) 40 CONTINUE GO TO 48 45 KA2=1 GO TO 48 47 NDD=2 48 IF(KA1.EQ.0.AND.KA2.EQ.1)GO TO 50 IF(KA1.EQ.1.AND.KA2.EQ.0)GO TO 60 IF(KA1.EQ.0.AND.KA2.EQ.0)GO TO 70 NUM=1 NN=0 GO TO 80 50 NDC1=NDC+1 DO 55 I=1,NDC1 RNUM(I)=A1(I) 55 CONTINUE NN=NDC GO TO 80 60 NDD1=NDD+1 DO 65 I=1,NDD1 RNUM(I)=A2(I) 65 CONTINUE NN=NDD GO TO 80 70 CALL PLYMUL(A1,A2,NDC,NDD,RNUM,NN) 80 IF(K1.EQ.0)GO TO 105 A3(1)=D(1) A3(2)=1. IF(K1.EQ.1)GO TO 107 B3(1)=D(2) B3(2)=1. NDA3=1 NDB3=1 DO 100 J=2,K1 CALL PLYMUL(A3,B3,NDA3,NDB3,E1,NDE) NDA3=NDE NDA31=NDA3+1 DO 90 I=1,NDA31 A3(I)=E1(I) 90 CONTINUE B3(1)=D(J) B3(2)=1. 100 CONTINUE GO TO 108 105 KA3=1 GO TO 108 107 NDE=1 108 IF(L1.EQ.0)GO TO 125 A4(1)=1. A4(2)=E(1) A4(3)=F(1) IF(L1.EQ.1)GO TO 127 B4(1)=1. B4(2)=E(2) B4(3)=F(2) NDA4=2 NDB4=2 DO 120 J=2,L1 CALL PLYMUL(A4,B4,NDA4,NDB4,F1,NDF) NDA4=NDF NDA41=NDA4+1 DO 110 I=1,NDA41 A4(I)=F1(I) 110 CONTINUE B4(1)=1. B4(2)=E(J) B4(3)=F(J) 120 CONTINUE GO TO 128 125 KA4=1 GO TO 128 127 NDF=2 128 IF(KA3.EQ.0.AND.KA4.EQ.1)GO TO 130 IF(KA3.EQ.1.AND.KA4.EQ.0)GO TO 140 IF(KA3.EQ.0.AND.KA4.EQ.0)GO TO 150 IDEN=1 ND=0 GO TO 160 130 NDE1=NDE+1 DO 135 I=1,NDE1 DNOM(I)=A3(I) 135 CONTINUE ND=NDE GO TO 160 140 NDF1=NDF+1 DO 145 I=1,NDF1 DNOM(I)=A4(I) 145 CONTINUE ND=NDF GO TO 160 150 CALL PLYMUL(A3,A4,NDE,NDF,DNOM,ND) 160 CONTINUE RETURN END  }}}   }} SUBROUTINE MAXMIN(WMAX,WMIN) COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN WMAX=0. WMIN=100. DO 50 J3=1,4 DO 50 J4=1,10 IF(WB(J3,J4).EQ.0.) GO TO 50 RMAX=WB(J3,J4) IF(RMAX.GE.WMAX) WMAX=RMAX IF(RMAX.LE.WMIN) WMIN=RMAX 50 CONTINUE RETURN END SUBROUTINE DSPLAY COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN REAL*4 PROGRM REAL*4 PROG2 DATA PROGRM,PROG2/6RRK0DSP,6RY1 SAV/ D CALL WRDK CALL CHAIN(PROGRM,L,1) END SUBROUTINE POLRT(XCOF,COF,M,ROOTR,ROOTI,IER) DIMENSION XCOF(1),COF(1),ROOTR(1),ROOTI(1) DOUBLE PRECISION XO,YO,X,Y,XPR,YPR,UX,UY,V,YT,XT,U,XT2,YT2,SUMSQ, 1 DX,DY,TEMP,ALPHA,DABS IFIT=0 N=M IER=0 IF(XCOF(N+1))10,25,10 10 IF(N) 15,15,32 15 IER=1 20 RETURN 25 IER=4 GO TO 20 30 IER=2 GO TO 20 32 IF(N-36) 35,35,30 35 NX=N NXX=N+1 N2=1 KJ1=N+1 DO 40 L=1,KJ1 MT=KJ1-L+1 40 COF(MT)=XCOF(L) 45 XO=.00500101 Y0=.01000101 IN=0 50 X=XO XO=-10.0*YO YO=-10.0*X X=XO Y=YO IN=IN+1 GO TO 59 55 IFIT=1 XPR=X YPR=Y 59 ICT=0 60 UX=0.0 UY=0.0 V =0.0 YT=0.0 XT=1.0 U=COF(N+1) IF(U) 65,130,65 65 DO 70 I=1,N L = N-I+1 TEMP=COF(L) XT2=X*XT-Y*YT YT2=X*YT+Y*XT U=U+TEMP*XT2 V=V+TEMP*YT2 FI=I UX=UX+FI*XT*TEMP UY=UY-FI*YT*TEMP XT=XT2 70 YT=YT2 SUMSQ=UX*UX+UY*UY IF(SUMSQ) 75,110,75 75 DX=(V*UY-U*UX)/SUMSQ X=X+DX DY=-(U*UY+V*UX)/SUMSQ Y=Y+DY 78 IF(DABS(DY)+DABS(DX)-1.0D-05) 100,80,80 80 ICT=ICT+1 IF(ICT-500) 60,85,85 85 IF(IFIT) 100,90,100 90 IF(IN-5) 50,95,95 95 IER=3 GO TO 20 100 DO 105 L=1,NXX MT=KJ1-L+1 TEMP=XCOF(MT) XCOF(MT)=COF(L) 105 COF(L)=TEMP ITEMP=N N=NX NX=ITEMP IF(IFIT) 120,55,120 110 IF(IFIT) 115,50,115 115 X=XPR Y=YPR 120 IFIT=0 122 IF(DABS(Y)-1.0D-4*DABS(X)) 135,125,125 125 ALPHA=X+X SUMSQ=X*X+Y*Y N=N-2 GO TO 140 130 X=0.0 NX=NX-1 NXX=NXX-1 135 Y=0.0 SUMSQ=0.0 ALPHA=X N=N-1 140 COF(2)=COF(2)+ALPHA*COF(1) 145 DO 150 L=2,N 150 COF(L+1)=COF(L+1)+ALPHA*COF(L)-SUMSQ*COF(L-1) 155 ROOTI(N2)=Y ROOTR(N2)=X N2=N2+1 IF(SUMSQ) 160,165,160 160 Y=-Y SUMSQ=0.0 GO TO 155 165 IF(N) 20,20,45 END  }}}   }} SUBROUTINE DISTAB C LINEAR CONTROL SYSTEM ANALYSIS: DISPLAY/TABULATE COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN 10 WRITE(5,111) WRITE(5,101) READ(5,108)K GO TO (30,11,65),K 11 WRITE(5,111) WRITE(5,109) READ(5,108)K1 GO TO (12,13),K1 12 M=5 GO TO 14 13 M=1 14 WRITE(5,111) WRITE(5,110) READ(5,108)K2 GO TO (15,17,15),K2 15 WRITE(5,111) WRITE(5,103) WRITE(5,106) DO 16 J=1,51,M 16 WRITE(5,104)W(J),RM3(J),RM2(J),RM(J),PH(J),RM4(J),RLG5(J) IF(K2.NE.3) GO TO 60 17 WRITE(5,111) WRITE(5,105) WRITE(5,106) DO 18 J=1,51,M 18 WRITE(5,104)W(J),RM3(J),PH2(J),PH3(J),PH4(J),RM5(J),PH1(J) GO TO 60 30 WRITE(5,111) WRITE(5,107) READ(5,108)L GO TO (35,50,55),L 35 DO 40 I=1,51 WAX(I)=RM4(I) WAY(I)=RLG5(I) 40 CONTINUE CALL DSPLAY D CALL DS GO TO 60 50 DO 52 I=1,51 WAX(I)=ALOG10(W(I)) WAY(I)=RM(I) WAY1(I)=PH(I) 52 CONTINUE CALL DSPLAY D CALL DS GO TO 60 55 DO 58 I=1,51 WAX(I)=ALOG10(W(I)) WAY(I)=PH3(I) 58 CONTINUE CALL DSPLAY D CALL DS 60 GO TO 10 65 IS=0 RETURN 101 FORMAT(' TYPE: 1 TO DISPLAY FREQUENCY RESPONSE'/' ', I' OR 2 TO TABULATE RESPONSE DATA'/' OR 3 TO ENTER', IR NEW TRANSFER FUNCTION ...'$) 102 FORMAT(F8.4) 103 FORMAT(23H OPEN LOOP VALUES: ) 104 FORMAT(F8.3,F7.3,5E11.3) 105 FORMAT(25H CLOSED LOOP VALUES: ) 106 FORMAT(' W(RAD) W(HZ) MAG. LOG. MOD. PHASE REAL', I' IMAG. ') 107 FORMAT(' TYPE: 1 FOR NYQUIST PLOT'/' OR 2 FOR ', I'BODE PLOT'/' OR 3 FOR CLOSED LOOP M VS. W ..........'$) 108 FORMAT(I1) 109 FORMAT(' TYPE: 1 FOR SHORT TABULATION'/' OR 2 ', I'FOR LONG TABULATION ..............'$) 110 FORMAT(' TYPE: 1 FOR OPEN LOOP VALUES'/' OR 2 ', I'FOR CLOSED LOOP VALUES'/' OR 3 FOR BOTH O/L AND C/L .', I'............'$) 111 FORMAT(/) END SUBROUTINE WRITE(YINC,ZMIN) COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN DO 65 J1=1,51 W(J1)=EXP(ZMIN+FLOAT(J1-1)*YINC) CALL RMOD 65 CONTINUE RETURN END C CONTROL MASTER : START PROGRAM, MAKES IS=2 IN CNTRL!! REAL*4 PROGNM REAL*4 PROG COMMON IS DATA PROGNM,PROG/6RRK0CNT,6RRL SAV/ IS=2 CALL CHAIN(PROGNM,IS,1) END SUBROUTINE READ COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN WRITE(5,101) READ(5,106)M1 WRITE(5,102) READ(5,106)N1 WRITE(5,103) READ(5,106)K1 WRITE(5,104) READ(5,106)L1 WRITE(5,105) READ(5,106)I1 RETURN 101 FORMAT(' M = '$) 102 FORMAT(' N = '$) 103 FORMAT(' P = '$) 104 FORMAT(' Q = '$) 105 FORMAT(' R = '$) 106 FORMAT(I1,$) END C*****FORTRAN RT-11 SPACEWAR C C C THIS SOFTWARE IS FURNISHED TO THE NON-PURCHASER C UNDER LICENSE FOR USE ON A DECLAB 11/40. IT CAN BE C COPIED TO YOUR HEART'S CONTENT FOR USE ON ANY EQUIVALENT C HARDWARE CONFIGURATION. LDP ASSUMES NO RESPONSIBILITY C FOR THE USE OR RELIABILITY OF THIS SOFTWARE ON EQUIPMENT C NOT SUPPLIED BY LDP. C C C*****ACKNOWLEDGMENTS AND KUDOES ARE DUE MARIO DE NOBILI C*****AND HENRY MAURER FOR THEIR GUIDING INFLUENCES IN THE C*****EVOLUTION OF THIS PROGRAM. ANY QUESTIONS REGARDING C*****ALGORITHMS, DESIGN, PROCEDURES, BUGS, ETC., MUST C*****BE REFERRED TO MARIO DE NOBILI. C C*****G. W. DULANEY, LDP, MARLBOROUGH COUNTRY, JAN., 1975. C C*****REQUIRES F4GT,SYSLIB DIMENSION IDBF(750) DIMENSION AST1(20),AST2(20),SUN(16),M(20),INTP(20),ITRP(2) DIMENSION SND(2),CSD(2),NTRP(2),MPTR(4),KTH(2) DIMENSION SNA(2),CSA(2),VX(20),VY(20),X(20),Y(20) DIMENSION S1(10),S2(10) INTEGER TT,R,H EQUIVALENCE (NTRP(1),NTRP1),(NTRP(2),NTRP2),(KTH(1),KTH1), X (KTH(2),KTH2),(M(1),M1),(M(2),M2),(ITRP(1),ITRP1), X (ITRP(2),ITRP2) C*****COORD'S FOR ASTEROIDS AND SUN DATA AST1/6.,-6.,6.,3.,0.,6.,6.,3.,-6.,6.,-6.,0., X -6.,3.,-3.,-9.,-6.,-6.,9.,0./ DATA AST2/-6.,-6.,9.,-2.,6.,8.,-1.,5.,-5.,4.,-3.,-3.,-3.,3., X -6.,-6.,3.,-3.,6.,0./ DATA SUN/6.,-18.,6.,18.,18.,6.,-18.,6.,-6.,18.,-6., X -18.,-18.,-6.,18.,-6./ C*****CONSTANTS FOR ANGLES, SHIP SIZE, TORPEDOES, GRAVITY, ETC. DATA G,NT,TD,TV,R1,STH,ISC1,ISC2/.03,50,25.,5.,32.,.025,0,0/ DATA MRGN,TT,C,S,SND,CSD/14,500,.99619,.08716,.3125,.53125, X .94992,.84722/ DATA Y,X,VX,VY/20*620.,60*0./ C P=3.14159/36 C C=COS(P) C S=SIN(P) C*****SND=SIN(DELTA) AND CSD=COS(DELTA) C SND(1)=10/R1 C CSD(1)=SQRT(1-SND(1)**2) C SND(2)=17/R1 C CSD(2)=SQRT(1-SND(2)**2) C C CALL INIT(IDBF,740) C C C*****BEGIN WITH INTRO MESSAGE. CALL APNT(350.,750.,0,-8,1) CALL TEXT('S P A C E W A R ! !',2) CALL RDOT(0.,0.,0,-7,-1) CALL TEXT('YOU ARE ABOUT TO BEGIN YET ANOTHER COMPUTERIZED ', X 'VERSION OF',1,'SPACEWAR. ONLY HERE, IT IS RUNNING ON A ', X 'STANDARD MINICOMPUTER',1,'USING FORTRAN IV EXCLUSIVELY!!.',2, X 'IT IS THE OUTSTANDING EFFICIENCY OF RT-11 FORTRAN AND THE', X ' DECLAB 11/40',1,'HARDWARE WHICH ALLOW THE NUMEROUS') CALL TEXT(' CALCULATIONS TO BE PERFORMED',1,'ON THE FLY.',2, X 'THE RULES ARE SIMPLE:',1,'EACH OF TWO ASTRONAUTS HAVE 50', X ' TORPEDOES AND 500 UNITS OF ATOMIC FUEL.',1,'THE SHIPS, ', X '#1 BEING THE LARGER, ARE ROTATED BY TURNING LPS',1,'POT', X ' 1 FOR #1 OR 3 FOR #2 ONE-HALF TURN IN DESIRED DIRECTION.', X 2,'THRUST IS GENERATED BY CLOCKWISE TURN OF POT 0 FOR ', X 'SHIP 1',1,'OR POT 2 FOR SHIP 2. TORPEDOES ARE FIRED BY SET', X 'TING SWITCH REGISTER',1,'BIT 15 UP FOR SHIP 1 OR BIT 0 UP ', X 'FOR SHIP 2.',1,'FUEL AND TORP MONITORS ARE SHOWN AT TOP') CALL TEXT(' OF SCREEN.',1,'GAME WINNER COUNTS ARE MAINTAINED', X ' IN LEFT TWO DIGITS OF LPS LEDS',1,'FOR SHIP 1', X ' AND RIGHT TWO FOR SHIP 2.',2, X 'BEFORE STARTING, POSITION ALL FOUR POTS FIVE TURNS IN', X ' FROM EITHER END',1,'AND CLEAR SWITCH REGISTER-ALL DOWN.', X ' PLEASE NOTE THAT THE POTS',1,'ACT AS SWITCHES AND ARE ', X 'TREATED AS EITHER ON OR OFF. THUS',1,'DO NOT TURN THEM ') CALL TEXT('MORE THAN ONE TURN AWAY FROM CENTER.',1,'IF BOTH', X ' SHIPS RUN OUT OF FUEL/TORPEDOES OR DESTRUCTION OCCURS',1, X '(STAR APPEARS) THE GALAXY IS RESET FOR THE NEXT ROUND.',1, X 'BEWARE THE SUN AND ASTEROIDS!! TO COLLIDE IS TO DIE!.',2, X ' TO BEGIN, PRESS THE CR KEY AT RIGHT OF KEYBOARD.') C C C*****WAIT FOR KEYBOARD CHARACTER 1 I=ITTINR() IF (I.LT.0)GOTO 1 C C C CC*****SET UP FIGR'S FOR SUN,SHIPS,AND ASTEROIDS. CALL INIT(IDBF,300) C*****DRAW BORDER IN DASHED LINES CALL APNT(11.,14.,0,-4,0,3) CALL VECT(1000.,0.) CALL VECT(0.,690.) CALL VECT(-1000.,0.) CALL VECT(0.,-690.) C*****TITLE THEN FUEL & TORP MONITORS CALL APNT(350.,755.,0,-5,1,1) CALL TEXT('RT-11 FORTRAN SPACEWAR') CALL APNT(50.,710.,0,-5,-1) CALL TEXT('SHIP 1: FUEL ') CALL RDOT(0.,0.) C*****SAVE ADDRESSES FOR LATER UPDATES. MPTR FOR Y VECTORS. CALL DPTR(I) MPTR(1)=I+2 CALL LVECT(0.,50.) CALL APNT(250.,710.,0,-5) CALL TEXT('TORPS ') CALL RDOT(0.,0.) CALL DPTR(I) MPTR(2)=I+2 CALL LVECT(0.,50.) CALL APNT(650.,710.,0,-5) CALL TEXT('SHIP 2: FUEL ') CALL RDOT(0.,0.) CALL DPTR(I) MPTR(3)=I+2 CALL LVECT(0.,50.) CALL APNT(850.,710.,0,-5) CALL TEXT('TORPS ') CALL RDOT(0.,0.) CALL DPTR(I) MPTR(4)=I+2 CALL LVECT(0.,50.) CALL APNT(506.,378.,0,-7) CALL FIGR(SUN,16,0,7,1) C*****KEEP DISPLAY FILE POINTERS FOR FIGR'S IN INTP. C*****POINTERS TO X COORD'S. CALL DPTR(I) INTP(1)=I+1 CALL APNT(512.,384.,0,-5,-1) CALL FIGR(S1,10) CALL DPTR(I) INTP(2)=I+1 CALL APNT(512.,384.,0,-5) CALL FIGR(S2,10) CALL DPTR(I) INTP(3)=I+1 CALL APNT(662.,384.,0,-4) CALL FIGR(AST1,20) CALL DPTR(I) INTP(4)=I+1 CALL APNT(362.,384.,0,-4) CALL FIGR(AST2,20) C*****SAVE TORPEDO POINTERS DO 50 J=5,20 CALL DPTR(I) INTP(J)=I+1 CALL APNT(512.,1023.) 50 CALL RDOT(0,0,0,8) C*****BEGIN START OF MAIN LOOP. RETURN TO HERE TO RESTART. C*****SNA, CSA ARE SIN & COS FOR ANGLE OF ATTACK MINUS PI. C*****NOSE OF SHIP IS ORIGIN OF CENTER LINE VECTOR POINTING C*****TOWARD STERN. C C*****SET UP SHIPS 240 SNA(1)=0 CSA(1)=1 SNA(2)=0 CSA(2)=-1 X(1)=50 Y(1)=200 X(2)=-50 Y(2)=-200 VX(1)=-50.*G VY(1)=0 VX(2)=-VX(1) VY(2)=-VY(1) M1=1 M2=1 C*****INDIVIDUAL TORP & THRUST COUNTERS WILL DECR. TO 0 NTRP1=NT NTRP2=NT KTH1=TT KTH2=TT C*****SET UP ASTEROIDS M(3)=1 M(4)=1 X(3)=150 Y(3)=0 X(4)=-X(3) Y(4)=-Y(3) VX(3)=0 VY(3)=80.*G VX(4)=-VX(3) VY(4)=-VY(3) L1=0 NTX=4 LTX=0 H=0 L=-2 C*****PUT TORP'S OUT OF PICTURE DO 250 I=5,20 250 M(I)=-1 C*****LOAD LEDS WITH SHIP1 GAMES IN RIGHT 2 DIGITS, SHIP 2 IN LEFT CALL IPOKE("170402,"1017) CALL IPOKE("170402,"1417) I=ISC2/10 J=ISC2-I*10 IF(I.EQ.0)I="17 CALL IPOKE("170402,(I.AND."17)+"2400) CALL IPOKE("170402,J+"2000) I=ISC1/10 J=ISC1-I*10 IF(I.EQ.0)I="17 CALL IPOKE("170402,(I.AND."17)+"400) CALL IPOKE("170402,J) C*****BEGIN REPETITIVE LOOP C*****FIRST, LOOP TO CHECK COLLISIONS FOR ALL & RESET POSITIONS C*****IF HAVE A COLLISION, M GOES -1 WHICH IS SERVICED BELOW. 320 DO 550 J=1,19 C*****J=1 FOR SHIP 1, =2 FOR SHIP 2, =3 FOR ASTEROID 1, C =4 FOR ASTEROID 2, AND =5-19 FOR TORPEDOES. C*****CHECK SUN'S PROXIMITY XJ=X(J) YJ=Y(J) D0=XJ*XJ+YJ*YJ G1=G/SQRT(D0) IF (M(J).LE.0)GOTO 510 IF(D0.LT.625.)GOTO 641 C*****NOW CHECK WALL COLLISIONS IF(XJ.GT.500.)GOTO 610 IF(XJ.GT.-500.)GOTO 620 610 VX(J)=-VX(J) GOTO 641 620 IF(YJ.LT.-370.)GOTO 640 IF(YJ.LT.320.)GOTO 350 640 VY(J)=-VY(J) 641 M(J)=-1 GOTO 510 C*****LOOP CHECKS PROXIMITY TO OTHER BODIES 350 DO 420 I=J+1,20 IF (M(I).LE.0)GOTO 420 IDX=X(I)-XJ IF(IDX.GT.MRGN.OR.IDX.LT.-MRGN)GOTO 420 IDY=Y(I)-YJ IF(IDY.GT.MRGN.OR.IDY.LT.-MRGN)GOTO 420 M(I)=-1 M(J)=-1 420 CONTINUE IF(M(J).GT.0)GOTO 520 510 IF (J.GT.2)GOTO 550 C*****INCLUDE SUN'S GRAVITY THEN REPOSITION 520 VX(J)=VX(J)-G1*XJ VY(J)=VY(J)-G1*YJ X(J)=XJ+VX(J) Y(J)=YJ+VY(J) 550 CONTINUE C*****READ TORPEDO SWITCHES ICT=IPEEK("177570) ITRP1=ICT.AND.1 ITRP2=ICT.AND."100000 C*****LARGE LOOP FOR SHIPS WHICH: C 1. CHECKS FOR CRASH C 2. LAUNCHES TORP'S(SR 15 & 0) C 3. ADDS THRUST(POTS 0 & 2) C 4. ROTATES SHIPS(POTS 1 & 3) DO 900 J=1,2 I=J*2-1 IDBF(MPTR(I))=KTH(J)/10 IDBF(MPTR(I+1))=NTRP(J) SNAJ=SNA(J) CSAJ=CSA(J) IF (M(J).GE.0)GOTO 645 C*****A SHIP HIT SOMETHING. COUNT IT OUT. H=H+1 IF(H.GT.100)GOTO 990 C*****SET UP PENTACLE AS CRASH SYMBOL X5=23. Y5=-69. X6=-59. Y6=43. X7=71. Y7=0. X0=-59. Y0=-43. X8=23. Y8=69. R=1 GOTO 880 C*****GO 660 IF SWITCH NOT SET TO LAUNCH 645 IF (LTX.LT.12)GOTO 660 C*****OR IF NO TORP'S IF (ITRP(J).EQ.0)GOTO 660 IF (NTRP(J).EQ.0)GOTO 660 NTRP(J)=NTRP(J)-1 C*****RING BUFFER THE TORP'S. DROP DEAD THEN OLD ONES. IF (NTX.GE.19)NTX=4 647 NTX=NTX+1 IF(M(NTX).LT.0)GOTO 649 IF(NTX.LT.19)GOTO 647 NTX=5 649 M(NTX)=1 X(NTX)=X(J)-TD*CSAJ Y(NTX)=Y(J)-TD*SNAJ VX(NTX)=VX(J)-TV*CSAJ VY(NTX)=VY(J)-TV*SNAJ C*****GET THRUST POT READING 660 IC=0 IF(J.EQ.1)IC=2 D=JPOT(IC) IF(D.LT.2250)GOTO 650 IF(KTH(J).LT.0)GOTO 650 D=-STH KTH(J)=KTH(J)-1 VX(J)=VX(J)+CSAJ*D VY(J)=VY(J)+SNAJ*D C*****COMPUTE NEW CENTER LINE VECTOR 650 Y0=R1*SNAJ X0=R1*CSAJ R=0 S3=S C*****ROTATION IS REQUIRED ONLY ONCE IN TWO PASSES IF(L.GT.1)GOTO 850 C*****GET ROTATION POT R=JPOT(IC+1)+1 C*****L<0 SETS UP SHIPS FIRST TIMES THRU. IF (L.LT.0)GOTO 730 IF(R.LT.1850)GOTO 730 IF(R.GT.2250)GOTO 725 R=0 GOTO 850 C*****FOR CLOCKWISE ROTATION INVERT SIN 725 S3=-S C*****USE OLD SUM-OF-ANGLES RULES 730 SNA(J)=SNAJ*C+CSAJ*S3 CSA(J)=CSAJ*C-SNAJ*S3 C*****X(J)=X0*COS(DELTA)-Y0*SIN(DELTA) C*****Y(J)=Y0*COS(DELTA)+X0*SIN(DELTA) C*****WHERE X0,Y0 DEFINE VECTOR FOR CENTER LINE OF SHIP C*****AND DELTA IS ANGLE OF SIDES FROM THAT VECTOR C*****ROTATE CENTER LINE VECTOR Y0=R1*SNA(J) X0=R1*CSA(J) C*****COMPUTE PORT (LEFT) SIDE OF SHIP (NOTE NEGATIVE ANGLE) CSDJ=CSD(J) SNDJ=SND(J) X5=CSDJ*X0+Y0*SNDJ Y5=CSDJ*Y0-X0*SNDJ C*****THEN STERN VECTOR C X6=CSDJ*X0-Y0*SNDJ-X5 C Y6=CSDJ*Y0+X0*SNDJ-Y5 X6=-2.*Y0*SNDJ Y6=2.*X0*SNDJ C*****AND RETURN TO ORIGIN DRAWING STARBOARD (RIGHT) SIDE X7=-X5-X6 Y7=-Y5-Y6 C*****SET UP VARIABLE LENGTH FLAME VECTOR STERNWARD C*****IF THRUST IS ON (D IS NEGATIVE). 850 Z=L Z=Z/4. IF(D.GE.0)Z=0 X8=Z*X0 Y8=Z*Y0 C*****RESET ROTATION LOOP COUNTER 880 L=L+1 IF(L.GT.4)L=0 C*****RESET SHIP ANGLE OF ATTACK 920 IF(J.EQ.2)GOTO 980 CALL APUT(S1(9),X8) CALL APUT(S1(10),Y8) IF (R.EQ.0) GOTO 900 CALL APUT(S1(1),X5) CALL APUT(S1(2),Y5) CALL APUT(S1(3),X6) CALL APUT(S1(4),Y6) CALL APUT(S1(5),X7) CALL APUT(S1(6),Y7) CALL APUT(S1(7),X0) CALL APUT(S1(8),Y0) GOTO 900 980 CALL APUT(S2(9),X8) CALL APUT(S2(10),Y8) IF (R.EQ.0)GOTO 900 CALL APUT(S2(1),X5) CALL APUT(S2(2),Y5) CALL APUT(S2(3),X6) CALL APUT(S2(4),Y6) CALL APUT(S2(5),X7) CALL APUT(S2(6),Y7) CALL APUT(S2(7),X0) CALL APUT(S2(8),Y0) 900 CONTINUE C*****RESET TORP FIRING COUNTER LTX=LTX+1 IF (LTX.GT.12)LTX=0 C*****LOOP RESETS ALL POSITIONS DO 940 I=1,19 IF (M(I).GE.0)GOTO 930 C*****SHIP HAD A COLLISION OR IS INACTIVE AST. OR TORP(OFF SCREEN) IF (I.LT.3)GOTO 930 X(I)=0 Y(I)=620 VX(I)=0 VY(I)=0 930 IDBF(INTP(I))=X(I)+512.5 IDBF(INTP(I)+1)=Y(I)+384.5 940 CONTINUE C*****IF BOTH SHIPS OUT OF FUEL OR TORPS, COUNT DOWN IF(NTRP1+NTRP2.LT.2)L1=L1+2 IF(KTH1+KTH2.LT.0)L1=L1+1 IF (L1.LT.300)GOTO 320 C*****SEE IF ANYBODY WON THE GAME 990 IF(M1.LT.0.AND.M2.GE.0)ISC2=ISC2+1 IF(M1.GE.0.AND.M2.LT.0)ISC1=ISC1+1 C*****NOW RESET AND START AGAIN GOTO 240 END C*****FUNCTION TO READ LPS OR AR11. LOADS STATUS REG AND READS DATA REG. FUNCTION JPOT(ICH) MC=(ICH*"400.AND."1400)+1 CALL IPOKE("170400,MC) C*****EXPLICIT CHECK FOR AD DONE FLAG C1 IF ((IPEEK("170400).AND."200).EQ.0)GOTO 1 C*****THIS GIVES 40 OR MORE MICROSECS. DELAY FOR CONVERSION MC=3*0 JPOT=IPEEK("170402) C*****IF AR11, MULT. BY 4 IF(IPEEK("170404).AND."20.NE.0)JPOT=JPOT*4 RETURN END SUBROUTINE MSSAGE WRITE(5,20) WRITE(5,25) WRITE(5,30) RETURN 20 FORMAT(' LINEAR CONTROL SYSTEM ANALYSIS PROGRAMME'/ I' ----------------------------------------'// I' THIS PROGRAMME PERFORMS A FREQUENCY RESPONSE ANALYSIS FOR A'/ I' LOGARITHMIC RANGE OF FREQUENCIES FROM 1 DECADE BELOW THE MIN-'/ I' IMUM SYSTEM BREAK FREQUENCY TO 1 DECADE ABOVE THE MAXIMUM.'/ I' AT EACH FREQUENCY VALUE IT CALCULATES THE OPEN LOOP MAGNI-'/ I' FICATION,M;LOG.MODULUS,N;PHASE; AND THE REAL AND IMAGINARY'/ I' PARTS OF THE G(JW) FUNCTION. IT ALSO CALCULATES THE SAME PAR-'/ I' AMETERS FOR THE CLOSED LOOP TRANSFER FUNCTION,F(S),ASSUMING A'/ I' UNITY FEEDBACK LOOP.'/ I' AFTER ENTERING THE DATA WHICH DEFINES THE OPEN LOOP TRANS-'/ I' FER FUNCTION,G(S),TO BE ANALYSED IT IS POSSIBLE TO TABULATE'/ I' THE CALCULATED RESULTS, OR TO DISPLAY NYQUIST, BODE OR CLOSED'/ I' LOOP MAG. VS. FREQUENCY PLOTS. SYSTEM PARAMETERS SUCH AS GAIN'/ I' MARGIN,PHASE MARGIN,BANDWIDTH,ETC.,MAY ALSO BE QUOTED BY FLAG-') 25 FORMAT(' ING THEM WITH THE LIGHT PEN.'/ I' THE GENERAL FORM OF OPEN LOOP TRANSFER FUNCTION ACCEPTABLE TO'/ I' THIS PROGRAMME IS:-'// I' 2 2'/ I' K.(1+A(1)S)..(1+A(M)S)(S +B(1)S+C(1))..(S +B(N)S+C(N))'/ I' G(S)= ------------------------------------------------------'/ I' R 2 2'/ I' S .(1+(D1)S)..(1+D(P)S)(S +E(1)S+F(1))..(S +E(Q)S+F(Q))'// I' TO ENTER A SPECIFIC TRANSFER FUNCTION YOU MUST DEFINE THE') 30 FORMAT(' PARAMETERS;'/ I' M: THE # OF 1ST ORDER LEADS...(<10)'/ I' N: THE # OF 2ND ORDER LEADS...(<5)'/ I' P: THE # OF 1ST ORDER LAGS....(<10)'/ I' Q: THE # OF 2ND ORDER LAGS....(<5)'/ I' R: THE # OF OPEN LOOP INTEGRATIONS'/ I' ALL AS INTEGER'/ I' --------------'/ I' AND THE REQUIRED COEFFICIENTS A,B,C,D,E,F,AND THE GAIN,K'/ I' ALL AS REAL'/ I' -----------'/ I' SO DO IT!') END SUBROUTINE CALC COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN RM(J1)=20.*ALOG10((RK*RM1(J1)*RM2(J1))/(RM5(J1)*RM3(J1)*RM4(J1))) PH(J1)=PH1(J1)+PH2(J1)-PH3(J1)-PH4(J1)-PH5 RM1(J1)=RM(J1)/20. RM2(J1)=10.**RM1(J1) RM3(J1)=W(J1)/6.28319 RM4(J1)=RM2(J1)*COS(PH(J1)*3.14159/180.) RLG5(J1)=RM2(J1)*SIN(PH(J1)*3.14159/180.) RM5(J1)=(RM4(J1)*(1.+RM4(J1))+RLG5(J1)**2)/((1.+RM4(J1))**2 I+RLG5(J1)**2) PH1(J1)=RLG5(J1)/((1.+RM4(J1))**2+RLG5(J1)**2) PH2(J1)=SQRT(RM5(J1)**2+PH1(J1)**2) PH3(J1)=20.*ALOG10(PH2(J1)) PH4(J1)=ATAN(PH1(J1)/RM5(J1))*180./3.14159 IF(RM5(J1).GE.0.) GO TO 90 PH4(J1)=-180.+PH4(J1) 90 RETURN END SUBROUTINE RMOD COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN RM1(J1)=1. PH1(J1)=0. IF(M1.EQ.0) GO TO 83 DO 82 M=1,M1 RM11(M)=SQRT(1.+(A(M)*W(J1))**2) RM1(J1)=RM1(J1)*RM11(M) PH11(M)=(ATAN(W(J1)*A(M)))*180./3.14159 82 PH1(J1)=PH1(J1)+PH11(M) 83 RM2(J1)=1. PH2(J1)=0. IF(N1.EQ.0) GO TO 85 DO 84 N=1,N1 RM21(N)=SQRT((C(N)-W(J1)**2)**2+(B(N)*W(J1))**2) RM2(J1)=RM2(J1)*RM21(N) IF(W(J1).LE.WB(2,N)) GO TO 70 PH21(N)=180.-(ATAN((B(N)*W(J1))/(W(J1)**2-C(N))))*180./3.14159 GO TO 84 70 PH21(N)=(ATAN((B(N)*W(J1))/(C(N)-W(J1)**2)))*180./3.14159 84 PH2(J1)=PH2(J1)+PH21(N) 85 RM3(J1)=1. PH3(J1)=0. IF(K1.EQ.0) GO TO 87 DO 86 K=1,K1 RM31(K)=SQRT(1.+(D(K)*W(J1))**2) RM3(J1)=RM3(J1)*RM31(K) PH31(K)=(ATAN(W(J1)*D(K)))*180./3.14159 86 PH3(J1)=PH3(J1)+PH31(K) 87 RM4(J1)=1. PH4(J1)=0. IF(L1.EQ.0) GO TO 89 DO 88 L=1,L1 RM41(L)=SQRT((F(L)-W(J1)**2)**2+(E(L)*W(J1))**2) RM4(J1)=RM4(J1)*RM41(L) IF(W(J1).LE.WB(4,L)) GO TO 75 PH41(L)=180.-(ATAN((E(L)*W(J1))/(W(J1)**2-F(L))))*180./3.14159 GO TO 88 75 PH41(L)=(ATAN((E(L)*W(J1))/(F(L)-W(J1)**2)))*180./3.14159 88 PH4(J1)=PH4(J1)+PH41(L) 89 RLG5(J1)=FLOAT(I1)*ALOG(W(J1)) RM5(J1)=EXP(RLG5(J1)) PH5=90.*FLOAT(I1) CALL CALC RETURN END C CONTROL SYSTEM DESIGN PROGRAMME COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN IF(IS.EQ.1) GO TO 10 IF(IS.EQ.2) GO TO 5 CALL MSSAGE 5 CALL LINCON 10 CALL DISTAB IF(IS.EQ.0) GO TO 5 END SUBROUTINE CAL(J,W180,WCO,PM,GM) COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) GO TO (5,30),J 5 DO 10 I=1,51 IF(PH(I).GT.-180.) J1=I 10 CONTINUE K=J1+1 IF(PH(51).GT.-180.) GO TO 12 W180=W(J1)+(W(K)-W(J1))*(-180.-PH(J1))/(PH(K)-PH(J1)) RM180=RM2(J1)+(RM2(K)-RM2(J1))*(-180.-PH(J1))/(PH(K)-PH(J1)) GM=20.*ALOG10(1./RM180) WRITE(5,101)W180 WRITE(5,102)GM GO TO 13 12 WRITE(5,105) 13 DO 15 I=1,51 IF(RM2(I).GT.1.) J1=I 15 CONTINUE K=J1+1 WCO=W(J1)+(W(K)-W(J1))*(1.-RM2(J1))/(RM2(K)-RM2(J1)) PHCO=PH(J1)+(PH(K)-PH(J1))*(1.-RM2(J1))/(RM2(K)-RM2(J1)) PM=180.+PHCO IF(PM.GT.180.) GO TO 60 WRITE(5,103)WCO WRITE(5,104)PM GO TO 60 30 W180=0. DO 40 I=1,51 RMAX=PH2(I) IF(RMAX.GE.W180) GO TO 35 GO TO 40 35 W180=RMAX J1=I 40 CONTINUE RM180=PH3(J1) GM=W(J1) DO 45 I=1,51 IF(PH3(I).GT.-3.) J1=I 45 CONTINUE K=J1+1 IF(PH3(K).GT.-3.) GO TO 50 WCO=W(J1)+(W(K)-W(J1))*(-3.-PH3(J1))/(PH3(K)-PH3(J1)) WRITE(5,108)W180 WRITE(5,106)RM180 WRITE(5,109)GM WRITE(5,110)WCO PM=RM180 GO TO 60 50 WRITE(5,111) 60 RETURN 101 FORMAT(' FREQUENCY AT 180 DEG PHASE LAG = ',F8.3,' RAD/S') 102 FORMAT(' SYSTEM GAIN MARGIN = ',F8.3,' DBS') 103 FORMAT(' UNITY CROSS-OVER FREQUENCY = ',F8.3,' RAD/S') 104 FORMAT(' SYSTEM PHASE MARGIN = ',F8.3,' DEG') 105 FORMAT(' SYSTEM IS INHERENTLY STABLE',/) 108 FORMAT(' APPROXIMATE RESONANT AMPLITUDE = ',F8.3) 106 FORMAT(' = ',F8.3,' DBS') 109 FORMAT(' APPROXIMATE RESONANT FREQUENCY = ',F8.3,' RAD/S') 110 FORMAT(' SYSTEM -3DBS BANDWIDTH = ',F8.3,' RAD/S') 111 FORMAT(' SYSTEM HAS NO -3DBS BANDWIDTH') END SUBROUTINE EX COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) REAL*4 PROGDB REAL*4 PROG IS=1 DATA PROGDB,PROG/6RRK0CNT,6RRL SAV/ PAUSE CALL CHAIN(PROGDB,IS,1) END SUBROUTINE DISDAT(J,W180,WCO,PM,GM,SCX,SCY,SCY2) COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) GO TO (5,20),J 5 IF(AXY(13).LT.200..OR.AXY(13).GT.1000.) GO TO 10 W1=(ALOG10(WCO)-XMIN)*SCX CALL APNT(W1,200.,0,-5,-1) CALL VECT(0.,(AXY(13)-200.),0,2,-1,2) CALL RDOT(0.,0.,0,8,1) CALL RDOT(0.,(AXY1(7)-AXY(13)),0,-5,-1) CALL VECT(0.,PM*SCY2,0,5,1,1) CALL RDOT(-35.,-PM*SCY2*0.5,0,-5) CALL TEXT('PM') 10 IF(AXY1(7).LT.200..OR.AXY1(7).GT.1000.) GO TO 15 W2=(ALOG10(W180)-XMIN)*SCX CALL APNT(W2,200.,0,-5,-1) CALL VECT(0.,(AXY(13)-200.),0,2,-1,2) CALL APNT(W2,AXY1(7),0,8,1) CALL RDOT(0.,(AXY(13)-AXY1(7)),0,-5,-1) CALL VECT(0.,-GM*SCY,0,5,1,1) CALL RDOT(15.,GM*SCY*0.5,0,-5) CALL TEXT('GM') GO TO 15 20 IF(AXY(13).LT.200..OR.AXY(13).GT.1000.)GO TO 15 W1=(ALOG10(GM)-XMIN)*SCX CALL APNT(W1,200.,0,-5,-1) CALL VECT(0.,(AXY(13)+(PM*SCY)-200.),0,2,-1,2) CALL RDOT(0.,0.,0,8,1) W2=(ALOG10(WCO)-XMIN)*SCX CALL APNT(W2,200.,0,-5,-1) CALL VECT(0.,(AXY(13)-(3.*SCY)-200.),0,2,-1,2) CALL RDOT(0.,0.,0,8,1) CALL VECT((WAX(1)-W2),0.,0,2,-1,2) 15 RETURN END SUBROUTINE AXES(SCX,SCY,SCY2,DEC) COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) GO TO (5,13,15),L 5 AXX(20)=(0.-XMIN)*SCX DO 10 I=1,10 AXX(I)=((-1.*FLOAT(11-I))-XMIN)*SCX 10 CONTINUE DO 12 I=11,19 AXX(I)=((-.1*FLOAT(20-I))-XMIN)*SCX 12 CONTINUE RETURN 13 DO 14 I=1,20 NAXY(I)=20*(I-16) AXY1(I)=((20.*FLOAT(I)-320.-Y1MIN)*SCY2)+200. 14 CONTINUE 15 DEC=.001 20 IF(W(50).LE.DEC) GO TO 30 DEC=DEC*10 GO TO 20 30 AX1=ALOG10(DEC) AXX(1)=(AX1-XMIN)*SCX DO 35 I=2,10 AXX(I)=(AX1-FLOAT(I-1)-XMIN)*SCX 35 CONTINUE DO 50 I=1,20 MAXY(I)=10*(I-13) AXY(I)=((10.*FLOAT(I)-130.-YMIN)*SCY)+200. 50 CONTINUE RETURN END COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) CALL INIT(IBUF,1390) CALL SCROL(4,100) CALL DSPL WRITE(5,100) CALL EX 100 FORMAT(' EXIT FROM DISPLAY ROUTINE') END SUBROUTINE DSPL COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) CALL SCALE RX=XMAX-XMIN RY=YMAX-YMIN RY1=Y1MAX-Y1MIN GO TO (50,60,65),L 50 IF(RX.GT.RY) RY=RX SCX=800./RY SCY=800./RY XMIN=YMIN GO TO 70 60 SCY2=800./RY1 65 SCX=800./RX SCY=800./RY 70 CALL AXES(SCX,SCY,SCY2,DEC) DO 5 I=1,51 WAX(I)=SCX*(WAX(I)-XMIN) WAY(I)=(SCY*(WAY(I)-YMIN))+200. IF(L.NE.2) GO TO 5 WAY1(I)=(SCY2*(WAY1(I)-Y1MIN))+200. 5 CONTINUE DO 10 I=2,51 X=WAX(I-1) Y=WAY(I-1) CALL APNT(X,Y,0,-5) X=WAX(I)-WAX(I-1) Y=WAY(I)-WAY(I-1) CALL VECT(X,Y) 10 CONTINUE IF(L.NE.2) GO TO 15 DO 15 I=2,51 X=WAX(I-1) Y=WAY1(I-1) CALL APNT(X,Y,0,-5) X=WAX(I)-WAX(I-1) Y=WAY1(I)-WAY1(I-1) CALL VECT(X,Y) 15 CONTINUE GO TO (20,25,30),L 20 DO 22 I=1,20 X=AXX(I) IF(X.LT.0..OR.X.GT.800.)GO TO 22 Y=((0.-YMIN)*SCY)+200. CALL APNT(X,Y) 22 CONTINUE CALL APNT(AXX(10)-20.,(Y+5.),0,-5) CALL TEXT('-1') DO 24 I=1,10 X=(0.-XMIN)*SCX Y=AXX(I)+200. IF(Y.LT.200..OR.Y.GT.1000.)GO TO 24 CALL APNT(X,Y,0,6) 24 CONTINUE CALL APNT(0.,(AXX(20)+200.),0,-5) CALL VECT(AXX(20),0,0,2) CALL VECT(0,-AXX(20),0,2) GO TO 35 25 DO 27 I=1,20 X=WAX(51) Y=AXY1(I) IF(Y.LT.200..OR.Y.GT.1000.)GO TO 27 CALL APNT(X,Y,0,6) X=WAX(51) Y=AXY1(I)-10. CALL APNT(X,Y,0,-5) CALL NMBR(I+30,NAXY(I),'I4') IF(I.NE.7)GO TO 27 CALL APNT(WAX(51),AXY1(7),0,-5) CALL VECT((WAX(1)-WAX(51)),0.,0,2,0,4) 27 CONTINUE CALL APNT(WAX(51),200.,0,-5) CALL VECT(0,800.,0,2,0,1) CALL APNT(WAX(51),1005.,0,-5) CALL TEXT(-1,'BO') 30 DO 32 I=1,10 X=AXX(I) IF(X.LT.0..OR.X.GT.800.)GO TO 32 Y=200. CALL APNT(X,Y,0,6) X=AXX(I)-65. Y=175. CALL APNT(X,Y,0,-5) CALL NMBR(I,DEC*10.**(1-I),'F8.3') 32 CONTINUE CALL APNT(WAX(51),200.,0,-5) CALL VECT((WAX(1)-WAX(51)),0,0,2,0,1) CALL APNT((WAX(51)-100.),140.,0,-5) CALL TEXT('W RAD/S') DO 34 I=1,20 X=WAX(1) Y=AXY(I) IF(Y.LT.200..OR.Y.GT.1000.) GO TO 34 CALL APNT(X,Y,0,6) X=WAX(1) Y=AXY(I)-10. CALL APNT(X,Y,0,-5) CALL NMBR(I+10,MAXY(I),'I4') IF(I.NE.13) GO TO 34 CALL APNT(WAX(1),AXY(13),0,-5) CALL VECT((WAX(51)-WAX(1)),0.,0,2,0,4) 34 CONTINUE CALL APNT(WAX(1),200.,0,-5) CALL VECT(0.,800.,0,2,0,1) CALL APNT(WAX(1),1005.,0,-5) CALL TEXT('M DBS') 35 IF(L.EQ.3) GO TO 37 CALL SUBP(100) CALL APNT(875.,500.,1,-5) CALL TEXT('STABILITY') CALL APNT(875.,475.,1,-5) CALL TEXT(' MARGINS') CALL ESUB GO TO 38 37 CALL SUBP(200) CALL APNT(875.,500.,1,-5) CALL TEXT('RESONANCE') CALL APNT(875.,475.,1,-5) CALL TEXT('SPECS ETC') CALL ESUB 38 CALL SUBP(300) CALL APNT(950.,200.,1,-5) CALL TEXT('EXIT') CALL ESUB 39 K4=0 40 CALL LPEN(K4,KP) IF(K4.EQ.0) GO TO 40 J=KP/100 IF(J.EQ.3) GO TO 42 CALL CAL(J,W180,WCO,PM,GM) CALL DISDAT(J,W180,WCO,PM,GM,SCX,SCY,SCY2) GO TO 39 42 CALL INIT(IBUF,1390) CALL SCROL(-1,-1) CALL FREE RETURN END SUBROUTINE SCALE COMMON IS,L,A(10),C(5),D(10),E(5),F(5),WB(4,10),W(51),RM1(51), IRM2(51),RM3(51),RM4(51),RLG5(51),RM5(51),RM(51),RM11(10),RM21(5), IRM31(10),RM41(5),PH1(51),PH2(51),PH3(51),PH4(51),PH(51),B(5), IPH11(10),PH21(5),PH31(10),PH41(5),RLMAG(51),WAX(51),WAY(51), IWAY1(51),AXX(20),AXY(20),AXY1(20),M1,N1,K1,L1,I1,RK,J1,PH5,K, IXMAX,YMAX,Y1MAX,XMIN,YMIN,Y1MIN,IBUF(1400),MAXY(20),NAXY(20) XMAX=0. YMAX=0. Y1MAX=0. XMIN=200. YMIN=200. Y1MIN=200. DO 5 I=1,51 RMAX=WAX(I) SMAX=WAY(I) TMAX=WAY1(I) IF(RMAX.GE.XMAX) XMAX=RMAX IF(SMAX.GE.YMAX) YMAX=SMAX IF(TMAX.GE.Y1MAX) Y1MAX=TMAX IF(RMAX.LE.XMIN) XMIN=RMAX IF(SMAX.LE.YMIN) YMIN=SMAX IF(TMAX.LE.Y1MIN) Y1MIN=TMAX 5 CONTINUE RETURN END C LOG. MOD. CONVERSION, ENTER -VE M TO EXIT 10 WRITE(5,100) 100 FORMAT(' MAGNIFICATION M = '$) READ(5,105)RM 105 FORMAT(F12.4) IF(RM.LT.0.) GO TO 20 RN=20.*ALOG10(RM) WRITE(5,110)RN 110 FORMAT(' LOG. MODULUS N = ',F12.4) GO TO 10 20 STOP END CC VT TEST DIMENSION IBUF(500) CALL INIT(IBUF,500) 1 CONTINUE Y=FLOAT(IADC(0)) CALL APNT(100.,Y,0,-5) CALL TEXT('TEXT HERE') CALL LED(Y/4095.*5.,'F7.5') GO TO 1 END C FORTRAN SUB SUBROUTINE CALSQT COMMON /JACKY/X,Y Y= SQRT(X) RETURN END WRITE (5,100) 100 FORMAT(1H,'PLEASE TYPE IN A 4 DIGIT INTEGER') READ (5,120)I 120 FORMAT(I4) COMMON /JACKY/ I CALL SWAP WRITE(5,130)I 130 FORMAT(1H,'THE SWAPPED RESULT IS ',I6) STOP END C JOHNS PROG C HELP C JUMP C RLC PROGRAM C SUBROUTINE RLC COMMON /DPYBUF/IDBUF(2000)/RAND/IA,IB,IC IA=0 IB=0 IC=0 50 CALL INIT(IDBUF,2000) CALL APNT(0.,700.) CALL VECT(20.,0.) CALL VECT(5.,10.) CALL VECT(10.,-20.) CALL VECT(10.,20.) CALL VECT(10.,-20.) CALL VECT(10.,20.) CALL VECT(10.,-20.) CALL VECT(5.,10.) CALL VECT(20.,0.) CALL VECT(0.,-20.) DO 100 I=1,4 CALL VECT(5.,-3.) CALL VECT(3.,-7.) CALL VECT(-3.,-7.) 100 CALL VECT(-5.,-3.) CALL VECT(0.,-20.) CALL VECT(-45.,0.) CALL RDOT(0.,-10.,0,-5) CALL VECT(0.,20.) CALL RDOT(-20.,0.,0,-5) CALL VECT(6.,-4.) CALL VECT(4.,-6.) CALL VECT(-4.,-6.) CALL VECT(-6.,-4.) CALL RDOT(10.,10.,0,-5) CALL VECT(-45.,0.) CALL RDOT(0.,0.) R=RAN(IA,IB)*100.+1. CALL APNT(0.,725.,0,-5) CALL NMBR(1,R,'F6.0') AL=RAN(IA,IB)*1.+.1 CALL APNT(115.,635.,0,-5) CALL NMBR(2,AL,'F4.0') AL=AL*1.E-3 C=RAN(IA,IB)*1.+1.E-6 CALL APNT(0.,540.,0,-5) CALL NMBR(3,C,'F4.0') C=C*1.E-6 CALL APNT(0.,500.,0,-5) W0=1/SQRT(AL*C) CALL TEXT('CENTER FREQ.',1) CALL NMBR(4,W0,'F12.6') Q=W0*AL/R CALL TEXT(2,'CIRCUIT Q',1) CALL NMBR(5,Q,'F12.6') B=R/AL CALL TEXT(2,'BANDWIDTH',1) CALL NMBR(6,B,'F12.6') CALL APNT(250.,40.,0,-3) CALL VECT(0.,750.) CALL APNT(250.,40.,0,-3) CALL VECT(750.,0.) CALL APNT(950.,0.,0,-5) CALL TEXT('FREQ.') CALL APNT(270.,735.,0,-5) CALL TEXT('ADMITTANCE') CALL APNT(625.,35.,0,-5) CALL VECT(0.,665.,0,0,0,3) CALL APNT(250.,660./SQRT(2.)+.5,0,-5) CALL VECT(700.,0.,0,4,0,4) CALL RDOT(10.,-5.,0,-5) CALL TEXT('1/2') CALL RDOT(-55.,-25.,0,-5) CALL TEXT('POWER') W=W0-5*B I1=10*B/750 CALL APNT(250.,40.,0,-5) I1=2*I1 DO 690 I=0,375 IF(W.LE.0) GOTO 690 A=660*R/SQRT(R*R+(W*AL-1/(W*C))**2) CALL APNT(250.+2*I,40.+A,0,5) 690 W=W+I1 CALL APNT(650.,700.,0,-5) CALL TEXT(' Y') CALL STAT(-1) CALL RDOT(0.,-5.,0,-5) CALL TEXT('MAX. ') CALL STAT(1) CALL RDOT(0.,5.,0,-5) CALL TEXT('= ') CALL NMBR(7,1./R,'F12.6') CALL TEXT(' MHOS') CALL TIME(180) 900 CALL TIMR(IE) IF (IE.NE.0)GOTO 900 GOTO 50 END SUBROUTINE FORBAC COMMON /DPYBUF/ IDBUF(2000) C C C CALL INIT CALL APNT(0.,766.,0,-5) CALL TEXT('RT-11 is a high-performance, easy-to-use', +' operating system designed for',1, +'the single user environment. it pr', +'ovides fast, efficient program',1, +'development and/or real-time applicatio', +'ns facilities for any PDP-11',1, +'processor with at least 8K words o', +'f memory (at least 16K words for',1, +'foreground/background operation).',4, +'The RT-11 Operating System actually ', +' provides two monitors - the',1, +'single-job monitor and the foreground/ba', +'ckground (F/B) monitor. The F/B',1, +'monitor allows two jobs to execute concu', +'rrently - a foreground program',1, +'and a background program. The real-time', +' function is accomplished in the',1, +'foreground, which has priority for syste', +'m resources. Functions which do',1, +'not have critical response time requirem', +'ents (e.g., program development)',1, +'are accomplished in the background, ', +' which operates whenever the',1, +'foreground is not busy. within their', +' priorities, both foreground and',1, +'background are complete RT-11 system', +'s with access to all system',1, +'functions. Although they operate ', +' independantly, foreground and',1, +'background can communicate through syste', +'m message facilities or disk',1, +'files.',4, +'If F/B operation is not required, th', +'e single-job monitor - which',1, +'requires less memory and lower over', +'head - can be utilized. Should',1, +'requirements change, upgrading is easy ', +'since programs are completely',1, +'interchangeable between the single-job a', +'nd F/B monitors.',1) CALL SLEEP(0,0,30,0) RETURN END C~F~F H p: ^wBF d  \!F  F D F@U0$l&5 B5 @5 huaw READYFw 5 hw  ZBE w' w*,wBBc"w( XFIOULN&f    `D B  e<" 7A 3u <0W$ u "   b   ru B RJ5 ATL@ AB q,:e7L7E 5 U76B @ :EU  ʋ$eFNO@ߋ*wF5 huaw ?@ rW-!w AT LINE @5"5 5#5"5 5!eG vw Pwz@>5>   BSO~}   _  ꈇ7 ,EeH& EE& Е- eePPPЕ-  W  e0e0PK JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDECR%PeD C E 7 6& B:A u:  <u<  Ԃc 0 Cc    އe K c:~66666679SYN W eBAaDCEBBBc  BW @ WыB w @m 5 <5 Ai &5`8 E T5 @w DELETED Bw E_ILR@ E%H EU"" "7 nB  L    w~ LTL  5 5 "עע@ פרפ ! #"  5 "e e& C C eC e C ?@fuafh5hffh@ D h   0@ C        e `    0 #  7 D &e7  e 5 " " 5 "H 5 "-W 0  D" C  0  yEU C 0@      e |       Pe P    Ee0E $ e & ) .  E + - 0   e: . 0 $0 ! .  e 7 PA0u0 .7 <5`8 Ah& 5 9FTSWLODNRf&& e ыW WWWe WыV $wTLTw    09    & 0eC  .  09 .& E.u +  +-  09 m Ee& e0 E E e C B   Ee&&   v |N v  6 6  hv  `   @ (%.% D %e% e @ D   mm@ 0     A C v %\w     0  @  @ w H  & Dr)&&\   5@5@7         Nf&\  \& \\r1@\[?\ ew f ?U?*@ڪAD C %     @  f&\&f  & N & . )   v     C 6  %%    w ~6 6 %   Dv   0e%6  6  E v v ·ͅ%\ @       D f C_  fW & @&&&&7 R$.$ 4    pe\\;@\ \N @   =@f&ysE[\pCf&f&\% a @w   &  f 6A  v  6N\&f f & G   v  76   p  d deA @ A @ %  A @ 6v %\%    w    `@ `  ` `  \\ N A f C %C B    \ w  D& &&@7  FD& && 6  A7 \ \      e\ \S\ e& @7 x ne\ f& \:יc&>X4%]@& & & & & D&&e #@  @6 7 `6 6 #?%-0 @ ׳f&& @׳@f&7   f&f&7 l          \>f& \ e\>:L]L?ƪ@ \fEA#& e@ & f& f& f7  n ff w   &@& +-*/^()\&;,<==<>==><>><<>="':#[]%$LET VFIF END #LET IF GO TO FOR INPUT FOR OUTPUTFOR TO NEXT THEN STEP GOSUB RETURNINPUT PRINT REMDEF READ DATA CALL FNRND(RNDSIN(COS(SQR(ATN(EXP(LOG(ABS(INT(SGN(TAB(BINOCTLEN(ASC(CHR$(POS(SEG$(VAL(TRM$(DAT$STR$(OPEN CLOSE CHAIN OVERLAY AS FILE DOUBLE BUF LINE VFDIM RANDOMIZERESTORE STOPENDLISTNHRUNNHRENAMENEWREPLACELISTRUNSAVEOLDSCRCLEDXY ; COMMANDS. THIS COMMAND DEFINES THE SPECIFIED ; ARRAYS, BUF1, BUF2, ETC..., AS CIRCULAR ; DATA ARRAYS. ANY NUMBER OF BUFFERS MAY BE ; SPECIFIED, BUT ALL MUST BE GIVEN IN A SINGLE ; "USE" STATEMENT. CURRENTLY THE SYSTEM WILL ; SUPPORT UP TO 5 OF THESE AREAS, HOWEVER, THIS ; MAY BE CHANGED AT ANY TIME BY REASSEMBLY. EACH ; BUF DEFINED MUST HAVE PREVIOUSLY BEEN DEFINED ; IN A "DIM" STATEMENT. THE FOLLOWING FORM, HOWEVER, ; IS LEGAL: ; 10 DIM A(50),B(100),C(200) ; 20 CALL "USE" r8AWw R5iC@ Bw B@c""  B" f &5 B5 @ww2 fAN@@@c" A#  0 iwJ XDW,C CCc" "  4W C CCc"a@B"""  @B""H  EcC`Ҕ  0   +@ @ ECCm w :  :B   #@`" @ WB BBc$J w5 hDA B  &p~*hD@`5 wȕ5 wF   WwOLD O  X  5.5i& $5 2 ewX WwNEW E   vw22 W   4 v5 05.5h $ e  Nw | Wfɋ 8 W ɋ   ۇN  W  R  ABBBcB ]Dd RBKBBcWE WW>C< CWW1  WW)D' DW!"  WW ,@m8544WwIDMIDFWBBm WJ5 DA  WwwNPRw HvzX*B  ^<@@  5 0@C  Nu"0W @5 .WWw0. UC  @" 5`.@ XU@TUΕU@C , u"W@5C  @"  ΐ@5 C  0 & < 0 r&e&5 2 zew*w:wjW'& W C pW @"  e wWwwnw n >  u@ @wF "  l 5 @W ڇ@ . 4 B u wwL Ew w< STOPAw0f@" DAw wF5 w wW-.B>C>55>j7 v5. fA eo7Ne 7De7 #5 C Bee @ & &p X5D@ l 7 5 >5j446@5 " " eu u :u <@ 5 wFILE NAME-- @פ  r!RbRdRf@ (   wd NONAME wR BASIC V01B-02 @ 5 A Bc%5Ee XWW@e e B w E B Bc"\  @ 5#u"u#u"5 u!u u#u" BBc""5 #5" 5!eG   瀜  v"$7 4#  : @bAa.     ѕ NONAMEfA. f Re $L   !&@B  5 3j  l&j 2 we  2bw 2 RPLwߋ*Ge 5 f05@ wX5 wCm.( @. Z^ \wJ5 @0 & Bm.ww* H֋ FNFNER POINT MINUS ONE f& b :# J D .# ,  H b@a  e   & # AZ@# & eD`09.:wL7 5 'e77<C & e  5&e  IeeBW @`B 5 .   ɕ.09wPAZaĘ h  פ Ӌ `1Eĥesѕ@ >  'ѕѕɕB  A Z NF @ @  e @ wwZA . ѕ@  ɕ 90C  "ee,$$$$ !e : T :* & # # # $ S S K u.Cѐѐ@ w& .wPTBw e  \ ^ \!YC C /W,W)W&W"WW  <!ѕѕ@  @ wZw wn C "e "ee : : :  # # w   ѕ@ ̆ѐѐf& A<B < N u ::  CC 0 Cc    ܆ ڇe"cK`b  )>*\-,,L+t0+.t/(-h,1),>* p $@!ʋ& emNҋ e f&f wwemׂ |f"f W[ f"f & WM" x65@w "5; "5 v /7 ;;:R J"Ue w 5ҕ    eҔ ww FDEBBBc W W  wW w LWW!kf i&&  eeҤ'  פ   ҥ   B fc`ww . WW!f"f f , 8BY963www BA!wWwzW   Ww nW W C Cm K w$GNDwwh T < w@fA" @  w7 (WC    Cm wwRBGf BBBc"W  BW އu u"5 "W W xʇW C B BBc"WWW B聁 BBc FWNe Bځ BBc W( QQQQQ!Q Q#Q"f N"ff   w 11 w\ fvwD BBԵ YVeCUCCc RLRJG"E$ " fvfv Zf"f fvfv    !!e %wfv " f wNBFwW   eHWWW,W,W)  V/ D w"   ew/b z R w W ^$W& @e e- w e-  $W W ua5hww S= u wPILNwT525iW2 dWP1BLBBc ע 2w ?f BwB"3@  B" h  ע  ע,WW i5 wwBRT wCפ  e W w& wdBہBBc  C* /ע.פ$’85   עעWWw= OOD= BDRCˋeפרf C פӋ¤&   e##    x6<7 ; ;: K Bm""K 5"# 5!e K5 " K5"# 5!eG K L 2 #ARGih $  B" Naww҄!!_BM)..4KwE " e wV5 5#u"w5 u!u u#u"Z fWTwWwBBcW"$=;wETCww    WWf"  WC"w  @""w$ x "Cנננ ננננ  e3&7$5<55444f"!f  wTw J e 5 "H 5 " Lx67 rR5^5;:wBh7v7 ZR5^5;:  wB\f"f \w & ww T , !& Β W  eJf @NSM#%  $ ҃!& Β`#"e 2 `e e ewSTLOVF:B2  x6b 2w@w vw8w,W(7 ^56: &6_f@8*e%5 u"\w "W w\wD   7 j:8x  ""%w& < "DV0 w5 5 " "@ E @EU D e  5 " 7 ;(8J8 Ѐ@"  /7 ;;87;,88;;;(87;488;;;:wf^ER $ \\ $ ( \7 X\8<8n8;x8:w"f&\b *wf*w\w~wlwBWBm-&! "Bc"f"f Bc$  wUFNwh&f&&6Bc% %,  ॲ  W&6Bc" $&B  ,&   wwpw : hw 5 5 5 "wV 4w"  f"7 P;:  7 <:J:!  ewd@$A&B(C*f,5$u&(*,\W# b" H u"B < " u"WwRww6@ 17 Z " KE @< L  GB"A#U B  B e    u"5  B e@"@" 07 ;; ;; 5 ""f"f \ "\& @\" & F  Fƃ2 #     m % ` " `SOB J @SSO 45<eӤ   ## @<me5 B"@C $R J"wB"@C  ,   B eKw ew6 H6 &f&  +-N n 5"  5 " U w4wC  W-"v"W JW   هfe A<C" ˂@ C,%m7"E7.5 5@#& f@& f1EBl@ Cܚ> www @ 43*W%@e6 B dbB be B     "_~4__2 43W E  "5 "H 5 "_~4_2_ 43W  "  5"5 _~4_2_5 & p:   0  "_~4_5 & p:     0 ` "_~4_ 2W& N"#HBN  B j< eЕ _5_ 43W 5 5 " "_~4_2_ 43W  5 5 ""_~4_2_ 2Wŀ"B j<p"_5_ 43XWW 43RWQ 43L ;WI ;@"-2 #- * ce0ece.`eҢ .  0  . %5"5 _~4_2_ 43LWK 43F ;f f"W? 43: ;W7-  # !C"   B j<c ee _^6_5_2_ 43&W! 5 5 " & Ҏ j<e  j=ȋ _~4__2 43W  `e  _5 j<_^6_2_ 43WB j<e05 . 0 f. j<_^6_2_CjCRD OFFSET BMI SYNER ;TOKEN ILLEGAL HERE SWAB R2 BISB (R1)+,R2 ADD (R5),R2 ;R2 NOW POINTS TO SYMBOL TABLE ENTRY JSR PC,@#GETC7 l& U$ > D BASIC V01B-02 *J 6NJ A  I Y-YES N-NOECee!&W!F# w w : N YT e!Ѓw`BC C @5\5"25m,5446 @ 6 USER FNS LOADEDU ee w  &>?RND ?>?ABS >?t?SGN t??BIN ??OCT ?6@TAB 6@`@LEN `@@ASC @@CHR$@|APOS |A"BSEG$"BxBVAL xBBTRM$BBSTR$ TO ACTUAL ARRAY ADDRESS ; ; ROUTINE FALLS THROUGH TO CKBUF. ; GETBUF: JSR PC,GETADD ;CALCULATE ARRAY ADDRESS FROM ; ARRAY NAME POINTED TO BY R1. CMP VARSAV(R5),R3 ;DETERMINE IF GIVEN SUBSCRIPTED ; ARRAY IS WITHIN BOUNDS OF ; DIMENSIONED ARRAY. BHIS ERBUF ;BUFFER ERROR ; ; .SBTTL CKBUF ; ;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ; ; POLISH ROUTINE TO CHECK IF ARRAY ADDRESS SPECIFIED ; IN VARSAV(R5) HAS BEEN DEFINED BY _aa> H p: ^w]F d  \!F  F D F@U0$l&5 B5 @5 huaw READYFw 5 hw  ZBE w' w*,wBBc"w( XFIOULN&f    `D B  e<" 7A 3u <0W$ u "   b   ru B RJ5 ATL@ AB q,:e7L7E 5 U76B @ :EU  ʋ$eFNO@ߋ*wF5 huaw ?@ rW-!w AT LINE @5"5 5#5"5 5!eG vw Swz@>5>   BSO~}   _  ꈇ7 ,EeH& EE& Е- eePPPЕ-  W  e0e0PK JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC;%PeD C E 7 6& B:A u:  <u<  Ԃc 0 Cc    އe K c:~66666679SYN W eBAaDCEBBBc  BW @ WыB w @m 5 <5 Ai &5`8 E T5 @w DELETED *w ;_ILR@ E%H EU"" "7 nB  L    w~ LTL  5 5 "עע@ פרפ ! #"  5 "e e& C C eC e C ?@fuafh5hffh@ D h   0@ C        e `    0 #  7 D &e7  e 5 " " 5 "H 5 "-W 0  D" C  0  yEU C 0@      e |       Pe P    Ee0E $ e & ) .  E + - 0   e: . 0 $0 ! .  e 7 PA0u0 .7 <5`8 Ah& 5 9FTSWLODNRf&& e ыW WWWe WыV $wTLTw    09    & 0eC  .  09 .& E.u +  +-  09 m Ee& e0 E E e C B   Ee&&   v |N v  6 6  hv  `   @ (%.% D %e% e @ D   mm@ 0     A C v %\w     0  @  @ w H  & Dr)&&\   5@5@7         Nf&\  \& \\r1@\[?\ ew f ?U?*@ڪAD C %     @  f&\&f  & N & . )   v     C 6  %%    w ~6 6 %   Dv   0e%6  6  E v v ·ͅ%\ @       D f C_  fW & @&&&&7 R$.$ 4    pe\\;@\ \N @   =@f&ysE[\pCf&f&\% a @w   &  f 6A  v  6N\&f f & G   v  76   p  d deA @ A @ %  A @ 6v %\%    w    `@ `  ` `  \\ N A f C %C B    \ w  D& &&@7  FD& && 6  A7 \ \      e\ \S\ e& @7 x ne\ f& \:יc&>X4%]@& & & & & D&&e #@  @6 7 `6 6 #?%-0 @ ׳f&& @׳@f&7   f&f&7 l          \>f& \ e\>:L]L?ƪ@ \fEA#& e@ & f& f& f7  n ff w   &@& +-*/^()\&;,<==<>==><>><<>="':#[]%$LET VFIF END #LET IF GO TO FOR INPUT FOR OUTPUTFOR TO NEXT THEN STEP GOSUB RETURNINPUT PRINT REMDEF READ DATA CALL FNRND(RNDSIN(COS(SQR(ATN(EXP(LOG(ABS(INT(SGN(TAB(BINOCTLEN(ASC(CHR$(POS(SEG$(VAL(TRM$(DAT$STR$(OPEN CLOSE CHAIN OVERLAY AS FILE DOUBLE BUF LINE VFDIM RANDOMIZERESTORE STOPENDLISTNHRUNNHRENAMENEWREPLACELISTRUNSAVEOLDSCRCLE! <--LINE(R5) NEEDED ; +---------------+ ; ! USER AREA ! ; ! STORAGE CELLS ! ; R5 POINTS--> ! ! ; +---------------+ ; ; ; -- ; ; CODE AREA CONTAINS STRING OF CODE BYTES WHICH COMPRISE ; THE COMPILED CODE TO BE INTERPETED. THE SYNTAX SCAN OF THESE ; CODE BYTES IS FACILITATED BY THE JUDICIOUS PLACEMENT ; OF CERTAIN OF THESE CODE BYTES TO BE CALLED 'TOKENS'. ; IF THE HIGH BIT OF A TOKEN IS ON ; IT IS A SYSTEM SYMBOL (S.SYM), (SEE TABLE, BELOW.) ; HIGH BIT OFF SIGNALS TOKEN AS THE HIGH r8AWw R5iC@ Bw B@c""  B" f &5 B5 @ww2 fAN@@@c" A#  0 iwJ XDW,C CCc" "  4W C CCc"a@B"""  @B""H  EcC`Ҕ  0   +@ @ ECCm w :  :B   #@`" @ WB BBc$J w5 hDA B  &p~*hD@`5 wȕ5 wF   WwOLD A  X  5.5i& $5 2 ewX WwNEW D   vw22 W   4 v5 05.5h $ e  Nw | Wfɋ 8 W ɋ   ۇN  W  R  ABBBcB ]Dd RBKBBcWE WW>C< CWW1  WW)D' DW!"  WW ,@m8544WwIDMIDFWBBm WJ5 DA  WwwNPRw HvzX*B  ^<@@  5 0@C  Nu"0W @5 .WWw0. UC  @" 5`.@ XU@TUΕU@C , u"W@5C  @"  ΐ@5 C  0 & < 0 r&e&5 2 zew*w:wjW'& W C pW @"  e wWwwnw n >  u@ @wF "  l 5 @W ڇ@ . 4 B u wwL #w w< STOP w0f@" DAw wF5 w wW-.B>C>55>j7 v5. fA eo7Ne 7De7 #5 C Bee @ & &p X5D@ l 7 5 >5j446@5 " " eu u :u <@ 5 wFILE NAME-- @פ  r!RbRdRf@ (   wd NONAME wR BASIC V01B-02 @ 5 A Bc%5Ee XWW@e e B w ; B Bc"\  @ 5#u"u#u"5 u!u u#u" BBc""5 #5" 5!eG   瀜  v"$7 4#  : @bAa.     ѕ NONAMEfA. f Re $L   !&@B  5 3j  l&j 2 we  2bw 2 RPLwߋ*Ge 5 f05@ wX5 wCm.( @. Z^ \wJ5 @0 & Bm.ww* H֋ FNFNER CODE = LOFREE+2 f& b :# J D .# ,  H b@a  e   & # AZ@# & eD`09.:wL7 5 'e77<C & e  5&e  IeeBW @`B 5 .   ɕ.09wPAZaĘ h  פ Ӌ `1Eĥesѕ@ >  'ѕѕɕB  A Z NF @ @  e @ wwZA . ѕ@  ɕ 90C  "ee,$$$$ !e : T :* & # # # $ S S K u.Cѐѐ@ w& .wPTBw e  \ ^ \!YC C /W,W)W&W"WW  <!ѕѕ@  @ wZw wn C "e "ee : : :  # # w   ѕ@ ̆ѐѐf& A<B < N u ::  CC 0 Cc    ܆ ڇe"cK`b  )>*\-,,L+t0+.t/(-h,1),>* p $@!ʋ& emNҋ e f&f wwemׂ |f"f W[ f"f & WM" x65@w "5; "5 v /7 ;;:R J"Ue w 5ҕ    eҔ ww FDEBBBc W W  wW w LWW!kf i&&  eeҤ'  פ   ҥ   B fc`ww . WW!f"f f , 8BY963www BA!wWwzW   Ww nW W C Cm K w$GNDwwh T < w@fA" @  w7 (WC    Cm wwRBGf BBBc"W  BW އu u"5 "W W xʇW C B BBc"WWW B聁 BBc FWNe Bځ BBc W( QQQQQ!Q Q#Q"f N"ff   w 11 w\ fvwD BBԵ YVeCUCCc RLRJG"E$ " fvfv Zf"f fvfv    !!e %wfv " f wNBFwW   eHWWW,W,W)  V/ D w"   ew/b z R w W ^$W& @e e- w e-  $W W ua5hww Z= u wPILNwT525iW2 dWP1BLBBc ע 2w ?f BwB"3@  B" h  ע  ע,WW i5 wwBRT wCפ  e W w& wdBہBBc  C* /ע.פ$’85   עעWWw= OOD= BDRCˋeפרf C פӋ¤&   e##    x6<7 ; ;: K Bm""K 5"# 5!e K5 " K5"# 5!eG K L 2 #ARGih $  B" Naww҄!!_BM)..4KwE " e wV5 5#u"w5 u!u u#u"Z fWTwWwBBcW"$=;wETCww    WWf"  WC"w  @""w$ x "Cנננ ננננ  e3&7$5<55444f"!f  wTw J e 5 "H 5 " Lx67 rR5^5;:wBh7v7 ZR5^5;:  wB\f"f \w & ww T , !& Β W  eJf @NSM#%  $ ҃!& Β`#"e 2 `e e ewSTLOVF:B2  x6b 2w@w vw8w,W(7 ^56: &6_f@8*e%5 u"\w "W w\wD   7 j:8x  ""%w& < "DV0 w5 5 " "@ E @EU D e  5 " 7 ;(8J8 Ѐ@"  /7 ;;87;,88;;;(87;488;;;:wf^ER $ \\ $ ( \7 X\8<8n8;x8:w"f&\b *wf*w\w~wlwBWBm-&! "Bc"f"f Bc$  wUFNwh&f&&6Bc% %,  ॲ  W&6Bc" $&B  ,&   wwpw : hw 5 5 5 "wV 4w"  f"7 P;:  7 <:J:!  ewd@$A&B(C*f,5$u&(*,\W# b" H u"B < " u"WwRww6@ 17 Z " KE @< L  GB"A#U B  B e    u"5  B e@"@" 07 ;; ;; 5 ""f"f \ "\& @\" & F  Fƃ2 #     m % ` " `SOB J @SSO 45<eӤ   ## @<me5 B"@C $R J"wB"@C  ,   B eKw ew6 H6 &f&  +-N n 5"  5 " U w4wC  W-"v"W JW   هfe A<C" ˂@ C,%m7"E7.5 5@#& f@& f1EBl@ Cܚ> www @SCALSVECTPRDOTOAPNTbPTIMEXTIMRPYSTATOTEXTWSUBPHESUBzILPENZJNOSCMDONMONMOFFNTRAKQERASJINITDLDSTPKSTOPKDCNTKCONTKXGRAxRYGRARAGETUDFIXNFIXNFREE*NAPUTPUFIGR@VFPUTVDSAVr?SAVEr?RSTRBff b    P  8 j Y$ fI7 i?    < 40"N!$ e $   "ֆ" e   e Y, $)  E  $ " 77 ( 0  @  W wLw7e7& w w. e@`&@VBNB&w ^tBFB7HB  &* wbwb ?NER-C .w wwf& B:A u:  <u< ' Ԃc 0 Cc    ݆ ۇe K cD &N<e>wm  & 5"5 w" WORDS FOR DISPLAY FILE  Tw e wC  "( NER - FOR DISPLAY BUFFERN R$!   8& $ C ;" $$ e" &%3 & m ea ` $  Be>   $ tf Uf,Awڭ7 * 6dY|  pY7 7 7^7 XC D 7 wwxwlUdf p? ````e  f"\ V \w&77\ \ \\B   5 5 "\&D \wwGee\~G p- f"f \& @\ "\7 nW\w^\W W wBw>& WW W Ww\e$U.\e$@ABCf. "`%Y&ܫ  e?7ƫz7^T 7 7 7  *7 HtH-:DFO - :e "    nGFFFFFFHw   vhe e%IFe> INS <  ,   H w  H 76 wD .IFDF $RT11 .A 'LISTNH' .BYTE .L $Y @ &\ JWnw fGFJB"w  >0  " w: `J  , J | J j f 7 wf L \w47  7  GRIF4RI2NJ&BaBBc"<&D $/,1 @C2       m e` `SOBw~wl$ $ * T J-B ` 6  G xdY K%K KG~Yx 7 w `****.LYX `,} G  *7 f,we5NO VT11 HDW5 5VT11 IN USE @Aew XpL  LL$L$LHN L7 7 N 7 j7 H & T z,7p 7 dY7 7 IjF ~Y  pY pYwI$LdYVD w4#WwF7 Xw GFMB"w  xv  w bGF"N pw hw@& RFFFFFFNN  eP 0P 7  U P P\ UU `&  l 7f"f 5 E5"  7`  "5 r U f"f 5 ФE5" TF 7`> : "5 * U v &7 JJR J"L "ł P GFFFFFOB"  PUw ^7 U ] l e ^ & U  7 A 6 ]]e ] H \U D nQ]  tQ w 7 <U wU ]j]  e  <%Uf&f & 8Q zQJQ dQpR tG(QȮOVF DV0 d \>QV\ |%\ z v \AORf\\f"f  W Q\  QGRnQIF4RtQQ7  6J pw7  U @wZ@" 7 U @"@  \ & @\ 7 7 L GR- RnQRR\ 4RtQIJQG2NR]w  ?U@  ~ B BBcWWwвwߗ$$ N& B "8b7 L p?":e  *  @     "- 4RtQS RnQSU@ w fGQFFQFQFQS 7 T DGtG DGGU w w" "U \w w"U ` ~"U Lw&&\E\8Q\7 lGT\QbGtGbGbGDGTTG FJT  @" \   w QGFQbG`U ("UtGnU wݶ4UUUU RnQU 4RtQU7 5  4R> :]6 vR](EP4 r"UJU wݷ"5 E@"UV"VVU5 5 "U"7 5 U bbG"U4V wT QG2NQNVU $BJBBc$D $ 7 U @  ")7 7  "  rR]$ 7 b4R ]]R www NQGFQbGW "UtGW w۶7 5  4R  R F]EP |  $"   U EQwE@5 E  7 W XWWSw&D L FFC"    fe bE! R J BĔ  47 ,Ĕ   5 (w5 GFX b-Y f J!@"w  @70z ""Y 7"Y7Rw|X  m7 $ *VY  ~w0TpY#~YYYT`_@@_?@__x@o^@O@TdY 43*W%@e6 B dbB be B     "_~4__2 43W E  "5 "H 5 "_~4_2_ 43W  "  5"5 _~4_2_5 & p:   0  "_~4_5 & p:     0 ` "_~4_ 2W& N"#& N  B j< eЕ _5_ 43W 5 5 " "_~4_2_ 43W  5 5 ""_~4_2_ 2Wŀ"B j<p"_5_ 43XWW 43RWQ 43L ;WI ;@"-2 #- * ce0ece.`eҢ .  0  . %5"5 _~4_2_ 43LWK 43F ;f f"W? 43: ;W7-  # !C"   B j<c ee _^6_5_2_ 43&W! 5 5 " & Ҏ j<e  j=ȋ _~4__2 43W  `e  _5 j<_^6_2_ 43WB j<e05 . 0 f. j<_^6_2__^P (R0),R1 BHI .+4 CLR (R0) EDICHI: TST (R0)+ ;### DEC R2 BGT EDICHG SUB R4,R1 ;### BR .+4 EDIPUT: CLR R1 SUB_7 l& U$ YD BASIC V01B-02 *E 6NJ A  I Y-YES N-NO`Cee!&W! ^C _ 5\5"5m 5446 @ 6 USER FNS LOADEDC ee wޠ  &Y"ZRND "Z`ZABS `ZZSGN ZZBIN Z[OCT [X[TAB X[[LEN [[ASC [[CHR$[\POS \D]SEG$D]]VAL ]]TRM$] ^STR$R3,(R5) BLO EDIMOVE TSTB -(R2) BEQ .+4 INC R2 ;R2 NOW POINTS TO BYTE AFTER THE .EOF. BIT R2,#1 BEQ .+4 CLRB (R2)+ ;R2 NOW HAS THE NEW START OF THE SYMTAB. MOV R2,(R5) MOV (R3)+26G6G&fe~B @& fE@^*F B ^*} ^*!w ^*,X?0_ @>._ @2_ @F5_ @86_ @F6_ @6_ @<7_ @|8_ @ `*_ @ +_ @ \-_ @ 3_ @ 3_ @ 3_ @ 4_ @ (5_ @ f6_ @ 6_ @ 7_ @ (7_ @ .7_ @ 47_ @ >7_ @ D7_ @ N7_ @ 7_ @ :_ @ :_ @ ;_ @ ;_ @ `;_ @ ;_ @ |<_ @ <_ @ <_ @ =_ @ v=_ @ =_ @ >_ @`*_ @+_ @-_ @._ @._ @"1_ @Dr H  *wF d  F z fF D LF@U0$8&5 B5 @5 huaw READYFw 5 hw  ZBE w w,wBBc"w FIOULN&f    `D B  e<" 7A 3u <0W$ u "   b   ru B RJ5 ATL@ AB q,:e7L7E 5 U76B @ :EU  ʋ$eFNO@ߋ*wF5 huaw ?@ rW-!w AT LINE @5"5 5#5"5 5!eG vw Wwz@>5>   BSO~}   _  ꈇ7 ,EeH& EE& Е- eePPPЕ-  W  e0e0PK JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC %PeD C E 7 6& B:A u:  <u<  Ԃc 0 Cc    އe K ct4<DLT\dlSYN W eBAaDCEBBBc  BW @ WыB w @m 5 <5 Ai &5`8 E T5 @w DELETED w _ILR@ E%H EU"" "7 nB  L    w~ LTL  5 5 "עע@ פרפ ! #"  5 "e e& C C eC e C ?@fuafh5hffh@ D h   0@ C        e `    0 #  7  &e7  e 5 " " 5 "H 5 "-W  D" C  0  yEU C 0@      e |       Pe P    Ee0E $ e & ) .  E + - 0   e: . 0 $0 ! .  e 7 PA0u0 .7 <5`8 Ah& 5 9FTSWLODNRf&& e ыW WWWe Wы" $wTLTw    09    & 0eC  .  09 .& E.u +  +-  09 m Ee& e0 E E e C B   Ee&&   v |N v  6 6  hv  `   @ (%.% D %e% e @ D   mm@ 0     A C v %\w     0  @  @ w H  & Dr)&&\   5@5@7   h    j f&\  \& \\r1@\[?\ ew f ?U?*@ڪAD C %     @  f&\&f  & N & . )   v     C 6  %%    w ~6 6 %   Dv   0e%6  6  E v v ·ͅ%\ @       D f C_  fW & @&&&&7 Rjh  h h <e\\;@\ \N @   =@f&ysE[\pCf&f&\% a @w   &  f 6A  v  6N\&f f & G   v  76   p  d deA @ A @ %  A @ 6v %\%    w    `@ `  ` `  \\ N A f C %C B    \ w  D& &&@7  D& && 6  A7 hd( nd(x ~dd    V e\ \S\ e& @7 x :e\f& \:יc&>X4%]@& & & & & D&&e #@  @6 7 h,6 6 #?%-0 @ ׳f&& @׳@f&7   hf&f&7 l         \ f& \ e\>:L]L?ƪ@ \fEA#& e@ & f& f& f7 h : ff w   &@& SCALz$VECT8!RDOT APNT TIMED)TIMR)STATN TEXTN(SUBPrESUBLPENNOSCdDONlONlOFFTRAK^"ERASINITDSTPdSTOPdDCNTCONTXGRA#YGRA #AGETn&DFIXFIXFREEAPUT%FIGR&FPUT'DSAVSAVERSTRf"\ 0 \w77\ \ \\B   5 5 "\&D D\ww.ee\ p- f"f \& @\ "\7 nW\w\W W wtwp& WW W WwF\e$U.\e$@ABCf. `%Z*T&B  e?7,ۂz7^T 7 7 7  *7 H-:DFO - :e "    n`Z`Zwp  vhe e%vFe> INS <  ,   H w  H 76 w MOVB (R2)+,R0 JC,PUTCHAR ;PRINT NEX $* @ &\ JWnw f`B"w:  >0  " w:   , 2 | ( j f 7 wf L \wf7  7  ""&BaBBc"<&D $/,1 @C2       m e` `SOBww$ $ * `% J-B ` 6  4 x) %z 4*x 7 w z` BHX*x) ``,} 4  *7 f,we5NO VT11 HDW5 5VT11 IN USE @Aew Xp $$B 7 7 N 7 j7 H & ,7p 7 )7 7 `jF *   *  *wH$L)ՇD wf#Wwx7 Xw `zB"wx  xv  w b` w0 w0@& Rp`Zz  eP 0P 7  U P P\ UU `&0  l 7f"f 5 ~E5"  7`  "5 Vr % f"f 5 6E5" TF 7`> : "5 * % v &7 (,R J"L "B Ӈ `Z`` B"  PUw ^7 U ] l e ^ & U  7 A 6 ]]e ] H \U D "]  " w 7 <U wU ]j]  e  <%tUnf&f & ! z8"! ! # !.އOVF DV0 d \!\ |%\ z v \AORf\\f"f  W jT"\  """""|"7  62 pw7 % @wZ@" 7 % @"@  \ & @\ 7 7 L @#- ""R#`#\ ""2"Jl#]w  ?U@  ~ B BBcWWww@ޗ$$ N& B "8b7 L X":e  *  @    " "- ""`$ ""`$U@ w f8"p8"z""8"$ 7 V%  % w w" "% \w w"% ` ~"% Lw&&\E\!(\7 L%!hhB%V% 2%  @" \   w "J"% (%& w۶4&"&,&6& ""^& ""^&7 5  "> :]6 v"](EP4 r%2x& w|۷"5 E@"&&&&%5 5 "U"7 5 % b%& wT "J"&U $BJBBc$D $ 7 U @  ")7 7  "  r"]$ 7 b" ]]R wwnw( N"J"' %' wBڶ7 5  "  " F]EP |  $"   U EQwE@5 E  7 X( .)WWSwD&D  F`C"    fe bE! R J BĔ  47 ,Ĕ   5 (w5 `N) b-) f J!@"w @70 ") 7)7w|b)  m7 \ֱV *)  ~w0T *#*P*"*T`_@@_?@__x@o^@O@T)JSR PC,STOSVAR TST (SP)+ CMPB (R1)+,#.COMMA BNE INPEND TST (SP)+ JMP INPY01 INPNULL:MOV #-1,(SP) BR INPNNUL .ENDC INPCR: .WORD CR ERRTR8: JMP ERRTRN ; 'READ' STATEMENT READ: MOVB (R1)+,R2 BMI ERRSX8 SWAB R2 BISB (R1)+,R2 ADD (R5),R2 JSR PC,GETVAR MOV @PDL(R5),R3 BEQ ERRDATA CMP R3,#-1 BEQ REASRCH CMPB (R3),#.EOL BEQ REAFIND CMPB (R3)+,#.COMMA BNE READBAD READGOT:MOVB (+-*/^()\&;,<==<>==><>><<>="':#[]%$LET VFIF END #LET IF GO TO FOR INPUT FOR OUTPUTFOR TO NEXT THEN STEP GOSUB RETURNINPUT PRINT REMDEF READ DATA CALL FNRND(RNDSIN(COS(SQR(ATN(EXP(LOG(ABS(INT(SGN(TAB(BINOCTLEN(ASC(CHR$(POS(SEG$(VAL(TRM$(DAT$STR$(OPEN CLOSE CHAIN OVERLAY AS FILE DOUBLE BUF LINE VFDIM RANDOMIZERESTORE STOPENDLISTNHRUNNHRENAMENEWREPLACELISTRUNSAVEOLDSCRCLEEVEN READBAD:CLR @PDL(R5) TRAP 0 .IFNDF $LONGER .ASCII \BDR\ .ENDC .IFDF $LONGER .ASCII 'BAD DATA READ' .ENDC .BYTE 0 .EVEN REASRCH:MOV CODE(R5),R3 REAFIND:TSTB (R3) BMI .+6 ADD #2,R3 CMPB (R3)+,#.DATA BEQ READGOT CMPB -(R3),#.EOF BEQ READOUT MOV R1,-(SP) MOV R3,R1 JSR PC,SKIPEOL MOV R1,R3 MOV (SP)+,R1 BR REAFIND .IFNDF $NOSTR READQT: INC R3 CMPB (R3)+,#.TEXT BNE READBAD MOV R3,R0 TSTB (R3)+ BNE .-2 CMPB (R3)+,R2 BNE READBAD MOV R3,-(SP) MOV R0,- 8AWw R5iC@ Bw B@c""  B" f &5 B5 @ww\ fAN@@@c" A#  0 iwJ DW,C CCc" "  ^W C CCc"a@B"""  @B""H  EcC`Ҕ  0   +@ @ ECCm w :  :B   #@`" @ WB BBc$J Bw5 hDA B  `0^1210JRb121 10@`5 w8ȕ5 w0F   WwOLD *   5.5i& X::,5 2 ewX WwNEW B  z vw@22 W  T 4 v5 05.5h X::, e  Nw | Wfɋ b W ɋ F  ۇN  W   ABBBcB ]Dd |BKBBcWE WW>C< CWW1  WW)D' DW!"  WW ,@m8544Ww&IDMIDFWBBm WJ5 DA  WwwNPRw 252552r444 ~ ^<@@  5 0@C  xu"0W @5 .WWwZ. UC  @" 5`.@ XU@TUΕU@C V u"W@5C ,հ @"  ΐ@5 C  0 & fك 0 &e&5 2 zewTwdwW'& W C W @"  e w Wwww n  u@ @wF  l 5 @W ڇ@ . 4 B u wBwv Tw wf STOP wZf@" nAw wp5 w wBW-.B>C>55>j7 5. fA eo7Ne 7De7 #5 C Bee @ & &p X5D@ l 7  5 >5j446@5 " " eu u :u <@ 5 wFILE NAME-- @פ  7RbRdRf @ R   w NONAME w| BASIC V01B-02 @ 5 A Bc%5Ee WW@e e B w E B Bc"\ 6Ծ @ 5#u"u#u"5 u!u u#u" 8BBc""5 #5" 5!eG   Ӏ  ӗ"$7 8  : @bAa.     ѕ NONAMEfA. f Re P:L   !&@B  5 3j  l&j 2 we  2bw 2 RPLw>ߋ*Ge 5 f05@ w5 wCm.( @. Z^ \wJ5 @0 & Bm.ww* H֋ FNFNERO MOV #COMES,( f& b :# J D .# ,  H b@a  e   & # AZ@# & eD`09.:wv7 5 'e77<C & e  5&e  IeeBW @`B 5 .   ɕ.09wPAZaĘ h  פ Ӌ `1Eĥesѕ@ >  'ѕѕɕB  A Z NF @ @  e @ wwZA . ѕ@  ɕ 90C  "ee,$$$$ !e : T :* & # # # $ S S K u.Cѐѐ@ w& .wPTBw e  ^ \!YC C /W,W)W&W"WW  <!ѕѕ@  @ wZwJwn C "e "ee : : :  # # w   ѕ@ ̆ѐѐf& A<B < N u ::  CC 0 Cc    ܆ ڇe"cK`b PPERR JSR PC,GET1BYT BCS NOCHR2 ;NOTHING TO GET MOVB R0,@#PPB RTS PC ;RESTORE REGS. AND RTI PPERR: BIS #1,BFSPEC(R1) ;INDIC. ERROR NOCHR2: CLR @#PPS ;CLEAR INTERUPT ENABLE RTS PC ; .ENDC .IFNDF $NOLPT ; ; LPINT - LINE PRINTER INTERUPT HAND f**.D-D-+1+T/0--42*-* $ !ʋ& empҋ e f&f wwem:؂ |f"f W[ f"f & WM" x65@w "5; "5 v /7 |<<4;R J"Ue wB5ҕ    eҔ ww FDEBBBc W W  wW w LWW!kf i&&  eeҤ'  פ   ҥ   B fc`w2w . WW!f"f f , 8BY963www BA!wWwW   Wwh W W C Cm K wFGNDw8w T < w:@fA" @  w7 JWC    Cm wwRBGf BBBc"W  BW އu u"5 "W W xʇW C B BBc"WWW B聁 BBc FWNe Bځ BBc W( QQQQQ!Q Q#Q"f N"ff   w 11 w~ fvwf BBԵ YVeCUCCc RLRJG"E$ " fvfv Zf"f fvfv    !!e %wfv " f wNBFwW   eWWW,W,W)  V/  wD   ew/ z t w W ^$W& @e e-@ w e-. $W W ua5hww -= u wrILNwv525iW2 dWP.2BLBBc ע 2w.?f dwB"3@  B" h  ע  ע,WW i5 wwBRT wCפ  e W w& wBہBBc  C* /ע.פ$’85   עעWWw&= OOD= BDRCˋeפרf C פӋ¤&   e##    "7^7 |< <4; K Bm""K 5"# 5!e K5 " K5"# 5!eG K L 2 #ARGih $  B" Nawwӄ!!_BM)..4KwE " e wV5 5#u"w5 u!u u#u"Z fWTwWwBBcW"$=;wETCww    WWf"  WC"w  @""w$ x "Cנננ ננננ  eB47555555f"!f  wTw J e 5 "H 5 " L"77 r56<4;wB87 Z56h<4;  wd\f"f \w & ww T , !& Β W  eJf @NSM#%  $ ҃!& Β`#"e 2 `e e ewSTLOVF3 "7.3*w@w vw8w,W(7 674; &7_f@8*e%5 u"\w "W w\wD   7 jj4;8  ""%w& < "DV0 w5 5 " "@ E @EU D e  5 " 7 |<88 Ѐ@"  /7 <<88|<88|<|<<88<88<|f& B:A u:  <u< ' Ԃc 0 Cc    ݆ ۇe K cD &N<ewm  & 5"5 w WORDS FOR DISPLAY FILE  Tw :e wC  "( ZNER - FOR DISPLAY BUFFERB R$!   8& $ C ;" $$ e" &%3 & m ea ` $  Be>   $   Uf,Aw7 `* P)(  *7 7 .7 7 C D 7 ww$w~Uvf X ````e  FHD,R2 ;PAPER TAPE PUNCH JSR PC,INITBF MOV #PRBFHD,R2 ;PAPER TAPE READER JSR PC,INITBF .ENDC .IFNDF $NOLPT MOV #LPBFHD,R2 JSR PC,INITBF .ENDC RTS PC ; ; BU *W%@e6 B dbB be B     "___ W E  "5 "H 5 "___ W  "  5"5 ___5 &    0  "__5 &      0 ` "__ W& N"#\VN  B  eЕ __ W 5 5 " "___ W  5 5 ""___ Wŀ"B p"__ XWW RWQ L WI ;@"-2 #- * ce0ece.`eҢ .  0  . %5"5 ___ LWK F f f"W? : W7-  # !C"   B c ee _,___ &W! 5 5 " & Ҏ e  ȋ ___ W  `e  _ _,__ WB e05 . b f. _,__D"DR PC,CHAIN ; R1 IS THE FILE HEADER ADDRESS ; FBUFE(R1) POINTS TO THE START OF THE ; FIRST BUFFER CHAINB: CMP T1(R5),#10 ;CHECD7v 8& U$ Z?4D BASIC V01B-02 * 6NJ A  I Y-YES N-NONFCee!&W!F# w w : N YT e!ЃwtCC D T5\5"F5m@5446  6 USER FNS LOADEDC ee w  &Z??RND ??ABS ?,@SGN ,@d@BIN d@@OCT @@TAB @ALEN ALAASC LAvACHR$vA4BPOS 4BBSEG$B0CVAL 0CtCTRM$tCCSTR$E DEL. (,'^U') ; INSTRUC. ;EXEC. IF ; INSTRUC. ;EXEC. IF (OR BACK ARROW) ; INSTRUC. ;EXEC. IF BELOW 40 OR 4PTR>PJw*OF !F nF RF@U0$ &5 B5 @5 huawf READYFwV 5 hw BE w4( wl,w.BBc"wB) FIOBSOULN F  ~@pPWF&f    `E C  e=" 8A 4u <1  u "   b   ru B RJ5 ATL@ (AC q,;e7L7E 5 U77B @ <EU  ʋeeFNO @ߋ*wdF5 huawH ?@ W-!w. AT LINE @5"5 5#5"5 5!eG w wP@>5>  Rw~}    _  _ ih . B" @awzDCEꈇ7 ,EeH& EE& Е- eePPPЕ-  W  e0e0PK JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC %PeD C E 7 *& B:A u:  <u<  Ԃc 0 Cc    އe K c966<6B6L6R6\669SYN W eBAawjBBBc BW @ WыB w @m 5 <5 Ai &5`8 tE 5 @w DELETED w _ILR@ E%H EU"" "7 ^B  J    w~ LTL  5 5 "עע@ פרפ ! #"  5 "e e& C C eC e C ?@fuaf@ @    0@ C        e p    0 #  7 0 &e7  e 5 " " 5 "H 5 "-W   D" C  0  yEU C 0@      e       Pe P    Ee0E 4 e & ) .  E + - 0   e: . 0 $0 ! .  e 7 PA0u0 .7 <5`8 Ah& p5 9FTSWLODNRf&& e ыW WWWe WыwTLTw    09    & 0eC  .  09 .& E.u +  +-  09 m Ee& e0 E E e C B   Ee&&   v |N v  6 6  hv  `   @ (%.% D %e% e @ D   mm@ 0     A C v %\w     0  @  @ w H  & Dr)&&\   5@5@7  t      v   &f&\  \& \\r1@\[?\ ew f ?U?*@ڪAD C %     @  f&\&f  & N & . )   v     C 6  %%    w ~6 6 %   Dv   0e%6  6  E v v ·ͅ%\ @       D f C_  fW & @&&&&7 Rvt  t t He\\;@\ \N @   =@f&ysE[\pCf&f&\% a @w   &  f 6A  v  6N\&f f & G   v  76   p  d deA @ A @ %  A @ 6v %\%    w    `@ `  ` `  \\ N A f C %C B    \ w  D& &&@7  D& && 6  A7 tp4 zp4 pp    b e\ \S\ e& @7 x Fe\f& \:יc&>X4%]@& & & & & D&&e #@  @6 7 t86 6 #?%-0 @ ׳f&& @׳@f&7   tf&f&7 l         \f& \ e\>:L]L?ƪ@ \fEA#& e@ & f& f& f7 t F ff w   &@& +-*/^()\&;,<==<>==><>><<>="':#[]%$LET VFIF END #LET IF GO TO FOR INPUT FOR OUTPUTFOR TO NEXT THEN STEP GOSUB RETURNINPUT PRINT REMDEF READ DATA CALL FNRND(RNDSIN(COS(SQR(ATN(EXP(LOG(ABS(INT(SGN(TAB(BINOCTLEN(ASC(CHR$(POS(SEG$(VAL(TRM$(DAT$STR$(OPEN CLOSE CHAIN OVERLAY AS FILE DOUBLE BUF LINE VFDIM RANDOMIZERESTORE STOPENDLISTNHRUNNHRENAMENEWREPLACELISTRUNSAVEOLDSCRCLE  &@& +-*/^()\&;,<==<>==><>><<>="':#[]%$LET VFIF END #LET IF GO TO FOR INPUT FOR OUTPUTFOR TO NEXT THEN STEP GOSUB RETURNINPUT PRINT REMDEF READ DATA CALL FNRND(RNDSIN(COS(SQR(ATN(EXP(LOG(ABS(INT(SGN(TAB(BINOCTLEN(ASC(CHR$(POS(SEG$(VAL(TRM$(DAT$STR$(OPEN CLOSE CHAIN OVERLAY AS FILE DOUBLE BUF LINE VFDIM RANDOMIZERESTORE STOPENDLISTNHRUNNHRENAMENEWREPLACELISTRUNSAVEOLDSCRCLE  &@ 8AWw b5iC@ Bw B@c""  B" f 5 B5 @ww < fAN@@@c" A#  0 iw@ dDW*C CCc" " @WC CCc"@B""  @B"H  EcC`Ҕ  0   +@ @ ECCm w\ : H :B   #@`" @ WB BBc$J .w5 hDA B  F">@`5 wȕ5 wF   WwOLD * J  5.5i& px5 2 Jewb WwNEW    w22 W   x 5 05.5h px e F hw  Wfɋ X W ɋ <  ۇN  W $ D  ABBBcB ]Dd hBKBBcWE WW>C< CWW1  WW)D' DW!"  |WW ,@m8544WwIDMIDFWBBm WJ5 DA h Ww|wNPRwX fj. (  <& @U@U 5 0@C 7 p3u"0W-@5 .'WW . UC  @"  5`.@ ZU@VwUΕU@C N u"W@5C $ @"  ΐ@5 C  0 & < 0 & N&5 2 ewww(W$& W# C W @"   e wwwTwn W $   u@ @wF    5 @W BՁBBc"φ@ d 4 B u wwX w wH STOPwf@" LAw w5 w wW-.B>C>55>j7 r5. fA eo7Ne 7De7 #5 C Bee @ & &p X5D@ l 7 5 >5j446@5 " " e 5 u u :u <@ 5 wFILE NAME-- @פ  B BBc$" e w~!RbRdRf    w: NONAME w( BASIC V01-05 @ 5 A Bc%5Ee WW@e e B w B Bc"\  @ 5#u"u#u"5 u!u u#u" BBc""5 #5" 5!eG   F瀜  <"$7 l V#  :@bAa.     ѕ NONAMEfA. f Re $L   !&@B  5 ,3j  ~l&j 2 we  2bw 2 RPLwXߋ*Ge 5 f05@ w"5 wCm.( @. \^ \wJ5 @0 & Bm.w&w,* ֋ FNFNER!eG  f& f : L F . ,  K b@a  e   &   AZ@ & eD`09.:w 7 5 'e77<C & e  X5&e  2 IeeBW @`B 5 .  ɕ.09w AZJaĘ h  פ Ӌ `1Eĥesѕ@ >  'ѕѕɕB  A Z NF @ @  e @ ww`ZA . ѕ@  ɕ 90C  "ee,$$$$ !e : T :* & # # # $ S S K u.Cѐѐ@ w& .wjPTBw e  < ^ \!YC C /W,W)W&W"WW  <!ѕѕ@  @ wbwwn C "e "ee : : :  # # w   ѕ@ ̆ѐѐf& A<B < N u ::  CC 0 Cc    ܆ ڇe"cK`b  ))@-,,4+Z0+.X/-P,p1*,) X&WF & W?5@w> 535 t +S K"Uew.5ӕ   e6  wPw FDE Z "ʋ& eҋ e f&f ww wڃeBBBc 6W W <wbW ^ LW؇WՂ!kf i&&  eeҤ'  פ   ҥ   B fc`wwX . WW!f"f f  BY963wfww BA!w6Ww*W | < Ww |W W C Cm K wGNDw&w  w@fA" @  wvWC    Cm wTwtRBGf BBBc"W  W pއu u"5 "W W HʇW C B BBc"WWW B聁 BBc FWNe Bځ BBc W( QQQQQ!Q Q#Q"f N"ff   w 11 w fvw BBԵ YVeCUCCc RLRJG"E$ " fvfv \f"f fvfv    !!e %wZfv "  w8NBFwW  e/WWW0W0W- TW/< 0 w8   eW/H t R w W X!W@ 8 > *   w W W ua5hw>w = u wfILNw525iW2 WPj1BLBBc ע 2w"?f XwB"3@  B"   p ע  ע,WW i5 wlwBRT wCפ  e : W w& wXBہBBc C* /ע.פ$’85  עעWWw= OOD= BDRCˋeפרf C פӋ¤&  e##  >  t 06.7 X; b;: K Bm""K 5"# 5!e K5 " K5"# 5!eG K   #ARG!!_BM)..4KwE " e w5 5#u"w5 u!u u#u"[ fWUwWwBBcW"$><wETCww    WWf"  WC"w @""w& H "Cנננ ננננ `abVTlN.*"f"!f  wPw & e 5 "H 5 " z067 H 55b;:w@ 77 0 55tb;:  wb\f"f \w & ww " , !& Β |W  eJf <NSM#%  $ ҃!& Β`#"e  `e e ewSTLOVF2 06: 2(w@w rwfwdW(7 56: &6_f@8*e%5 u"\w W wZwD   7 @v:7  ""%w$ < "DV0 w5 5 " "@ E @EU D e  5 " 7 X;78 Ѐ@"  /7 b;l;77X;77X;X;b;77b;77l;X;tb;:wd^ER $ \\ $ ( \7 .v87&8X;08:w f&\: *wf*w\wzwlwBWBmI& @Bc"$!߇R J"()Bc$,   Ҕʒ  wUFN&f  W&6Bc"$&B  ,&   www 9 \w 5 5 5 "wz (wH  f"7 Lvb;:  7 8v:J  ew@$A&B(C*f,5$u&(*,\W# " H u"B b " u"Ww|ww^@ *7 E @; L GA#U  B e   ' u"5  B e@"@" 07 X;l; b;; 5 "" 5 "f"f \ "\& @\" &   |ƃ2 #     m % ` " `SOB J H @SSO 45<eӤ   ## @<me5 WwB"@C $R J"wB"@C  ,   B eKw ewh6 H6 &f&  +-N 5"  5 " U wwC  f"W vW 0 Zfe ZA<C" ׂ@ C,%m7"E7.5 5@#& f@& f1EBl@  Ü>wwRDB@?ACC^?ADCARTSDBLEDRCSETRDSETCDHISTEWAITEDIRvFDORFDRSFRELfGCLRDHPUTD.IDISPIFSH|IDXYI >> JRRR   %> , ,  %wjW  5  4f@?AR@N? > w8 f@D@h?_AW_ 2\_2\f f"\\6 : W- Hu ""U"5 }-"2e2\"NOR EeH "5 "<@>@e2 \BBBc D:\_ C->/\e BUFfU`5 ,2 e,", 2 U e## ھUB(BBc%" D:%5  um eW!\__3W\ `ADCA2 xA|??AB" "_" 4@R@ߋ"5 _AD? A2 > xAf@D@?r???r???r???r??B@"7TJF@65 m, _@eD@U5U@5UU U5$ mm5@mm7,_@ ߐ>_A xA|?ZC7 A2 C@2A-v A  A"AAA& e% _A+ E. E=2 2 %A2 22 2 ( ?E ߋ> >_?5 @5  ߋ @ eߋ `d? ED2 xA|???r???r??D 5 "_" UA5EU 7P_A? ED2 xA|???r?(Eu& #)#& & Ef"f   vZE bE " 4@?5 "_"AA&wh_2zECHCD272 xAf@D@?r??Ew"_AD2 xA|??EW-" D@"   7 _Aʋ  *@ ?Dߋ 5E ^ @ T7ߋ>U ߋ> A> @ >>_? xA|??AR@AFU U @ `< 4@R@ @_ArF2 xA|??r??AFC"UP @ 4@R@ wG? rF2>E@ xAf@D@?r??r???r??AR@,GU>U>>U@wFetF2 |???r?zG  u]" _A_2 ` ? ߋ> ߋ>  @ >E@_?U@H2 xAf@D@?r???r??6H0.5$u&(*  _@  vIvt II?H@"B(2 f0f.  vH(C* @f"f   vHH2 I?H}"*e*B(r-*؃%A&_A%" "\f$\\BH2 xAf@?r???DIC" @_A^I.5 0wG K" e_AI.5 0wbG K" G I.u0w4G ^UK" c  H2 xAf@?JAf@?r???r??J}. 0e\m   _2 G  F,Bl ,l *l e %%Uߋ    2  2*W%@e6 B dbB be B     "_44__2 2W E  "5 "H 5 "_44_2_ 2W  "  5"5 _44_2_5 & 9   0  "_44_5 & 9     0 ` "_44_ 2W& N"#HHN  B ; eЕ _t5_ 2W 5 5 " "_44_2_ 2W  5 5 ""_44_2_ 2Wŀ"B ;p"_t5_ 2[WZ 2UWT 2O :WL ? "<@"- 4 # ,* ce0ece.`eҢ .  0 .%5"5 _44_2_ 2LWK 2F :f f"W? 2: :W7-  # !C"   B ;c ee _6_t5_2_ 2&W! 5 5 " & Ҏ ;e  <ȋ _44__2 2W  `e  _t5 ;_6_2_ 2WB ;e05 .  f. ;_6_2_4PO"5 _44_2_ 2LWK 2F :f f"W? 2: :W7- 4P7l  & U$ vK@ BASIC V01-05.2 * 2NJ A  I Y-YES N-NOQCee!&W!TR# w w : N YT e!ЃwxOC 4P ¯5\55e 5446  6 USER FNS LOADEDP ee wf  &KtKRND tKKABS KKSGN K LBIN L`LOCT `LLTAB LLLEN LMASC M2MCHR$2MMPOS MNSEG$NNVAL N6OTRM$6OxOSTR$ U$ vK@ BASIC V01-05.2 * 2NJ A  I Y-YES N-NOQCee!&W!TR# w w : N YT e!ЃwxOC 4P ¯5\55e 5446  6 USER FNS LOADEDP ee wf  &KtKRND tKKABS KKSGN K LBI 10 PRINT "THIS IS A DEMONSTRATION OF PDP-11 BASIC" 20 PRINT "IF YOU NEED INSTRUCTIONS FOR PLAYING FOOTBALL, TYPE A 1"; 30 INPUT I 40 IF I<>1 THEN 340 50 PRINT 60 PRINT 70 PRINT "WHEN IT ASKS YOU A QUESTION TO BE ANSWERED YES OR" 80 PRINT "NO, TYPE IN 0 FOR NO OR 1 FOR YES." 90 PRINT 100 PRINT "ON OFFENSE YOU HAVE THE FOLLOWING PERMITTED PLAYS:" 110 PRINT "PLAY","CODE" 120 PRINT "RUN","10" 130 PRINT "PASS","11" 140 PRINT "SWEEP","12" 150 PRINT "SCREEN PASS","13" 160 PRINT "LONG PASS","14" 170 PRINT "DRAW PLAY","15" 180 PRINT "PUNT","16" 190 PRINT "FIELDGOAL","17" 200 PRINT 210 PRINT "ON DEFENSE, YOU MAY TRY ONE OF THE FOLLOWING:" 220 PRINT "DEFENSE","CODE" 230 PRINT "NORMAL","4","GOOD AGAINST SWEEP AND SCREEN" 240 PRINT "HOLD","5","GOOD AGAINST RUN, PASS AND DRAW" 250 PRINT "BLITZ","6","GOOD AGAINST PASS OR LONG PASS" 260 PRINT "INTERCEPT","7","INCREASES THE ODDS FOR AN INTERCEPTION" 270 PRINT "BLOCK","8","GIVES YOU A CHANCE TO BLOCK A KICK," 280 PRINT " "," ","BUT DECREASES THE DISTANCE RUNBACK." 290 PRINT 300 PRINT "TO CALL A PARTICULAR PLAY JUST TYPE ITS CODE NUMBER." 310 PRINT "ALSO, AT ANY TIME DURING PLAY YOU MAY CALL TIME OUT" 320 PRINT "BY TYPING A '2'. HOWEVER YOU ARE PERMITTED ONLY THREE" 330 PRINT "TIMEOUTS PER HALF." 340 PRINT 350 PRINT 360 DEF FNT(X)=SIN(X)/COS(X) 370 DIM R(17) 380 FOR I=0 TO 17 390 READ R(I) 400 NEXT I 410 DATA 9,13,100,0,9,10,12,11,12,0,1,5,3,4,6,2,8,7 420 RANDOMIZE 430 LET F=0 440 LET Z3=0 450 LET O=0 460 LET L=0 470 DIM Z(5,3),P(2),D(2,5) 480 FOR A=0 TO 5 490 FOR B=0 TO 2 500 READ Z(A,B),D(B,A) 505 LET P(B)=0 510 NEXT B 520 READ Z(A,3) 530 NEXT A 540 PRINT "DO YOU WANT TO RECEIVE"; 550 LET X=1 560 GOSUB 3610 570 LET S=2-SGN(13-Q) 580 LET K=S 590 LET T1=120 600 LET U2=3 610 LET U=3 620 LET C=900 630 GOSUB 2250 640 LET F1=50 650 LET B=INT(F1+O*20*RND(0)+(1-O)*29*(2-RND(0)^7-RND(0)^(3-Z2))) 660 LET O=0 670 LET Z9=8 680 GOSUB 1490 690 LET L=0 700 IF B<=99 THEN 2340 710 PRINT "A TOUCHBACK" 720 LET B=20 730 LET L=0 740 IF S=2 THEN 770 750 PRINT "MY "; 760 GOTO 780 770 PRINT "YOUR "; 780 GOSUB 3290 790 GOSUB 2980 800 LET D=1 810 LET F2=.03 820 LET O=0 830 IF C<=0 THEN 2770 840 GOSUB 2530 850 LET Z2=1 860 LET Z3=.3 870 IF C<=F*T1 THEN 2920 880 IF C<=0 THEN 2770 890 IF L=0 THEN 910 900 PRINT "TIME TO GO--"; 910 PRINT INT(C/60);"MIN,";C-60*INT(C/60);"SEC. "; 920 PRINT "YOUR PLAY"; 930 GOSUB 3610 940 IF S=1 THEN 980 950 IF Q>8 THEN 920 960 LET M=Q 970 GOTO 1000 980 LET Y=Q-8 990 IF ABS(Q-10.5)^2>3 THEN 920 1000 LET C=INT(C-L*(5+23*RND(X))) 1010 LET L=1 1020 IF M=7 THEN 1760 1030 IF M=8 THEN 1920 1040 LET Y1=Y-1 1050 IF RND(X)>Z(M-1,Y1) THEN 1240 1060 LET A=2 1070 GOSUB 3020 1080 IF M<4 THEN 1110 1090 PRINT "PASS COMPLETE.."; 1100 LET L=SGN(INT(4*RND(0))) 1110 IF RND(X)0 THEN 1210 1130 IF G=0 THEN 1170 1140 IF G+B<1 THEN 2170 1150 PRINT "LOSS OF";-G; 1160 GOTO 1610 1170 PRINT "NO GAIN" 1180 LET Z9=2 1190 GOSUB 1490 1200 GOTO 1670 1210 IF B+G>99 THEN 1650 1220 PRINT "GAIN OF";G; 1230 GOTO 1610 1240 IF M>3 THEN 1280 1250 LET A=1 1260 GOSUB 3020 1270 GOTO 1120 1280 IF RND(X)<.06*(2-SGN(Y-3)) THEN 1360 1290 IF RND(0)<.05+INT(Y/3.5)/5 THEN 1510 1300 LET Z9=6 1310 GOSUB 1490 1320 PRINT "PASS INCOMPLETE" 1330 LET L=0 1340 LET G=0 1350 GOTO 3120 1360 PRINT "PASS **INTERCEPTED**"; 1370 LET A=1 1380 GOSUB 3020 1390 IF B<40 THEN 1410 1400 LET G=20*(1+SGN(G)) 1410 LET B=100-B-G 1420 LET S=3-S 1430 LET Z9=9 1440 GOSUB 1490 1450 IF B<1 THEN 710 1460 IF B>99 THEN 1650 1470 PRINT "AT "; 1480 GOTO 2360 1490 LET C=C-INT(4+Z9/2*(1+RND(0))) 1500 RETURN 1510 LET G=-(5+INT(10*RND(X))) 1520 PRINT "THE QUARTERBACK "; 1530 IF RND(X)>.5 THEN 1560 1540 PRINT "IS THROWN FOR A "; 1550 GOTO 1110 1560 LET G=-(2*G+8) 1570 LET M=5 1580 LET A=1 1590 PRINT "SCRAMBLES FOR A "; 1600 GOTO 1110 1610 LET B=B+G 1620 PRINT "TO "; 1630 GOSUB 3300 1640 IF B<=99 THEN 1670 1650 GOSUB 1990 1660 GOTO 630 1670 IF B1>B THEN 3120 1680 IF B1.5 THEN 1730 1700 PRINT "**MEASUREMENT**" 1710 GOSUB 3520 1720 IF RND(X)<.5 THEN 3120 1730 GOSUB 2980 1740 LET D=0 1750 GOTO 3120 1760 IF RND(X)<.06 THEN 1890 1770 LET B=B+30+INT(15*(1-RND(X)^3)) 1780 LET Z9=2 1790 GOSUB 1490 1800 IF B<=99 THEN 1850 1810 LET P1=3 1820 GOSUB 2030 1830 IF P1=0 THEN 710 1840 GOTO 630 1850 PRINT "THE KICK IS "; 1860 LET Z2=0 1870 LET S=3-S 1880 GOTO 2340 1890 PRINT "**BLOCKED** RECOVERED.."; 1900 LET G=-INT(14*RND(X)) 1910 GOTO 1410 1920 PRINT "THE PUNT IS "; 1930 IF RND(X)<.06 THEN 1890 1940 LET F1=B 1950 LET Z2=1 1960 LET S=3-S 1970 LET Z3=.65 1980 GOTO 650 1990 PRINT "** TOUCHDOWN**" 2000 LET P1=1 2010 LET P(S)=P(S)+6 2020 LET B=130 2030 PRINT "THE KICK IS "; 2040 IF RND(X)<(B/132)^4 THEN 2070 2050 LET P1=0 2060 PRINT "NO "; 2070 PRINT "GOOD" 2080 LET P(S)=P(S)+P1 2090 GOSUB 2120 2100 LET S=3-S 2110 RETURN 2120 PRINT "SCORE: ME";P(1);" YOU";P(2) 2130 LET L=0 2140 IF X<5 THEN 2160 2150 IF P(1)<>P(2) THEN 2770 2160 RETURN 2170 PRINT "**SAFETY**" 2180 LET P(3-S)=P(3-S)+2 2190 LET F1=30 2200 LET S=3-S 2210 GOSUB 2120 2220 GOSUB 3440 2230 PRINT "FROM THE 20" 2240 GOTO 650 2250 GOSUB 3440 2260 IF S=2 THEN 2330 2270 PRINT "ON-SIDE"; 2280 GOSUB 3610 2290 IF Q<>13 THEN 2330 2300 LET F2=.15 2310 LET Z2=1 2320 LET O=1 2330 RETURN 2340 LET B=100-B 2350 PRINT "RECEIVED AT "; 2360 GOSUB 3300 2370 IF Z2*RND(X)>Z3 THEN 2490 2380 IF RND(X)99 THEN 1650 2470 PRINT " TO "; 2480 GOSUB 3300 2490 IF RND(0)>F2 THEN 3260 2500 LET G=0 2510 PRINT "**FUMBLE**"; 2520 GOTO 1410 2530 IF S=1 THEN 2560 2540 LET Y=INT(1+3.5*RND(0)) 2550 RETURN 2560 LET M=INT(55*RND(0)/10.5)+1 2570 IF (B1-B)/(5-D)<3 THEN 2590 2580 LET M=INT(6-4*RND(0)^2) 2590 IF L*F*60>=C THEN 2670 2600 IF D<4 THEN 2550 2610 PRINT "I'LL "; 2620 IF B<55 THEN 2720 2630 IF 0<4*RND(0)-B1+B THEN 2750 2640 PRINT "TRY FOR A FIELD GOAL" 2650 LET M=7 2660 RETURN 2670 IF P(2)*U2<=P(1)*U2 THEN 2600 2680 PRINT "TIME OUT" 2690 LET U2=U2-1 2700 GOSUB 3520 2710 GOTO 2600 2720 PRINT "PUNT" 2730 LET M=8 2740 RETURN 2750 PRINT "GO FOR IT" 2760 RETURN 2770 IF X<4 THEN 2830 2780 IF P(1)=P(2) THEN 2830 2790 PRINT "THE GAME IS OVER" 2800 PRINT "FINAL "; 2810 GOSUB 2120 2820 STOP 2830 PRINT "END OF PERIOD";X 2840 GOSUB 2120 2850 LET F=1-F 2860 GOSUB 3520 2870 LET C=900 2880 LET X=X+1 2890 IF F<>0 THEN 810 2900 LET S=3-K 2910 GOTO 580 2920 IF T1=0 THEN 2770 2930 PRINT "2 MINUTE WARNING" 2940 GOSUB 3520 2950 LET T1=0 2960 LET C=120 2970 GOTO 880 2980 LET B1=B+10 2990 IF B1<=100 THEN 3010 3000 LET B1=100 3010 RETURN 3020 LET Q=1.3*(A*RND(0)-1)-.06 3030 LET A=1 3040 IF Q>=0 THEN 3070 3050 LET A=0 3060 LET Q=-Q 3070 LET M1=M-1 3080 LET G=D(A,M1)+FNT(Q)*(D(2,M1)-D(A,M1))/3.5 3090 LET G=G+INT(RND(0)+.02)*A*100*RND(0) 3100 LET G=INT(G) 3110 RETURN 3120 LET D=D+1 3130 IF D=5 THEN 3240 3140 IF D<> 1 THEN 3160 3150 PRINT "1ST"; 3160 IF D<>2 THEN 3180 3170 PRINT "2ND"; 3180 IF D<>3 THEN 3200 3190 PRINT "3RD"; 3200 IF D<4 THEN 3220 3210 PRINT "4TH"; 3220 PRINT " AND";B1-B;" "; 3230 GOTO 810 3240 LET S=3-S 3250 LET B=100-B 3260 IF S=2 THEN 770 3270 PRINT "MY "; 3280 GOTO 780 3290 PRINT "BALL ON "; 3300 IF B=50 THEN 3400 3310 LET V=50-ABS(B-50) 3320 LET C=C-INT(7+3*RND(0)) 3330 IF S=1 THEN 3420 3340 IF B<50 THEN 3370 3350 PRINT "MY "; 3360 GOTO 3380 3370 PRINT "YOUR "; 3380 PRINT V 3390 RETURN 3400 PRINT "THE 50" 3410 RETURN 3420 IF B<50 THEN 3350 3430 GOTO 3370 3440 IF S=2 THEN 3470 3450 PRINT "YOU"; 3460 GOTO 3480 3470 PRINT "I"; 3480 PRINT " KICK OFF." 3490 LET F2=.06 3500 LET Z2=0 3510 RETURN 3520 LET L=0 3530 PRINT "TIMEOUT CALLED..." 3540 PRINT 3550 RETURN 3560 IF U=0 THEN 3600 3570 LET U=U-1 3580 GOSUB 3520 3590 GOTO 3610 3600 PRINT "..WRONG, TRY AGAIN" 3610 INPUT A 3620 IF ABS(INT(A))>17 THEN 3600 3630 LET Q=R(INT(ABS(A))) 3640 IF Q=0 THEN 3600 3650 IF Q=100 THEN 3560 3660 RETURN 3670 DATA .5,-2,.25,4,.5,13,.55 3680 DATA .4,-2,.3,7,.65,15,.75 3690 DATA .4,-2,.3,6,.6,15,.35 3700 DATA .65,-2,.65,6,.6,17,.9 3710 DATA .4,2,.7,10,.4,27,.2 3720 DATA .1,19,.4,35,.2,100,.1 3730 END 5 DIM D(450) 7 N=450 10 PRINT "DAMP FAC ";\INPUT F 12 PRINT "# CYCLES ";\INPUT C 13 C=C*6.283/N 14 GOSUB 100 15 FOR I=0 TO N 20 D(I)=450+450*SIN(I*C) 25 D(I)=D(I)*EXP(-F*I/N) 30 D(I)=D(I)+50 45 NEXT I 50 CALL "YGRA"(2,D) 99 STOP 100 CALL "INIT" 105 CALL "SCAL"(0,0,1024,1300) 110 CALL "VECT"(1024,0)\CALL "APNT"(0,0,-1,-5) 120 CALL "VECT"(0,1024) 130 CALL "APNT"(50,50,-1,-5) 150 RETURN 999 END 10 CALL "INIT" 20 CALL "APNT"(0,700) 30 CALL "VECT"(20,0) 40 CALL "VECT"(5,10) 50 CALL "VECT"(10,-20) 60 CALL "VECT"(10,20) 70 CALL "VECT"(10,-20) 80 CALL "VECT"(10,20) 90 CALL "VECT"(10,-20) 100 CALL "VECT"(5,10) 110 CALL "VECT"(20,0) 120 CALL "VECT"(0,-20) 130 FOR I=1 TO 4 140 CALL "VECT"(5,-3) 150 CALL "VECT"(3,-7) 160 CALL "VECT"(-3,-7) 170 CALL "VECT"(-5,-3) 180 NEXT I 190 CALL "VECT"(0,-20) 200 CALL "VECT"(-45,0) 210 CALL "RDOT"(0,-10,0,-5) 220 CALL "VECT"(0,20) 230 CALL "RDOT"(-20,0,0,-5) 240 CALL "VECT"(6,-4) 250 CALL "VECT"(4,-6) 260 CALL "VECT"(-4,-6) 270 CALL "VECT"(-6,-4) 280 CALL "RDOT"(10,10,0,-5) 290 CALL "VECT"(-45,0) 300 CALL "RDOT"(0,0) 310 PRINT "ENTER THE VALUE OF THE RESISTOR IN OHMS "; 320 INPUT R 325 IF R<=0 THEN 310 330 CALL "APNT"(0,725,0,-5) 340 CALL "TEXT"(STR$(R)," ",-1,"Q") 350 PRINT "ENTER THE VALUE OF THE INDUCTOR IN MILLI-HENRIES "; 360 INPUT L 365 IF L<=0 THEN 350 370 CALL "APNT"(115,635,0,-5) 380 CALL "TEXT"(STR$(L)," ",CHR$(109),CHR$(104)) 385 L=L*10^-3 390 PRINT "ENTER THE VALUE OF THE CAPACITOR IN MICRO-FARADS "; 400 INPUT C 405 IF C<=0 THEN 390 410 CALL "APNT"(0,540,0,-5) 420 CALL "TEXT"(STR$(C)," ",-1,"M",CHR$(102)) 425 C=C*10^-6 430 CALL "APNT"(0,500,0,-5) 440 W0=1/SQR(L*C) 450 CALL "TEXT"("CENTER FREQ.",1,STR$(W0)," ",CHR$(104),CHR$(122),".") 460 Q=W0*L/R 470 CALL "TEXT"(2,"CIRCUIT Q",1,STR$(Q)) 480 B=R/L 490 CALL "TEXT"(2,"BANDWIDTH",1,STR$(B)," ",CHR$(104),CHR$(122),".") 500 CALL "APNT"(250,40,0,-3) 510 CALL "VECT"(0,750) 520 CALL "APNT"(250,40,0,-3) 530 CALL "VECT"(750,0) 540 CALL "APNT"(950,0,0,-5) 550 CALL "TEXT"("FREQ.") 560 CALL "APNT"(270,735,0,-5) 570 CALL "TEXT"("ADMITTANCE") 580 CALL "APNT"(625,35,0,-5) 590 CALL "VECT"(0,665,0,0,0,3) 600 CALL "APNT"(250,660/SQR(2)+.5,0,-5) 610 CALL "VECT"(700,0,0,4,0,4) 620 CALL "RDOT"(10,-5,0,-5) 630 CALL "TEXT"("1/2") 640 CALL "RDOT"(-55,-25,0,-5) 650 CALL "TEXT"("POWER") 660 W=W0-5*B\I1=10*B/750 665 CALL "APNT"(250,40,0,-5) 669 I1=2*I1 670 FOR I=0 TO 375 675 IF W<=0 THEN 690 680 A=660*R/SQR(R*R+(W*L-1/(W*C))^2) 685 CALL "APNT"(250+2*I,40+A,0,5) 690 W=W+I1 700 NEXT I 710 CALL "APNT"(650,700,0,-5) 720 CALL "TEXT"("Y") 730 CALL "STAT"(-1) 740 CALL "RDOT"(0,-5,0,-5) 750 CALL "TEXT"("MAX. ") 760 CALL "STAT"(1) 770 CALL "RDOT"(0,5,0,-5) 780 CALL "TEXT"("= ",STR$(1/R)," MHOS") 1000 END 1 REM PROGRAM TO PUT PRETTY LAMPSHADE DESIGNS ON THE SCREEN WITH BASGT 10 RANDOMIZE 12 J0=750 13 J=J0 15 T=180 20 G4=768 25 G5=250 30 PRINT "# OF LINE SEGMENTS: ";\INPUT N 32 N=N+1 40 REM THE ABOVE CONSTANTS CONTROL SPACE & TIME 50 REM G4,G5 SHOULD BE 768,250 FOR GT40; 500,0 FOR GT44 (BIG SCREEN) 60 REM T IS THE NUMBER OF CLOCK TICKS TO WAIT BETWEEN PICTURES 70 REM N IS THE NUMBER OF POINTS (# OF LINE SEGMENTS + 1) UP TO 10 100 DIM X(10),Y(10),Z(10),I3(7) 112 I3(1)=1\I3(2)=5\I3(3)=4\I3(4)=3\I3(5)=7\I3(6)=2\I3(7)=6 119 P1=ATN(1) 120 S9=SIN(P1/10) 130 C9=COS(P1/10) 140 F=3.20000E-04 150 REM THE OUTER LOOP STARTS HERE 160 S1=0 170 FOR I=1 TO N 180 X(I)=400*RND-130\IF X(I)>70 THEN 190 \X(I)=X(I)-140 190 Y(I)=400*RND-130\IF Y(I)>70 THEN 200 \Y(I)=Y(I)-140 200 Z(I)=400*RND-130\IF Z(I)>70 THEN 200 \Z(I)=Z(I)-140 210 S=X(I)*X(I)+Y(I)*Y(I)+Z(I)*Z(I) 220 IF S=0GO TO 516 515 J=J0-200 516 CALL 'APNT'(J,0,0,-6,-1)\CALL 'STAT'(-1) 517 CALL 'TEXT'('USING RT-11 BASIC/GT!')\CALL 'RDOT'(0,0,0,-5) 519 CALL 'SCAL'(-G4,-G4,G4,G4) 520 FOR L=1 TO 80 522 FOR U=1 TO N 524 IF I8=0 THEN 532 526 V=Y(U) 528 Y(U)=C*V-S*X(U) 530 X(U)=S*V+C*X(U) 532 IF I7=0 THEN 540 534 V=Z(U) 536 Z(U)=C*V-S*X(U) 538 X(U)=S*V+C*X(U) 540 IF I6=0 THEN 548 542 V=Y(U) 544 Y(U)=C*V-S*Z(U) 546 Z(U)=S*V+C*Z(U) 548 NEXT U 570 CALL "APNT"(X(1),Y(1)-G5,0,-5) 580 FOR I=1 TO N-1 590 CALL "VECT"(X(I+1)-X(I),Y(I+1)-Y(I)) 600 NEXT I 610 NEXT L 615 FOR I=1 TO 1000\I0=I*I\NEXT I 620 FOR I=1 TO 500\I0=I*I\NEXT I 650 NEXT I9 660 GO TO 150 9999 END 100 REM LIFE 110 REM BY YALE U 120 DIM A(1116),D(2,9) 130 DIM B0(200),D0(100) 135 CALL 'FIX'(1500) 140 Z$=CHR$(127) 150 GOSUB 460 160 R=0\REM GEN IS OFF AT THE START 170 CALL "INIT" 180 P1=0 190 G1=0 200 CALL "SUBP"(5) 210 FOR I=256 TO 656 STEP 25 215 CALL "APNT"(I,212,1,6) 220 FOR J=1 TO 16 230 CALL "RDOT"(0,25) 240 NEXT J\NEXT I 250 CALL "ESUB" 260 G=1 270 GOSUB 1120 \GOSUB 1040 280 FOR S=0 TO 1116\A(S)=0\NEXT S 290 GO TO 330 300 E=(X-6)/25\F=(Y-12)/25\S=31*E+F\IF A(S)=1 THEN 340 310 A(S)=1\CALL "APNT"(X-6,Y-12,-1,-6)\CALL "TEXT"(Z$) 320 GOSUB 1060 330 CALL 'LPEN'(H,T,X,Y) 340 CALL 'LPEN'(H,T,X,Y)\IF H=0 THEN 340 350 IF T=5 THEN 300 360 IF T=1 THEN 1260 \REM END 370 IF T=2 THEN 170 \REM CLEAR SCREEN 380 IF T=4 THEN 330 \REM FREEZE 390 REM HERE IF T=0 400 IF G=0 THEN 420 410 G=0\CALL 'OFF'(5)\REM KILL GRID 420 CALL 'ON'(4)\CALL 'OFF'(3)\R=1\REM RUNNING 430 GOSUB 570 440 CALL 'ON'(3)\CALL 'OFF'(4)\R=0\REM STOPPED 450 GO TO 360 460 REM DECISION TABLE 470 REM BIRTH=0,SURVIVAL=1,DEATH=2,NOTHING=3 480 FOR F=0 TO 8 490 D(0,F)=3 500 D(1,F)=2 510 NEXT F 520 REM UNOCCUPIED SQUARE 530 D(0,3)=0 540 REM OCCUPIED 550 D(1,2)=1\D(1,3)=1 560 RETURN 570 REM NEW GENERATION 580 L0=I0-1\L1=I1+1\M0=J0-1\M1=J1+1 590 IF L0>0 THEN 610 600 L0=1 610 IF M0>0 THEN 630 620 M0=1 630 IF L1<35 THEN 650 640 L1=34 650 IF M1<30 THEN 670 660 M1=29 670 GOSUB 1040 \N0=0\N1=0\B1=0 680 FOR E=L0 TO L1\S=31*E+M0 690 P=A(S-32)+A(S-1)+A(S+30) 700 C=A(S-31)+A(S)+A(S+31) 710 FOR F=M0 TO M1\S=31*E+F 720 N=A(S-30)+A(S+1)+A(S+32) 730 D1=D(A(S),P+C-A(S)+N) 740 IF D1>2 THEN 830 750 IF D1=2 THEN 820 755 IF D1=1 THEN 770 \B1=B1+1 760 REM BIRTH OR SURVIVAL 770 N0=N0+1\B0(N0)=S 780 REM FIND RANGE OF SUBSCRIPTS 790 GOSUB 1060 800 GO TO 830 810 REM DEATHS 820 N1=N1+1\D0(N1)=S 830 P=C\C=N\NEXT F 840 CALL 'LPEN'(H,T)\IF H=0 THEN 870 \IF T=3 THEN 870 850 I0=L0+1\I1=L1-1\J0=M0+1\J1=M1-1\REM SAVE RANGES 860 RETURN\REM GO FIND OUT WHAT HAPPENED 870 NEXT E 880 REM UPDATE A MATRIX AND DISPLAY NEW 890 IF P1=1 THEN 910 900 GOSUB 1110 910 IF N0>0 THEN 920 \T=2\RETURN 920 G1=G1+1 930 CALL 'SUBP'(P0)\FOR K=1 TO N0 940 S=B0(K)\E=INT(S/31)\F=S-31*E\A(S)=1 950 CALL 'APNT'(25*E,25*F,-1,-6)\CALL 'TEXT'(Z$) 960 NEXT K 970 CALL 'APNT'(900,100,-1,-5)\CALL 'TEXT'('GEN=',STR$(G1)) 972 CALL 'APNT'(900,70,-1,-5)\CALL 'TEXT'('POP=',STR$(N0)) 974 CALL 'APNT'(900,40,-1,-5)\CALL 'TEXT'('BIR=',STR$(B1)) 976 CALL 'APNT'(900,10,-1,-5)\CALL 'TEXT'('DTH=',STR$(N1)) 980 CALL 'ESUB'\IF P1=0 THEN 990 \CALL 'ERAS'(30-P0)\CALL 'SAVE' 990 P1=1\P0=30-P0 1000 FOR K=1 TO N1 1010 A(D0(K))=0 1020 NEXT K 1030 GO TO 570 1040 REM INIT MIN & MAX 1050 I0=34\J0=29\I1=1\J1=1\RETURN 1060 IF E>=I0 THEN 1070 \I0=E 1070 IF E<=I1 THEN 1080 \I1=E 1080 IF F>=J0 THEN 1090 \J0=F 1090 IF F<=J1 THEN 1100 \J1=F 1100 RETURN 1110 CALL 'INIT' 1120 P0=10\CALL 'SUBP'(1) 1130 CALL 'APNT'(900,500,1,-5)\CALL 'TEXT'(Z$,' END') 1140 CALL 'ESUB' 1150 CALL 'SUBP'(2) 1160 CALL 'APNT'(900,400,1,-5)\CALL 'TEXT'(Z$,' NEW') 1170 CALL 'ESUB' 1180 CALL 'SUBP'(3)\CALL 'OFF'(3) 1190 CALL 'APNT'(900,300,1,-5)\CALL 'TEXT'(Z$,' GO') 1200 CALL 'ESUB' 1210 CALL 'SUBP'(4)\CALL 'OFF'(4) 1220 CALL 'APNT'(900,200,1,-5)\CALL 'TEXT'(Z$,' STOP') 1230 CALL 'ESUB'\IF R=0 THEN 1250 1240 CALL 'ON'(4)\RETURN 1250 CALL 'ON'(3)\RETURN 1260 CALL 'INIT'\END 110 FOR I=1 TO 10\PRINT CHR$(7);\NEXT I 120 PRINT "EARTH CONTROL CALLING LUNAR LANDER. OUR IBM COMPUTER" 130 PRINT "HAS LOST YOUR DESCENT PROGRAM. YOU ARE NOW UNDER MANUAL" 140 PRINT "CONTROL. USE ANY TIME INTERVAL YOU FEEL IS NECESSARY FOR" 150 PRINT "RETRO-ROCKET BURSTS. USE 0 OR ANY VALUE BETWEEN" 160 PRINT "8 AND 200 LBS./SEC. AS YOUR RETRO-ROCKET BURN RATE FOR" 170 PRINT "EACH BURN INTERVAL." 180 PRINT 190 PRINT "WE'RE WITH YOU, FELLA!" 200 PRINT 210 PRINT 220 PRINT " TIME ALTITUDE SPEED FUEL WT MOMENTUM "; 230 PRINT "INTERVAL RATE" 240 PRINT " SEC MILES FEET FPS LBS RELATIVE"; 250 PRINT " SEC LBS/SEC" 260 PRINT 270 I1=0 280 L=0 290 A=120 300 V=1 310 M=32500 320 N=16500 330 G=1.00000E-03 340 Z=1.8 350 Q1=5 360 Q2=L 370 GOSUB 1050 380 Q1=13 390 Q2=SGN(A)*INT(ABS(A)) 400 GOSUB 1050 410 Q1=19 420 Q2=INT(5280*(A-SGN(A)*INT(ABS(A)))) 430 GOSUB 1050 440 Q1=26 450 Q2=INT(5280*V) 460 GOSUB 1050 470 Q1=35 480 Q2=INT(M-N) 490 GOSUB 1050 500 Q1=43 510 Q2=INT(M*V/32.5) 520 GOSUB 1050 530 IF I1=0 THEN 580 540 K=0 550 T=20 560 PRINT 570 GO TO 600 580 PRINT TAB(51); 590 INPUT T,K 600 IF K<0 THEN 640 610 IF K=0 THEN 700 620 IF K<8 THEN 640 630 IF K<=200 THEN 700 640 PRINT "NOT POSSIBLE"; 650 FOR X=1 TO 44 660 PRINT "."; 670 NEXT X 680 INPUT K 690 GO TO 600 700 IF ABS(M-N)<1.00000E-03 THEN 1110 710 IF T<1.00000E-03 THEN 350 720 S=T 730 IF (N+S*K)-M<=0 THEN 760 740 IF K=0 THEN 760 750 S=(M-N)/K 760 GOSUB 1010 770 IF I<=0 THEN 880 780 IF V<=0 THEN 800 790 IF J<0 THEN 930 800 GOSUB 820 810 GO TO 700 820 L=L+S 830 T=T-S 840 M=M-S*K 850 A=I 860 V=J 870 RETURN 880 IF S<5.00000E-03 THEN 1160 890 S=2*A/(V+SQR(V*V+2*A*(G-Z*K/M))) 900 GOSUB 1010 910 GOSUB 820 920 GO TO 880 930 W=(1-M*G/(Z*K))/2 940 S=M*V/(Z*K*(W+SQR(W*W+V/Z)))+.05 950 GOSUB 1010 960 IF I<=0 THEN 880 970 GOSUB 820 980 IF J>=0 THEN 700 990 IF V<=0 THEN 700 1000 GO TO 930 1010 Q=S*K/M 1015 IF Q<1.00000E-07GO TO 1420 1020 J=V+G*S+Z*(-Q-Q^2/2-Q^3/3-Q^4/4-Q^5/5) 1030 I=A-G*S*S/2-V*S+Z*S*(Q/2+Q^2/6+Q^3/12+Q^4/20+Q^5/30) 1040 RETURN 1050 IF Q2=0 THEN 1080 1060 PRINT TAB(Q1-INT(LOG(.5+ABS(Q2))/LOG(10))); 1070 GO TO 1090 1080 PRINT TAB(Q1); 1090 PRINT Q2; 1100 RETURN 1110 IF I1<>0 THEN 710 1120 I1=1 1130 PRINT "OUT OF FUEL AT"L"SECS" 1140 K=0 1150 GO TO 710 1160 PRINT "ON THE MOON AT"L"SECS" 1170 W=3600*V 1180 PRINT "IMPACT VELOCITY OF"W"M.P.H. ("V*5280"F.P.S.)" 1190 IF ABS(M-N)>.01 THEN 1210 1200 N=M 1210 PRINT "FUEL LEFT"M-N"LBS." 1220 IF W>1 THEN 1250 1230 PRINT "PERFECT LANDING ! - (LUCKY)" 1240 GO TO 1370 1250 IF W>10 THEN 1280 1260 PRINT "GOOD LANDING - (COULD BE BETTER)" 1270 GO TO 1370 1280 IF W>25 THEN 1310 1290 PRINT "CONGRATULATIONS ON A POOR LANDING" 1300 GO TO 1370 1310 IF W>60 THEN 1340 1320 PRINT "CRAFT DAMAGE. GOOD LUCK!" 1330 GO TO 1370 1340 PRINT "SORRY, BUT THERE WERE NO SURVIVORS-YOU BLEW IT!" 1350 PRINT "IN FACT YOU BLASTED A NEW LUNAR CRATER"W*.277777; 1360 PRINT "FEET DEEP" 1370 PRINT 1380 GO TO 210 1400 STOP 1420 LET Q=0\GO TO 1020 9999 END 100 PRINT "YOU ARE THE RULER OF THE ANCIENT KINGDOM OF SUMERIA." 101 PRINT "YOUR PEOPLE CALL YOU 'HAMURABI THE WISE'. YOUR TASK IS" 102 PRINT "TO DEVELOP A STABLE ECONOMY BY THE WISE MANAGEMENT OF" 103 PRINT "YOUR RESOURCES. YOU WILL BE BESET FROM TIME TO TIME" 104 PRINT "BY NATURAL EVENTS. THE ONLY HELP I CAN GIVE YOU IS THE " 105 PRINT "FACT THAT IT TAKES 2 BUSHELS OF GRAIN AS SEED TO PLANT" 106 PRINT "AN ACRE. MAY YOU JUDGE WELL, ALKNOWING HAMURABI." 107 PRINT "***********HAMURABI IS HERE***********" 110 P=95 111 S=2800 112 H=3000 113 E=H-S 114 Y=3 115 A=H/Y 116 I=5 117 Q=1 210 D=0 215 PRINT 217 PRINT "LAST YEAR"D"PEOPLE STARVED,"I"CAME TO THE CITY" 218 P=P+I 227 IF Q>0 THEN 230 228 P=INT(P/2) 229 PRINT "HALF DIED OF THE PLAGUE" 230 PRINT "POPULATION IS NOW"P 232 PRINT "CITY OWNS"A"ACRES,"Y"BUSHELS HARVESTED PER ACRE" 250 PRINT "RATS DESTROYED"E"BUSHELS,"S"BUSHELS IN STORE" 260 PRINT \PRINT "DO YOU WISH TO ABDICATE"; 270 INPUT B$\PRINT 280 IF B$="NO" THEN 310 \IF B$<>"YES" THEN 260 290 STOP 310 C=INT(10*RND(0)) 311 Y=C+17 312 PRINT "LAND COSTS"Y"BUSHELS PER ACRE" 320 PRINT "BUY"; 321 INPUT Q 322 IF Y*Q=10*P THEN 452 510 S=S-INT(D/2) 511 GOSUB 800 512 Y=C 513 H=D*Y 520 E=0 521 GOSUB 800 522 IF INT(C/2)<>C/2 THEN 530 523 E=INT(S/C) 530 S=S-E+H 531 GOSUB 800 532 I=INT(C*(20*A+S)/P/100+1) 540 C=INT(Q/20) 541 Q=INT(10*(2*RND(0)-1)) 550 IF P0 THEN 51 49 PRINT " I ROLL";D1;"AND";D2; 50 GO TO 52 51 PRINT "YOU ROLL";D1;"AND";D2; 52 IF Q<>1 THEN 84 53 IF (S-2)*(S-3)*(S-12)=0 THEN 62 54 IF (S-7)*(S-11)=O THEN 69 55 IF W>0 THEN 58 56 PRINT "SO MY POINT IS";S; 57 GO TO 59 58 PRINT "SO YOUR POINT IS";S; 59 PRINT ".....LET'S ROLL 'EM AGAIN....." 60 LET P=S 61 GO TO 44 62 PRINT "AND CRAP OUT..." 63 LET C=1 64 IF W>0 THEN 67 65 LET Z=Z+B 66 GO TO 75 67 LET Z=Z-B 68 GO TO 75 69 PRINT "AND PASS....." 70 LET C=1 71 IF W>0 THEN 74 72 LET Z=Z-B 73 GO TO 75 74 LET Z=Z+B 75 PRINT 76 IF Z<1 THEN 104 77 PRINT "YOU NOW HAVE ";Z;"DOLLARS LEFT....." 78 IF C>0 THEN 81 79 PRINT "CHANGE DICE NOW....." 80 PRINT 81 LET W=W*C 82 LET Q=0 83 GO TO 32 84 IF S<>7 THEN 92 85 PRINT "AND LOSE....." 86 LET C=-1 87 IF W>0 THEN 90 88 LET Z=Z+B 89 GO TO 75 90 LET Z=Z-B 91 GO TO 75 92 IF S=P THEN 95 93 PRINT "...ROLL AGAIN....." 94 GO TO 44 95 IF W>0 THEN 100 96 PRINT "AND MAKE MY POINT....." 97 LET C=1 98 LET Z=Z-B 99 GO TO 75 100 PRINT "AND MAKE YOUR POINT....." 101 LET C=1 102 LET Z=Z+B 103 GO TO 75 104 PRINT 105 PRINT "YOU HAVE RUN OUT OF MONEY....SORRY ABOUT THAT....." 106 PRINT "THANKS FOR THE GAME.....BETTER LUCK NEXT TIME, PARDNER!" 107 GO TO 110 108 PRINT "THANKS FOR THE GAME.....AND CONGRATULATIONS" 109 PRINT "FOR BEING ABLE TO QUIT WHILE YOU WERE AHEAD." 110 STOP 120 END 5 CALL "INIT" 10 CALL "SCAL"(0,0,500,500) 15 CALL "APNT"(250,0,0,-5) 22 FOR F=0 TO 11 23 Q=6.28/12*F 24 CALL "APNT"(125*SIN(Q)+150,125*COS(Q)+150,-1,5,0,1) 25 CALL "VECT"(25*SIN(Q),25*COS(Q),-1,5,0,1) 26 NEXT F 30 S=1 32 CALL "APNT"(340,150,0,-8) 35 CALL "TEXT"("DE TIJD IS NU:") 37 GO TO 100 40 FOR X=0 TO 300 STEP S 50 T=SQR(ABS(150^2-(X-150)^2))+150 60 CALL "APNT"(X,T) 70 CALL "APNT"(X,300-T) 80 NEXT X 100 GOSUB 400 205 FOR H=K TO 11 210 FOR J=L TO 59 220 FOR I=M TO 59 225 CALL "SUBP"(1) 230 Q=6.28*I/60 235 P=6.28*(J+I/60)/60 237 S=6.28*(H+J/60)/12 238 CALL "TIME"(50) 239 GOSUB 500 240 CALL "APNT"(150,150) 250 CALL "VECT"(150*SIN(Q),150*COS(Q),-1,5,0,3) 252 CALL "APNT"(150,150) 254 CALL "VECT"(125*SIN(P),125*COS(P),-1,5,0,1) 256 CALL "APNT"(150,150) 258 CALL "VECT"(100*SIN(S),100*COS(S),-1,5,0,1) 260 CALL "ESUB" 262 CALL "TIMR"(G) 264 IF G<>0 THEN 262 265 CALL "ERAS"(1) 266 IF N=0 THEN 268 267 PRINT CHR$(7);\N=N-1 268 CALL "DSAV" 270 NEXT I 275 M=0 280 NEXT J 285 L=0 290 N=H+1 300 NEXT H 302 K=0 310 GO TO 205 400 PRINT "UUR";\INPUT K\K=INT(K) 410 PRINT "MINUUT";\INPUT L\L=INT(L) 420 PRINT "SECOND";\INPUT M\M=INT(M) 430 RETURN 500 CALL "APNT"(440,150,0,-8) 510 CALL "TEXT"(STR$(H)&":"&STR$(J)&":"&STR$(I)) 520 RETURN 10 DIM P(2),P$(2) 30 D2=5 40 B1=35 50 B2=B1-50 60 C2=500 70 L1=70 80 L=C2-L1 90 H1=C2+L1 100 F=(H1-L)/5 110 D1=.07 120 G=-30 125 CALL "FREE"\CALL "INIT" 130 GOSUB 1420 160 INPUT P$(1)\CALL "TEXT"(P$(1)) 170 CALL "TEXT"(" NAME: ") 180 INPUT P$(2)\CALL "TEXT"(P$(2)) 190 P(1)=0\P(2)=0\S2=1 200 FOR I4=0 TO 2*D2-1 210 CALL "INIT" 220 CALL "APNT"(270,700,-1,-6) 230 CALL "TEXT"("THE GENTLEMANLY GAME OF DARTS!") 240 CALL "APNT"(100,100,-1,-5) 250 CALL "TEXT"(P$(1)," ",STR$(P(1))) 260 CALL "TEXT"(" ",P$(2)," ",STR$(P(2))) 270 CALL "APNT"(100,50,-1,-5) 280 Z=D2-INT(I4/2) 290 CALL "TEXT"("DARTS LEFT: ",STR$(Z)) 300 CALL "APNT"(500,200,-1,-5) 310 CALL "TEXT"(P$(S2)," IS UP") 315 CALL "SUBP"(4) 320 CALL "APNT"(B2,L-.8*F,1,-5) 325 CALL "RDOT"(0,0,1,-5) 330 CALL "TEXT"(" 0") 340 CALL "APNT"(B1,L,1,-5) 350 CALL "VECT"(0,5*F) 360 CALL "APNT"(B2,L+.2*F,1,-5) 370 CALL "TEXT"(" 5") 380 CALL "APNT"(B1,L+F)\CALL "VECT"(10,0) 390 CALL "APNT"(B2,L+1.2*F,1,-5) 400 CALL "TEXT"("10") 410 CALL "APNT"(B1,L+2*F)\CALL "VECT"(10,0) 420 CALL "APNT"(B2,L+2.2*F,1,-5) 425 CALL "STAT"(-1) 430 CALL "TEXT"("20") 435 CALL "STAT"(1) 440 CALL "APNT"(B1,L+3*F)\CALL "VECT"(10,0) 450 CALL "APNT"(B2,L+3.2*F,1,-5) 460 CALL "TEXT"("10") 470 CALL "APNT"(B1,L+4*F)\CALL "VECT"(10,0) 480 CALL "APNT"(B2,L+4.2*F,1,-5) 490 CALL "TEXT"(" 5") 500 CALL "APNT"(B2,L+5.2*F,1,-5) 510 CALL "TEXT"(" 0") 512 CALL "ESUB" 514 CALL "APNT"(100,10,-1,-5) 516 CALL "TEXT"("TOUCH TARGET TO RESTART") 520 CALL "SUBP"(2) 530 CALL "APNT"(600,50,-1,-5) 540 CALL "TEXT"("TOUCH LINE WHEN READY") 550 CALL "VECT"(50,0,1)\CALL "ESUB" 560 CALL "LPEN"(N,T)\IF N<>1 THEN 560 562 IF T=2 THEN 580 565 IF T=4 THEN 125 570 GO TO 560 580 CALL "ERAS"(2) 590 GOSUB 780 595 X=15 600 FOR I=1 TO A1 STEP X 610 V2=V2+D1*G 620 Y=V2*D1 630 A=A-X\B=B+Y 640 CALL "SUBP"(1) 650 GOSUB 1280 660 I9=5\GOSUB 1380 670 IF I>A1-X THEN 710 680 CALL "ERAS"(1) 690 CALL "SAVE" 700 NEXT I 710 I9=500\GOSUB 1380 720 B=B+Y 730 GOSUB 1000 740 CALL "ERAS"(1)\CALL "SAVE" 750 NEXT I4 760 GOSUB 1200 770 GO TO 190 780 A=900\B=550 790 CALL "SUBP"(3) 800 CALL "APNT"(500,100,-1,-5) 810 CALL "VECT"(100,0,1) 820 CALL "TEXT"("TOUCH LINE TO RELEASE DART") 830 CALL "ESUB" 840 I2=100 850 FOR I=1 TO I2 860 A=A-1 870 CALL "SUBP"(1)\GOSUB 1280 880 I9=10\GOSUB 1380 890 CALL "LPEN"(H,T) 900 IF H<>1 THEN 920 \IF T<>3 THEN 890 910 GO TO 940 920 CALL "ERAS"(1) 925 CALL "SAVE" 930 NEXT I 940 V2=90-I+RND(0)*10 950 IF I>I2-1 THEN 980 960 CALL "ERAS"(1) 970 CALL "ERAS"(3) 980 A1=A-B1-25 990 RETURN 1000 S=0\IF BP(2) THEN 1250 1220 S2=2\IF P(1)16 THEN 2330 1370 IF X1=1 THEN 1390 1380 GO TO 1410 1390 IF A1=1 THEN 1410 1400 IF X1=1 THEN 140 1410 IF X1=2 THEN 1430 1420 GO TO 1450 1430 IF A2=1 THEN 1450 1440 IF X1=2 THEN 290 1450 IF X1=3 THEN 1470 1460 GO TO 1490 1470 IF A3=1 THEN 1490 1480 IF X1=3 THEN 190 1490 IF X1=4 THEN 1510 1500 GO TO 1530 1510 IF A4=1 THEN 1530 1520 IF X1=4 THEN 240 1530 IF X1=5 THEN 1550 1540 GO TO 1570 1550 IF A5=1 THEN 1570 1560 IF X1=5 THEN 340 1570 IF X1=6 THEN 1590 1580 GO TO 1610 1590 IF A6=1 THEN 1610 1600 IF X1=6 THEN 400 1610 IF X1=7 THEN 1630 1620 GO TO 1650 1630 IF A7=1 THEN 1650 1640 GO TO 520 1650 IF X1=8 THEN 1670 1660 GO TO 1690 1670 IF A8=1 THEN 1690 1680 GO TO 570 1690 IF X1=9 THEN 1710 1700 GO TO 1730 1710 IF A9=1 THEN 1730 1720 GO TO 620 1730 IF X1=10 THEN 1750 1740 GO TO 1780 1750 GO TO 1760 1760 IF B1=1 THEN 1780 1770 GO TO 660 1780 IF X1=11 THEN 1800 1790 GO TO 1820 1800 IF B2=1 THEN 1820 1810 GO TO 710 1820 IF X1=12 THEN 1840 1830 GO TO 1860 1840 IF B3=1 THEN 1860 1850 GO TO 760 1860 IF X1=13 THEN 1880 1870 GO TO 1900 1880 IF B4=1 THEN 1900 1890 GO TO 800 1900 IF X1=14 THEN 1920 1910 GO TO 1940 1920 IF B5=1 THEN 1840 1930 GO TO 850 1940 IF X1=15 THEN 1960 1950 GO TO 1980 1960 IF B6=1 THEN 1980 1970 GO TO 890 1980 IF X1=16 THEN 2000 1990 GO TO 2020 2000 IF B7=1 THEN 2020 2010 GO TO 940 2020 IF X1=17 THEN 2040 2030 GO TO 2060 2040 IF B8=1 THEN 2060 2050 GO TO 990 2060 IF X1=18 THEN 2080 2070 GO TO 2100 2080 IF B9=1 THEN 2100 2090 GO TO 1040 2100 IF X1=19 THEN 2120 2110 GO TO 2140 2120 IF C1=1 THEN 2140 2130 GO TO 1090 2140 IF X1=20 THEN 2160 2150 GO TO 2180 2160 IF C2=1 THEN 2180 2170 GO TO 1140 2180 IF X1=21 THEN 2200 2190 GO TO 2220 2200 IF C3=1 THEN 2220 2210 GO TO 1190 2220 IF X1=22 THEN 2240 2230 GO TO 2260 2240 IF C4=1 THEN 2260 2250 GO TO 1240 2260 IF X1=23 THEN 2280 2270 GO TO 2300 2280 IF C5=1 THEN 2300 2290 GO TO 440 2300 GO TO 2320 2310 IF X1=24 THEN 1280 2320 GO TO 1350 2330 PRINT 2340 PRINT 2350 PRINT " BY A. COM PUTER." 2360 END 10 CALL "INIT" 15 DIM A(1) 20 CALL "SCAL"(0,0,2000,1500) 100 CALL "APNT"(700,300,-8,-8,-8) 105 X=200\Y=90 110 FOR I=0 TO 4 120 IF I<>4 THEN 130 \CALL "VECT"(230,110)\GO TO 150 130 CALL "VECT"(X,Y) 140 CALL "VECT"(0,-50) 150 NEXT I 200 CALL "APNT"(700,300,-8,-8,-8) 205 X=-200\Y=100 210 FOR I=0 TO 2 220 CALL "VECT"(X,Y) 235 IF I=2 THEN 250 240 CALL "VECT"(0,50) 250 NEXT I 300 CALL "APNT"(100,700,-8,-8,-8) 305 CALL "VECT"(150,70) 310 CALL "VECT"(0,40) 315 CALL "VECT"(170,80) 320 CALL "VECT"(195,-90) 400 CALL "APNT"(700,350,-8,-8,-8) 405 X=-150\Y=80 410 FOR I=0 TO 2 415 IF I<>2 THEN 420 \X=-140\Y=70 420 CALL "VECT"(X,Y)\X=-200\Y=100 435 IF I=2 THEN 450 440 CALL "VECT"(0,50) 450 NEXT I 505 X=100\Y=50 510 CALL "VECT"(100,50) 515 CALL "VECT"(0,50) 520 CALL "VECT"(110,50) 600 X=200\Y=-90 605 FOR I=0 TO 5 610 CALL "VECT"(X,Y) 615 IF I=5 THEN 650 620 CALL "VECT"(0,55) 650 NEXT I 660 CALL "VECT"(-135,-70) 700 X=1430\Y=520 705 FOR I=0 TO 3 710 CALL "APNT"(X,Y,-8,-8,-8) 720 CALL "VECT"(70,-18) 730 CALL "APNT"(X,Y,-8,-8,-8) 740 CALL "VECT"(-135,-70) 745 X=X-200\Y=Y-35 750 NEXT I 800 X=670\Y=820 805 FOR I=0 TO 4 810 CALL "APNT"(X,Y,-8,-8,-8) 815 CALL "VECT"(-45,-10) 820 CALL "APNT"(X,Y,-8,-8,-8) 825 IF I<>4 THEN 830 \CALL "VECT"(245,-105)\GO TO 845 830 CALL "VECT"(140,-60) 845 X=X+200\Y=Y-37\NEXT I 900 CALL "APNT"(100,690,-8,-8,-8) 910 CALL "VECT"(0,-390) 920 CALL "VECT"(600,-300) 940 CALL "VECT"(0,300) 950 CALL "APNT"(700,0,-8,-8,-8) 960 CALL "VECT"(1025,500) 970 CALL "VECT"(0,60) 980 CALL "APNT"(420,840,-8,-8,-8) 990 CALL "VECT"(0,-300) 1000 CALL "APNT"(500,400) 1010 CALL "VECT"(50,35) 1020 CALL "APNT"(500,450) 1030 CALL "VECT"(50,35) 1040 CALL "APNT"(300,550) 1050 CALL "VECT"(50,35) 1060 CALL "APNT"(300,600) 1070 CALL "VECT"(50,35) 1080 CALL "APNT"(305,750) 1090 CALL "VECT"(-50,20) 1100 CALL "APNT"(305,800) 1110 CALL "VECT"(-50,15) 1150 CALL "APNT"(1200,100,-8,-8,-8) 1160 CALL "TEXT"("ESCHER") 1162 CALL "APNT"(0,0,-8,-8,-8) 1163 CALL "TEXT"("HH") 1180 CALL "APNT"(700,325,0,-8,-8,-8) 1200 CALL "FIGR"(A,0,-5) 1210 CALL "VECT"(-20,0)\CALL "VECT"(-20,10) 1220 CALL "VECT"(-10,20)\CALL "VECT"(0,20) 1230 CALL "VECT"(10,20)\CALL "VECT"(20,10) 1240 CALL "VECT"(30,0)\CALL "VECT"(20,-10) 1250 CALL "VECT"(10,-20)\CALL "VECT"(0,-10) 1260 CALL "VECT"(-10,-20)\CALL "VECT"(-20,-10) 1390 D=0\E=50 1400 Y1=280 1410 X1=-400\N=2\Y2=50 1435 X9=0\Y9=0 1440 GOSUB 2000 1450 X1=150\Y1=100\N=1 1460 Y2=50 1490 GOSUB 2000 1500 X1=1000 1510 Y1=-200 1530 N=5 1535 Y2=50 1540 GOSUB 2000 1550 X1=-725 1560 Y1=-160 1570 N=4 1575 Y2=50 1580 GOSUB 2000 1600 GO TO 1400 2000 Y3=INT((Y1-N*Y2)/N+1) 2005 X3=INT(X1/N+1) 2007 X5=1\Y5=1 2008 IF Y1>0 THEN 2009 \Y5=-1 2009 IF X1>0 THEN 2010 \X5=-1 2010 P=0 2011 Y5=Y5*2\X5=X5*2 2012 P1=Y3/X3 2018 FOR J=1 TO N+1 2020 FOR I=0 TO X3 STEP X5 2030 CALL "APUT"(A(0),I+X3*P+X9) 2040 CALL "APUT"(A(1),I*P1+P*(Y3+Y2)+Y9) 2050 NEXT I 2065 IF J>=N+1 THEN 2095 2067 Y5=1\IF Y2>0 THEN 2070 \Y5=-1 2070 FOR I=0 TO Y2 STEP Y5 2080 CALL "APUT"(A(1),I+(P+1)*Y3+P*Y2+Y9) 2090 NEXT I 2095 P=P+1 2100 NEXT J 2110 P=P-1 2120 X9=I+X3*P+X9 2130 Y9=I*P1+P*(Y3+Y2)+Y9 2200 RETURN 5 PRINT "HOUR: ";\INPUT S6 7 PRINT "MIN : ";\INPUT S7 8 PRINT "DATE: ";\INPUT A$ 10 DIM A(200) 20 B4=0\S8=0 25 P5=1 30 GOSUB 5000 40 CALL "TIME"(600) 100 CALL "INIT" 200 CALL "SCAL"(0,0,1000,825) 202 GOSUB 255 205 GOSUB 4000 220 CALL "SUBP"(3) 240 CALL "APNT"(600,160,0,-5) 242 CALL "TEXT"(P$&" "&STR$(A1)&" "&STR$(A2)&" . "&STR$(A3)) 244 CALL "ESUB"\GO TO 1000 255 FOR I=0 TO 4 260 FOR J=0 TO 2 265 IF I=3 THEN 300 270 CALL "APNT"(600+I*50+J*3,0,1,5) 280 CALL "VECT"(0,150,1,5) 290 NEXT J 300 NEXT I 305 RETURN 400 CALL "LPEN"(H,T,X1,Y1) 410 CALL "TIMR"(T2) 412 IF T2=0 THEN 7000 414 T3=T2 415 CALL "TIMR"(T4) 416 IF T4=0 THEN 420 \IF T42 THEN 430 427 CALL "ERAS"(2)\CALL "DSAV"\GO TO 1000 430 D=INT(Y1/15)\F=INT((X1-575)/50) 440 IF F<>0 THEN 444 \IF D<5 THEN 442 \P$="+"\GO TO 500 442 P$="-"\GO TO 500 444 IF F<>1 THEN 448 \A1=D\GO TO 500 448 IF F<>2 THEN 452 \A2=D\GO TO 500 452 IF F<>3 THEN 456 \GO TO 500 456 IF F<>4 THEN 500 \A3=D\GO TO 500 500 D8=VAL(P$&STR$(A1)&STR$(A2)&STR$(A3))/10 510 CALL "ERAS"(3) 520 CALL "ERAS"(2) 550 CALL "DSAV" 600 GO TO 220 1000 CALL "SUBP"(2) 1020 CALL "APNT"(300,120,1,-8,B1) 1040 CALL "TEXT"("*** SET "&STR$(D1)) 1060 CALL "APNT"(300,90,1,-8,B2) 1080 CALL "TEXT"("*** HIGH "&STR$(D2)) 1100 CALL "APNT"(300,60,1,-8,B3) 1120 CALL "TEXT"("*** LOW "&STR$(D3)) 1130 CALL "APNT"(850,450,0,-8,-1) 1140 CALL "ESUB" 1470 IF X1>600 THEN 400 1500 Y1=INT((Y1-60)/30) 1505 B1=-1\B2=-2\B3=-3 1507 B5=Y1+2 1510 IF Y1<>0 THEN 1530 \B2=1\IF X1<350 THEN 400 \D2=D8\GO TO 400 1530 IF Y1<>1 THEN 1550 \B1=1\IF X1<350 THEN 400 \D1=D8\GO TO 400 1550 B5=1\B3=1\IF X1<350 THEN 400 \D3=D8\GO TO 400 4000 CALL "SUBP"(4) 4001 CALL "APNT"(850,450,0,-8,-1) 4002 CALL "TEXT"("TIME") 4003 CALL "APNT"(850,400,0,-8,-1) 4004 CALL "TEXT"(STR$(S6)&":"&STR$(S7)&":"&STR$(10*S8)) 4005 FOR I=0 TO 4 4010 CALL "APNT"(50,200+75*I,0,-8) 4020 CALL "VECT"(700,0,0,8,0,3) 4030 NEXT I 4040 FOR I=0 TO 7 4050 CALL "APNT"(50+100*I,200,0,-8) 4060 CALL "VECT"(0,300,0,8,0,3) 4070 NEXT I 4071 CALL "APNT"(850,350,0,-8,-1) 4072 CALL "TEXT"(A$) 4075 P=0 4077 CALL "STAT"(-1) 4078 CALL "RDOT"(0,0,-1) 4080 FOR I=0 TO 3 4090 FOR J=1 TO 7 4092 IF A(P)A(P+56) THEN 4096 4094 C5=-1\GO TO 4100 4096 C5=1 4100 CALL "APNT"(-40+J*100,480-I*75,0,-8) 4105 CALL "RDOT"(0,0,1,-8,C5) 4110 CALL "TEXT"(STR$((P5-1)*28+P+1)) 4115 P=P+1 4120 NEXT J\NEXT I 4125 CALL "RDOT"(0,0,1,-8,-1) 4135 CALL "STAT"(1,-1) 4136 CALL "RDOT"(0,0,-1,-8) 4137 GOSUB 8000 4138 P=0\O1=0\O2=+10 4139 O2=0 4140 GOSUB 4300 4150 P=0\O1=B5 4151 O2=20 4160 GOSUB 4300 4165 CALL "ESUB" 4170 RETURN 4300 FOR I=0 TO 3\FOR J=1 TO 7 4310 CALL "APNT"(-40+J*100,450-O2-I*75,0,-8,0,1) 4320 CALL "TEXT"(STR$(A(P+O1*28))) 4330 P=P+1 4340 NEXT J\NEXT I 4350 RETURN 5000 REM 5015 FOR I=0 TO 27 5017 IF A(I+84)=0 THEN 5030 5020 A9=(RND(Z)*10)-5+A(I+84) 5021 A(I)=INT(A9*10)/10 5030 NEXT I 5040 RETURN 6000 X1=INT((X1-60)/100+.5)+1 6010 Y1=ABS(INT((Y1-225)/75)-3) 6015 IF Y1>=4 THEN 400 6020 X1=7*Y1+X1 6021 PRINT CHR$(7);\X1=X1-1 6022 A(X1+28)=D3\A(X1+56)=D2\A(X1+84)=D1 6026 D7=D3 6030 GO TO 400 7000 GOSUB 5000 \CALL "ERAS"(4)\CALL "DSAV" 7001 S8=S8+1 7002 IF S8<>6 THEN 7005 \S8=0\S7=S7+1\IF S7<>60 THEN 7005 \S7=0\S6=S6+1 7003 IF S6<>24 THEN 7005 \S6=0 7005 GOSUB 4000 7007 CALL "APNT"(0,0,0,-1) 7010 CALL "TIME"(600)\GO TO 400 8000 CALL "APNT"(0,600,0,-8,-1) 8010 CALL "TEXT"("SECTION:") 8020 FOR I=1 TO 15 8030 CALL "APNT"(100+50*I,600,0,-8) 8035 C6=-1\IF I<>P5 THEN 8040 \C6=1 8040 CALL "RDOT"(0,0,1,-8,C6) 8050 CALL "TEXT"(STR$(I)) 8060 NEXT I 8070 CALL "RDOT"(0,0,-1,-8,-1) 8080 RETURN 90 DIM T(20) 100 PRINT "THIS SIMULATION LETS YOU SPECIFY THE INITIAL VELOCITY" 110 PRINT "OF A BALL THROWN STRAIGHT UP, AND THE COEFFICIENT OF" 120 PRINT "ELASTICITY OF THE BALL. PLEASE USE A DECIMAL FRACTION" 130 PRINT "COEFFICIENT (LESS THAN 1)." 131 PRINT 132 PRINT "YOU ALSO SPECIFY THE TIME INCREMENT TO BE USED IN" 133 PRINT "'STROBING' THE BALL'S FLIGHT (TRY .1 INITIALLY)." 134 PRINT 135 PRINT "TIME INCREMENT (SEC)"; 136 INPUT S2 140 PRINT 150 PRINT "VELOCITY (FPS)"; 160 INPUT V 165 PRINT 170 PRINT "COEFFICIENT"; 180 INPUT C 184 PRINT 185 PRINT "FEET" 186 PRINT 187 S1=INT(70/(V/(16*S2))) 190 FOR I=1 TO S1 200 T(I)=V*C^(I-1)/16 210 NEXT I 220 FOR H=INT(-16*(V/32)^2+V^2/32+.5) TO 0 STEP -.5 221 IF INT(H)<>H THEN 225 222 PRINT H; 225 L=0 230 FOR I=1 TO S1 240 FOR T=0 TO T(I) STEP S2 245 L=L+S2 250 IF ABS(H-(.5*(-32)*T^2+V*C^(I-1)*T))>.25 THEN 270 260 PRINT TAB(L/S2);"O"; 270 NEXT T 275 T=T(I+1)/2 276 IF -16*T^2+V*C^(I-1)*T0 THEN 176 190 CALL "ERAS"(1) 195 CALL "INIT" 200 NEXT I 210 GO TO 10 220 END 0 CALL "INIT" 10 CALL "INIT" 15 FOR I=0 TO 80 STEP 10 16 CALL "SUBP"(1) 18 CALL "SCAL"(10-I,0,110-I,100) 30 CALL "APNT"(10,10,0,-5) 40 CALL "VECT"(10,30) 50 CALL "VECT"(10,-30) 60 CALL "APNT"(20,40,0,-5) 70 CALL "VECT"(0,30) 80 CALL "APNT"(10,50,0,-5) 90 CALL "VECT"(10,10) 100 CALL "VECT"(10,-10) 110 FOR X=0 TO 5 STEP .1 120 LET Y=SQR(25-X^2) 130 CALL "APNT"(20+X,75+Y) 140 CALL "APNT"(20+X,75-Y) 150 CALL "APNT"(20-X,75+Y) 160 CALL "APNT"(20-X,75-Y) 170 NEXT X 172 CALL "ESUB" 175 CALL "TIME"(50) 176 CALL "TIMR"(T) 177 IF T>0 THEN 176 190 CALL "ERAS"(1) 195 CALL "INIT" 200 NEXT I 210 GO TO 10 220 END 100 REM BASIC/RT-11 DEMONSTRATION PROGRAM 100 REM DEC-11-ORCPA-A-LA3 100 REM COPYRIGHT 1973, DIGITAL EQUIPMENT CORPORATION. 100 REM MAYNARD, MASSACHUSETTS 01754 100 REM DEC ASSUMES NO RESPONSIBILITY FOR THE 100 REM USE OR RELIABILITY OF ITS SOFTWARE ON 100 REM EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. 100 REM BASIC PROGRAM USING CALL STATEMENT 116 REM CALL USER FUNCTION BITS WHICH COUNTS 118 REM THE NUMBER OF BITS SET IN A NUMBER. 120 INPUT A 122 IF A=0 THEN STOP 124 CALL "BITS" (A,X) 126 PRINT X 128 GO TO 25 130 END 10 20 REM BASIC/RT-11 DEMONSTRATION PROGRAM 30 40 REM DEC-11-ORCPA-A-LA3 50 60 REM COPYRIGHT 1973, DIGITAL EQUIPMENT CORPORATION. 70 REM MAYNARD, MASSACHUSETTS 01754 80 90 REM DEC ASSUMES NO RESPONSIBILITY FOR THE 100 REM USE OR RELIABILITY OF ITS SOFTWARE ON 110 REM EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. 120 130 140 150 REM BASIC PROGRAM USING CALL STATEMENT 160 REM CALL USER FUNCTION BITS WHICH COUNTS 170 REM THE NUMBER OF BITS SET IN A NUMBER. 180 INPUT A 190 IF A=0 THEN STOP 200 CALL "BITS" (A,X) 210 PRINT X 220 GO TO *???* 230 END 1000 REM *** GAME OF ROULETTE WRITTEN BY DAVID JOSLIN 1010 REM *** CONVERTED TO BASIC-PLUS BY DAVID AHL, DIGITAL 1020 PRINT "WELCOME TO THE ROULETTE TABLE" 1030 PRINT \PRINT "WANT INSTRUCTIONS (Y OR N)"; 1040 INPUT Y$ 1060 IF Y$="N" THEN 1550 1070 PRINT 1080 PRINT "THIS IS THE BETTING LAYOUT" 1090 PRINT " (*=RED)" 1100 PRINT 1110 PRINT " 1* 2 3*" 1120 PRINT " 4 5* 6 " 1130 PRINT " 7* 8 9*" 1140 PRINT "10 11 12*" 1150 PRINT "---------------" 1160 PRINT "13 14* 15 " 1170 PRINT "16* 17 18*" 1180 PRINT "19* 20 21*" 1190 PRINT "22 23* 24 " 1200 PRINT "---------------" 1210 PRINT "25* 26 27*" 1220 PRINT "28 29 30*" 1230 PRINT "31 32* 33 " 1240 PRINT "34* 35 36*" 1250 PRINT "---------------" 1260 PRINT " 00 0 " 1270 PRINT 1280 PRINT "TYPES OF BETS" 1290 PRINT 1300 PRINT "THE NUMBERS 1 TO 36 SIGNIFY A STRAIGHT BET" 1310 PRINT "ON THAT NUMBER" 1320 PRINT "THESE PAY OFF 35:1" 1330 PRINT 1340 PRINT "THE 2:1 BETS ARE:" 1350 PRINT " 37) 1-12 40) FIRST COLUMN" 1360 PRINT " 38) 13-24 41) SECOND COLUMN" 1370 PRINT " 39) 25-36 42) THIRD COLUMN" 1380 PRINT 1390 PRINT "THE EVEN MONEY BETS ARE:" 1400 PRINT " 43) 1-18 46) ODD" 1410 PRINT " 44) 19-36 47) RED" 1420 PRINT " 45) EVEN 48) BLACK" 1430 PRINT 1440 PRINT " 49)0 AND 50)00 PAY OFF 35:1" 1450 PRINT " NOTE: 0 AND 00 DO NOT COUNT UNDER ANY" 1460 PRINT " BETS EXCEPT THEIR OWN" 1470 PRINT 1480 PRINT "WHEN I ASK FOR EACH BET,TYPE THE NUMBER" 1490 PRINT "AND THE AMOUNT,SEPERATED BY A COMMA" 1500 PRINT "FOR EXAMPLE:TO BET $500 ON BLACK,TYPE 48,500" 1520 PRINT 1530 PRINT "MINIMUM BET IS $5,MAXIMUM IS $500" 1540 PRINT "YOUR'E STARTING WITH $1000; I HAVE $100,000 IN THE BANK"\PRINT 1550 REM-PROGRAM BEGINS HERE 1560 REM-TYPE OF BET(NUMBER) ODDS 1580 DIM B(100),C(100),T(100),X(38),A(50) 1600 FOR Q9=0 TO 38\X(Q9)=0\NEXT Q9 1610 P=1000 1620 D=100000 1630 PRINT "HOW MANY BETS"; 1640 INPUT Y 1650 IF Y<1 THEN 1630 \IF Y<>INT(Y) THEN 1630 1660 FOR Q9=0 TO 50\A(Q9)=0\NEXT Q9 1670 FOR C=1 TO Y 1680 PRINT "NUMBER";C; 1690 INPUT X,Z 1700 B(C)=Z 1710 T(C)=X 1720 IF X<1 THEN 1680 \IF X>50 THEN 1680 \IF X<>INT(X) THEN 1680 1730 IF Z<1 THEN 1680 \IF Z<>INT(Z) THEN 1680 1740 IF Z<5 THEN 1680 \IF Z>500 THEN 1680 1750 IF A(X)=0 THEN 1780 1760 PRINT "YOU MADE THAT BET ONCE ALREADY,DUM-DUM" 1770 GO TO 1680 1780 A(X)=1 1790 NEXT C 1800 PRINT "SPINNING" 1810 PRINT 1820 PRINT 1830 S=INT(RND(0)*100) 1840 IF S=0 THEN 1830 \IF S>38 THEN 1830 1850 X(S)=X(S)+1 1860 IF S<37 THEN 1920 1870 IF S=37 THEN 1900 1880 PRINT "00" 1890 GO TO 2020 1900 PRINT "0" 1910 GO TO 2020 1920 RESTORE 1930 FOR I=1 TO 18 1940 READ R 1950 IF R=S THEN 2000 1960 NEXT I 1970 A$="BLACK" 1980 PRINT S;A$ 1990 GO TO 2020 2000 A$="RED" 2010 GO TO 1980 2020 PRINT 2030 FOR C=1 TO Y 2040 IF T(C)<37 THEN 2710 2050 ON T(C)-36 GOTO 2090,2190,2220,2250,2300,2350,2400,2470,2500,2530,2560,2630 2070 GO TO 2710 2080 STOP 2090 REM 1-12(37) 2:1 2100 IF S<=12 THEN 2150 2110 PRINT "YOU LOSE"B(C)"DOLLARS ON BET"C 2120 D=D+B(C) 2130 P=P-B(C) 2140 GO TO 2180 2150 PRINT "YOU WIN"B(C)*2"DOLLARS ON BET"C 2160 D=D-B(C)*2 2170 P=P+B(C)*2 2180 GO TO 2810 2190 REM 13-24(38) 2:1 2200 IF S>12AND S<25 THEN 2150 2210 GO TO 2110 2220 REM 25-36(39) 2:1 2230 IF S>24AND S<37 THEN 2150 2240 GO TO 2110 2250 REM FIRST COLUMN(40) 2:1 2260 FOR I=1 TO 34 STEP 3 2270 IF S=I THEN 2150 2280 NEXT I 2290 GO TO 2110 2300 REM SECOND COLUMN(41) 2:1 2310 FOR I=2 TO 35 STEP 3 2320 IF S=I THEN 2150 2330 NEXT I 2340 GO TO 2110 2350 REM THIRD COLUMN(42) 2:1 2360 FOR I=3 TO 36 STEP 3 2370 IF S=I THEN 2150 2380 NEXT I 2390 GO TO 2110 2400 REM 1-18(43) 1:1 2410 IF S<19 THEN 2430 2420 GO TO 2110 2430 PRINT "YOU WIN"B(C)"DOLLARS ON BET"C 2440 D=D-B(C) 2450 P=P+B(C) 2460 GO TO 2810 2470 REM 19-36(44) 1:1 2480 IF S<37AND S>18 THEN 2430 2490 GO TO 2110 2500 REM EVEN(45) 1:1 2510 IF S/2=INT(S/2)AND S<37 THEN 2430 2520 GO TO 2110 2530 REM ODD(46) 1:1 2540 IF S/2<>INT(S/2)AND S<37 THEN 2430 2550 GO TO 2110 2560 REM RED(47) 1:1 2570 RESTORE 2580 FOR I=1 TO 18 2590 READ R 2600 IF S=R THEN 2430 2610 NEXT I 2620 GO TO 2110 2630 REM BLACK(48) 1:1 2640 RESTORE 2650 FOR I=1 TO 18 2660 READ R 2670 IF S=R THEN 2110 2680 NEXT I 2690 IF S>36 THEN 2110 2700 GO TO 2430 2710 REM--1TO36,0,00(1-36,49,50)35:1 2720 IF T(C)<49 THEN 2760 2730 IF T(C)=49AND S=37 THEN 2780 2740 IF T(C)=50AND S=38 THEN 2780 2750 GO TO 2110 2760 IF T(C)=S THEN 2780 2770 GO TO 2110 2780 PRINT "YOU WIN"B(C)*35"DOLLARS ON BET"C 2790 D=D-B(C)*35 2800 P=P+B(C)*35 2810 NEXT C 2820 PRINT 2830 PRINT "TOTALS:","ME","YOU" 2840 PRINT " ",D,P 2850 IF P>0 THEN 2880 2860 PRINT "OOPS! YOU JUST SPENT YOUR LAST DOLLAR" 2870 GO TO 3190 2880 IF D>0 THEN 2920 2890 PRINT "YOU BROKE THE HOUSE!" 2900 P=101000 2910 GO TO 2960 2920 PRINT "AGAIN"; 2930 INPUT Y$ 2940 IF Y$="Y" THEN 1630 2950 DATA 1,3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36 2960 IF P<1 THEN 3190 2970 PRINT "TO WHOM SHALL I MAKE OUT THE CHECK"; 2980 INPUT B$ 2990 PRINT 3000 PRINT "--------------------------------------------------------------------" 3010 PRINT TAB(50)"CHECK NO. ";INT(RND(0)*100) 3020 PRINT 3040 PRINT TAB(40);DATE$(0) 3050 PRINT 3060 PRINT 3070 PRINT "PAY TO THE ORDER OF-----";B$;"-----$ "; 3080 PRINT P 3090 PRINT 3100 PRINT 3110 PRINT TAB(10),"THE MEMORY BANK OF VIRGINIA" 3120 PRINT 3130 PRINT TAB(40),"THE COMPUTER" 3140 PRINT TAB(40)"----------X-----" 3150 PRINT 3160 PRINT "--------------------------------------------------------------" 3170 PRINT "COME BACK SOON!" 3180 GO TO 3210 3190 PRINT "THANKS FOR YOUR MONEY" 3200 PRINT "I'LL USE IT TO BUY A SOLID GOLD ROULETTE WHEEL" 3210 PRINT 3220 GO TO 3420 3420 END 1200 C=C+1\GOSUB 4300 \T2=T+V 1210 IF T2>21 THEN 1230 1220 GOSUB 4400 \T=T2\GO TO 1100 1230 PRINT " HOUSE STICKS "; 1240 IF T1>21 THEN 1080 1250 IF T1>T THEN 1060 1260 GO TO 1080 1200 IF T<=18 THEN 1240 1210 IF T=19 THEN 1230 1220 Z=FNR(13)\GO TO 1250 1230 Z=FNR(6)\GO TO 1250 1240 Z=FNR(T-14) 1250 IF Z<>1 THEN 1290 \REM NO PLAY 1260 C=C+1\GOSUB 4400 \GOSUB 4300 \T=T+V\C2=C2+1 1270 IF T>21 THEN 1060 1280 GO TO 1100 1290 PRINT " HOUSE STICKS ': 1300 IF T1>21 THEN 1080 1310 IF T1>T THEN 1060 \GO TO 1080 10 REM PROGRAM TO SIMULATE A FRUIT MACHINE 20 REM TITLE IS GAMBLE.BAS AND PROVIDES A 22 REM DEMONSTRATION OF THE RND RANDOM NUMBER GENERATOR FUNCTION. 30 GOSUB 4000 \REM FORM FEED 40 PRINT "PLAY THE FRUIT MACHINE WITH D.E.C. RT11/BASIC" 50 PRINT \PRINT "DO YOU KNOW HOW TO PLAY"; 60 GOSUB 4100 \IF Z$="Y" THEN 500 \IF Z$="" THEN 500 70 PRINT \PRINT "THIS FRUIT MACHINE HAS FOUR WHEELS OF FORTUNE," 80 PRINT "EACH WHEEL HAS NINE FRUITS PLUS LUCKY STAR." 90 PRINT "YOU WILL COMMENCE PLAY WITH THE LOOSE CHANGE" 100 PRINT "IN YOUR POCKET (ASSESSED BY THE COMPUTER)." 110 PRINT "WHEN THE COMPUTER TYPES '?' IT IS EXPECTING A" 120 PRINT "'YES' OR 'NO' ANSWER- THE FIRST LETTER 'Y' OR 'N' WILL" 130 PRINT "SUFFICE. THE FRUIT MACHINE HAS A RANDOM 'HOLD'" 140 PRINT "FACILITY AND A RANDOM 'GAMBLE' FACILITY WHICH WHEN " 150 PRINT "AVAILABLE YOU MAY HOLD ANY OR ALL OF" 160 PRINT "THE WHEELS AND/OR GAMBLE A WINNING LINE" 170 PRINT "TO DOUBLE YOUR WINNINGS A MAXIMUM OF THREE TIMES." 190 PRINT "THE MACHINE WILL RETIRE YOU WHEN IT THINKS YOU" 200 PRINT "HAVE WON ENOUGH MONEY IN WHICH CASE YOU HAVE BEATEN THE" 210 PRINT "MACHINE. YOU LOSE WHEN YOU HAVE NO MONEY LEFT TO PLAY" 220 PRINT "WITH. YOU MAY RETIRE FROM THE GAME AT ANY TIME AND COLLECT" 230 PRINT "YOUR WINNINGS. A SPIN OF THE WHEEL COSTS YOU 5 CENTS." 240 PRINT "TYPE 'T' FOR A PRINT OF CASH IN HAND." 300 DATA " ****** "," CHERRY "," PLUM "," APPLE ","STRAWBY " 301 DATA " PEACH "," ORANGE "," LEMON "," BANANA "," GRAPE " 302 DATA 18 310 DATA 1,1,0,0,50,2,2,0,0,30 320 DATA 3,3,0,0,20,4,4,0,0,20 330 DATA 5,5,0,0,20,6,6,0,0,20 340 DATA 7,7,0,0,20,8,8,0,0,20 350 DATA 9,9,0,0,15,10,10,0,0,15 360 DATA 1,0,0,0,10,0,1,0,0,10 370 DATA 0,0,1,0,10,0,0,0,1,10 380 DATA 2,0,0,0,5,0,2,0,0,5 390 DATA 0,0,2,0,5,0,0,0,2,5 500 DIM R(4),S(4),F$(10),W(20,5),H(4) 510 FOR I=1 TO 10\READ F$(I)\NEXT I 520 READ L\FOR I=1 TO L\FOR J=1 TO 5\READ W(I,J) 530 NEXT J\NEXT I 540 PRINT "DO YOU WANT A PRINT OUT OF THE WINNING LINES"; 550 GOSUB 4100 \IF Z$="N" THEN 850 \IF Z$="" THEN 850 560 PRINT \PRINT "WINNING LINES ARE--" 570 PRINT "FOUR STARS '******' PAYS $100.00" 580 PRINT "FOUR IDENTICAL FRUITS PAY $25.00" 590 PRINT "THREE STARS IN ANY POSITION PAY $10.00" 600 PRINT "THREE IDENTICAL FRUITS IN ANY POSITION PAY $1.00" 700 PRINT "TWO PAIRS OF FRUITS IN ANY POSITION PAY $1.00" 800 FOR I=1 TO L\FOR J=1 TO 4 810 IF W(I,J)=0 THEN 830 820 PRINT F$(W(I,J));\GO TO 835 830 PRINT " "; 835 NEXT J 840 PRINT " PAYS "W(I,5);" CENTS."\NEXT I 850 PRINT \PRINT \FOR I=1 TO 4\H(I)=0\NEXT I 860 RANDOMIZE\M=FNR(Z)*10 870 PRINT "YOU HAVE "M;"CENTS TO PLAY WITH. " 880 PRINT "GOOD LUCK."\PRINT 890 N=0\C=0 900 PRINT "TYPE 'H' FOR HELP IF YOU DO NOT UNDERSTAND."\PRINT 910 GO TO 1008 1000 M=M+C\C=0\IF M>0 THEN 1008 1001 PRINT \PRINT "YOU HAVE NO MONEY LEFT TO PLAY WITH." 1002 PRINT "I HOPE YOU HAVE LEARNED YOUR LESSON." 1003 GOSUB 4400 1008 PRINT "PLAY";\GOSUB 4100 \IF Z$<>"T" THEN 1010 1009 PRINT \PRINT "YOUR TOTAL IS $"M/100;\GO TO 1008 1010 IF Z$<>"H" THEN 1050 1020 PRINT "IF YOU WISH TO RISK 5C ON THE NEXT SPIN OF" 1030 PRINT "THE WHEELS TYPE 'Y' OR JUST , IF YOU WISH TO RETIRE" 1040 PRINT "TYPE 'N'."\GO TO 1008 1050 IF Z$<>"N" THEN 1120 1060 IF N<30 THEN 1110 1070 GOSUB 4000 1080 PRINT "YOU'VE HAD A GOOD RUN FOR YOUR MONEY," 1090 PRINT "AND TAKE $"M/100;" AWAY WITH YOU." 1100 PRINT "THANKS FOR THE GAME."\GO TO 4400 1110 PRINT "YOU RETIRE-- VERY SENSIBLE TOO."\GO TO 1090 1120 PRINT " ";\M=M-5 1125 FOR I=1 TO 4\IF H(I)>0 THEN 1140 1130 R(I)=FNR(Z) 1140 PRINT F$(R(I));\NEXT I 1150 IF R(1)+R(2)+R(3)+R(4)<>4 THEN 1170 1160 PRINT "PAYS $100.00 JACKPOT!!!."\M=M+10000\GO TO 4300 1170 IF R(1)<>R(2) THEN 1200 \IF R(2)<>R(3) THEN 1200 1180 IF R(3)<>R(4) THEN 1200 1190 PRINT "PAYS $25.00 JACKPOT!!!"\M=M+2500\GO TO 1000 1200 FOR I=1 TO 4\S(I)=R(I)\NEXT I 1300 FOR I=1 TO 4\FOR J=1 TO 3\IF S(J)<=S(J+1) THEN 1320 1310 A=S(J)\S(J)=S(J+1)\S(J+1)=A 1320 NEXT J\NEXT I 1330 IF S(1)+S(2)+S(3)<>3 THEN 1341 1340 PRINT "PAYS $10.00 JACKPOT!!!"\M=M+1000\GO TO 1000 1341 IF S(2)<>S(3) THEN 1350 \IF S(1)<>S(2) THEN 1343 1342 PRINT "PAYS $1.00 "\C=100\GO TO 1390 1343 IF S(3)<>S(4) THEN 1350 \GO TO 1342 1350 IF S(1)<>S(2) THEN 1670 \IF S(3)<>S(4) THEN 1670 1380 PRINT "PAYS $1.00 "\C=100\GO TO 1390 1390 IF FNR(Z)>3 THEN 1520 \REM NO GAMBLE 1400 FOR I=1 TO 3\PRINT "GAMBLE";\GOSUB 4100 1410 IF Z$<>"H" THEN 1470 1420 PRINT \PRINT "YOU MAY GAMBLE YOUR WINNINGS OF "C;" CENTS" 1422 PRINT "UP TO THREE TIMES. EACH GAMBLE HAS A EVEN CHANCE OF" 1440 PRINT "DOUBLING YOUR WINNINGS. IF YOU LOSE A GAMBLE YOU LOSE" 1445 PRINT "YOUR WINNINGS." 1450 PRINT "TYPE 'Y' IF YOU WISH TO GAMBLE." 1460 PRINT "GAMBLE";\GOSUB 4100 \GO TO 1410 1470 IF Z$<>"Y" THEN 1520 1480 IF FNR(Z)>5 THEN 1500 1482 PRINT " WIN"\C=C+C\NEXT I 1490 GO TO 1520 1500 PRINT " LOSE"\C=0 1520 IF C>30 THEN 1550 \IF FNR(Z)>4 THEN 1550 1530 PRINT "HOLD";\INPUT Z$ 1540 IF Z$<>"" THEN 1560 1550 FOR I=1 TO 4\H(I)=0\NEXT I\GO TO 1000 1560 IF LEN(Z$)<>4 THEN 1610 1565 PRINT " "; 1570 FOR I=1 TO 4\IF SEG$(Z$,I,I)<>"Y" THEN 1590 1580 H(I)=1\PRINT " HOLD ";\GO TO 1600 1590 H(I)=0\PRINT " "; 1600 NEXT I\PRINT " O.K.";\GOSUB 4100 1602 IF Z$<>"N" THEN 1000 \GO TO 1530 1610 PRINT "TO ENTER HOLD CONDITION REQUIRED" 1620 PRINT "TYPE FOUR CHATACTERS- 1 PER WHEEL." 1630 PRINT "WHERE HOLD IS REQUIRED TYPE 'Y'," 1640 PRINT "WHERE NO HOLD IS REQUIRED TYPE SOMETHING ELSE." 1650 PRINT "FOR EXAMPLE, TO HOLD THE SECOND AND FOURTH WHEELS TYPE '*Y*Y'." 1651 PRINT "IF NO HOLD IS REQUIRED TYPE ." 1660 GO TO 1530 1670 A=0\B=1 1680 FOR I=1 TO L\B=1 1690 FOR J=1 TO 4\IF W(I,J)=0 THEN 1810 1700 IF R(J)=W(I,J) THEN 1810 1800 B=0 1810 NEXT J 1820 IF B=1 THEN 1860 1840 NEXT I 1850 IF A<=0 THEN 1870 \REM NO WIN 1860 C=W(I,5)\PRINT "PAYS"C;"CENTS."\GO TO 1390 1870 IF S(1)+S(2)+S(3)+S(4)<>20 THEN 1520 1880 C=20\PRINT "SURPRISE WIN PAYS"C;"CENTS."\GO TO 1390 4000 REM SUBR TO PRINT 6 LINE FEEDS 4010 FOR I=1 TO 6\PRINT \NEXT I\RETURN 4100 REM SUBR TO INPUT A YES OR NO ANSWER 4110 INPUT Z$\Z$=SEG$(Z$,1,1)\IF Z$="Y" THEN 4120 4112 IF Z$="T" THEN 4120 \IF Z$="" THEN 4120 4114 IF Z$="N" THEN 4120 \IF Z$="H" THEN 4120 4116 PRINT "PLEASE ANSWER 'YES' OR 'NO' OR 'HELP'";\GO TO 4110 4120 RETURN 4200 DEF FNR(Z)=INT(RND(1)*9+1) 4300 PRINT "CONGRATULATIONS. YOU HAVE WON! AND HAVE $"M/100;" TO TAKE AWAY." 4400 GOSUB 4000 \GO TO 5000 5000 END 100 REM PROGRAM TO PLAY PONTOON (BLACKJACK OR WHATEVER) PONTN.BAS 110 PRINT \PRINT \PRINT \PRINT "PLAY PONTOON WITH D.E.C. RT11 BASIC." 120 PRINT \PRINT "IT IS ASSUMED THAT YOU KNOW HOW TO PLAY THE GAME OF PONTOON." 130 PRINT "BUT DO YOU KNOW HOW TO OPERATE THIS PROGRAM"; 140 INPUT Z$\Z$=SEG$(Z$,1,1) 150 IF Z$="" THEN 260 \IF Z$="Y" THEN 260 160 PRINT \PRINT "THE COMPUTER WILL ALLOCATE YOU A RANDOM SUM OF MONEY" 170 PRINT "TO START WITH. THE MINIMUM BET FOR START OR BUYING A CARD" 180 PRINT "IS FIVE CENTS." 190 PRINT "TO PLAY ANSWER THE QUESTION 'PLAY?' WITH 'Y' OR ." 200 PRINT "TO RETIRE ANSWER THIS QUESTION WITH 'N'." 210 PRINT "TO ANSWER THE QUESTION 'ACTION?' TYPE 'T' FOR TWIST," 220 PRINT "'S' FOR STICK OR 'B' TO BUY A CARD." 230 PRINT "YOU MAY ANSWER THE QUESTIONS 'BET?' AND 'BUY FOR?' WITH" 240 PRINT "ANY AMOUNT IN CENTS THAT YOU CAN AFFORD." 250 PRINT \PRINT "GOOD LUCK!" 260 PRINT "DO YOU CONSIDER YOURSELF A GOOD PLAYER";\GOSUB 4100 261 IF Z$<>"N" THEN 280 270 OVERLAY "PONOV1.BAS"\GO TO 300 280 OVERLAY "PONOV2.BAS" 300 PRINT \PRINT \PRINT \M=FNR(10)*10\C=0 310 DIM P$(52),N$(13),S$(4) 320 FOR I=1 TO 13\READ N$(I)\NEXT I 330 DATA " ACE"," TWO","THREE"," FOUR"," FIVE"," SIX" 332 DATA "SEVEN","EIGHT"," NINE"," TEN"," JACK","QUEEN"," KING" 350 FOR I=1 TO 4\READ S$(I)\NEXT I 360 DATA "HEARTS","DIAMDS","CLUBS ","SPADES" 370 FOR I=1 TO 13\FOR J=1 TO 4 380 P$(J+4*(I-1))=STR$(I)&"\"&S$(J)&" " 390 NEXT J\NEXT I\RANDOMIZE 400 GOSUB 4000 \REM SHUFFLE 405 IF M>0 THEN 410 \PRINT \PRINT \PRINT 406 PRINT "YOU HAVE NO MONEY LEFT TO PLAY WITH."\PRINT 407 PRINT "THE HOUSE WINS. AS USUAL."\GO TO 6000 410 PRINT "YOU HAVE"M;"CENTS TO PLAY WITH."; 411 IF C<40 THEN 420 412 GOSUB 4000 420 PRINT "PLAY";\GOSUB 4100 430 IF Z$<>"N" THEN 460 440 PRINT \PRINT \PRINT "YOU RETIRE WITH"M;"CENTS TO YOUR CREDIT." 450 PRINT \PRINT "THANKS FOR THE GAME. SEE YOU AGAIN."\GO TO 6000 460 C=C+1\REM FIRST CARD 470 A=0\GOSUB 4200 \REM DEAL ONE CARD 480 GOSUB 4300 \REM SWET TO VALUE AND MARK A 490 PRINT "BET";\INPUT B 500 IF B<5 THEN 530 \IF B>M THEN 540 \IF B<>M THEN 510 502 PRINT "RISKING ALL!!!" 510 T=V\C=C+1\GOSUB 4200 \GOSUB 4300 \T=T+V\C1=2 520 PRINT "ACTION";\GOSUB 4100 \GO TO 600 530 PRINT "MINIMUM BET IS FIVE CENTS."\GO TO 490 540 PRINT "THIS HOUSE DOES NOT LEND MONEY."\GO TO 490 600 IF Z$="T" THEN 620 \IF Z$="S" THEN 690 \IF Z$="B" THEN 650 610 PRINT "PLEASE ANSWER 'T','S' OR 'B'."\GO TO 520 620 C=C+1\GOSUB 4200 \GOSUB 4300 \T=T+V\C1=C1+1 630 IF T<22 THEN 520 640 PRINT "**BUST**"\GO TO 700 650 PRINT " BUY FOR";\INPUT B1 660 IF B1<=M-B THEN 680 670 PRINT "THIS HOUSE DOES NOT LEND MONEY."\GO TO 650 680 B=B+B1\GO TO 620 690 IF T>=16 THEN 700 \IF C1>5 THEN 700 \IF A=1 THEN 696 692 PRINT "YOU CANNOT STICK ON LESS THEN 16 "; 693 GO TO 520 696 IF T>=6 THEN 700 \GO TO 692 700 PRINT \V1=V\A1=A\T1=T 1000 C=C+1\V=0\A=0 1010 GOSUB 4400 \GOSUB 4300 \C=C+1\T=V\C2=2 1020 GOSUB 4400 \GOSUB 4300 \T=T+V 1030 IF T<>11 THEN 1100 \IF A<>1 THEN 1100 \IF C2<>2 THEN 1100 1040 PRINT "**PONTOON**";|GOSUB 4000 1050 IF C1<>5 THEN 1080 \IF T1>21 THEN 1080 1055 B=B*2 1060 PRINT "YOU WIN"B;"CENTS."\PRINT 1070 M=M+B\GO TO 410 1080 PRINT " HOUSE WINS."\PRINT 1090 M=M-B\GO TO 405 1100 IF T<>21 THEN 1130 1110 IF T1<>21 THEN 1050 \IF C1<>2 THEN 1050 1120 GOSUB 4000 \GO TO 1055 1130 IF T>=16 THEN 1200 1140 C=C+1\GOSUB 4400 \GOSUB 4300 \T=T+V\C2=C2+1 1150 IF T<=21 THEN 1170 1160 GO TO 1060 1170 IF C2=5 THEN 1080 1180 GO TO 1100 1200 C=C+1\GOSUB 4300 \T2=T+V 1210 IF T2>21 THEN 1230 1220 GOSUB 4400 \T=T2\GO TO 1100 1230 PRINT " HOUSE STICKS "; 1240 IF T1>21 THEN 1080 1250 IF T1>T THEN 1060 1260 GO TO 1080 1270 IF T>21 THEN 1060 1280 GO TO 1100 1290 PRINT " HOUSE STICKS ': 1300 IF T1>21 THEN 1080 1310 IF T1>T THEN 1060 \GO TO 1080 4000 PRINT \PRINT "SHUFFLING IN PROGRESS... WAIT... "; 4010 Z1=FNR(50)\Z2=FNR(50) 4020 FOR I=1 TO Z1\FOR J=1 TO Z2 4030 Z3=FNR(52)\Z4=FNR(52) 4040 C$=P$(Z3)\P$(Z3)=P$(Z4)\P$(Z4)=C$ 4050 NEXT J\NEXT I 4060 PRINT "COMPLETED."\PRINT \C=0 4070 RETURN 4100 INPUT Z$\Z$=SEG$(Z$,1,1)\RETURN 4200 PRINT " YOU ARE DEALT "FNO(C);" OF "FNS(C); 4210 RETURN 4300 V=FNN(C)\IF V<11 THEN 4310 \V=10 4310 IF V<>1 THEN 4320 \A=1 4320 RETURN 4400 PRINT \PRINT "HOUSE IS DEALT "FNO(C);" OF "FNS(C); 4410 RETURN 5000 DEF FNS(I)=SEG$(P$(I),POS(P$(I),"\",1)+1,256) 5010 DEF FNN(I)=VAL(SEG$(P$(I),1,POS(P$(I),"\",1)-1)) 5020 DEF FNO(I)=N$(FNN(I)) 5030 DEF FNR(X)=INT(RND(1)*X+1) 6000 END 100 REM POLICY - NATIONAL POLICY FORMATION 110 REM CHANGES 18 INDICATORS IN RESPONSE TO WHICH OF THE 120 REM 14 PROPOSITIONS ARE PASSED. 130 REM COPYRIGHT 1972, STATE UNIVERSITY OF NEW YORK 140 REM S(X): VALUE OF INDICATOR X AT BEGINNING OF PERIOD 150 REM E(X): VALUE OF INDICATOR X AT END OF PERIOD 160 REM W(X): NUMBER OF POINTS TO BE USED BY GROUP X 170 REM Y(X): NUMBER OF MINUS POINTS TO BE USED BY GROUP X 180 REM Q(X): BETWEEN LINES 650 AND 1190 Q(X) IS THE NUMBER OF POINTS 190 REM FOR PROPOSITION X. AT OTHER TIMES Q(X) = 200 REM 1, IF PROPOSITION X PASSED 210 REM 0, IF PROPOSITION X DID NOT PASS 220 REM DEVELOPED BY D. KLASSEN AND J. MCGRATH 230 REM PROGRAMMED BY S. HOLLANDER AND L. OBERLANDER 240 REM LATEST REVISION 8-27-72 250 DIME(18),S(18),Q(14),W(6),Y(6) 260 FORZ=1TO18 270 READE(Z) 280 LETS(Z)=E(Z) 290 NEXTZ 300 PRINT 310 DATA 976.5,197,80,18.2,3,82 315 DATA 54,3,140,4.5,25,8.2 320 DATA 30,116.3,142,5568,20,0 330 PRINT"HOW MANY PERIODS"; 340 INPUTP1 350 LETP2=0 360 PRINT 370 PRINT 380 IFP2>0THEN410 390 PRINT"INITIAL AMOUNTS:" 400 GOTO420 410 PRINT"END OF PERIOD";P2 420 PRINT 430 PRINT 440 PRINT"INDICATOR","CURRENTLY","INCREASE","PCT. INC." 450 FORZ=1TO18 460 LETD1=INT(100*(E(Z)-S(Z)))/100 470 IFS(Z)=0THEN490 480 LETD2=100*D1/S(Z) 490 LETD2=INT(100*D2)/100 500 PRINTZ+100,INT(100*E(Z))/100; 510 IFP2=0THEN530 520 PRINT" ",D1,D2; 530 PRINT 540 NEXTZ 550 PRINT 560 PRINT 570 LETP2=P2+1 580 FORZ=1TO18 590 LETS(Z)=E(Z) 600 NEXTZ 610 FORZ=1TO6 620 LETW(Z)=100 630 LETY(Z)=50 640 NEXTZ 650 FORZ=1TO14 660 LETQ(Z)=0 670 NEXTZ 680 PRINT"TAPE?(1=YES,0=NO)"; 690 INPUTZ 700 IFZ=1THEN1900 710 IFP2>P1THEN2040 720 FORZ=1TO6 730 PRINT 740 IFZ>1THEN770 750 PRINT"BUSINESS" 760 GOTO900 770 IFZ>2THEN800 780 PRINT"LABOR" 790 GOTO900 800 IFZ>3THEN830 810 PRINT"CIVIL RIGHTS" 820 GOTO900 830 IFZ>4THEN860 840 PRINT"MILITARY" 850 GOTO900 860 IFZ>5THEN890 870 PRINT"NATIONALISTS" 880 GOTO900 890 PRINT"INTERNATIONALISTS" 900 PRINT 910 PRINT"TOTAL POINTS REMAINING : ";W(Z) 920 IFY(Z)<=W(Z)THEN940 930 LETY(Z)=W(Z) 940 PRINT"MAXIMUM MINUS POINTS : ";Y(Z) 950 PRINT"INPUT POLICY NO.,POINTS" 960 PRINT 970 INPUTA,B 980 LETA=INT(A) 990 LETB=INT(B) 1000 IFA>14THEN910 1010 IFA=0THEN1150 1020 IFB=0THEN910 1030 IFA>0THEN1080 1040 PRINT"TAPE?(1=YES,0=NO)"; 1050 INPUTG 1060 IFG=1THEN1900 1070 GOTO910 1080 IFABS(B)>W(Z)THEN910 1090 IFB>=0THEN1120 1100 IFABS(B)>Y(Z)THEN910 1110 LETY(Z)=Y(Z)+B 1120 LETQ(A)=Q(A)+B 1130 LETW(Z)=W(Z)-ABS(B) 1140 IFW(Z)>0THEN970 1150 NEXTZ 1160 PRINT 1170 PRINT"PASSED : "; 1180 LETZ2=0 1190 FORZ=1TO14 1200 IFQ(Z)<101THEN1250 1210 PRINTZ; 1220 LETZ2=1 1230 LETQ(Z)=1 1240 GOTO1260 1250 LETQ(Z)=0 1260 NEXTZ 1270 IFZ2>0THEN1300 1280 PRINT"NONE" 1290 GOTO1600 1300 PRINT 1310 PRINT 1320 FORZ=1TO14 1330 IFQ(Z)<>0THEN1370 1340 READA,B 1350 IFA<>0THEN1340 1360 GOTO1410 1370 READA,B 1380 IFA=0THEN1410 1390 LETE(A)=E(A)+B 1400 GOTO1370 1410 NEXTZ 1420 RESTORE 1430 FORZ=1TO9 1440 READA,B 1450 NEXTZ 1460 DATA1,15.2,0,0 1470 DATA1,10,8,2,9,2.25,0,0 1480 DATA1,12,2,5,9,2.25,12,-1.5,13,-5,16,-100,0,0 1490 DATA2,4,3,1,12,2,13,3,0,0 1500 DATA1,12,2,3,6,1,7,1,10,-.1,11,-.05,12,-1,13,-3,16,-50,0,0 1510 DATA1,8,2,2,3,1,6,.5,10,-.1,14,3,0,0 1520 DATA2,1,16,-100,0,0 1530 DATA1,24,2,11,4,.3,6,3,11,-.05,13,-.1,16,-500,17,-2,0,0 1540 DATA1,9,2,8,4,-1,8,1,10,-.05,11,-2,12,-1,13,-.05,16,-300,17,-3,0,0 1550 DATA1,-8,2,-10,3,-30,5,1,6,-4,7,4,10,.25,13,1,14,-2,0,0 1560 DATA1,2,2,.5,6,-2,7,5,8,-1,14,1,15,-15,17,-1,0,0 1570 DATA1,4,2,2,3,2,6,.5,15,3,0,0 1580 DATA1,10,6,5,7,3,14,-4,0,0 1590 DATA1,3,2,1,5,1,0,0 1600 IFE(1)<>S(1)THEN1620 1610 LETE(1)=1.04*E(1) 1620 IFE(2)<>S(2)THEN1640 1630 LETE(2)=E(2)+1 1640 IFE(3)<>S(3)THEN1660 1650 LETE(3)=.99*E(3) 1660 IFE(4)<>S(4)THEN1680 1670 LETE(4)=E(4)*.99 1680 IFE(5)<>S(5)THEN1700 1690 LETE(5)=.9*E(5) 1700 IFE(8)<>S(8)THEN1720 1710 LETE(8)=1.01*E(8) 1720 IFS(1)=0THEN1750 1730 IF(E(1)-S(1))/S(1)<.04THEN1750 1740 LETE(10)=1.015*E(10) 1750 IFE(11)<>S(11)THEN1770 1760 LETE(11)=.99*E(11) 1770 IFE(12)<>S(12)THEN1810 1780 IFS(1)=0THEN1810 1790 IF(E(1)-S(1))/S(1)<.04THEN1810 1800 LETE(12)=1.03*E(12) 1810 IFE(13)<>S(13)THEN1830 1820 LETE(13)=.98*E(13) 1830 IFE(14)<>S(14)THEN1850 1840 LETE(14)=1.04*E(14) 1850 IFE(15)<>S(15)THEN1870 1860 LETE(15)=1.1*E(15) 1870 IFE(16)<>S(16)THEN360 1880 LETE(16)=1.18*E(16) 1890 GOTO360 1900 PRINT 1910 PRINT" " 1920 FORL=0TO12STEP6 1930 IFL>0THEN1960 1940 PRINT"310"; 1950 GOTO2000 1960 IFL>6THEN1990 1970 PRINT"315"; 1980 GOTO2000 1990 PRINT"320"; 2000 PRINT"DATA"; 2005 FORZ=L+1TOL+5 2010 PRINTE(Z);","; 2015 NEXTZ 2020 PRINTE(L+6) 2025 NEXTL 2030 PRINT 2035 PRINT 2040 END 100 REM PROGRAM TO PRODUCE FORMATTED LISTINGS. LIST.BAS 110 REM COPYWRITE DANNY O'MARA MARCH 1977 200 PRINT \PRINT \PRINT \PRINT 210 PRINT "BASIC/RT11 SOURCE LISTING PROGRAM."\PRINT 220 PRINT "TYPE'H' FOR HELP IF REQUIRED."\PRINT \PRINT 230 PRINT "DEFINE INPUT AND DIRECTORY FILESPEC"; 240 INPUT Z$\A=POS(Z$,":",1) 250 IF A=0 THEN 260 \D$=SEG$(Z$,1,A)\GO TO 270 260 IF SEG$(Z$,1,1)="H" THEN 5000 \D$="SY:"\GO TO 350 270 D1$=SEG$(D$,1,2) 280 DATA "SY","DK","CT","DP","DS","DT","DX","RF","RK" 300 FOR I=1 TO 9\READ D2$ 310 IF D1$=D2$ THEN 330 \NEXT I 320 PRINT "INVALID DEVICE."\GO TO 230 330 IF LEN(D$)<>4 THEN 350 \A=VAL(SEG$(D$,3,3)) 340 IF A<8 THEN 350 \GO TO 320 350 A=A+1\Z$=SEG$(Z$,A,256)\REM REST OF IP STRING 355 IF LEN(Z$)<>0 THEN 360 \D$=D$&"RT11.DIR"\X1=1\GO TO 510 360 A=POS(Z$,"/",1)\X1=1 370 IF A=0 THEN 430 380 Z1$=SEG$(Z$,A+1,A+1) 390 IF Z$="N" THEN 410 400 PRINT "INVALID SWITCH."\GO TO 230 410 X1=0\REM MARK NO DIRECTORY FILE 420 GO TO 510 430 A=POS(Z$,".",1) 440 IF A<>0 THEN 480 450 Z1$=SEG$(Z$,1,6) 460 IF LEN(Z1$)<7 THEN 470 \PRINT "INVALID FILE."\GO TO 230 470 D$=D$&Z1$&".DIR"\GO TO 510 480 Z1$=SEG$(Z$,1,A+3) 490 IF Z1$=Z$ THEN 500 \PRINT "INVALID EXTENSION."\GO TO 230 500 D$=D$&Z$ 510 PRINT D$;" WILL BE USED" 520 PRINT "DEFINE LISTING (OUTPUT) FILESPEC"; 530 INPUT Z$\IF SEG$(Z$,1,1)="H" THEN 5000 540 X2=0\REM IMMEDIATE MARKER 550 IF Z$<>"" THEN 560 \X2=1\O$="TT:"\GO TO 810 560 Z1$=SEG$(Z$,1,3) 570 IF Z$="TT:" THEN 690 590 IF Z$="LP:" THEN 690 600 A=POS(Z$,":",1) 610 IF A=0 THEN 680 620 RESTORE \Z1$=SEG$(Z$,1,2) 630 FOR I=1 TO 9\READ Z2$\IF Z1$=Z2$ THEN 650 640 NEXT I\PRINT "INVALID DEVICE."\GO TO 520 650 IF A<>4 THEN 670 660 IF VAL(SEG$(Z$,3,3))<8 THEN 670 \PRINT "INVALID DEVICE."\GO TO 520 670 O$=SEG$(Z$,1,A)\GO TO 700 680 O$="SY:"\GO TO 700 690 O$=Z1$\X2=1\GO TO 810 700 A=A+1\Z1$=SEG$(Z$,A,20) 710 IF Z1$="" THEN 800 720 IF POS(Z1$,".",2)=0 THEN 780 730 A=POS(Z1$,".",2) 740 IF A<7 THEN 750 \PRINT "INVALID FILE."\GO TO 520 750 IF LEN(Z1$)-A>3 THEN 770 760 O$=O$&Z1$\GO TO 810 770 PRINT "INVALID FILE."\GO TO 520 780 IF LEN(Z1$)>6 THEN 770 790 O$=O$&Z1$&".LST"\GO TO 810 800 O$=O$&"LIST.LST" 810 PRINT O$;" WILL BE USED" 820 PRINT "DEFINE PAGE LENGTH IN LINES"; 830 INPUT L$\L=VAL(L$)\IF L<>0 THEN 840 \L=66\GO TO 880 840 IF L>19 THEN 860 850 PRINT "TOO SMALL"\GO TO 820 860 IF L<201 THEN 880 870 PRINT "TOO LARGE."\GO TO 820 880 RESTORE \PRINT "DEFINE NUMBER OF FILLS";\INPUT B$ 881 B=VAL(B$) 882 IF B<15 THEN 885 \PRINT "TOO LARGE"\GO TO 880 885 OPEN "LIST" FOR OUTPUT AS FILE VF1$(200)=16 890 N=0 895 I$=SEG$(D$,1,POS(D$,":",1)) 900 PRINT "FILES";\INPUT Z$ 910 IF Z$<>"" THEN 940 920 IF N<>0 THEN 1350 930 PRINT "WHAT NO FILES?"\CLOSE \STOP 940 IF POS(Z$,".",1)<>0 THEN 960 950 VF1(N)=Z$&".BAS"\N=N+1\GO TO 900 960 IF POS(Z$,"*",1)<>0 THEN 990 970 IF POS(Z$,"?",1)<>0 THEN 990 980 VF1(N)=Z$\N=N+1\GO TO 900 990 A=POS(Z$,"*",1) 1000 IF A=0 THEN 1040 1010 IF A<>1 THEN 1030 1020 Z$="??????"&SEG$(Z$,2,7)\GO TO 990 1030 Z$=SEG$(Z$,1,A-1)&"???"&SEG$(Z$,A+1,10) 1040 A=POS(Z$,".",1) 1050 IF A=7 THEN 1090 1060 FOR I=1 TO 7-A\REM PAD FILEN WITH SPACES 1070 Z$=SEG$(Z$,1,A-1)&" "&SEG$(Z$,A,12) 1080 NEXT I 1090 A=POS(Z$,"/Q",1) 1100 IF A=0 THEN 1120 \REM MARK /Q 1110 Z$=SEG$(Z$,1,10)\Q=1\GO TO 1130 1120 Q=0 1130 IF X1<>0 THEN 1160 1140 PRINT "NO DIRECTORY FILE--WILD CARDS NOT ALLOWED." 1150 GO TO 900 1160 OPEN D$ FOR INPUT AS FILE #1 1170 IF END #1 THEN 1300 1180 INPUT #1:A$ 1190 A=POS(A$,".",1) 1200 A=A+3\A$=SEG$(A$,1,A)\REM A DIR FILE 1210 FOR I=1 TO 10 1220 IF SEG$(Z$,I,I)="?" THEN 1240 1230 IF SEG$(Z$,I,I)<>SEG$(A$,I,I) THEN 1170 1240 NEXT I 1250 IF Q=0 THEN 1280 1260 PRINT A$;\INPUT Z1$ 1270 IF SEG$(Z1$,1,1)<>"Y" THEN 1170 1280 VF1(N)=A$\N=N+1\GO TO 1170 1300 CLOSE #1\GO TO 900 1350 CLOSE VF1 1400 IF X2=0 THEN 1450 1410 PRINT "SET OUTPUT IF LP TO TOP OF FORM" 1420 PRINT "SET OUTPUT IF TT TO BOTTOM OF FORM" 1430 PRINT "TYPE WHEN DONE."; 1440 INPUT A$ 1450 P=1 1460 P1=1 1470 M=0 1480 OPEN "LIST" FOR INPUT AS FILE VF1$(200)=16 1490 OPEN O$ FOR OUTPUT AS FILE #1 1500 FOR I=0 TO N-1 1510 C$=SEG$(D$,1,POS(D$,";",1))&VF1(I) 1515 P$=SEG$(C$,1,POS(C$,".",1)+3) 1520 OPEN P$ FOR INPUT AS FILE #2 1540 PRINT #1:\PRINT #1: 1545 FOR J=1 TO B\PRINT #1:" ";\NEXT J 1550 PRINT #1:"BASIC/RT11 LISTING PAGE"P;" "DAT$ 1554 PRINT #1: 1555 FOR J=1 TO B\PRINT #1:" ";\NEXT J 1560 PRINT #1:"LISTING OF "C$;" PAGE"P1 1570 PRINT #1:\PRINT #1:\PRINT #1:\M=9 1580 IF END #2 THEN 1640 1590 INPUT #2:Z$\FOR J=1 TO B\PRINT #1:" ";\NEXT J 1600 PRINT #1:Z$\M=M+1 1610 IF L-M<>4 THEN 1580 1620 PRINT #1:\PRINT #1:\PRINT #1:\PRINT #1: 1621 PRINT #1: 1630 P=P+1\P1=P1+1\GO TO 1540 1640 CLOSE #2 1650 FOR J=1 TO L-M+1\PRINT #1:\NEXT J 1660 P1=1\P=P+1\NEXT I 1670 CLOSE #1 1680 CLOSE VF1 1690 GO TO 6000 5000 PRINT \PRINT 5010 OPEN "LIST.HLP" FOR INPUT AS FILE #1 5020 IF END #1 THEN 5040 5030 INPUT #1:Z$\PRINT Z$\GO TO 5020 5040 CLOSE #1\PRINT \GO TO 230 6000 END . :hH`((`@z((.=t(G(`(z(a8}.```za(}=t#S'P;.HHsHGHG&`((hG(hM`(hh~@G7 tAh~ a8}ta8}' :l  a(},a(}7pS pSm >a(}7a8}a(}7a8}$,    Su~"(, S\ S0 ,?T  Ha(}G a8}8,6  yp cr d    65Kd :`" u~" i;R ,?T ;& y:} G(ii j ii zj iS4 a8}:`" a8}i;R ^&&i hj ii Vj ii &6 a8}&;&  a8}0y:} a8}6*DLj i-j ii Bji-4  S a8}65Kd".fj ii 8ji-j il6S  a8}6d S&a,i &ji-j ii j6 a8}6crS a8}6"ypU&i-j ii ji.S a8}6.u~"hH`((`@z((.=t(G(`(z(a8}.```za(}=t#S'P;G(u~"hY{~@G7 {~ a8}aa8}'u~"  a(},a(}7SIa8}a(}3a8}(    S u~"G * SX SX S a(}a(}G &a8}.6 :E u~" i;R .@Q u~; G(ii j ii tj i+4 a8}i;R a8}.@Q i*&i jj ij' i w0jww0 a8}"u~;  S"a(} &H&je&j0jwfjEejiO4a(}  a(} a(} a(} 0ffjj @j fj &ji\4a(} S Sa(}a(} &$\j ifjifj7j n2a(}a(}a(}a(}(,i\jAjBB @7j ii n2 a(} Sa(}  $a8}($(Dj ifj 7j i\jA 0:E a(}a(} a(}*jBB @7j ii Dj ie0 Sa(} a8}(:E \jiefj i"a(} a(}.,?ThH`((`@z((.=t(G(`(z(a8}.```za(}=t#S'P;G(,?Th#{~@G7 {~ a8}aa8}',?T  a(},a(}7SIa8}a(}7a8} $   S\ S0 ,?Ta(} G ta8} ,?T ;& G0jj' j wdjwZjeGZj-2 Sa(}"a(}(a(}/,.djwjEej jjj @4a(}a(} a(}S&Rj j Zj jj pj 2 S^ a(}a(} a8} ;& pj .:hH`((`@z((.=t(G(`(z(a8}.```za(}=t#S'P;G(:hD{~@G7 {~ a8}aa8}':  a(},a(}7a8}a(}3a8}   a(}G La8} : :E qG2.kLk k.kDk zk5.ku4 a8}:E a8}: *.$0 607 *" N     l ' w@w>e82w*Ee+  @   7 A BB @7 f v Z 7 JA BB @7 . > "ered 7 ' wJwHeGB<w6Ee+  & @   $ 7 .< zB 5fF n r7 Nf{*p"  f&& e {+ߕ+:?SYSLIB-F-Interrupt overrun &f&& VVVrd :N$v, u~"Nv P,?T^$":j868:100 REM PROGRAM TO PLAY PONTOON (BLACKJACK OR WHATEVER) PONTN.BAS 110 PRINT \PRINT \PRINT \PRINT "PLAY PONTOON WITH D.E.C. RT11 BASIC." 120 PRINT \PRINT "IT IS ASSUMED THAT YOU KNOW HOW TO PLAY THE GAME OF PONTOON." 130 PRINT "BUT DO YOU KNOW HOW TO OPERATE THIS PROGRAM"; 140 INPUT Z$\Z$=SEG$(Z$,1,1) 150 IF Z$="" THEN 260 \IF Z$="Y" THEN 260 160 PRINT \PRINT "THE COMPUTER WILL ALLOCATE YOU A RANDOM SUM OF MONEY" 170 PRINT "TO START WITH. THE MINIMUM BET FOR START OR BUYING A CARD" 180 PRINT "IS FIVE CENTS." 190 PRINT "TO PLAY ANSWER THE QUESTION 'PLAY?' WITH 'Y' OR ." 200 PRINT "TO RETIRE ANSWER THIS QUESTION WITH 'N'." 210 PRINT "TO ANSWER THE QUESTION 'ACTION?' TYPE 'T' FOR TWIST," 220 PRINT "'S' FOR STICK OR 'B' TO BUY A CARD." 230 PRINT "YOU MAY ANSWER THE QUESTIONS 'BET?' AND 'BUY FOR?' WITH" 240 PRINT "ANY AMOUNT IN CENTS THAT YOU CAN AFFORD." 250 PRINT \PRINT "GOOD LUCK!" 260 PRINT "DO YOU CONSIDER YOURSELF A GOOD PLAYER";\GOSUB 4100 261 IF Z$<>"N" THEN 280 270 OVERLAY "PONOV1.BAS"\GO TO 300 280 OVERLAY "PONOV2.BAS" 300 PRINT \PRINT \PRINT \M=FNR(10)*10\C=0 310 DIM P$(52),N$(13),S$(4) 320 FOR I=1 TO 13\READ N$(I)\NEXT I 330 DATA " ACE"," TWO","THREE"," FOUR"," FIVE"," SIX" 332 DATA "SEVEN","EIGHT"," NINE"," TEN"," JACK","QUEEN"," KING" 350 FOR I=1 TO 4\READ S$(I)\NEXT I 360 DATA "HEARTS","DIAMDS","CLUBS ","SPADES" 370 FOR I=1 TO 13\FOR J=1 TO 4 380 P$(J+4*(I-1))=STR$(I)&"\"&S$(J)&" " ";\GOSUB 4100 261 IF Z$<>"N" THEN 280 2711)=O THEN 69 55 IF W>0 THEN 58 56 PRINT "SO MY POINT IS";S; 57 GO TO 59 58 PRINT "SO YOUR POINT IS";S; 59 PRINT ".....LET'S ROLL 'EM AGAIN....." 60 LET P=S 61 GO TO 44 62 PRINT "AND CRAP OUT..." 63 LET C=1 64 IF W>0 THEN 67 65 LET Z=Z+B 66 GO TO 75 67 LET Z=Z-B 68 GO TO 75 69 PRINT "AND PASS....." 70 LET C=1 71 IF W>0 THEN 74 72 LET Z=Z-B 73 GO TO 75 74 LET Z=Z+B 75 PRINT 76 IF Z<1 THEN 104 77 PRINT "YOU NOW HAVE ";Z;"DOLLARS LEFT....." 78 IF C>0 THEN 81 79 PRINT "CHANGE DICE NOW....." 80 PRINT 81 LET W=W*C 82 LET Q=0 83 GO TO 32 84 IF S<>7 THEN 92 85 PRINT "AND LOSE....." 86 LET C=-1 87 IF W>0 THEN 90 88 LET Z=Z+B 89 GO TO 75 90 LET Z=Z-B 91 GO TO 75 92 IF S=P THEN 95 93 PRINT "...ROLL AGAIN....." 94 GO TO 44 95 IF W>0 THEN 100 96 PRINT "AND MAKE MY POINT....." 97 LET C=1 98 LET Z=Z-B 99 GO TO 75 100 PRINT "AND MAKE YOUR POINT....." 101 LET C=1 102 LET Z=Z+B 103 GO TO 75 104 PRINT 10RINT "SPINNING" 1810 PRINT 1820 PRINT 1830 S=INT(RND(0)*100) 1840 IF S=0 THEN 1830 \IF S>38 THEN 1830 1850 X(S)=X(S)+1 1860 IF S<37 THEN 1920 1870 IF S=37 THEN 1900 1880 PRINT "00" 1890 GO TO 2020 1900 PRINT "0" 1910 GO TO 2020 1920 RESTORE 1930 FOR I=1 TO 18 1940 READ R 1950 IF R=S THEN 2000 1960 NEXT I 1970 A$="BLACK" 1980 PRINT S;A$ 1990 GO TO 2020 2000 A$="RED" 2010 GO TO 1980 2020 PRINT 2030 FOR C=1 TO Y 2040 IF T(C)<37 THEN 2710 2050 ON T(C)-36 GOTO 2090,2190,2220,2250,2300,2350,2400,2470,2500,2530,2560,2630 2070 GO TO 2710 2080 STOP 2090 REM 1-12(37) 2:1 2100 IF S<=12 THEN 2150 2110 PRINT "YOU LOSE"B(C)"DOLLARS ON BET"C 2120 D=D+B(C) 2130 P=P-B(C) 2140 GO TO 2180 2150 PRINT "YOU WIN"B(C)*2"DOLLARS ON BET"C 2160 D=D-B(C)*2 2170 P=P+B(C)*2 2180 GO TO 2810 2190 REM 13-24(38) 2:1 2200 IF S>12AND S<25 THEN 2150 2210 GO TO 2110 2220 REM 25-36(39) 2:1 2230 IF S>24AND S<37 THEN 2150 2240 GO TO 2110 2250 REM FIRST COLUMN(40) 2:1 2260 FOR I=1 TO 34 STEP 3 2270 IF S=I THEN 2150 2280 NEXT I 2290 GO TO 2110 2300 REM SECOND COLUMN(41) 2:1 2310 FOR I=2 TO 35 STEP 3 2320 IF S=I THEN 2150 2330 NEXT I 2340 GO TO 2110 2350 REM THIRD COLUMN(42) 2:1 2360 FOR I=3 TO 36 STEP 3 2370 IF S=I THEN 2150 2380 NEXT I 2390 GO TO 2110 2400 REM 1-18(43) 1:1 2410 IF S<19 THEN 2430 2420 GO TO 2110 2430 PRINT "YOU WIN"B(C)"DOLLARS ON BET"C 2440 D=D-B(C) 2450 P=P+B(C) 2460 GO TO 2810 2470 REM 19-36(44) 1:1 2480 IF S<37AND S>18 THEN 2430 2490 GO TO 2110 2500 REM EVEN(45) 1:1 2510 IF S/2=INT(S/2)AND S<37 THEN 2430 2520 GO TO 2110 2530 REM ODD(46) 1:1 2540 IF S/2<>INT(S/2)AND S<37 THEN 2430 2550 GO TO 2110 2560 REM RED(47) 1:1 2570 RESTORE 2580 FOR I=1 TO 18 2590 READ R 2600 IF S=R THEN 2430 2610 NEXT I 2620 GO TO 2110 2630 REM BLACK(48) 1:1 2640 RESTORE 2650 FOR I=1 TO 18 2660 READ R 2670 IF S=R THEN 2110 2680 NEXT I 2690 IF S>36 THEN 2110 2700 GO TO 2430 2710 REM--1TO36,0,00(1-36,49,50)35:1 2720 IF T(C)<49 THEN 2760 2730 IF T(C)=49AND S=37 THEN 2780 2740 IF T(C)=50AND S=38 THEN 2780 2750 GO TO 2110 2760 IF T(C)=S THEN 2780 2770 GO TO 2110 2780 PRINT "YOU WIN"B(C)*35"DOLLARS ON BET"C 2790 D=D-B(C)*35 2800 P=P+B(C)*35 2810 NEXT C 2820 PRINT 2830 PRINT "TOTALS:","ME","YOU" 2840 PRINT " ",D,P 2850 IF P>0 THEN 2880 2860 PRINT "OOPS! YOU JUST SPENT YOUR LAST DOLLAR" 2870 GO TO 3190 2880 IF D>0 THEN 2920 2890 PRINT "YOU BROKE THE HOUSE!" 2900 P=101000 2910 GO TO 2960 2920 PRINT "AGAIN"; 2930 INPUT Y$ 2940 IF Y$="Y" THEN 1630 2950 DATA 1,3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36 2960 IF P<1 THEN 3190 2970 PRINT "TO WHOM SHALL I MAKE OUT THE CHECK"; 2980 INPUT B$ 2990 PRINT 3000 PRINT "--------------------------------------------------------------------" 3010 PRINT TAB(50)"CHECK NO. ";INT(RND(0)*100) 3020 PRINT 3040 PRINT TAB(40);DATE$(0) 3050 PRINT 3060 PRINT 3070 PRINT "PAY TO THE ORDER OF-----";B$;"-----$ "; 3080 PRINT P 3090 PRINT 3100 PRINT 3110 PRINT TAB(10),"THE MEMORY BANK OF VIRGINIA" 3120 PRINT 3130 PRINT TAB(40),"THE COMPUTER" 3140 PRINT TAB(40)"----------X-----" 3150 PRINT 3160 PRINT "--------------------------------------------------------------" 3170 PRINT "COME BACK SOON!" 3180 GO TO 3210 3190 PRINT "THANKS FOR YOUR MONEY" 3200 PRINT "I'LL USE IT TO BUY A SOLID GOLD ROULETTE WHEEL" 3210 PRINT 3220 GO TO 3420 3420 END "PAY TO THE ORDER OF-----";B$;"-----$ "; 3080 PRINT P 3090 PRINT 3100 PRINT 3110 PRINT TAB(10),"THE MEMORY BANK OF VIRGINIA" 3120 PRINT 3130 PRINT TAB(40),"THE COMPUTER" 3140 PRINT TAB(40)"----------X-----" 3150 PRINT 3160 PRINT "--------------------------------------------------------------" 3170 PRINT "COME BACK SOON!" 3180 GO TO 3210 3190 PRINT "THANKS FOR YOUR MONEY" 3200 PRINT "I'LL USE IT TO BUY A SOLID GOLD ROULETTE WHEEL" 3210 PRI2690 LET U2=U2-1 2700 GOSUB 3520 2710 GOTO 2600 2720 PRINT "PUNT" 2730 LET M=8 2740 RETURN 2750 PRINT "GO FOR IT" 2760 RETURN 2770 IF X<4 THEN 2830 2780 IF P(1)=P(2) THEN 2830 2790 PRINT "THE GAME IS OVER" 2800 PRINT "FINAL "; 2810 GOSUB 2120 2820 STOP 2830 PRINT "END OF PERIOD";X 2840 GOSUB 2120 2850 LET F=1-F 2860 GOSUB 3520 2870 LET C=900 2880 LET X=X+1 2890 IF F<>0 THEN 810 2900 LET S=3-K 2910 GOTO 580 2920 IF T1=0 THEN 2770 2930 PRINT "2 MINUTE WARNING" 2940 GOSUB 3520 2950 LET T1=0 2960 LET C=120 2970 GOTO 880 2980 LET B1=B+10 2990 IF B1<=100 THEN 3010 3000 LET B1=100 3010 RETURN 3020 LET Q=1.3*(A*RND(0)-1)-.06 3030 LET A=1 3040 IF Q>=0 THEN 3070 3050 LET A=0 3060 LET Q=-Q 3070 LET M1=M-1 3080 LET G=D(A,M1)+FNT(Q)*(D(2,M1)-D(A,M1))/3.5 3090 LET G=G+INT(RND(0)+.02)*A*100*RND(0) 3100 LET G=INT(G) 3110 RETURN 3120 LET D=D+1 3130 IF D=5 THEN 3240 3140 IF D<> 1 THEN 3160 3150 PRINT "1ST"; 3160 IF D<>2 THEN 3180 3170 PRINT "2ND"; 3180 IF D<>3 THEN 3200 3190 PRINT "3RD"; 3200 IF D<4 THEN 3220 3210 PRINT "4TH"; 3220 PRINT " AND";B1-B;" "; 3230 GOTO 810 3240 LET S=3-S 3250 LET B=100-B 3260 IF S=2 THEN 770 3270 PRINT "MY "; 3280 GOTO 780 3290 PRINT "BALL ON "; 3300 IF B=50 THEN 3400 3310 LET V=50-ABS(B-50) 3320 LET C=C-INT(7+3*RND(0)) 3330 IF S=1 THEN 3420 3340 IF B<50 THEN 3370 3350 PRINT "MY "; 3360 GOTO 3380 3370 PRINT "YOUR "; 3380 PRINT V 3390 RETURN 3400 PRINT "THE 50" 3410 RETURN 3420 IF B<50 THEN 3350 3430 GOTO 3370 3440 IF S=2 THEN 3470 3450 PRINT "YOU"; 3460 GOTO 3480 3470 PRINT "I"; 3480 PRINT " KICK OFF." 3490 LET F2=.06 3500 LET Z2=0 3510 RETURN 3520 LET L=0 3530 PRINT "TIMEOUT CALLED..." 3540 PRINT 3550 RETURN 3560 IF U=0 THEN 3600 3570 LET U=U-1 3580 GOSUB 3520 3590 GOTO 3610 3600 PRINT "..WRONG, TRY AGAIN" 3610 INPUT A 3620 IF ABS(INT(A))>17 THEN 3600 3630 LET Q=R(INT(ABS(A))) 3640 IF Q=0 THEN 3600 3650 IF Q=100 THEN 3560 3660 RETURN 3670 DATA .5,-2,.25,4,.5,13,.55 3680 DATA .4,-2,.3,7,.65,15,.75 3690 DATA .4,-2,.3,6,.6,15,.35 3700 DATA .65,-2,.65,6,.6,17,.9 3710 DATA .4,2,.7,10,.4,27,.2 3720 DATA .1,19,.4,35,.2,100,.1 3730 END LED..." 3540 PRINT 3550 RETURN 3560 IF U=0 THEN 3600 3570 LET U=U-1 3580 GOSUB 3520 3590 GOTO 3610 3600 PRINT "..WRONG, TRY AGAIN" 3610 INPUT A 3620 IF ABS(INT(A))>17 THEN 3600 3630 LET Q=R(INT(ABS(A))) length : byte; opcode : byte; success : byte; unit : byte; unused : byte; sequence : word; byte_count : word; summary : word; checksum : word end;{record} { Command packet format }" command_packet = packed record" flag : byte;" length : byte;" opcode : byte;" modifier : byte;" unit : byte;" switches : byte;" sequence : word;" byte_count : word;" block : word;! checksum : word end;{record} { Full data packet }1 full_packet = tu58_packet(full_packet_bytes); rec_region = record$ owned : boolean; mrsp : boolean; get_buff : integer; put_buff : integer;0 rec_struc : array [0..1] of buff_struc; end; { record } xmt_region = record powerfail : boolean; owned : boolean; pointer : integer; packet_length : integer;. c_packet : string(full_packet_size); end; { record } buff_struc = record$ pointer : integer;$ packet_length : integer;5 c_packet : string(full_packet_size); end; { record } rx_region_ptr = ^rec_region; tx_region_ptr = ^xmt_region;3 transmit_status_register = [long] packed record) break : boolean;2 int_ena : [pos(6)] boolean;2 ready : [pos(7)] boolean; end;{record}2 receive_status_register = [long] packed record2 int_ena : [pos(6)] boolean;2 done : [pos(7)] boolean; end;{record} tu58_structure = record unit : integer; end;) tu58_structure_ptr = ^tu58_structure; var { Device stuff } tu58_transmit : device; tu58_receive : device; rx_region : rx_region_ptr; tx_region : tx_region_ptr; tu58_priority : integer; { Misc. stuff }E this_process : process; {token for unit processes}= tu58_mutex : mutex; {controller mutex}) controller_name : varying_string(8);) universal_name : varying_string(8);: init_event : event; {a dummy event} file_service_ptr : ^anytype; allocate_status : integer; PROGRAM dddriver;{++{{ This is the TU58 driver{{--}VAR unit : byte; cstat : boolean;beginM eln$allocate_stack ( 4 * 512, status := allocate_status ); { four pages }- controller_name := program_argument( 1 );- universal_name := program_argument( 2 );$ create_device ( controller_name," tu58_transmit, vector_number := 2,< service_routine := tu58_transmit_interrupt,. powerfail_routine := tu58_xmt_powerfail,. region := tx_region,4 priority := tu58_priority );$ create_device ( controller_name, tu58_receive, vector_number := 1,; service_routine := tu58_receive_interrupt,. powerfail_routine := tu58_rec_powerfail,0 region := rx_region );C { Now that the devices are created, initialize the controller } initialize_controller;5 { Initialize the job wide file service database }8 file_service_ptr := eln$file_initialize ( tu58_open, tu58_get, tu58_put, tu58_close );) { Create a mutex for the controller } create_mutex ( tu58_mutex ); { Create a dummy event }/ create_event ( init_event, event$cleared );6 { For each unit create the actual driver process } for unit := 0 to 1 do begin% create_process (this_process, tu58_process, unit, init_event ); wait_any ( init_event ); clear_event ( init_event ) end; { Complete initialization } initialization_done;4 { Sit and wait on something that won't happen so" subprocesses don't go away } wait_any ( this_process );end; ?interrupt_service tu58_transmit_interrupt ( xregist : ^anytype;# region : tx_region_ptr );{++<{ tu58_transmit_interrupt : device interrupt service routine{F{ This is the transmit interrupt service routine for the tu58 driver.{@{ Inputs : region - pointer to the communications region{{ Outputs : none{{--}var xmt : long_word_byte;begin with region^ do { Are we done? }' if pointer = packet_length then beginJ { All done so turn off the transmitter and signal the device } xmt.long := 0;$ mtpr ( csts, xmt.long ); owned := false; signal_device end else begin< { Bump up the pointer and output the next byte }# pointer := pointer + 1; xmt.long := 0;: xmt.byte1::char := substr(c_packet,pointer,1);$ mtpr ( cstd, xmt.long ); endend; =interrupt_service tu58_receive_interrupt ( xreg : ^anytype;! region : rx_region_ptr );{++;{ tu58_receive_interrupt : device interrupt service routine{E{ This is the receive interrupt service routine for the tu58 driver.{<{ Inputs : region - pointer to the communications region{{ Outputs : none{{--}var rec, xmt : lonKN$ELN023.A(U#h [KITBUILD.INSTALL]DDDRIVER.PAS;1tXE;1N99"g_word_byte;begin0 with region^, region^.rec_struc[put_buff] do begin { Read the input character }" rec.long := mfpr ( csrd ); { if MRSP, send ack byte } xmt.long := 0; xmt.byte1 := continue; mtpr ( cstd, xmt.long ); { Input expected? } if owned then begin6 { Bump up the pointer and store the byte }# pointer := pointer + 1;: substr(c_packet,pointer,1) := rec.byte1::char;I { if this is the first byte, determine the type of response }0 if pointer = 1 then*! case rec.byte1 of*A { Allow (initially) for a full sized packet }6F data, control : packet_length := size(full_packet)6 otherwise packet_length := 1 end;{case}9 { The second byte gives us the actual count }r if pointer = 2 thene> packet_length := size(tu58_packet(rec.byte1)); + if pointer = packet_length then  begin  6 { Swap buffers and signal the device } get_buff := put_buff;_% put_buff := ( put_buff + 1 ) mod 2;# rec_struc[put_buff].pointer := 0;  signal_device  endt end elsen begin { disable interrupts }r rec.long := 0;$ mtpr ( csrs, rec.long ); end end {with}end; 9interrupt_service tu58_xmt_powerfail ( xreg : ^anytype;e$ region : tx_region_ptr );{++ {l8{ This is the transmit device powerfail recovery routine{ { Inputs: { &{ Standard interrupt service arguments{; { Outputs:{ :{ Controller initialized and any waiting process signalled{ {--}begin reset_controller;u with region^ doe begin powerfail := true;e pointer := 0; if owned then signal_device;i end;eend; 9interrupt_service tu58_rec_powerfail ( xreg : ^anytype;$ region : rx_region_ptr );{++ {f7{ This is the receive device powerfail recovery routineo{n { Inputs:s{&{ Standard interrupt service arguments{{ { Outputs:{x{ Any waiting process signalledg{r{--}beginn with region^ dog begin put_buff := 0;t get_buff := 1; " rec_struc[put_buff].pointer := 0; if owned then signal_device;a end;uend; r procedure initialize_controller;{++h{i7{ This procedure will perform controller initialization{ {--}begina% disable_interrupt ( ipl$_power );4 reset_controller;a enable_interrupt;e with rx_region^ do begin mrsp := true; put_buff := 0;a get_buff := 0;m" rec_struc[put_buff].pointer := 0; end;t tx_region^.pointer := 0;end; sprocedure reset_controller;{++ { N{ This is the TU58 controller initialization module. It will send out a BREAKH{ signal for one character time followed by 2 INIT characters. The TU58M{ responds to the second INIT with a CONTINUE character and is then ready forl{ normal operations.{ {--}varv* xmt_status : transmit_status_register; xmt_data : long_word_byte;) rec_status : receive_status_register;= rec_data : long_word_byte; i : integer;rbegin xmt_status :: integer := 0;e xmt_status.break := true; ) mtpr ( csts, xmt_status :: integer );n xmt_data.long := 0;s$ { Send two nulls while we wait } for i := 1 to 2 do begin  repeat2 xmt_status :: integer := mfpr ( csts ) until xmt_status.ready;n# mtpr( cstd, xmt_data.long )u end; 7 { Clear the status register to turn off the break }e xmt_status :: integer := 0;h) mtpr ( csts, xmt_status :: integer ); ' { Now send the two required INITs }r xmt_data.byte1 := init; for i := 1 to 2 do begin  repeat3 xmt_status :: integer := mfpr ( csts );e until xmt_status.ready; * mtpr ( cstd, xmt_data :: integer ) end;; { Read the receiver status } repeat. rec_status :: integer := mfpr ( csrs ) until rec_status.done;# rec_data.long := mfpr ( csrd );8$ { Turn off receiver interrupts } rec_status :: integer := 0;p) mtpr ( csrs, rec_status :: integer );eend; t(function get_checksum ( psize : integer;? var pack : tu58_packet(psize) ) : word; {++i{ 6{ This procedure will compute the checksum of a packet{n{--}type ck = [long] packed recordy case boolean of ) true : ( int : [long] integer );}$ false : ( word1 : [word] word; word2 : [word] word );  end; { record } / tu58_word_packet(n:integer) = packed record  flag : byte;  length : byte;() buff : packed array [1..n] of wordl end; { record }lvar csum : ck;  i : integer; ch : char;  word_length : integer;begin}3 { Initialize checksum to first word in packet }., csum.int := pack.flag + 256*pack.length;C { Compute the number of words in the message part of the pack } % word_length := pack.length div 2;v5 {with x as pack::tu58_word_packet(word_length) do  begin}r for i := 1 to word_length dor beginH csum.int := csum.int + pack::tu58_word_packet(word_length).buff[i];+ csum.word1 := csum.word1 + csum.word2; csum.word2 := 0 end;  if odd(pack.length) thenn begin, ch := substr(pack.pbuff,pack.length,1);$ csum.int := csum.int + ord(ch);* csum.word1 := csum.word1 + csum.word2 end; { if } {end;} { with } get_checksum := csum.intend; {-procedure send_packet ( psize : integer;b# var packet : byte_data(psize) );.{++{/{ This procedure transmits a packet to the TU58{ { Inputs: {p{ packet size and the packet{e { Outputs:{ { packet sent to tu58{ {--}vars- xmt : transmit_status_register; begin repeat tx_region^.powerfail := false;f { Synchronize with the device }% disable_interrupt ( tu58_priority );t' { Initialize the communications area }l tx_region^.pointer := 0; # tx_region^.packet_length := psize; 3 tx_region^.c_packet :: byte_data(psize) := packet; * { Enable interrupts for the transmitter } xmt :: integer := 0; xmt.int_ena := true;d { Check for powerfail }" disable_interrupt ( ipl$_power );! if not tx_region^.powerfail then= begin! mtpr ( csts, xmt::integer );  tx_region^.owned := true; enable_interrupt;+ { Actual i/o done at interrupt level }N wait_any ( tu58_transmit ); end elsey enable_interrupt;# until not tx_region^.powerfail; end; >function receive_packet( var packet : full_packet ) : boolean;{++l{n0{ This procedure receives a packet from the tu58{e { Inputs: {p{ none{ { Outputs:{ 7{ received packed or indication that powerfail occurredh{s{--}varl" rec : receive_status_register;beginh if tx_region^.powerfail then receive_packet := true* else begin% disable_interrupt ( tu58_priority );* rec :: integer := 0;+ rec.int_ena := true; " disable_interrupt ( ipl$_power );! if not tx_region^.powerfail thenh begin! mtpr ( csrs, rec::integer );  rx_region^.owned := true; enable_interrupt; wait_any ( tu58_receive );O end;2 0 if tx_region^.powerfail then  receive_packet := true elsed begin receive_packet := false;  with rx_region^ do' packet :: string(full_packet_size) :=o" rec_struc[get_buff].c_packet; end;d end;end; _7procedure send_command_packet ( operation, unit : byte;_) block, buffer_length : word );n{++ {=9{ This procedure will formulate and ship a command packets{%{--}varc c_packet : command_packet;begine { Load the command packet }i# c_packet.flag := control;s* c_packet.length := command_length;% c_packet.opcode := operation;  c_packet.modifier := 0;= c_packet.unit := unit; if rx_region^.mrsp then ! c_packet.switches := mrsp_switchm else c_packet.switches := 0; c_packet.sequence := 0;c* c_packet.byte_count := buffer_length; ! c_packet.block := block;i% { Compute and load the checksum }=7 c_packet.checksum := get_checksum ( command_length, 2 c_packet::tu58_packet(command_length) ); { Ship the packet } I send_packet ( sizeL;$ELN023.A(U#h [KITBUILD.INSTALL]DDDRIVER.PAS;11N9"%(c_packet), c_packet :: byte_data(size(c_packet)) ) end; =function verify_checksum ( cpacket : full_packet ) : boolean; {++_{cD{ This function will verify that the checksum in a packet is correct{{--}varo cksum : word;0begin9 cksum := get_checksum ( full_packet_bytes, cpacket );o5 with x as cpacket::tu58_packet(cpacket.length) do_ if cksum = x.checksum thene verify_checksum := true else= verify_checksum := false end; w(function minimum ( a, b : byte ) : byte;begine if a <= b then minimum := a else minimum := bend; r;function set_status ( success_code : byte ) : dap$l_status; {++ { 5{ This function will examine the success code and sett-{ the function value to the proper dap statuso{ {--}begin " if success_code = success then# set_status := dap$k_successr4 else if success_code = success_with_retries then0 set_status := dap$k_success_with_retries, else if success_code = no_cartridge then( set_status := dap$k_no_cartridge, else if success_code = write_locked then/ set_status := dap$k_device_write_lockeda* else if success_code = data_check then& set_status := dap$k_data_check else( set_status := dap$k_device_errorend; .function do_tu58_io ( opcode : integer; unit : integer; block : integer; buffer_length : integer;@ var buffer : x_buffer(buffer_length) ) : tu58_status;var  done,error : boolean;3 rsp_packet : tu58_packet(full_packet_bytes);e buffer_offset : integer;3 data_packet : tu58_packet(full_packet_bytes);  retries : integer; nc : integer; status : tu58_status; powerfailed : boolean;3procedure move_to_user ( length : integer; * var rpacket : tu58_packet(length);' var user_buffer : x_buffer(length);c var offset : integer );begino< substr ( user_buffer, offset, length ) := rpacket.pbuff; offset := offset + lengtheend;5procedure move_from_user ( buffer_length : integer;m0 var user_buffer : x_buffer(buffer_length); var offset : integer;& var dpacket : full_packet );begint' { Compute number of bytes to send }=2 nc := minimum ( 128, buffer_length-offset+1 ); { Form the data packet }) with x as dpacket::tu58_packet(nc) doi begin x.flag := data; x.length := nc;2 x.pbuff := substr ( user_buffer, offset, nc );+ x.checksum := get_checksum ( nc, dpacket )a end;a offset := offset + nc:end;begin  { Lock the controller }m lock_mutex ( tu58_mutex ); { Initialize flags } done := false; retries := max_retries; while not done do  begin { Send the command packet }< send_command_packet ( opcode, unit, block, buffer_length ); { Initialize buffer offset } buffer_offset := 1; error := false;/ { Loop until done or an error is encountered }{ repeatiA { Get a response - if a powerfail occurred, skip out of thisi/ loop and retransmit the command packet }o2 powerfailed := receive_packet ( rsp_packet ); if not powerfailed then, { What kind of a response was is? } case rsp_packet.flag of { Data - response to read }= data : { Validate checksum and copy data to user's buffer }+ if verify_checksum ( rsp_packet ) thenn* move_to_user ( rsp_packet.length,2 rsp_packet::tu58_packet(rsp_packet.length), buffer, buffer_offset ) elseN error := true;t" { Continue - response to write } continue: begin 1 { Copy data from user's buffer and ship it }, move_from_user ( buffer_length, buffer,% buffer_offset, data_packet );e% send_packet ( size(data_packet),e0 data_packet::byte_data(size(data_packet)) ); end;e { end - operation completion }? control : if verify_checksum ( rsp_packet::full_packet ) theni done := true elseh error := true;u" { No other responses are valid } otherwise error := truec end { case }i$ until done or error or powerfailed;1 { First check for done via end packet received } if done thenp* with x as rsp_packet :: end_packet do case x.success ofe- success, success_with_retries,bad_unit,). no_cartridge, write_locked, data_check : status := x.success=* otherwise status := controller_error end; { case } ' { Now check for error exit from loop }f if error then begin7 { Reset the controller and decrement retry count } reset_controller; retries := retries - 1;F { if no more retries, we're done with status = controller error } if retries <= 0 then  beginm done := true; status := controller_error endc end;i end; { while }e4 { Release the controller and return the status } unlock_mutex ( tu58_mutex ); do_tu58_io := statusend; =,function tu58_open of type disk$open_action;{++ {u${ Open_action - open action routine{r>{ This routine is called by the file server to open the device{w { Inputs:{2{ device_char specifies the device characteristicsF{ device_dependent_char specifies the device dependent characteristicsE{ context is a pointer to the drive data base structure for this unito{n { Outputs: { 0{ device_char returns the device characteristicsD{ device_dependent_char returns the device dependent characteristics"{ return value = completion status{ {--}beginn( with context::tu58_structure_ptr^ do begin% device_char := [dap$v_devdir,h% dap$v_devfod," dap$v_devshr, dap$v_devavl, dap$v_devidv, dap$v_devodv,o dap$v_devrnd];0 { Set device dependent characteristics }% with device_dependent_char DO  begin:# dap$b_sectors := 128;m! dap$b_tracks := 4;! dap$w_cylinders := 1; / { Return max LOGICAL block number }/ dap$l_maxblock := max_block_numbera end;A { Save the max record size and return successful status }u# tu58_open := dap$k_success; end end; c*function tu58_get of type disk$get_action;{++ {c { tu58_get - get action routine{eF{ This routine is called by the file service to read a block or blocks{ from the device_{e { Inputs:{ :{ starting_lbn specifies the starting logical block number5{ buffer is the address of the buffer to receive data +{ buffer_length is the length of the buffers:{ context is a pointer to the drive database for this unit{ { Outputs: {e({ return value = completion status{{--}vard success_code : byte; block_length : word;begin L eln$allocate_stack ( 2 * 512, status := allocate_status ); { two pages }( with context::tu58_structure_ptr^ do begin' block_length := buffer_length div 512;l0 if ( starting_lbn <= max_block_number ) and@ ( ( starting_lbn+block_length-1 ) <= max_block_number ) then begine@ success_code := do_tu58_io ( read_data, unit, starting_lbn, buffer_length,) buffer^::x_buffer(buffer_length) );r4 tu58_get := set_status ( success_code ); end elseB { Illegal block number (either start or end or both) }+ tu58_get := dap$k_illegal_blockf end;tend; :*function tu58_put of type disk$put_action;{++ { { tu58_put - put action routine{gG{ This routine is called by the file service to write a block or blocks { to the device {e { Inputs:{ :{ starting_lbn specifies the starting logical block number9{ buffer is the address of the buffer containing the datag+{ buffer_length is the length of the buffer}:{ context is a pointer to the drive database for this unit{ { Outputs:n{ ({ return value = completion status{,{--}var  success_code : byte; block_length : word;begin L eln$allocate_stack ( 2 * 512, status := allocate_status ); { two pages }( with context::tu58_structure_ptr^ do begin' block_length := buffer_length div 512;s0 if ( starting_lbn <= max_block_number ) and@ ( ( starting_lbn+block_length-1 ) <= max_block_number ) then beginIA success_code := do_tu58_io ( write_data, unit, starting_lbn, buffer_length,) M$ if f$search("ELN$:DPASCALIO.EXE") .eqs. "" then goto warning-$ library /share eln$:rtlshare eln$:dpascalio$ !$done_pascal_shareable:$ language = "C"0$ if f$search("ELN$:DCMATH.EXE") .eqs. "" .or. -9 f$search("ELN$:DCIO.EXE") .eqs. "" then goto warning$ define /user sys$error nl:$ define /user sys$output nl:/$ library /delete=(gcmath, gcio) eln$:crtlshare1$ library /share eln$:crtlshare eln$:dcmath, dcio$ !$done_c_shareable:$done_shareable:$ ! $ ! Configure the object library$ !$ language = ""$ subject = "object"3$ if f$search("ELN$:RTLOBJECT.OLB") .eqs. "" .or. -< f$search("ELN$:DFLOATRTL.OBS") .eqs. "" then goto error$ define /user sys$error nl:$ define /user sys$output nl:$$ library eln$:rtlobject /delete=( - uvx$exp, - uvx$gsincos, - uvx$powgg, - uvx$powrr, - uvx$sincos, - uvx$sqrt)4$ library /replace eln$:rtlobject eln$:dfloatrtl.obs$ !$ language = "C"4$ if f$search("ELN$:CRTLOBJECT.OLB") .eqs. "" .or. -? f$search("ELN$:DFLOATCRTL.OBS") .eqs. "" then goto warning6$ library /replace eln$:crtlobject eln$:dfloatcrtl.obs$ !$done_c_object: $done_object:$ exit$ !$ ! Error subroutines$ !$error:$ write sys$error -O"%ELN-E-DFLOAT The VAXELN ''subject' library can not be configured for D_FLOAT"$ goto done_'subject'$ ! $warning:$ write sys$error -"%ELN-W-DFLOAT " + -G"The VAXELN ''language' modules are missing for the ''subject' library" $ goto done_'language'_'subject'!*[KITBUILD.INSTALL]DFLOATRTL.OBS;1+,V./ 4-h0123KPWO56@Zʇ7ธ88n?'9GGHJ@ELN$CONVERT_REALV2.0-0025-NOV-1986 11:35 VAX/VMS Macro V04-00MACRO/NODEBUG/LIS=LIS$:CVRTREAL/OBJ=OBJ$:CVRTREAL SRC$:CVRTREAL+OBJD$:[SEALIB.OBJ]SYSTEMLIB/LIB+OBJD$:[KERNEL.OBJ]KERMAC/LIB+SYS$LIBRARY:LIB/LIB - datatype conversion routines# FOR$CVT_D_TE FOR$CVT_G_TE . ABS .Po$CODEPp$ pELN$FLOATING_TO_CHAR_R3& p( pELN$FLOATING_TO_CHAR_VAR_R3&SQVUV`~Qp`n P`~VUVSTT^PTVV^^V^QUU  FOR$CVT_D_TE FOR$CVT_G_TE(SbVV^?ELN$CONVERT_T_FV2.0-0025-NOV-1986 11:35 VAX/VMS Macro V04-00MACRO/NODEBUG/LIS=LIS$:CVRTTF/OBJ=OBJ$:CVRTTF SRC$:CVRTTF+OBJD$:[SEALIB.OBJ]SYSTEMLIB/LIB+OBJD$:[KERNEL.OBJ]KERMAC/LIB+SYS$LIBRARY:LIB/LIB!; Convert text to real (F only)4ELN$_INVREALSTR LIB$SIGNAL OTS$CVT_T_D . ABS .P$ABS$ PP$CODEP< <ELN$CONVERT_T_F&lP@^ďP(Pln~n OTS$CVT_T_DPOmvPPԼELN$_INVREALSTR LIB$SIGNALPЬPЬQա PЏ P5MTH$EXP1-01116-SEP-1984 01:23 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:MTHEXP/OBJ=OBJ$:MTHEXP MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:MTHEXP/UPDATE=(ENH$:MTHEXP)*; Single Precision Floating Exponrntial uMTH$$JACKET_HNDMTH$$JACKET_TST MTH$$SIGNAL  MTH$EXP_R4MTH$K_FLOOVEMATMTH$K_FLOUNDMAT . ABS .P$ABS$P _MTH$CODEP@@ê@•@Ø@7@2@@?X@@@*g@$@D@@@}%@@êg{H@׋@ës@7Q@2`@9Q@>XBK@3e޽@X7 @*gU@$@Dk@*@9$@}%$̆5$c8_u;1>r*>3*?U?@@B;1>p7@ @MTH$EXP&(MTH$$JACKET_HNDmPPPR>RSS\RB EPQJQTNTQEQRBRPDQBQPDPT)PTPUPuˏTRDBϨP`BPvPPT ~D`PP=R4UPRPPSP(RMTH$$JACKET_TSTP<RPR nMTH$K_FLOUNDMAT%~ MTH$$SIGNALTnMTH$K_FLOOVEMAT%~yP MTH$$SIGNAL9 MTH$GSINCOS2-00316-SEP-1984 01:30 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:MTHGSINCO/OBJ=OBJ$:MTHGSINCO MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:MTHGSINCO/UPDATE=(ENH$:MTHGSINCO)*; Floating Point Sine, Cosine and SincosMTH$$JACKET_HNDMTH$$JACKET_TST MTH$$SIGNALMTH$AL_4_OV_PI_V H MTH$GCOSD_R7  MTH$GCOS_R7 MTH$GSINCOSD_R7 nMTH$GSINCOS_R7  MTH$GSIND_R7 k MTH$GSIN_R7MTH$K_FLOUNDMAT . ABS .P$ABS$ PP _MTH$CODEP @!DT-<@:F̾"@|3!/@zjU)^85@uf@f>ܥc?ll}?j)%\@ܥclܥc@DBiŸ@DBiŸ@-2O#)'ѓJA@DBiŸ@ES*NjȽ^4A>G=ɲO~o?~vvl-6?UUUU3U@Ƚ^4̀A>G=ɲO~o?~vvl-6?UUUU3U@nz峵3>QZJP0h$?U<]<~\?<ZP0h$?U<]<~\?<ZͿM.)D0]=>m8>09A>#,--R?fugԿ%A?BDѭ>acr 9֭ #/<\F[xP>jsC۹@>acr 9֭ #/<\F[xP>js)D0]G9 5v[ȟ;_J6Z==; ^/}?j)%  MTH$GSINCOS&0MTH$$JACKET_HNDmPPn}P}R  MTH$GSIN&(MTH$$JACKET_HNDmPPk MTH$GCOS&(MTH$$JACKET_HNDmPP ' MTH$GSINCOSD&0MTH$$JACKET_HNDmPP}P}R  D MTH$GSIND&(MTH$$JACKET_HNDmPP Y MTH$GCOSD&MTH$$JACKET_HNDmPPHPPVRPPPQP1QP1}T~RЎR}T}P~}R@P7`>P+}PVEVVT}T~UT}nT}PnUTNDVP@VP}RPR}P~VPTdTTvTR}R~}T~UR}TTbTVPPbTPvPP}nR}PnUR}RDnP@PR}T~X}TЎR}P~}RSP{RPPPQσP"QσP8R 4&0 4&0 4& 4& 4&t 4&t 4& 4&`>P}PVDPPUPyDVP@VPTR 4& 4& 4& 4&{ 4&. 4&. 4&{ 4&RRRR 4& 4& 4& 4&SPPQP"QP@R0 4& 4& 4&t 4&t 4& 4& 4&0 4&ٱ@PVPT1`>P DPPUPlPPTR `4& `4&{ `4&. `4&. `4&{ `4& `4& `4&RRRR |4& |4& |4& |4&SPPRPPQϒP$t }V~S^ЎS}nV}Pn}R^}Pnr}P}P}RSPRPPPQ4Pt S  4&  4&  4&  4&~  4&  4&  4&~  4&Q"P}PV1[SPQ/P1sEPR`P@RPSPPQPt S b4& b4&~ b4& b4& b4&~ b4& b4& b4&QP}PV1/PPQϖP2QφPVPPcPTRRVPPcPTRRQdPVPPcϸPTRRVPPcϳPTRR!@PSSSTʏTMTH$AL_4_OV_PI_VRMTH$AL_4_OV_PI_VRTRPN;>B$ELN023.AVh![KITBUILD.INSTALL]DFLOATRTL.OBS;1H" SPPAPJPPQQP~ʏn $^^T ^U TWySbgWRySbg֧TWzPnzPP ddzQdzQzQ ֤Qee nخخ eӏ?e7Te!я 1e я 5eʏ UT բPe cPTЮ R1}PTЮ R1=eя (я }d= eSR1VT cPtTR® T:=eя դ  }d eT }PTR® T$(^RySbVzQWQzPWP  zQWzPWdخ ֤֤ Ю^VnPd֤ Pnfd`fP Pnf`ϲf`fP @0 @0`CPNPRʏPPCPPR}PSʏ?QBPSP@SPRR RS SSRSMBRMBRDRP@BP(EsPVRʏR TVSTRBTVS/@VTKlPSTSSVNVVDVBPVSNSVDV@PVST@T(dTT}T~vTTUTϪ}TTbTVPPbTPvPPvTVDVVUVET@T(dTT}T~vTTUTf}TTbTVPPbPTvTPvTVDVVUVPT}T~vT~EnnTUTcDP}TVPP`TPvPPqϺT)dTT}T~vTTUTϭ}TTbTVPPbTPvPPvTVDVVUVG@PTqpT)dTT}T~vTTUTc}TTbTVPPbPTvTPvTVDVVUVCPχPT}T~vT~EnnTUT\DP}nTnbTVPP`TPvPPQϤVIVVTdTT}T~vTTUTϛVPP}*T TяW}T~ʏWbTnbPbTbTPvPPDVVUVPPQ@VIVVTdTT}T~vTTUT7VPP}T TяW}T~ʏWbTnbPbTbPTvTPDVV UVϷPPτPRVVEVVPUPDVP`V@VPPPPXPRMTH$$JACKET_TSTP<RPR nMTH$K_FLOUNDMAT%~ MTH$$SIGNAL7 OTS$POWGG2-00416-SEP-1984 01:58 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:OTSPOWGG/OBJ=OBJ$:OTSPOWGG MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:OTSPOWGG/UPDATE=(ENH$:OTSPOWGG)&- G REAL*8 ** G REAL*8 power routineJ MTH$$SIGNALMTH$K_FLOOVEMATMTH$K_FLOUNDMAT MTH$K_UNDEXP . ABS .P$ABS$P  _OTS$CODEP  @@1 WXCT|@U φ)B@0%N ٮ1@+ǃͭJ@Hs[(@##Vl\@)Q]J@o0qRZ0F\@7ssqPEE/G@=dB#[#"A>t@D16 @KSbqz9!.@BSiG}mQl?@X̬(J@Ί;"T U|@s {^EOT# @I* ?k+@P#;UI$@:MssZ @/o䵪n{S<@ؽ)U"± *@r P<@ՀύH]rZf@7s묌9)@J* IX:0@eTtK(vb@J@a(8 R@lwP>^@ :@TqRv/wxtlcd=0̇=c>o{>k݀N?Ŷ?B.9R  OTS$POWGG&jV ~PPn<PQ MTH$K_UNDEXP%~ MTH$$SIGNALˏPX@XXPVPPPTʏTDϺT>HdXcD/PTPbTPgPT~vnVEVVPUP"VPP`9PdPnXT`TPdnPPT@TKkPXnXTbTPvPPUPˏXT}DTvTRDRPVPP`TPvPPXXXXPPSPX|P MTH$K_FLOUNDMAT%~ MTH$$SIGNALMTH$K_FLOOVEMAT%~yP MTH$$SIGNAL7 OTS$POWRR2-00616-SEP-1984 02:04 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:OTSPOWRR/OBJ=OBJ$:OTSPOWRR MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:OTSPOWRR/UPDATE=(ENH$:OTSPOWRR)e- REAL ** REAL power routineJ MTH$$SIGNALMTH$K_FLOOVEMATMTH$K_FLOUNDMAT MTH$K_UNDEXP . ABS .P$ABS$PH _OTS$CODEE*P ((((((000000008888888@@@@@@@@HHHHHHHHPPPPPPPPPXXXXXXXXX`````````hhhhhhhhhhppppppppppxxxxxxxxxxxD;\)g@@êg{H@׋@ës@7Q@2`@9Q@>XBK@3e޽@X7 @*gU@$@Dk@*@9$@}%$̆A3Yv8f<r%   OTS$POWRR&}PPPQ<P MTH$K_UNDEXP%~ MTH$$SIGNALˏPT@TTPQˏPRBϜRRTRRcBPRPbRPfPRERRQEC#QP@CO8PDQPQ`PdPRNTPQ`PRPPP~nRTTTTVdPRAMRPBMPbPRIPT2UR%ˏTRRR}BϋRDRP`RPvPPTTPPSPTSPP MTH$K_FLOUNDMAT%~ MTH$$SIGNALMTH$K_FLOOVEMAT%~yP MTH$$SIGNAL8 MTH$SINCOS2-00416-SEP-1984 01:49 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:MTHSINCOS/OBJ=OBJ$:MTHSINCOS MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:MTHSINCOS/UPDATE=(ENH$:MTHSINCOS)H*; Floating Point Sine, Cosine and SincosMTH$$JACKET_HNDMTH$$JACKET_TST MTH$$SIGNALMTH$AL_4_OV_PI  MTH$COSD_R4  MTH$COS_R4MTH$K_FLOUNDMAT =MTH$SINCOSD_R5 H MTH$SINCOS_R5  MTH$SIND_R4  MTH$SIN_R4 . ABS .PT$ABS$- PP:% _MTH$CODEP@!hIA!hA˙A!hl*>@8e*>2&<L=*^ފl7Ϫu=@l7Ϫu=o2O}#-12@w!40Ƅ2vv5ݥm. cm;Q4&>4&>4&>4&>4&T>4&T>4&>4&ɱ@P:PPTDPPUPDTP@TPPVPPdPPUPDnP@PS.R4&4&4&4&4&4&4&4&RRRR4& 4&4& 4&SPPQI@P#QA1P<,R4&4&4&T4&T4&4&4&4&ݱ@PVPS14:P DPPUPPPSR4&4&4&4&4&4&4&4&RRRR 54&54& 54&54&SPPPRPP4CP}S~}SPЎQPPUЎPUQSPRPPP4CPS4&=4&=4&4&4&4&4&4&Qe=.PPT1 SPQe.P1!E;QPQP@QPSPP4CPS= 4& 4& 4& 4& 4& 4& 4&= 4&Qe=.PPT1PPQQ{ASP)QAPcϼPSRRcϴPSRRQAPcϣPSRRcϛPSRR`PRRRSʏSMTH$AL_4_OV_PIQSQRPLPJPP~ʏn yRa~QyRaSzPTSPTŮPnnT Tnӏ?nG^}SnZTn֮,Tяn1T яnK}nSՎ^TRnSPTRȏTnTSS`PSS1ʏTnTSS`PSS1S~Џ я?ZnT ֮֮1я}Sn=@ SR^1~SnnPnnnSS ScSϒSbPSRŽS1OS~Џ я ZnT֮T }Sn TnnnPnnnSS`PSRŽSn^QyRaSzPTSPT @0 @0LPEˏPQLQQPˏQRBRQR@RQPP PR RRPRM@PM@PDQPT=` PSTSSTNTTD4CTBPTSNSTD4T@PTSS@SdSSSUSÏSbSbSPvPPvSTDTTUTS@SdSSSUSÏSbSbPSvSPvSTDTTUTϗPSSDSSUSϥЎSDSP`SPvPPQ"@SdSSSUSϨÏSbSbSPvPPvSTDTTUTvQ"@SdSSSUSuÏ]SbSbPSvSPvSTDTTUTCPS}S~DSSUSTDnPÏnSbSbSPvPPQB.T9VTSdSSSUSHÏSяT}S~ʏTbSn`PbSbSPvPPDTTUTQB.T9VTSdSSSUSÏSяT}S~ʏTbSn`PbSbPSvSPDTTUTϸPRTTETTPUPDTPT@TPPPPPRMTH$$JACKET_TSTP<RPR nMTH$K_FLOUNDMAT%~ MTH$$SIGNALT6MTH$SQRT1-01516-SEP-1984 01:51 VAX/VMS Macro V04-00MACRO/ENABLE=SUPPRESSION/DISABLE=(GLOBAL,TRACEBACK)/LIS=LIS$:MTHSQRT/OBJ=OBJ$:MTHSQRT MSRC$:MTHJACKET/UPDATE=(ENH$:MTHJACKET)+MSRC$:MTHSQRT/UPDATE=(ENH$:MTHSQRT)&; Floating Point Square Root routineNMTH$$JACKET_HND MTH$$SIGNALMTH$K_SQUROONEG  MTH$SQRT_R3 . ABS .P}| _MTH$CODE}P @  @MTH$SQRT&MTH$$JACKET_HNDmPPPPQSPAS$F_FLOAT_IOV2.0-0025-NOV-1986 11:28 VAXELN PASCAL V2.3-06 e /ruSeN PAS$IODEFPAS$WRITE_REALE_FPAS$WRITE_REALF_FPAS$READ_REAL_F PFV  F_VALUE% TOTAL_WIDTH% PAS$R_PFV    % % FRAC_DIGITS%     t FOR$CVT_D_TF FOR$CVT_D_TEELN$CONVERT_T_FPAS$$READ_REALPAS$$WRITE_REALFPAS$$WRITE_REALEP PAS$READ_REAL_FE$^ޭPELN$CONVERT_T_Fԭ߭PPAS$$READ_REALPP (PAS$WRITE_REALF_Fc(P^޼޼ ޼nPԭP FOR$CVT_D_TFԭ߭ݮݮ PPAS$$WRITE_REALF} hPAS$WRITE_REALE_F]hP^޼޼ nPԭP FOR$CVT_D_TEԭ߭ݮPPAS$$WRITE_REALE$CODE$DATAP!*[KITBUILD.INSTALL]DHVDRIVER.EXE;1+,jZ. / 4 -h0123 KPWO 56@갾ˇ7@8@?'9GGHJ0DX0205( DHVDRIVERVAXELN V2.3-00 ˇ04-00  ?!! TERMINAL_001!DAP_001"! PASCALMSC_001! DDCMP_001T0 0:0:20΀^\<~XD(S2SR ߭E RR PPWQPP^޼n޼TPPSSPЬ QC $^R޼TxTV VPP1<@@QTPPQQPPPD¤ VWUWePP ,<SPQQPPSQPPSPSPD(SD(>H CD(bSPVޯMԭ߭V`~W`~SD¤l  D(S޼TRD(P^R޼U޼VVlV1GS޼ TPU0<@@QUPPQQ<QCPPQPQPE E|~VS1P4- SSWWES߭V SWЬ P`SSPPU0<@@TUPPTTP ޼VVSPSԭ߭߭߭RݢCȤmPTTsѦYЭYY Y}P`PѦ ЦTTSмRCTSWмWR(RgY Џ'RЏRЏ!RЏ!RRP ^QRnS޼޼nρԭ߭ݢݮ ݮТP@äPЏPЏ!P ^QSRУQPA('Pԭ߭Q5ЏPЏ!Pμ^Ь<~NP`] ]!]g]|~|~|~|~|~|~PnPPÞ^2V޼Y޼<~0YRRðWW  W(WأW RRRWR(RcS2Sޭح߭߭|~YIƤxYRBY/xYRRR2ŏYSR>C RieIYRݭxYSSRRl~PTYdSSRRxYSRCRR|~RTR߭R|~RŏYSR>C RϽԭ߭R'1F<ЬQ QSQ П8P,ПPQР P<RxRR RB0PРXPˏC`Px PPQ P<< S RBSxSS~R~T~UeݬS~dbx dP PPbR<ЬR< S P@SxSSެUЬQ ah QTQeP,ПPQР P<QxQQ QA0PРXPD`PTȏTȏTЀQQTTSbݬ 8 ݬx~< P QAPxP~@@08( h`p @TERMINALDAP PASCALMSCDDCMP!*[KITBUILD.INSTALL]DHVDRIVER.PAS;1+,.Z/ 4RZX-h0123KPWO[56ގ78k?'9GGHJ$module dhvdriver [ident('V2.2-00')];M{****************************************************************************{* **{* Copyright (c) 1984, 1986 *<{* by DIGITAL Equipment Corporation, Maynard, Mass. *{* *M{* This software is furnished under a license and may be used and copied *M{* only in accordance with the terms of such license and with the *M{* inclusion of the above copyright notice. This software or any other *M{* copies thereof may not be provided or otherwise made available to any *M{* other person. No title to and ownership of the software is hereby *{* transferred. *{* *M{* The information in this software is subject to change without notice *M{* and should not be construed as a commitment by DIGITAL Equipment *{* Corporation. *{* *M{* DIGITAL assumes no responsibility for the use or reliability of its *B{* software on equipment which is not supplied by DIGITAL. *{* *M{****************************************************************************{{++ { FACILITY:{{ VAXELN Run-time System{ { ABSTRACT:{6{ This module contains the driver for the DHV-11 async{ multiplexor device{ { AUTHOR:{{ Kris Barker 16-September-1983{ { VERSION:{ { V1.0-00{{ MODIFIED BY:{!{ V2.0-00 Gary Kimura 31-Oct-1984{ added ddcmp support{!{ V2.0-01 Gary Kimura 27-Nov-1984/R(/$ELN023.Ah![KITBUILD.INSTALL]DHVDRIVER.PAS;1RZ~"{ added unibus mapping for MicroVax-II support{!{ V2.0-02 Kris Barker 25-Mar-1985>{ added dispose call in circuit process to dispose circuit db#{ structure when circuit is closed{+{ V2.1-01 Eric Schott 29-July-1985 (ers008)={ fixed unibus mapping for MicroVax-II with fortran carriage { control{-{ V2.1-02 Eric Schott 16-August-1985 (ers018)/{ Added handling of VFC record format on input{-{ V2.1-03 Eric Schott 16-August-1985 (ers019)2{ Fixed open_action to set maximum_record_size to1{ max_read_buffer_size if maximum_record_size is%{ greater than max_read_buffer_size.{-{ V2.1-04 Eric Schott 19-August-1985 (ers022)%{ Raised max_read_buffer size to 512{6{ V2.2-00 - November 18, 1985 - Eric R Schott (ers063)3{ Added checks for dead await_control_key circuits{--} include $dap;include $terminal;include $physical_address;include $ddcmp;include $stack_utility;include $unibus;const: input_buffer_size = 256; {size of the input buffer}4 max_line_number = 7; {lines are 0 thru 7}; max_read_buffer_size = 512; {maximum read buffer size}& ipl$_power = 31; {powerfail ipl}B handle_xon_xoff = false; {xon/xoff handled by the controller} input_vector_number = 1; output_vector_number = 2;? pr$_sid = %x3e; {system identification register number}1 microvax_1_id = 7; {system ID of microVAX-I} {!{ Possible device characteristics{}% { Baud rate bit representations } rate_50 = %b'0000'; rate_75 = %b'0001'; rate_110 = %b'0010'; rate_134_5 = %b'0011'; rate_150 = %b'0100'; rate_300 = %b'0101'; rate_600 = %b'0110'; rate_1200 = %b'0111'; rate_1800 = %b'1000'; rate_2000 = %b'1001'; rate_2400 = %b'1010'; rate_4800 = %b'1011'; rate_7200 = %b'1100'; rate_9600 = %b'1101'; rate_19200 = %b'1110'; rate_38400 = %b'1111'; {bits per character} char_length_5 = %b'00'; char_length_6 = %b'01'; char_length_7 = %b'10'; char_length_8 = %b'11'; {number of stop bits} stop0 = 0; stop1 = 1; {parity stuff} oddp = 0; even = 1; {modem indicators} modem = true; no_modem = false;$ { Default line characteristics }) default$char_length = char_length_8; default$stop_bits = stop0;& default$parity_enable = false; default$sense = even;# default$baud_rate = rate_9600; default$modem = no_modem; default$hardcopy = false; default$ANSI_escape = true; default$echo = true; default$passall = false;( default$eightbit = false;& default$ddcmp_protocol = false; type { Some useful types } byte = 0..255; xbyte = -128..127; word = 0..65535; small_integer = 0..7; bits$1 = 0..1; bits$2 = 0..3; bits$3 = 0..7; bits$4 = 0..15; bits$5 = 0..31; bits$6 = 0..63; bits$14 = 0..16383;( buffer_ptr = ^terminal_read_buffer;3 any_pointer = ^anytype; {a pointer to anytype}& char_str = varying_string (12);% lw_string = varying_string (4); {SID register description }2 system_identification_register = packed record hardware_rev : byte; miccode_rev : byte; reserved : byte; id : byte; end; {!{ Async device registers contents{} { Control status register } csr = [word] packed record@ ind_reg_address : bits$4; {indirect register number}> master_reset : [pos(5)] boolean; {master reset}A rx_int_ena : boolean; {receive interrupt enable}? rx_data_avail : boolean; {receive data available}8 tx_line : bits$4; {transmit line number}3 tx_dma_err : boolean; {transfer dma error}0 diag_fail : boolean; {diagnostic fail}A tx_int_ena : boolean; {transmit interrupt enable}7 tx_ready : boolean; {transmitter ready} end; { record }- { Receive buffer and transmit character }" rxb_txc = [word] packed record case boolean of8 true : ( rx_char : char; {received character}? rx_line : bits$4; {receive line number}; parity_error : boolean; {parity error}: frame_error : boolean; {frame error}< overrun_error : boolean; {overrun error}D data_valid : boolean );{receive buffer valid}: false : ( tx_char : char; {transmit character}- tx_valid : [pos(15)] boolean ); end; { record } { Line parameter register } lpr = [word] packed record' diag_code : [pos(1)] bits$2;C char_length : bits$2; {character length (5-8 bits)}6 parity_enable : boolean; {parity enable}; even_odd_parity : bits$1; {parity sense select}; stop_code : bits$1; {number of stop bits}9 rx_baud_rate : bits$4; {receive baud rate}: tx_baud_rate : bits$4; {transmit baud rate} end; { record } { Line status register } lstat = [word] packed record0 clear_to_send : [pos(11)] boolean;# carrier_detect : boolean;# ring_indicator : boolean;# data_set_ready : boolean; end; { record } { Line control register } lctrl = [word] packed record tx_dma_abort : boolean; iauto : boolean;0 rx_en : boolean; {rx enable}, break : boolean; {break} oauto : boolean;$ maint : [pos(6)] bits$2; link_type : boolean;: dtr : boolean; {data terminal ready}6 rts : boolean; {request to send} end; { record }* { Transmit buffer address register 2 }# txb_high = [word] packed record tbuff_high : bits$6;% tx_dma_start : [pos(7)] boolean;& tx_ena : [pos(15)] boolean; end; { record } { Register layout }# async_registers = packed record async_csr : csr; rx_tx : rxb_txc; line_param : lpr; line_status : lstat; line_control : lctrl; txb_addr1 : [word] word; txb_addr2 : txb_high; tx_dma_count : [word] word end; { record }6 { Some pointers to the aforementioned structures }$ register_ptr = ^async_registers;  { Line parameters record }' ln_param_rec = [long] packed recordA char_length : char_length_5..char_length_8; {bits 0-1}0 stop_bits : stop0..stop1; {bit 2}+ parity_enable : boolean; {bit 3}/ sense : oddp..even; {bit 4}9 rx_baud_rate : rate_50..rate_38400; {bits 5-8}: tx_baud_rate : rate_50..rate_38400; {bits 9-12}, modem : boolean; {bit 13}, hardcopy : boolean; {bit 14}, ANSI_escape : boolean; {bit 15}, echo : boolean; {bit 16}, passall : boolean; {bit 17} eightbit : boolean;! ddcmp_protocol: boolean; end; { record }& { Circuit process data structure } ct_data_base = recordI line : integer; {line number for this circuit}< port : port; {connecting port}: read_buffer_size : integer; {record length}@ local_pass : boolean; {local passall state}= local_echo : boolean; {local echo state} end; { record } ct_ptr = ^ct_data_base;8 { Line configuration record sent by system builder }" builder_params = packed record= dummy_word : word; {length of the varying string} line : integer;, parity_enable : boolean;/ sense : oddp..even;, modem : boolean;, hardcopy : boolean;, ANSI_escape : boolean;, echo : boolean;, passall : boolean;, ddcmp_protocol : boolean;3 character_length : [pos(64)] byte;) stop_bits : byte;( comm_speed : word end; { record }$ { Communications region layout } input_region = record3 get : integerS$ELN023.Ah![KITBUILD.INSTALL]DHVDRIVER.PAS;1RZ"; {input buffer get}V3 put : integer; {input buffer put}*C buffer : array [0..input_buffer_size-1] of rxb_txc; {input buffer}hF ddcmp_protocol : packed array [0..max_line_number] of boolean;J ddcmp_region : array [0..max_line_number] of eln$ddcmp_rec_region; end; { record }s. output_region = [aligned(2)] packed record? line_char : [aligned(2)] array [0..max_line_number] off ln_param_rec;; xmt_waiting : array [0..max_line_number] of boolean;pH line_valid : [aligned(2)] array [0..max_line_number] of boolean;+ indirect_register : [aligned(2)] integer;b@ bus_adapter : boolean; { flag for unibus mapping } end; { record }# rec_region_ptr = ^input_region;o$ xmt_region_ptr = ^output_region; varn{ F{ Device, device records, communications region, registers, etc., etc.{}M async_input : array [0..eln$ddcmp_term_device_number] of device;tB async_output : array [0..max_line_number] of device;, rec_region : rec_region_ptr;, xmt_region : xmt_region_ptr;* register_location : register_ptr;% async_ipl : integer; 0 controller_name : varying_string (8); { Register contents } " async_csr : csr; {async csr} { Line data structures }D dhv_struc : array [0..max_line_number] of terminal_data_pointer; jparam : builder_params;$ jp : varying_string (100); { Some misc. stuff }N line_number : integer; {current line number for initialization}P sync_event : event; {event used to synchronize initialization}E sub_process : process; {process ID used for line processes}p8 lines : array [0..max_line_number] of integer;) control_z_character : char := ''(26);s cprogram dhvdriver;{++{ G{ This is the main driver procedure. It creates the device, resets thep<{ async interface, and starts a process for each async line.B{ These line processes will do the actual i/o. This process waitsE{ (via a signal) for each line process to complete its initializationtA{ before starting the next process. Once all processes have been I{ started and the exec has been informed that initialization is complete, :{ this procedure performs dispatching of input characters.{ {--}vara p_number : integer; line_number : integer; i : integer; rx : rxb_txc; character : char;  line : integer; ds_change : boolean; qbus_adapter : ^anytype; my_proc : process;n) timer, time_interval : large_integer;b signaled_object : integer;beginl/ eln$allocate_stack ( 2048 ); { four pages }n{e8{ Get the controller name specified by the job parameter{}. controller_name := program_argument ( 1 );{e{ Create the async devicen{}$ create_device ( controller_name, async_input,/ vector_number := input_vector_number,u* region := rec_region,1 registers := register_location,l) priority := async_ipl,r5 service_routine := async_input_interrupt, 8 adapter_registers := qbus_adapter );$ create_device ( controller_name, async_output, 4 vector_number := output_vector_number,& region := xmt_region,. powerfail_routine := powerfail_recovery,8 service_routine := async_output_interrupt );{p.{ Do global level initialization of the device{}1 { Determine the existence of device mapping } 3 xmt_region^.bus_adapter := qbus_adapter <> nil;i? { Initialize the get and put pointers to the input buffer }  rec_region^.get := 0;  rec_region^.put := 0; L for i := 0 to max_line_number do rec_region^.ddcmp_protocol[i] := false;5 { Synchronize with device during initialization }0$ disable_interrupt ( async_ipl );; initialize_interface ( register_location, xmt_region );b enable_interrupt;s. for line_number := 0 to max_line_number do$ set_default_params ( line_number );{ *{ Check for user-specified line parameters{} p_number := 2;( jp := program_argument ( p_number ); while length(jp)<>0 do begin jparam := jp :: builder_params;' store_line_characteristics ( jparam );t p_number := p_number + 1;% jp := program_argument ( p_number );  end;r{ "{ Create the synchronization event{}/ create_event ( sync_event, event$cleared ); {o={ Start a process to service i/o requests for each async line {}# { For each line out there ... }s. for line_number := 0 to max_line_number do begin clear_event ( sync_event );1 { Create a process to service this line }_" create_process ( sub_process, line_process,g line_number, sync_event );  { Wait for completion } wait_any ( sync_event ) end; { while } * { Enable interrupts on the interface }F write_register ( register_location^.async_csr, rx_int_ena := true, tx_int_ena := true );{e9{ Signal the exec that we're done with our initialization {} initialization_done;a{ O{ Bump up the process priority of the dispatcher - note: this assumes a default :{ process priority of 8 for the line and circuit processes{} current_process(my_proc); $ set_process_priority(my_proc,7);, time_interval := time_value('0 0:0:20'); get_time(timer);# timer := timer - time_interval;r{ { Perform input dispatching {} while true do beginr( disable_interrupt ( async_ipl );$ { Wait for some characters }2 while rec_region^.get = rec_region^.put do begin  enable_interrupt;nA wait_any ( async_input[eln$ddcmp_term_device_number], - time:= timer, result := signaled_object );n if signaled_object = 0r then_ begine, for line_number := 0 to max_line_number do/ cleanup_ctrl_key(dhv_struc[line_number]);o get_time(timer); timer := timer - time_interval end;5 {**************** DEVICE IPL ******************}s, disable_interrupt ( async_ipl ); end;E { Get the character out of the input buffer and update get pointer } 2 rx := rec_region^.buffer[rec_region^.get];I rec_region^.get := ( rec_region^.get + 1 ) mod input_buffer_size;  enable_interrupt;s3 {****************** LOWER IPL *******************}& { Handle the input character } line := rx.rx_line; character := rx.rx_char;B { Give the character to the proper line (or if all error bits are! set, process a modem change) }m@ if rx.parity_error and rx.frame_error and rx.overrun_error then" process_modem_change ( line ) elseH* dispatch_character ( dhv_struc[line], character,) xmt_region^.line_char[line].passall,0* xmt_region^.line_char[line].eightbit, put_chars );0 end; { while }Nend. :procedure initialize_interface ( registers : register_ptr;" region : xmt_region_ptr );{++l{nH{ This procedure will perform interface initialization either at startup{ or after a powerfail.h{ { Inputs:5{r1{ registers points to the dhv-11 device registersh<{ region points to the transmit device communications region{s { Outputs:{{ async interface initializedr{o{t5{ Note: This procedure should be called at device IPLr{9{--}begino! { Reset the async interface } B write_register ( registers^.async_csr, master_reset := true );* { Wait until the reset has completed } repeat9 async_csr := read_register ( registers^.async_csr );% until not async_csr.master_reset;Rend; s>interrupt_service powerfail_recovery ( xreg : register_ptr;& xregion : xmt_region_ptr );{++l{ G{ This is the powerfail recovery routine for the DZV-11 async interfaceu{u { Inputs:{){ std. interrupt_service procedure inputse{p { Outputs:{ @{ device reinitialized and circuit processes waiting to transmit { signaled{2{--}vare i : integer;beginr# { First, reinit the interface }x initialize_interface ( xreg, xregion ); G { Now reinit each line and check for xmtting circuit processes thatx were waiting }$ for i := 0 to max_line_number do begin { Initialize this line }4 initialize_line ( i, xregion^.line_char[i], xreg );- { Anyone waiting to transmit T$ELN023.Ah![KITBUILD.INSTALL]DHVDRIVER.PAS;11tXE;1RZȨ"&on this line? } if xregion^.xmt_waiting[i] then* signal_device ( device_number := i );" xregion^.xmt_waiting[i] := false; end; { for }a+ { Set the CSR up for the current line };% write_register ( xreg^.async_csr,0 rx_int_ena := true, tx_int_ena := true,: ind_reg_address := xregion^.indirect_register::bits$4);end; '0procedure set_default_params ( line : integer );{++0{J{ This procedure will set the line characteristics for LINE to the default{ values{ {--}begin ' with xmt_region^.line_char[line] do  begin& char_length := default$char_length;$ stop_bits := default$stop_bits;( parity_enable := default$parity_enable; sense := default$sense;$ rx_baud_rate := default$baud_rate;$ tx_baud_rate := default$baud_rate; modem := default$modem;# hardcopy := default$hardcopy;$& ANSI_escape := default$ANSI_escape; echo := default$echo;$" passall := default$passall;# eightbit := default$eightbit;=0 ddcmp_protocol:= default$ddcmp_protocol; end;N) xmt_region^.line_valid[line] := true;end; lAprocedure store_line_characteristics ( jparam : builder_params );a{++d{_J{ This procedure is used to store user-specified line characteristics into5{ the parameter record of the data base for this line {6{--} beginl/ with xmt_region^.line_char[jparam.line] dos beginG { Set the characteristics for this line - note: for now, you can't6G set the character length and # of stop bits via the system builder }b0 parity_enable := jparam.parity_enable;( sense := jparam.sense;- rx_baud_rate := jparam.comm_speed;- tx_baud_rate := jparam.comm_speed;m+ hardcopy := jparam.hardcopy; . ANSI_escape := jparam.ANSI_escape;' echo := jparam.echo; * passall := jparam.passall;- if jparam.character_length = 3 then  eightbit := true  else! eightbit := false; C { Set the modem flag and if line is a modem, clear the valid bit }2( modem := jparam.modem; if modem thenm< xmt_region^.line_valid[jparam.line] := false;1 ddcmp_protocol:= jparam.ddcmp_protocol; if ddcmp_protocol then beginr$ ANSI_escape := false;$ echo := false;# passall := true;# eightbit := true;? rec_region^.ddcmp_protocol[jparam.line] := true;  end; end end; s8procedure initialize_line ( line : integer;( line_parameters : ln_param_rec;* register_location : register_ptr );{u{nK{ This procedure will write the line parameters for this line to the proper:M{ line parameters register and enable the line for transmitting and receivinge{ { Inputs: { "{ line number specifies which line<{ line_parameters contains the characteristics for this line8{ register_location points to the dmf32 device registers{{ { Outputs:{*{ line initialized{*1{ Note: This routine assumes device IPL or higherp{;{--}var  lparam : lpr;ebeginr with line_parameters dod begin { Set line parameters }iH write_register ( register_location^.async_csr, ind_reg_address:=line );7 write_register ( register_location^.line_param,t* char_length := char_length,, parity_enable := parity_enable,$ even_odd_parity := sense,( stop_code := stop_bits,+ rx_baud_rate := rx_baud_rate,r- tx_baud_rate := tx_baud_rate );  * { Enable this line for receiving }9 write_register ( register_location^.line_control,i rx_en := true,' iauto := not passall, oauto := not passall, link_type := modem ); end { with }iend; pJinterrupt_service async_input_interrupt ( device_registers : register_ptr;+ inp : rec_region_ptr );:{++r{oD{ Async_input_interrupt : async line input interrupt service routine{i={ This is the input interrupt service routine for the DHV-11.@{ It reads characters from the input silo and puts them into theJ{ input buffer which is located in the input device record region. If theM{ input buffer state changes from empty to non-empty, the device is signaled.d{c8{ Inputs : inp - pointer to input communications region*{ device_registers - pointer to registers{s{ Outputs : nonet{ {--}var 7 rx_data : rxb_txc; {receive buffer}a begin {r{ Read the input registerc{}: rx_data := read_register ( device_registers^.rx_tx );{rC{ As long as there is input in the silo, put it in the input bufferx{} while rx_data.data_valid do begin= if not inp^.ddcmp_protocol [ rx_data.rx_line ] then  begin.D { If the input buffer is not full, put the character in it }K if ( ( inp^.put+1 ) mod input_buffer_size ) <> inp^.get thena beginO { If input buffer goes from empty to non-empty, signal dispatcher }x/ if inp^.put = inp^.get thent( signal_device (O device_number := eln$ddcmp_term_device_number );gJ { Store the character in input buffer and update put pointer }5 inp^.buffer[inp^.put] := rx_data;eF inp^.put := ( inp^.put + 1 ) mod input_buffer_size end;. end  else begine) if eln$ddcmp_receive_isr ( O address ( inp^.ddcmp_region [ rx_data.rx_line ] ),,3 rx_data.rx_char ) theniG signal_device ( device_number := rx_data.rx_line ); end; { if }eM { Now read input register again to see if more characters are there }? rx_data := read_register ( device_registers^.rx_tx );_ end; { while }l end; _Kinterrupt_service async_output_interrupt ( device_registers : register_ptr; , xregion : xmt_region_ptr );{++${dF{ Async_output_interrupt : async line output interrupt service routine{e>{ This is the output interrupt service routine for the DHV-11.B{ It reads the CSR to determine which line interrupted and signals{ the appropriate device.i{ @{ Inputs : xregion - pointer to output communications region1{ device_registers - pointer to registers]{ { Outputs : none{r{--}varr: async_csr : csr; {control status register}N this_line : integer; {line number on which interrupt was received}begina{ { Read the CSR{}? async_csr := read_register ( device_registers^.async_csr );i# this_line := async_csr.tx_line;n{ 5{ Signal the interrupt and clear the xmt waiting flagn{}1 signal_device ( device_number := this_line );o- xregion^.xmt_waiting[this_line] := false;yend; j2procedure process_modem_change ( line : integer );{++;{ D{ This procedure will update the status of a modem line based on the{ current state of the line { {--}type% ASCII_char = [byte] packed recorde low7 : 0..127;N high : 0..1 end; { record }avar  stat : boolean;j modem_status : lstat;f not_passall : boolean;tbegin ! { Only valid on modem lines } - if xmt_region^.line_char[line].modem thenS begina { Read the modem status }! disable_interrupt ( async_ipl ); / write_register ( register_location^.async_csr,m rx_int_ena := true,o tx_int_ena := true,] ind_reg_address := line );B modem_status := read_register ( register_location^.line_status );4 { On modem status change, clear type ahead buffer }, clear_typeahead_buffer ( dhv_struc[line] );8 not_passall := not xmt_region^.line_char[line].passall; { What happened? }f$ if modem_status.ring_indicator then begin { Answer the phone } = write_register ( register_location^.line_control, rx_en := true,' iauto := not_passall,s oauto := not_passall, link_type := modem, dtr := true );d+ xmt_region^.line_valid[line] := false;a end elsem) { Check for dsr and carrier detect }r) if xmt_region^.line_valid[line] then begU*S$ELN023.Ah![KITBUILD.INSTALL]DHVDRIVER.PAS;1RZr"7in) if not ( modem_status.data_set_ready or - modem_status.carrier_detect ) then begin 9 { When line goes down, put a terminator in the typeo2 ahead buffer and flush the transmit silo }, xmt_region^.line_valid[line] := false;/ dispatch_character ( dhv_struc[line],h control_z_character,) xmt_region^.line_char[line].passall,h* xmt_region^.line_char[line].eightbit, put_chars ); end; endf elset; { Otherwise, if the line came up, set line_valid }o$ if modem_status.data_set_ready and% modem_status.carrier_detect then + xmt_region^.line_valid[line] := true;  enable_interrupt; endend; bIfunction line_valid of type check_line_valid; { (line_number : integer )} beginp6 line_valid := xmt_region^.line_valid[line_number];end; -function put_chars of type output_characters;;" { ( line_number : integer;" number_of_chars : integer;@ var output_buffer : string(number_of_chars) ) : boolean; }{++ {s3{ This function outputs characters to an async line {i { Inputs:n{v{ line number specifies line){ number_of_chars specifies buffer length$.{ output_buffer points to buffer of characters{e { Outputs:{r%{ characters output on specified line}={ function returns false if line goes invalid, true otherwisee{e{--}type( physical_addr = [long] packed record case boolean of true : ( full : integer ); false : ( low : word;  high : bits$6 )c end; { record }vart output_character : char; tx_csr : csr;  full : boolean;v count : integer;r done : boolean;e% physical : physical_addr;r correct : integer;, temp : ^string(3); beginrE { For outputting 1-3 characters (i.e. , etc.), use directo6 character output. For longer buffers, use DMA } if number_of_chars <= 3 then( { Output the characters one at a time }% for count := 1 to number_of_chars doe begin { Synchronize with device }% disable_interrupt ( async_ipl ); 7 xmt_region^.indirect_register := line_number;tA { Write the register number and then the transmit register }=7 write_register ( register_location^.async_csr,p rx_int_ena := true, tx_int_ena := true,v% ind_reg_address := line_number );lC write_register ( register_location^.rx_tx, data_valid := true,i/ tx_char := substr(output_buffer,count,1) ); 2 { Raise to powerfail IPL to set waiting bit }& disable_interrupt ( IPL$_power );2 xmt_region^.xmt_waiting[line_number] := true; enable_interrupt; { Wait for completion }, wait_any ( async_output[line_number] ); end {for} else begin) { Get the address of the buffer } ' if xmt_region^.bus_adapter then begin 4 { hack because q-bus map wants odd addresses }% temp := address(output_buffer); if odd( temp::integer )e then correct := 1 else correct := 0;l { map the buffer }eF unibus_map ( dev := async_output[line_number],: buffer := output_buffer,< buffer_size := number_of_chars,< unibus_address := physical.full );/ physical.full := physical.full + correct; endi else7 { Get the physical address of the buffer }sJ physical.full := physical_address ( address(output_buffer) ); { Synchronize with device }! disable_interrupt ( async_ipl );o3 xmt_region^.indirect_register := line_number; = { Write the register number and then the transmit register } 3 write_register ( register_location^.async_csr,r rx_int_ena := true,_ tx_int_ena := true,7% ind_reg_address := line_number );0? write_register ( register_location^.txb_addr1, physical.low );vE write_register ( register_location^.tx_dma_count, number_of_chars ); / write_register ( register_location^.txb_addr2,r# tbuff_high := physical.high,  tx_dma_start := true, tx_ena := true );. { Raise to powerfail IPL to set waiting bit }" disable_interrupt ( IPL$_power );. xmt_region^.xmt_waiting[line_number] := true; enable_interrupt;/ wait_any ( async_output[line_number] );v- { Unmap the buffer if it was mapped } " if xmt_region^.bus_adapter then begin / physical.full := physical.full - correct; H unibus_unmap ( dev := async_output[line_number],< buffer := output_buffer,> buffer_size := number_of_chars,> unibus_address := physical.full ); end; end;J { Check for line valid to return status. True is returned only if theD line is up. If not, wait to see if it comes back (checking inF midstream). Caller of this routine can then check line_valid to5 determine which dap status to return to user. }  put_chars := true;3 if not xmt_region^.line_valid[line_number] then  begin put_chars := false;$ wait_any ( time := modem_timeout );0 if not xmt_region^.line_valid[line_number] then( wait_any ( time := modem_timeout ); end;_end; 9process_block circuit_process ( circuit_struc : ct_ptr );r{++t{ I{ Circuit process : This process is started to service an i/o request fort{ the specified line.t{aI{ Inputs : circuit_struc - a structure containing information peculiar to { this circuit{d{ Outputs : none{ {--}var3 read_buff : terminal_read_buffer;( saved_record_attributes : dap$b_rat;@ saved_record_format: dap$b_rfm; { Record format from open }I saved_fixed_control_size: dap$b_fsz; { Fixed control size from open }^& this_line : integer;& context : integer;& status : integer;- circuit_flags : terminal_flags;a s-function open_action of type dap$open_action;e{++ { ${ Open_action - open action routine{I{ This routine is called by the dap$server routine when the user process { executes an open statement.r{i { Inputs:{e{ create - create/open flage"{ file_access - file access mode{ share - share accessa${ organization - file organization!{ record_format - record format ({ record_attributes - record attributes,{ maximum_record_size - maximum record size{ file_options - file options ({ device_char - device characteristics:{ device_dependent_char - device dependent characteristics*{ file_specification - file specification){ fixed_control_size - fixed control sizep0{ context - driver specific parameter (unused){ c { Outputs:f{e${ organization - file organization!{ record_format - record format ({ record_attributes - record attributes,{ maximum_record_size - maximum record size{ file_options - file optionsb({ device_char - device characteristics:{ device_dependent_char - device dependent characteristics{ { return value = success{o{--}begin:( { Save specified record attributes }1 saved_record_attributes := record_attributes;c) saved_record_format := record_format;(3 saved_fixed_control_size := fixed_control_size; 0 { Set max record size and read buffer size }# if (maximum_record_size = 0) or}- (maximum_record_size > max_read_buffer_size)u then- maximum_record_size := max_read_buffer_size;m; circuit_struc^.read_buffer_size := maximum_record_size;}) { Set some other various parameters }  organization := dap$k_seq;! {record_format := dap$k_var;}i file_options := [];dL device_char := [ dap$v_devrec, dap$v_devccl, dap$v_devtrm, dap$v_devidv, dap$v_devodv ]; a { Set up the flags record }e with circuit_flags dol begin6 passall := circuit_struc^.local_pass;6 echo := circuit_struc^.local_echo;? hardcopy := xmt_region^.line_char[this_line].hardcopy;tB escape_recognize := xmt_region^.line_char[this_line].ANSI_escape; end;l- { If max record size is 1, special case }  if maximum_record_size = 1 then begin circuit_flags.passall := true;{ circuit_flags.echo := false; end;  { Success !!}f open_action := dap$k_successend; e+function get_action of type dap$get_action;p{++ {d"{ Get_action - get actiVfCbm'4Y 1tXE;1 9t =f8{wIB_dr4P ϋ| yf%pj-_ nk"uY3q?ໍL5,+9%TZuj[E l;T0,DpA?Kt$1$FBE%IuDôa(G} k5F&G͘xOyOJJ[\ӖHn!zGoD`Ns(Yt h/6=櫸y}H&tai6 +H1#[m mp1Zv*Wz̔mz7c|:@IvlYguBn| la,;[N'@Qv o&'TQx S'#[r#;XP6# ]\#7c7~mh=|?VUs@PYm];!PIJX*zC~Ev -lh Z:G*:`@=XtLU5; w'"]ΣMXrgܷ.=4D#)v&jPDIP%nl3vԞIPIQ1 Kw'E-Z4M5bc ,'+\WYej[V6BA[~PH( '*M4sk;Y+q\oJ}{\2#]N3e[PM^?f[^' qNj#DaWk[]\Qjli#M8Th@ls(sxDZ`Tz`nqu~ I`{W_N|? jUEKI!%de Vr#yi_-~zOR9PCWZ51 '$n|5d:7nJ0anvn(?-٠J/GT Z2;P 0)Jq(f U5\-41Vb{e g$ GlY%h=3i{ GXKjcAEIlBl$sUtU79c+2R_lJ0xm0%F?\+bCBb3NoU1f@Ux_&L6vt~H/QdpQDaS.@t`OoawM<}==S*{;U$&bYh>c|4r|s=CBZZG mWp=+,@'U(-gzP#R̍ 킊Ђʸӈ禊ɧǙ⨪~WҶ褩ʐ%EּܸާGӳߜԃ̼ۘउΚ:*-:z%F@mpow3hVPfq`lXS6K- TU?]2Sj~CG to&y:>\6x_?\0%^\pb'oj"EQ4:0v,:GO-Tb}#zl9fX 7,/4<`,;FR4OY3ZwlZQW?F6WeSbfs2EjS'7*`_hnEuK5CgE?#(+=m54z>tav m#Ha'Mw iV#F@)nlB42-getIW1OT_e kT|! }*$>zBf~axF7+mlCf~g B}kfq30d[Lac ?XX /;~N{`ekmDiZ7W ,'o(mzI:F3* H*"yKZ.`2GI׶u9VwOrhO{O)?!iDŽ?~r9 ;YsaˑC7ɰR[ (i@EZ˭*br.iaV&Y3ZqWJH!%:Y~a9 >u9{mOp|zkZ$/R rCύ:Uht| @>)J٫ƪ|"m,rOAm" 0 7C\/ ̱$\ D۸pE S>ϯy x/6+ۥ;sc9K13ԋ!ȸ9ږIթfM-Z uBoI]\T%.O [?"QZѡT&e )q-W@j5kӫdu%bdhe/dn!, T }"g _5.\ƂN?x#9e BK=I3'I!uI%BCYd^!$CDhD8IKLܢ3#qI-\I') N`':9(p(P9 bFR,̊~78¦pM5l!EpTPq [r]HoF'h'xXՒ7x=70@"5&06toIBUV֍μޱ^XeDv'GJ8%W&܏j5M7cZ ,Ԑ5e IKv@s^.aL}r cN[xoP{{S_~`Z3j U>H]}6+-kWe~䮂!C(|̞)(^V$YpgOS 3+Be 6s^ ".)|$x8 'pVTҙI6663Sa^upE+-^fLECvcH\6:Y/fAp"_,:"yr$wRMN!ynj+ - m P!|+tzOwN] K0> U{gCGF}0G騾TI|n =0b҆"`qQBP'v iD1 Q[wJakhf,vF˹+YIB좝:Jm`f~hMj.zoݻ6hz˻_,-BJY:[Bp۱UaC Wfur HbNhݴ$YX=pQ@(EHc  U+ۿ /q~XG;R!2qj&r(1ͼ8~-nG[5AZXH% oDAg ~B{ɺ};jn5"}ګ})~A=b4ݸzF&ivdXƔ9C@(B[i˽9a gDs>ȳB Vl}w6dtD`!ʮ]x {aќt [WU&DE!@6V*(nBo&Pvݻ0FpPr u1y'HaX|UAt}$:'cw&!$5=Lw:\d U!U X/r($-5}M8o!ԃy