X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fclock.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fclock.ra;h=a99428167239a7dd741af1b15f4a27d92323540b;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/clock.ra b/sw/os8/v3d/sources/fortran/all/clock.ra new file mode 100644 index 0000000..a994281 --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/clock.ra @@ -0,0 +1,399 @@ +/ +/ VERSION 5A 4/26/77 MH +/ + EXTERN #DISP /SYSTEM PAGE 0,NEEDED TO + /PUT CLOCK STATUS ON PG0 + /(CSTAT) FOR USE BY GEN + /USER CLOCK SERVICE ROUTS + EXTERN #T812 /RTS CPTYP + EXTERN ONQI /INTERRUPT QUEUER + CLZE=6130 /CLOCK IOTS + CLSK=6131 + CLLR=6132 /ALSO CLOE + CLAB=6133 + CLEN=6134 + CLSA=6135 + CSTAT=157 /IDOCLK PUTS CLSA BITS + /IN HERE + BASE FTMP0 + INDEX FCNWD + FIELD1 SYNC + JSA SETUP /HERE TO READ A STRIG + /INITIALIZE ARGS + TRAP4 DOSYNC /FCNWD (XR) HOLDS STRIG + /TO READ + XTA FCNWD /=ANS=0,1 + FSTA% FTMP1 /GIVE ANS TO CALLER + JA GOBAK +FTMP0, F 0.0 /BASE PAGE +FTMP1, F 0.0 +RPTR, 27;ADDR RTBL /PTR TO RATE TBL, ALSO + /USED TO FLT OVRCNT (NOTE + /THAT THE EXPONENT=27) +MINRAT, F .02 /MIN ALLOWABLE RATE +TOVR, F 0.0 +NAME, TEXT +CLOCK + + ORG 10*3+FTMP0 + FNOP + JA NAME+3 + 0 +GOBAK, JA . +RTBL, F 16.0 /CONSTANT USED TO CHK FOR + /EXT CLK BIT IN FCNWD + /THIS CONST MUST BE NE 0 +MAXRAT, +F4096, F 4096.0 /USED TO GET OVRFLO COUNT + F 100000.0 /FASTEST RATE IN HERTZ + F 10000.0 /NEXT FASTEST RATE + F 1000.0 + F 100.0 /SLOWEST RATE + F 1.0 /USED BY TIME FOR EXT CLK + BASE 0 + +SETUP, 0;0 /HERE TO INIT ALL FPP SUBS + STARTD + FLDA 30 /PICK UP RTN TO CALLER + FSTA GOBAK + FLDA 0 /GET PTR TO CALLERS ARGS + SETX FCNWD /CLOCK XR AND BASE + SETB FTMP0 + BASE FTMP0 + FSTA FTMP1 + FLDA% FTMP1,P1 + FSTA FTMP0 /PTR TO 1ST ARG + FLDA% FTMP1,P2 + FSTA FTMP1 /PTR TO 2ND ARG + FLDA #T812 /TELLS PDP8,PDP12 + ATX CPTYP /0=8=DK8ES,1=12=KW12A + STARTF + FLDA% FTMP0 /=1ST ARG + ATX FCNWD /ALWAYS IN FCNWD + JA SETUP + ENTRY CLOCK +CLOCK, JSA SETUP /HERE FOR CLOCK START + FLDA% FTMP0 + FSUB RTBL /FCNWD IS IN FAC,IF GE 16 + JGE ITSEXT /(RTBL=16.0) THEN USER IS + /REQUESTING AN EXTERNAL + /CLOCK I.E. B8 OF FCNWD + /IS SET. + FLDA% FTMP1 /=REQUESTED RATE IN HERTZ + FSUB MINRAT /.LE. MINUMUM RATE + JLE GOTR-2 /MEANS STOP CLOCK. + FADD MINRAT + FSUB MAXRAT /CHK FOR TOO FAST + JGT GOTR-2 + LDX -4,OVRFLO /THERE ARE 4 BASIC RATES + LDX 1,RATE /=INDEX INTO RTBL; UPON + /TRAP(CLOCK) RATE=(0, + /2,3,4,5,6) 0=STOP, + /6=EXTERNAL + /2-5=PROGRAMMABLE RATES +LOP0, FLDA% RPTR,RATE+ + /GET NEXT SLOWEST RATE + FDIV% FTMP1 /=REQUESTED RATE IN HZ. + /FAC=OVRFLO COUNT; + FSUB F4096 /MUST BE MODULO 12 BITS. + JLE GOTR /FOUND IT + JXN LOP0,OVRFLO+ + LDX 0,RATE /RATE IS TOO SLOW, STOP + /CLOCK. +GOTR, FADD F4096 /RESTORE + FSTA TOVR + ATX OVRFLO /OVER FLOW COUNT + TRAP4 SETCLK /GO START CLOCK + JA GOBAK /RTN TO CALLER +ITSEXT, LDX 6,RATE /=RATE FOR EXT CLK + FLDA% FTMP1 /REQUESTED RATE IS + /INTERPRETED AS OVRFLO + JA GOTR+1 /WHEN RATE IS EXTERNAL + /MAGIC TABLE USED BY SETCLK TO SET CLOCK ENABLE +/BITS. EVEN NUMBERED ENTRIES ARE FOR THE DK8ES; +/ODD NUMBERED ONES ARE FOR THE KW12A. + +CLKTBL, 0675 /"STANDARD" DK BITS + 300 /STND KW BITS + 1 /DK STRIG1 BIT + 60 /KW STRIG1 BITS + 2 /DK S2 + 14 /KW S2 + 4 /S3 +P3, 3 /S3 + 40 /DK ADC ON OVR BIT + 400 /KW ADC ON OVR BIT + + /IF NOT NEXT PAGE DO ORG + IFNEG .-200 < ORG .-SYNC&7600+200+SYNC > + SETCLK, 0 /TRAP HERE TO START CLK + /THIS ROUT HANDLES BOTH + /DK8ES AND KW12A. + CLLR /STOP KW AND SET MODE 0; + /NOP FOR DK. + CLEN /CLR KW12 ENABLE OR + /READ DK ENABLE. + CLA + TAD P7540 /TOGGLE KW MODE 0 TO 1 TO + CLLR /CLR CLK COUNTER, OR SET + /DK ENABLE BITS, RATE FOR + CLA CMA /BOTH NOW=7=STOP. + CLZE /CLR ALL DK ENABLE BITS, + CLSA /CLR STATUS OF BOTH, ALL + CLA /IS NOW CLEAR. + TAD FCNTBL+1 /SET PTR TO CLKTBL FOR + /SETTING OF ENABLE REGS. + TAD CPTYP /=0 IF PDP8 =1 IF PDP12 + DCA FCNPTR /TBL ENTRIES ALTERNATE + /FOR 8 AND 12. CPTYP SETS + /PTR TO 1ST 8 OR 1ST 12 + /ENTRY + TAD IDOCLK /(AC=JMP AROUND). THE + /FOLLOWING IS ONCE ONLY + /CODE. THESE LOCS ARE + /SUBSEQUENTLY USED AS + /OPERANDS + DCA .-1 + /THE TAG "ISVBIT" MUST BE + /IN FRONT OF THE STRIG + /FLAGS (STFLG) TO COVER + /THE ILLEGAL CASE OF + /STRIG 0 IN A FORT CALL + /TO SYNC. +ISVBIT, TAD CPTYP /(AC=0,1) MAKE THE INST + /RAR CLL (FOR DK) OR THE + /INST RTR CLL FOR IDOCLK; +STFLG, RAL CLL /BECAUSE STATUS BITS FOR + TAD RARCLL /STRIGS DIFFER ON DK,KW. + DCA LOP2+1 /SEE SUB IDOCLK. + /THE ABOVE 3 LOCS ARE + /SCHMITT TRIGGER FLAGS. + /THE ORDER IS S1,S2,S3 + /FOR PDP8 AND S3,S2,S1 + /FOR PDP12. THE MAIN + /REASON FOR REVERSING + /THE ORDER IS BECAUSE + /ENGINEERS NEVER CONSULT + /PROGRAMMERS WHEN THEY + /ARE BUILDING NEW + /HARDWARE (CHK THE STATUS + /BITS FOR DK AND KW). + JMS% KONQI+1 /PUT CLOCK ON THE +ITMP0, CLSK /INTERRUPT QUE + /VIA ONQI. +CLENAB, ADDR IDOCLK /THIS LOC WILL HOLD THE + /ENABLE BITS FOR DK,KW +AROUND, TAD RATE /(AC=0,2,3,4,5,6) RATE IS + /SET BY FPP + RTR CLL /START TO POSITION RATE + RAR /BITS. B3-B5 FOR DK + /B0-B2 FOR KW + TAD CPTYP /(THIS IS TRICKY) NEED + RAR /CPTYP IN LNK BECAUSE + /POSITION OF RATE BITS + /DIFFER FOR DK KW. + TAD% FCNPTR /AC="STANDARD" + /ENABLE BITS FOR DK,KW. + SZL /IF ITS A KW THE RATE AND + /AND STND BITS ARE ALREADY + /POSITIONED AS FOLLOWS: + /RRR011000000 + /B0-B3 AND B5 WILL GO TO + /KW CONTROL. B4,B5 WILL + /GO TO ENABLE. B3 IS ADC + /ON OVRFLO AND MAY BE SET + /BELOW. B5 ON CONTROL IS + /MODE 1. B4 AND B5 ON + /ENABLE ARE BUFF PRESET TO + /CLOCK COUNTER AND INTRUPT + /ON OVRFLO RESPECTIVELY. + JMP NOBIT-1 /ITS KW GO PUT IN CLENAB. + RTR /ITS DK; POSITION RATE TO + RAR /B3-B5. NOTE THAT THE LNK + /(CPTYP=0) IS BEING USED. + CMA /NOTE ALSO THAT THE RATE + /AND STND BITS ARE THE 1S + /COMP. OF WHAT THEY SHOULD + /BE, IE CPTYP=LNK=0 + /BECOMES + /B2=1 OF ENABLE=BUFF + /PRESET TO CLK CNTR ON + /OVERFLO. LOOK AT THE RATE + /BITS IN THE HANDBOOK FOR + /BOTH DK,KW. R2,R5 + /FOR DK IS 100HZ, 100KHZ + /RESPECTIVELY. R2,R5 FOR + /KW IS 100KHZ,100HZ. + /1S COMP.OF 2=5 ETC. + /SMARTEN UP STEVE! + /THE FINAL VALUE OF THE + /STND DK ENABLE BITS (1ST + /ENTRY IN CLKTBL) IS LEFT + /AS AN EXERCISE FOR THE + /PROGRAMMER. + JMP NOBIT-1 /GO PUT IN CLENAB +LOP1, RAR CLL /ROT 1 FCN BIT INTO LNK. + /B7=EXT CLK AND IS + /IGNORED HERE. B8=ADC ON + /OVRFLO, B9-B11 ARE STRIG3 + /-STRIG1 RESP. BX=1=ENABLE + /FCN. 0=DISABLE + DCA FCNWD /PUT IT BACK (FCNWD IS + /SET BY FPP) + SNL /ENABLE FCN ? + JMP NOBIT /NO + TAD% FCNPTR /GET BITS FROM THE MAGIC + TAD CLENAB /TABLE. + DCA CLENAB /UPDATE ENABLE WORD. +NOBIT, ISZ FCNPTR /ADV TO NEXT + ISZ FCNPTR /TBL ENTRY. + TAD FCNWD /WHEN FCNWD GOES TO 0 + AND P17 /WE ARE ALL DONE. + /THE "AND" IS DONE TO + /PROTECT AGAINST A BAD + /ARG FROM THE FORT CALL. + /IN A FRIENDLY ENIVORN, + /ITS NOT NECESSARY. + /NEVER TRUST A FORTRAN + /"PROGRAMMER". +P7540, SMA SZA /SMA IS SUPERFLOUS TO + /THE ROUT; BUT IT + /CREATES A NICE CONST. + JMP LOP1 /MORE TO DO + DCA STFLG /CLR THE SCHMITT + DCA STFLG+1 /TRIGGER FLAGS. + DCA STFLG+2 + TAD OVRFLO /SET BUFF PRESET + CIA /(FPP SET THIS ARG) + CLAB + CLA + TAD CLENAB /THIS IS FOR KW ONLY. + AND P377 /AC=3XX. 3= OR BUFF PRE + /INTO CLK CNTR AND ENAB + /INT ON OVRFLO. + /XX ARE THE STRIGS. + CLEN /SET KW ENABLE OR + CLA /READ DK ENABLE. + DCA OVRCNT+1 /CLR NUM OF CLK OVRFLOS + DCA OVRCNT /SINCE TIME 0. + TAD CPTYP /NEED TYPE IN ORDER TO +RARCLL, RAR CLL /ISOLATE CONTROL + TAD CLENAB /BITS FOR + SZL /KW ? + AND P7540 /YES, B0-B2 IS RATE, + /B3 IS ADC, B5 IS BUFF + /PRE TO CLK CNTR ON + /OVRFLO, B6 IS MOX NIX. + /IF DK ALL BITS MAY HAVE + /MEANING + CLLR /START THE CLOCK + CLA + CIF CDF + JMP% SETCLK /RTN TO RTS + DOSYNC, 0 /HERE TO DISPOSITION A + /A SCHMITT TRIGGER. + TAD CPTYP /DK AND KW FLAGS ARE IN + RAR CLL /REVERSE ORDER. IF DK + /ARG IS OK; IF KW THEN + /MUST SET 1=3, 2=2, 3=1 + /TO GET INDEX TO + /CORRECT FLAG. + TAD FCNWD /=REQUESTED STRIG=1,2,3 + /(SET BY FPP) + SZL /DK ? + CIA /NO KW + AND P3 /IE 1 GOES TO -1 GOES + /TO 3 ETC. "AND" ALSO + /INSURES RANGE IS 0-3. + /IF ARG IS 0 RESULT IS + /ALWAYS 0. + TAD KSTFLG+1 /GET PTR TO FLAG + DCA SETCLK + TAD% SETCLK /FLAG=0 IF TRIG HAS NOT + /TRIPPED SINCE THE LAST + /CALL TO SYNC; =1 + /OTHERWISE IE RTN 0=FALSE + DCA FCNWD /,1=TRUE (FPP WILL PICK + / UP FCNWD) + DCA% SETCLK /CLR FLAG ANYWAY + CIF CDF + JMP% DOSYNC /RTN TO RTS + IDOCLK, JMP AROUND /HERE ON CLOCK INTERRUPT + /(JMP AROUND IS A ONCE + /ONLY CONSTANT). + TAD KSTFLG+1 /SET PTR TO STRIG FLAGS. + DCA ITMP0 + CLSA /GET CLOCK BITS. + DCAZ CSTAT /SAVE THEM FOR SOME + TADZ CSTAT /BODY ELSE. + SPA /OVER FLOW ? + ISZ OVRCNT+1 /YES BUMP LO ORD CNTR + SKP + ISZ OVRCNT /BUMP HI ORD + JMP DOTRIG /(HI ORD ISZ SKP IS + /HARMLESS) +LOP2, ISZ ITMP0 /ADV STRIG FLAG PTR. + RAR CLL /(OR RTR CLL IF KW) + /IE PUT STRIG BIT IN LNK. + /IF DK THE ORDER OF + /INTERROGATION IS S1,S2,S3 + /IF KW THE ORDER IS S3, + /S2,S1. THE STATUS BITS + /FOR DK ARE ADJACENT IE + / B9(S3),B10(S2),B11(S1) + /FOR KW ITS EVERY OTHER, + /B6(S1),B8(S2),B10(S3). + DCA ISVBIT /SAVE WHATS LEFT. + RAL /COPY LNK INTO FLAG IF=1 + SZA /IE DONT CLR FLAG WHEN + DCA% ITMP0 /ITS SET. + TAD ISVBIT +DOTRIG, AND P377 /THE "AND" INSURES THAT + /THE HI ORD BITS ARE + /CLRED SO THAT ISVBIT + /GOES TO 0 WHEN ALL + /STRIGS HAVE BEEN + /DISPOSITIONED. IE + /CLR OVRFLO BIT FOR DK,KW + /AND CLR PRE-EVENT BIT + /ON KW IF IT IS SET + SZA /DONE ? + JMP LOP2 /NO + TAD #CLINT /CALL USER EXTENDED + SZA CLA /CLOCK ROUT ? + JMS% #CLINT+1 /YES + JMP% IDOCLK /RTN TO IHANDL + FCNPTR, +OVRCNT, +KONQI, ADDR ONQI +P17, 17 +P377, 377 +FCNWD, 0 /FPP XRS +CPTYP, 0 +RATE, 0 +P1, 1 +P2, 2 +OVRFLO, +FCNTBL, ADDR CLKTBL +KSTFLG, ADDR STFLG-1 + ENTRY #CLINT +#CLINT, 0;0 + ENTRY TIME /FIGURE WHAT TIME IT IS +TIME, JSA SETUP + FLDA RPTR /=27;X;X IS USED TO FLOAT + STARTD + FLDA# OVRCNT /NUM OF CLK OVRFLOS SINCE + STARTF /TIME 0 + FNORM + FMUL TOVR /=NUM OF BASIC TICKS PER + /CLOCK OVER FLOW. + /FAC=NUM OF TICKS SINCE + /TIME 0. + FDIV% RPTR,RATE /DIV BY BASIC RATE IN HZ + /OR 1 IF EXTERNAL CLK. + FSTA% FTMP0 /GIVE ANS TO CALLER, ALSO + /LEAVE ANS IN FAC IN + /CASE TIME WAS A FCN + /CALL. ANS=ELAPSED TIME IN + /SECONDS SINCE TIME 0 OR + /NUM OF EXTERNAL UNIT + JA GOBAK /TICKS +