sw/os8/v3d/sources/extensions/dectapes/dectape2/uf.pa

   1 /OS8 BASIC USER FUNCTIONS, V5
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1974 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 \f/JR    6-JUN-77        MODIFIED FOR V5
  46
  47         VERSON= 5       /VERSION OF BRTS
  48         SUBVUF= 01      /SUBVERSION OF BASIC.UF
  49                         /FIRST WORD OF THIS OVERLAY CONTAINS
  50                         /BRTS VERSION IN LEFT HALF AND SUBVERSION IN RIGHT HALF
  51
  52         FPP=    4000
  53         FADD=   FPP+2000
  54         FSUB=   FPP+2117
  55         FMPY=   FPP+1600
  56         FDIV=   FPP+1722
  57         FFNEG=  FPP+2135
  58         FFPUT=  FPP+2256
  59         FFGET=  FPP+2241
  60         FFNOR=  FPP+2215
  61         FACCLR= 0365
  62         UNSFIX= 1615
  63         PSWAP=  1230
  64         ARGPRE= 307
  65
  66         /VC8E POINT PLOTTING DISPLAY CONTROL IOT'S
  67
  68         DISD=   6052    /SKIP ON DONE FLAG
  69         DILX=   6053    /LOAD AC2-11 INTO X-REGISTER (DOESN'T CLEAR AC)
  70         DILY=   6054    /LOAD AC2-11 INTO Y-REGISTER (DOESN'T CLEAR AC)
  71         DIXY=   6055    /INTENSIFY
  72
  73         /DK8EP PROGRAMMABLE REAL TIME CLOCK IOT'S
  74
  75         CLZE=   6130    /CLEAR CLOCK ENABLE BITS PER AC
  76         CLSK=   6131    /SKIP ON CLOCK FLAG
  77         CLOE=   6132    /SET CLOCK ENABLE BITS PER AC
  78         CLAB=   6133    /AC TO CLOCK BUFFER
  79         CLSA=   6135    /READ CLOCK STATUS TO AC
  80                         /BIT 0 SET ON OVERFLOW
  81                         /BITS 9-11 SET ON RESPECTIVE SCHMITT TRIGGER FIRING
  82
  83         /CLOCK ENABLE REGISTER BITS
  84         /BIT    FUNCTION
  85         /0      INTERRUPT ENABLE BIT
  86         /1-2    MODE BITS:
  87         /       00      RUN COUNTER, INTERRUPTING EACH 4096 TICKS
  88         /       01      RUN COUNTER AND RESET WITH CLOCK BUFFER ON OVERFLOW
  89         /       10      RUN COUNTER AND READ COUNTER WHEN EVENT OCCURS
  90         /       11      RUN COUNTER AND READ AND CLEAR IT ON EVENT
  91         /3-5    RATE SELECTION:
  92         /       000     STOPPED
  93         /       001     EXTERNAL TIME BASE
  94         /       010     100 HZ
  95         /       011     1 KHZ
  96         /       100     10 KHZ
  97         /       101     100 KHZ
  98         /       110     1 MHZ
  99         /       111     STOPPED
 100         /6      OVERFLOW STARTS A-D
 101         /7      SET TO INHIBIT CLOCK
 102         /8      EVENT ON CHAN 1, 2, OR 3 CAUSE INTERRUPT AND OVERFLOW
 103         /9-11   ENABLE EVENTS 1 THRU 3
 104
 105         /AD8EA A-D CONVERTER IOT'S
 106
 107         ADCL=   6530    /CLEAR A-D
 108         ADLM=   6531    /LOAD MULTIPLEXOR FROM AC8-11 AND CLEAR AC
 109         ADST=   6532    /START A-D CONVERTER
 110         ADRB=   6533    /READ A-D BUFFER INTO AC0-11 AND CLEAR FLAG
 111         ADSK=   6534    /SKIP ON A-D DONE FLAG (DOESN'T CLEAR FLAG)
 112         ADLE=   6536    /SKIP ON TIMING ERROR
 113         ADRS=   6537    /READ STATUS REGISTER
 114
 115         /STATUS REGISTER FORMAT:
 116         /0      A-D DONE FLAG
 117         /1      TIMING ERROR FLAG
 118         /2      ENABLE INTERRUPT ON DONE FLAG
 119         /3      ENABLE INTERRUPT ON TIMING ERROR
 120         /4      ENABLE EXTERNAL START (EG CLOCK)
 121         /5      AUTO INCREMENT MODE
 122         /6-7    UNUSED
 123         /8-11   4 BIT CHANNEL NUMBER
 124
 125         /DR8E-A DIGITAL BUFFERED I/O BASE IOT'S
 126
 127         DBDI=   6500    /DISABLE INTERRUPTS
 128         DBEI=   6501    /ENABLE INTERRUPTS
 129         DBSK=   6502    /SKIP IF THE IN FLAG IS SET
 130         DBCI=   6503    /SET SELECTED BITS IN INPUT REGISTER
 131         DBRI=   6504    /READ INPUT REGISTER TO AC
 132         DBCO=   6505    /CLEAR SELECTED BITS IN OUTPUT REGISTER
 133         DBSO=   6506    /SET SELECTED BITS IN OUTPUT REGISTER
 134         DBRO=   6507    /READ OUTPUT REGISTER TO AC
 135
 136         ACX=    44
 137         ACH=    45
 138         ACL=    46
 139
 140         MAXPTS= XR0
 141         REFRFL= XR1
 142         BUFXR=  XR2
 143         DX=     XR3             /XR3,XR4,XR5=   TEMP FL PT LOC
 144
 145         SPF=    6040    /SET TTY PRINTER FLAG
 146         CAF=    6007    /RESET PROCESSOR
 147
 148         IA=     1465    /ENTRY POINT FOR USER FUNCTION ERROR MESSAGE
 149 \f       NOPUNCH         /DUMMY SECTION FOR MISC PAGE 0 REFERENCES
 150
 151         *1
 152         JMP I   .+1
 153         SERVC
 154         *6
 155 USECON, 0       /ENTRY #OF USER BUF IN DIM TBL
 156         *10
 157 XR0,    0
 158 XR1,    0
 159 XR2,    0
 160 XR3,    0
 161 XR4,    0
 162 XR5,    0
 163         *20
 164 CDFIO,  CDF 10  /FLD OF PSEUDO DIM TBL
 165         0
 166 ARSTRT, 0       /ADR-1 OF PSEUDO DIM TBL
 167         *64
 168 INSAV,  0
 169         *73
 170 K0010,  10
 171 K0017,  17
 172         *77
 173 K0200,  200
 174         *107
 175 M14,    -14
 176         *114
 177 FIXP,   UNSFIX
 178         *134
 179 FGETL,  FFGET
 180 FPUTL,  FFPUT
 181 FNORL,  FFNOR
 182 FCLR,   FACCLR
 183 FNEGL,  FFNEG
 184         *156
 185 P1SWAP, PSWAP
 186
 187         ENPUNCH
 188 \f       *3400
 189
 190 /INI(N)-INITIALIZE ROUTN;CALLED BY USER BEFORE 'PLY
 191 /       OR ADC';INITIALIZE CTRS,FLGS,ETC
 192 /       N IS A DUMMY ARG
 193 /
 194 INI,    VERSON^100+SUBVUF /VERSION NUMBER OF USER FUNCTIONS
 195         JMS     BUFCDF
 196         TAD     BUFBAK  /PICK UP ADDR OF DISPLAY BUFFER
 197         DCA     BUFXR   /STORE IN BUFFER XR FOR PUTBUF ROUTINE
 198         DCA     TOTPTS  /BUF IS NOW EMPTY
 199         IAC
 200         DCA I   (STPT   /ACCES BUF AT 1ST PT
 201         IAC
 202         DCA I   (NTHY   /ACCES EVERY PT
 203         IAC
 204         DCA I   (XFLG   /BUF MAYBE DISPLAYED
 205         JMP I   INI
 206
 207         /ROUTINE TO GET FIELD AND ADDRESS OF USER BUFFER
 208         /FROM 'USECON' LOCATION
 209
 210 BUFCDF, 0
 211         TAD     USECON  /ENTRY PT OF BUF IN DIM TBL
 212         CLL RTL         /MULT BY 4
 213         TAD     ARSTRT  /ADR-1 OF STRT F DIM TBL
 214         DCA     XR5     /ADR-1 OF ENTRY IN DIM TBL
 215         TAD     CDFIO   /COPY CDF TO BRTS TABLES INLINE
 216         DCA     .+1
 217         0
 218         CMA
 219         TAD I   XR5     /ADR-1 OF BUF
 220         DCA     BUFBAK  /NEED FOR DISPLY ROUTN
 221         TAD I   XR5     /GET CDF OF BUF
 222         DCA     PUTCDF
 223         TAD     PUTCDF
 224         DCA     CDFBAK  /NEED FOR DISPLY ROUTN
 225         CDF             /RESTORE DF
 226         JMP I   BUFCDF
 227 CDFBAK, 0
 228 BUFBAK, 0
 229 TOTPTS, 0
 230
 231 /PUTBUF-ENTER WITH A 12BIT VALUE IN AC;PUT VAL IN
 232 /       USER BUFFER;CHK TO SEE IF NXT VAL WILL CROSS FLDS
 233 /
 234 PUTBUF, 0
 235 PUTCDF, 0
 236         DCA I   BUFXR
 237         IAC
 238         TAD     BUFXR
 239         SZA CLA         /ABOUT TO CROSS FLDS?
 240         JMP     .+4     /NO
 241         TAD     K0010   /YES
 242         TAD     PUTCDF
 243         DCA     PUTCDF  /DF=DF+1
 244         CDF             /RESTORE DF
 245         JMP I   PUTBUF
 246 \f
 247 /PLY(Y)-ENTER WITH YVAL IN FAC;CHK 0<=VAL<1.;
 248 /       PUT LEGIT VAL IN USER BUF
 249 /
 250 PLY,    0
 251         TAD     ACH
 252         SPA CLA         /YVAL>=0?
 253         JMP I   (IA     /NO,ERR
 254         TAD     ACX
 255         SMA SZA CLA     /YVAL<1?
 256         JMP I   (IA     /NO, ERR
 257 /CONV # IN FAC TO A 10BIT DISPLAYABLE VAL
 258 /       FAC=FAC*1776+1001
 259 /
 260         JMS  I  (FMPY   /YES
 261         FL1022          /1776(8)
 262         JMS  I  (FADD
 263         FL513           /1001(8)
 264         JMS I   FIXP
 265         JMS     PUTBUF
 266         ISZ     TOTPTS  /KEEP CNT OF PTS IN BUF
 267         JMP I   PLY
 268 \f/DLY(N)-N IS MAX # OF PTS TO BE EVENTUALLY DISPLAYED
 269 /       CHK IF 1<=N<=1024; SET 'REFRFL' =0 FOR
 270 /       A ONE SHOT DISPLAY.
 271 /
 272 DLY,    0
 273         JMS I   FIXP
 274         SPA SNA         /1<=N?
 275         JMP I   (IA     /NO,ERR
 276 /CHK IF N IS SAME AS LAST TIME &
 277 /IF SO, NO NEED TO GO THE "SETDX" ROUT
 278         DCA     INI     /YES,TEMPORARY SAVE
 279         DCA     XR1
 280         TAD     INI
 281         CIA
 282         TAD     MAXPTS
 283         SZA CLA         /N IS STILL THE SAME?
 284         JMP     .+3     /NO
 285         JMS I   (DISPLY /YES, DISPLY ONCE &
 286         JMP I   DLY     /RETURN
 287         TAD     INI     /GET N BACK
 288         DCA     MAXPTS  /ASSUME N IS VALID FOR MOMENT
 289         TAD     MAXPTS
 290         CIA
 291         TAD     (2000
 292         SPA CLA         /N<=1024?
 293         JMP I   (IA     /NO
 294         DCA     REFRFL  /ONE SHOT DISPLY
 295         JMS I   (SETDX  /SET DX FOR DISPLY
 296         JMP I   DLY
 297 \f/ADC(N)-SAMPLE ADC NTH CHANNEL; RETN FL PT VAL IN FAC
 298 /
 299
 300 ADC,    0
 301         JMS I   FIXP    /GET ARG N
 302         CIA
 303         TAD     K0017
 304         SPA             /N<=17(8)?
 305         JMP I   (IA     /NO,ERR
 306         CIA             /YES
 307         TAD     K0017
 308         ADLM            /LOAD MUX
 309         ADST            /START CONV
 310         ADSK
 311         JMP     .-1
 312         ADRB            /GET VAL
 313         DCA     ACH
 314         JMS I   (FFLOT
 315         JMP I   ADC
 316 \f/CLW(N)-N IS A DUMMY ARG; WAIT UNTIL CLOCK O.F. OR
 317 /       UNTIL A SCHMITT TRIG FIRES(DEPENDING WHICH WAS
 318 /       SPECIFIED IN 'CLK') BEFORE RETURNING TO BASIC
 319 /
 320 CLW,    0
 321         CLSK            /STATUS REG IS ALREADY SET?
 322         SKP             /NO
 323         JMP     EARLY   /YES
 324         CLSK
 325         JMP     .-1
 326         CLSA            /READ STATUS
 327 CLW1,   CLL RAL         /CHK ON O.F.
 328         SZL             /O.F. BIT SET IN SATUS WD?
 329         CIA             /YES,NEG REST OF STATUS REG
 330 /RTN 0 IF O.F. ONLY; 1,2,...,7 IF SCHMITT ONLY;
 331 /-1,-2,...,-7 IF BOTH
 332         RAR             /NO
 333         DCA     ACH
 334         JMS I   (FFLOT
 335         JMP I   CLW
 336 /IF CLOCK INTERRUPTED TOO SOON TELL USER;
 337 /-8 IF O.F. ONLY; 9 THRU 15 IF SCHMITT ONLY;
 338 /-9 THRU -15 IF BOTH
 339 EARLY,  CLSA
 340         TAD     K0010
 341         JMP     CLW1
 342
 343         PAGE
 344 \f/DIS(S,E,N,X)-DISPLY EVERY NTH PT BEGIN WITH S
 345 /       & NOT EXCEEDING N; X=1 DISPLY NOW,
 346 /       X=0 SETUP TO DISPLY FOR A SAM
 347 /
 348 DIS,    0
 349         JMS I   (BUFCDF /SETUP CDF & USER BUF
 350         JMS I   (ARG123
 351         STPT-1
 352 /FLOAT N
 353         TAD     NTHY
 354         DCA     ACH
 355         JMS I   (FFLOT
 356         JMS I   FPUTL   /IT BETTER NOT =0
 357         DX              /HOLD TEMPORARY
 358 /CHK 1<=S,0<=E-S
 359         TAD     STPT
 360         SPA SNA
 361         JMP I   (IA     /ERROR
 362         CIA
 363         TAD     ENDPT
 364         SPA
 365         JMP I   (IA     /ERROR
 366 /FLOAT (E-S) & GET (E-S)/N
 367         DCA     ACH
 368         JMS I   (FFLOT
 369         JMS I   (FDIV
 370         DX
 371 /CHK (E-S)/N+1<=1024; MAXPTS=(E-S)/N+1
 372         JMS I   FIXP
 373         IAC
 374         DCA     MAXPTS  /ASSUME OK FOR NOW
 375         TAD     MAXPTS
 376         CIA
 377         TAD     (2000   /1024(10)
 378         SPA CLA
 379         JMP I   (IA     /ERROR
 380 /GET X ARG; DISPLY BUF(X=1); ONLY A SETUP FOR SAM (X=0)
 381         CLL IAC RAL     /4TH ARG DESIGNATED BY AC=2
 382         JMS I   (GETARG
 383         JMS I   FIXP
 384         DCA     XFLG
 385         TAD     XFLG
 386         SZA CLA         /USER WANTS TO DISPLY?
 387         TAD     MAXPTS  /YES,TOTPTS=MAXPTS
 388 DPY1,   DCA I   (TOTPTS /NO,JUST SET UP,TOTPTS=0
 389         IAC             /REFRESH TILL ^N(NON INTERRUPT)
 390         DCA     REFRFL  /OR TILL CLK INTERRPT(INT MODE)
 391         JMS I   (SETDX
 392         JMP I   DIS
 393 STPT,   0               /THESE 3 LOCATIONS
 394 ENDPT,  0               /GO TOGETHER & MUST
 395 NTHY,   0               /BE IN THIS ORDER
 396 XFLG,   0
 397 \f/DISPLY-SETUP CDF & PTR TO STARTING PT OF USER BUF;
 398 /       SETUP 'DISCTR' FOR # OF PTS TO DISPLY THIS TIME;
 399 /       INITIALIZE FL PT 'DXSUM'=-'DX'
 400 /
 401 DISPLY,0
 402 /IF TOTPTS<=MAXPTS,DISPLY TOTPTS;OTHERWSE MAXPTS
 403 D4,     TAD I   (TOTPTS
 404         SNA             /SIMPLE WAIT LOOP FOR THAT'1ST'
 405         JMP     .-1     /ADC TO BE SAMPLED
 406         CIA
 407         DCA     DISCTR
 408         TAD     DISCTR
 409         TAD     MAXPTS
 410         SMA CLA         /TOTPTS<=MAXPTS?
 411         JMP     .+4     /YES
 412         TAD     MAXPTS  /NO
 413         CIA
 414         DCA     DISCTR
 415 /SETUP CDF & PTR TO START PT OF USER BUFFER
 416         TAD I   (CDFBAK /RE-INIT CDF FOR LAST TIME YOU DISPLY
 417         DCA     DISCDF  /YOU MAY HAVE CROSSED FLDS
 418         TAD I   (BUFBAK /ADR-1 OF BUF
 419         TAD     STPT
 420         DCA     BUFPTR
 421         TAD     XCRD    /INITIALIZE XCOORD
 422         DCA     XCOORD
 423 D3,     TAD     XCOORD
 424         DILX
 425         TAD     DELTAX
 426         DCA     XCOORD  /UPDATE XCOORD BY DELTAX
 427 DISCDF, 0
 428         TAD I   BUFPTR
 429         CDF
 430         DILY
 431         CLA CLL
 432         TAD     NTHY    /MOVE PTR TO NXT LOC TO BE
 433         TAD     BUFPTR  /ACCESSED IN BUF
 434         DCA     BUFPTR
 435         SNL             /JUST CROSSED FLDS?
 436         JMP     .+4     /NO
 437         TAD     K0010   /YES
 438         TAD     DISCDF
 439         DCA     DISCDF
 440         DISD
 441         JMP     .-1
 442         DIXY    /INTENSIFY
 443 /DISPLYED ALL PTS YET?
 444         ISZ     DISCTR
 445         JMP     D3      /NO
 446         TAD     REFRFL  /YES,KEEP REFRESHING?
 447         SNA CLA
 448         JMP I   DISPLY  /NO
 449 /KEYBOARD IS CHK HERE FOR ^N WHEN DSPL & NOT SAMPLING
 450 /KEYBOARD INTERRUPTS TO THE INT ROUTN
 451 /
 452         KSF             /YES
 453         JMP     D4
 454         KRB
 455         TLS
 456         TAD     (-216
 457         SNA CLA         /USER HIT ^N?
 458         JMP I   DISPLY  /YES
 459         JMP     D4      /NO, KEEP REFRESHING
 460 DISCTR, 0
 461 BUFPTR, 0
 462 XCRD,   0
 463 XCOORD, 0
 464 DELTAX, 0
 465 \f/FFLOT-FLOAT ANY INTEGER IN ACH(LOC 45) INTO FAC
 466
 467 FFLOT,  0
 468         DCA     ACL     /CLEAR LOW MANTISSA
 469         TAD     (13     /11(10) INTO EXPONENT
 470         DCA     ACX
 471         JMS I   FNORL   /NORMALIZE
 472         JMP I   FFLOT   /RETURN
 473 FL513,  12;2002;0
 474 FL1022, 12;3774;0
 475
 476         PAGE
 477 \f/SAM(C,N,P,T)-SETUP PARAMETERS FOR SUBSEQUENT SAMPLING
 478 /       OF ADC'S OR OR DOING DIGITAL IO
 479 /
 480         CONST=CLK
 481         TSAM=NCTR
 482 SAM,    0
 483         JMS I   (ARG123
 484         CSAM-1
 485         TAD     PSAM
 486         SPA SNA         /P=0?
 487         JMP I   (IA     /YES,ERR
 488         CIA             /NO
 489         DCA     PCTR    /PCTR=-P(DONE CTR)
 490         CLL IAC RAL     /4TH ARG IS DESIGN BY AC=2
 491         JMS     GETARG  /GET T
 492         JMS I   FIXP
 493         DCA     TSAM
 494         TAD     TSAM
 495         SZA CLA         /SET UP TO SAMPLE ADC'S?
 496         JMP     DIG     /NO, DO DIGAL IO
 497         IAC             /YES
 498         DCA     SAMFLG  /SET FLG=1 FOR 'CLK'
 499         TAD     K0017   /15(10)
 500         JMP     SAM1
 501 DIG,    CMA
 502         DCA     SAMFLG  /SET FLG=-1 FOR 'CLK'
 503         CLA CLL IAC RAL /2
 504 SAM1,   DCA     CONST
 505 /CHK IF 0<=C, 1<=N, N+C-1<=2(DIG IO)OR <=17(8)(ADC'S)
 506 /
 507         CMA
 508         TAD     NSAM
 509         SPA             /1<=N?
 510         JMP I   (IA     /NO,ERR
 511         TAD     CSAM
 512         CIA
 513         TAD     CONST
 514         SPA CLA         /N+C-1<=2 OR 17?
 515         JMP I   (IA     /NO,ERR
 516         TAD     TSAM
 517         SNA CLA
 518         JMP     SAM3
 519 /CLEAR ALL DIGIAL INPT REGS
 520         JMS I   (BUFCDF /SET UP USER BUF
 521         TAD     NSAM
 522         CIA
 523         DCA     NCTR    /-#OF BOARDS TO CLAR
 524         TAD     CSAM    /START BOARD#(0,1,2)
 525         CLL RTL
 526         RAL             /START BOARD# * 10(8)
 527         TAD     (DBCI
 528 A1,     DCA     .+2
 529         CLA CMA
 530         0               /DBCI IS ISSUED
 531         CLA
 532         TAD     .-2
 533         TAD     K0010
 534         ISZ     NCTR    /MORE BOARDS TO CLEAR?
 535         JMP     A1      /YES
 536         CLA
 537         JMP I   SAM
 538 /DO A CLEAR ALL; AD DONE FLG, ERR FLG, CLR MUX & EN REG.
 539 /SET NON-AUTO INCR MODE
 540 /
 541 SAM3,   CAF             /CL ALL FLGS-I MAY USE ION'S
 542         ADCL
 543         TAD     K0200
 544         ADLE            /ENABLE EXT START OF ADC'S
 545         JMP I   SAM
 546 CSAM,   0               /THESE 3 LOCATIONS MUST
 547 NSAM,   0               /BE TOGETHER & IN THIS
 548 PSAM,   0               /ORDER
 549 PCTR,   0
 550 NCTR,   0
 551 \f/CLK(R,O,S)-A COMPLEX CLK ROUTN WHICH SETS UP CLOCK
 552 /       FOR ADC SAMPLING; DIGIAL IO SMPLING;
 553 /       & SETS UP A SIMPLE CLOCK-WAIT ROUTN
 554 /
 555 CLK,    0
 556         JMS I   (ARG123
 557         R-1
 558         CLSA            /CLEAR CLK STATUS REG
 559         CLA
 560         TAD     R
 561         SPA SNA         /R>0?
 562         JMP     IAA     /NO,ERR
 563         TAD     (-6     /YES
 564         SMA SZA CLA     /R<=6?
 565         JMP     IAA     /NO
 566         TAD     R       /R GIVES CORRECT VAL FOR
 567         CLL RTL         /EXT START, .1,1,10,100,1000 KHZ RATE
 568         RTL
 569         RTL             /RATE GOES INTO BITS 3-5 OF EN REG
 570         TAD     (5050   /BITS 0,2,6,8 OF EN REG ALWAYS SET
 571         DCA     SAM     /SAVE TEMP
 572         TAD     O       /OVERFLOW CNT
 573         CIA
 574         CLAB            /SET BUF PRESET REG
 575         CLA
 576         TAD     S
 577         SZA CLA         /ANY SCHMITT TRIGS ASKED FOR?
 578         TAD     (27     /YES,SET BITS 7,9-11 OF EN REG
 579         TAD     SAM     /FINAL ENABLE VAL
 580         CMA
 581         CLZE            /CLEAR BAD BITS FROM EN REG
 582         CMA             /ENABLE VAL IS BACK AGAIN
 583         CLOE            /START CLOCK
 584         CLA
 585         TAD     SAMFLG
 586         SNA             /JUST SETTING UP FOR A SIMPLE TIMING DEV?
 587         JMP     DONE    /YES,RTN TO BASIC
 588         SPA CLA         /SAMPLE ADC'S?
 589         JMP I   (DRESET /NO,DO DIGITAL IO
 590         JMP I   (SRESET /YES
 591 DONE,   DCA     SAMFLG  /CLR FLG
 592         SPF             /RESET TTY FLG FOR BASIC
 593         JMP I   CLK     /RTN TO BASIC
 594 IAA,    SPF
 595         JMP I   (IA
 596 R,      0               /THESE 3 LOCATIONS
 597 O,      0               /MUST BE TOGETHER IN
 598 S,      0               /THIS ORDER
 599 SAMFLG, 0
 600 FL4096, 15;2000;0
 601 \f/GETARG-ENTER WITH SCALER(0=ARG2,1=ARG3,2=ARG4) IN AC;
 602 /       CALL 'ARGPRE' & ON RTN THE D.F. OF ARG IS SET
 603 /       & ADR OF ARG IS IN FAC
 604 /       PUT FL PT ARG IN FAC( 44-46)
 605
 606 GETARG, 0
 607         DCA     INSAV   /ARGPRE USES THIS SCALER LOC 64
 608         JMS I   KARG    /GET ADR OF ARG
 609         JMS I   FGETL   /PUT ARG IN FAC
 610 KARG,   ARGPRE          /USED TO ADVANTAGE
 611         CDF             /RESET D.F.
 612         JMP I   GETARG
 613
 614         PAGE
 615 \f/SETDX-SETUP DELTAX; CHK IF DISPL IS TO BE
 616 /       ACTIVATED; DX IS A FL PT NO
 617 /       SETUP DELTAX SUCH THAT IT =1,2,3,...,1023;
 618 /       & XCOORD SO THAT DISPLY IS CENTERED
 619 /
 620 SETDX,  0
 621         CMA
 622         TAD     MAXPTS  /MAXPTS-1
 623         SNA             /IF # OF MAXPTS=1 THEN DISPLY
 624         IAC             /IS POSITIONED AT X=0 COORD
 625         DCA     ACH
 626         JMS  I  (FFLOT
 627         JMS I   FPUTL
 628         DX              /SAVE FL PT(MAXPTS-1) TEMP
 629         TAD     (1777   /1023
 630         DCA     ACH
 631         JMS I   (FFLOT
 632         JMS I   (FDIV
 633         DX              /FL PT (1023/MAXPTS-1) =DX
 634         JMS I   FIXP    /FIXED 'DX'
 635         DCA I   (DELTAX
 636         TAD I   (DELTAX
 637         DCA     ACH
 638         JMS I   (FFLOT
 639         JMS I   (FMPY
 640         DX              /(MAXPTS-1)*(FIX'DX')=FLOT PROD
 641         JMS I   FIXP    /FIX 'PROD'
 642         CIA
 643         TAD     (1777
 644         CLL RAR         /(1023-FIX'PROD')/2
 645         TAD     (1001
 646         DCA I   (XCRD   /XCOORD=[1001+(1023-FIX'DX')/2]
 647 /CHK  SHOULD DISPLY NOW(XFLG=1)
 648 /OR RTN TO BASIC DUE TO SAM SETUP(XFLG=0
 649
 650         TAD I   (XFLG
 651         SZA CLA
 652         JMS I   (DISPLY
 653         JMP I   SETDX
 654 \f/ADSAM-A CLOCK INTERRUPT FOR SAMPLING ADC'S COMES HERE
 655 /
 656 ADSAM1, ADRS            /RD STATUS(GET MUX)
 657         IAC
 658         ADLM            /BMP MUX BY 1
 659         JMP     CLUGE
 660 ADSAM,  CLSA            /READ STATUS REG & CLEAR IT
 661         SMA CLA         /CLK O.F.?
 662         JMP     TION    /NO, SCHMITT TRIG SYNC
 663         ADSK            /CONV IS DONE?
 664         JMP     .-1     /NO
 665         ADRB            /GET VAL FR CONV BUF
 666         JMS I   (PUTBUF /YES
 667         ISZ I   (NCTR   /SAMPLED ALL CHANS FOR THIS INTERRUPT?
 668         JMP     ADSAM1  /NO
 669         ISZ I   (PCTR   /YES,JOB IS ALL DONE?
 670         JMP     SRESET-1        /NO
 671         JMP I   (DONE   /YES,'DONE' IS IN 'CLK' ROUTN
 672
 673 /SRESET-USED TO RESET STCHAN & CTR FR ADC SAMPLING
 674 /       ROUTN SETS MUX TO SAMPLE 1ST OF A SERIES OF CHANS.
 675 /       A CTR IS SET TO -# OF CONSEC CHANS TO SAMPLE
 676 /
 677
 678         ISZ I   (TOTPTS /#PTS /CHANNEL
 679 SRESET, TAD I   (NSAM
 680         CIA
 681         DCA I   (NCTR
 682         TAD I   (CSAM
 683         ADLM            /LOAD MUX WITH 1ST CHAN
 684 TION,   ION
 685         JMS I   (DISPLY /DISPLY UNTIL CLK INTERRUPT
 686 \f/DRI(N) -SAMPLE DIGITAL IO BOARD N; & RTN RESULT
 687 /       AS FL PT IN FAC
 688
 689 DRI,    0
 690         JMS     ARGN
 691         JMS I   (DIGIO  /GET DIGITAL VAL
 692         JMS     NEGCHK
 693         JMP I   DRI
 694
 695 /ARGN - GET N AND MAKE A 'DBSK' INSTRUCTION
 696
 697 ARGN,   0
 698         JMS I   FIXP    /BOARD #
 699 /CHK 0<=N<=2
 700         DCA     SETDX   /SAV N TEMP
 701         TAD     SETDX
 702         CIA
 703         TAD     (2
 704         SPA CLA
 705         JMP I   (IA     /ERR
 706         TAD     SETDX   /GET N BAK
 707         CLL RTL
 708         RAL             /BOARD # = BITS 6-8
 709         TAD     (DBCI
 710         JMP I   ARGN
 711
 712 /DRO(M,N)- M=FL PT VAL TO OUTPUT, N=BOARD #
 713 /       IF M=0 CLR OUTPUT REG; OTHERWISE LEAVE
 714 /       THE BITS OF DBSO SET
 715
 716         MASK=DIGIO
 717 DRO,    0
 718         JMS I   FIXP
 719         DCA I   (MASK   /DIGITAL OUTPUT VAL
 720         JMS I   (GETARG
 721         JMS     ARGN
 722         TAD     (2      /65N5='DBCI+2'
 723         DCA     KDBCO
 724         IAC
 725         TAD     KDBCO
 726         DCA     KDBSO
 727         TAD I   (MASK   /GET FL PT VAL
 728         SZA             /CLR OUTPUT REG/
 729         JMP     KDBSO   /NO
 730         CMA             /YES,SET ALL BITS OF AC
 731 KDBCO,  0       /CLR OUTPUT REG
 732         SKP
 733 KDBSO,  0               /OUTPUT DIG VAL
 734         CLA
 735         JMP I   DRO
 736 \f       FLGNEG=DRO
 737 /NEGCHK- THIS ROUTINE CHKS TO SEE IF A VALUE FROM
 738 /       'DRI' OR 'GET' IS NEGATIVE.  IF IT IS
 739 /       THE VALUE IS CHANGED TO 4096+NEG VAL.
 740
 741 NEGCHK, 0
 742         DCA     FLGNEG  /VAL IS EITHER + R -
 743         TAD     FLGNEG
 744         DCA     ACH
 745         JMS I   (FFLOT
 746         TAD     FLGNEG
 747         SMA CLA         /VAL WAS NEG?
 748         JMP I   NEGCHK  /NO
 749         JMS I   (FADD   /YES
 750         FL4096
 751         JMP I   NEGCHK
 752 CLUGE,  ADST            /START CONV
 753         JMP     ADSAM+3
 754
 755         PAGE
 756 \f/GET(M,L)- M=0, GET VAL FROM USER BUF & NO MASKING
 757 /       M>0, GET VAL FROM USER BUF & MASK WHERE
 758 /       M IS THE MASKING VALUE.
 759 /       L IS THE LOCATION OF USER BUF TO ACCESS
 760
 761         LHOLD=ARG123
 762 GET,    0
 763         IAC
 764         DCA     MSKCTR
 765         JMS I   FIXP    /GET M
 766         SNA             /M=0
 767         CMA             /YES,SET M=7777
 768         CLL RAR
 769         SZL
 770         JMP     .+3
 771         ISZ     MSKCTR
 772         JMP     .-4
 773         RAL
 774         JMS COMMON      /SAME CODE FOR 'GET' & 'PUT'
 775         TAD     MSKCTR
 776         CIA
 777         DCA     MSKCTR
 778         TAD I   LHOLD
 779         CDF             /RESET D.F.
 780         CLL RAR
 781         ISZ     MSKCTR
 782         JMP     .-2
 783         RAL
 784         AND     MASK
 785         JMS I   (NEGCHK
 786         JMP I   GET
 787 MSKCTR, 0
 788
 789 /PUT(M,L)- M IS THE FL PT VALU TO BE FIXED & PUT
 790 /       IN THE USER BUF;  L IS THE LOC OF THE USER
 791 /       BUF WHERE TO STORE THE FIXED NUMBER.
 792
 793 PUT,    0
 794         JMS I   FIXP    /GET & FIX THE FL PT VAL
 795         JMS COMMON
 796         TAD     MASK
 797         DCA I   LHOLD
 798         CDF
 799         JMP I   PUT
 800
 801 /COMMON- THIS ROUTINE IS USED BY BOTH 'GET' & 'PUT'
 802
 803 COMMON, 0
 804         DCA     MASK    /SAVE M TEMPORARILY
 805         JMS I   (GETARG
 806         JMS I   FIXP    /GET L
 807         CLL
 808         TAD I   (BUFBAK
 809         DCA     LHOLD
 810         SZL             /CROSSED FIELDS?
 811         TAD     K0010   /YES
 812         TAD I   (CDFBAK /NO
 813         DCA     .+1
 814         0
 815         JMP I   COMMON
 816 \f/WHEN INTERRUPT OCCURS COME HERE
 817 /
 818
 819 SERVC,  CLA
 820         CLSK            /CLOCK INTERRUPT?
 821         SKP             /NO
 822         JMP I   (ADSAM  /YES
 823         KSF             /TTY INTERRUPT?
 824         SKP             /NO
 825         JMP     KKBRD   /YES
 826         TSF             /DUE TO LAST ECHO?
 827         HLT             /SPURIOUS INTERRUPT
 828         TCF             /YES
 829         JMP I   (TION
 830 KKBRD,  KRB
 831         TLS             /ECHO CHAR
 832         TAD     (-203
 833         SZA CLA         /^C TYPED?
 834         JMP I   (TION   /NO,IGNORE CHAR
 835         JMS I   P1SWAP  /YES
 836         JMP I   (7605   /RTN TO MONITOR
 837 \f/ARG123-THIS ROUTINE GETS 3 ARGUMENTS OF A FUNCTION
 838 /       AND STORES THEIR FL PT VALUES IN
 839 /       'ARG1,ARG2,ARG3' & STORES THEIR FIXED VALUES
 840 /       AT 'ADR,ADR+1,ADR+2'
 841 /               CALL: JMS ARG123
 842 /                     ADR-1
 843
 844 ARG123, 0
 845         TAD I   ARG123  /GET(ADR-1)FOR THE THREE
 846         DCA     XR1     /1WD ARGS
 847         ISZ     ARG123
 848         JMS I   FIXP
 849         DCA I   XR1     /SINGLE PREC ARG1
 850         JMS I   (GETARG /ARG2 DESIGN BY AC=0
 851         JMS I   FIXP
 852         DCA I   XR1     /SINGLE PREC ARG2
 853         IAC
 854         JMS I   (GETARG /ARG3 DESIGN BY AC-3
 855         JMS I   FIXP
 856         DCA I   XR1     /SINGLE PREC ARG3
 857         JMP I   ARG123
 858 \f/DRESET-USED TO RESET STARTING DIGITAL IO BOARD & CTR;
 859 /       WAIT FOR CLK TO O.F.; SAMPLE EACH BOARD ASKED FOR.
 860 /
 861
 862 DRESET, TAD I   (NSAM
 863         CIA
 864         DCA I   (NCTR
 865         TAD I   (CSAM   /STARTING BOARD #
 866         CLL RTL
 867         RAL             /ST BOARD #*10(8)
 868         TAD     (DBCI-10
 869         DCA     KDBCI   /[DBCI-10(8)] FOR 1ST BOARD
 870 /WAIT LOOP
 871         CLSK
 872         JMP     .-1
 873         CLSA            /READ STATUS & CLR
 874         CLA
 875 /SAMPLE ALL BOARDS ASKED FOR
 876
 877 DIGSAM, TAD     K0010
 878         TAD     KDBCI
 879         JMS     DIGIO   /SAMPLE BOARD
 880         JMS I   (PUTBUF /PUT DIG VAL IN BUF
 881         ISZ I   (NCTR   /MORE BOARDS?
 882         JMP     DIGSAM  /YES
 883         ISZ I   (PCTR   /NO, JOB IS ALL DONE?
 884         JMP     DRESET  /NO
 885         JMP I   (DONE   /YES,'DONE' IS IN 'CLK' ROUTN
 886 /DIGIO-ENTER WITH 'DBCI' SETUP FOR CORRECT BOARD; THIS RTN
 887 /       SETS UP THE 'DBRI & DBCI' AND SAMPLES CORRECT BOARD;
 888 /       EXIT WITH DIGITAL VAL IN AC
 889 /
 890
 891 DIGIO,  0
 892         DCA     KDBCI
 893         TAD     KDBCI
 894         IAC
 895         DCA     KDBRI
 896 KDBRI,  0
 897 KDBCI,  0
 898         JMP I   DIGIO
 899 $
 900 \f