sw/rescue/lab8e_goettingen/disk2_11/rka/paroff/adbuff.ra

   1 /       OS/8 TSAR/TSARINA
   2 /
   3 /       ADBUFF.RA
   4 /
   5 /       DEC-S8-STSAA-A-LA25
   6 /
   7 /       K. ELLSON AND L. PEARSON
   8 /
   9 /       /8      AD CONVERSION CLOCKED WITH CLOCK ROUTINE
  10 /       /8 /1   AD CONVERSION CLOCKED WITH CLOCK1 ROUTINE
  11 /       /8/4/1  AD CONVERSION CLOCKED WITH CLOCK1 AND SCHMITT TRIGGER INPUT TIMED WITH CLOCK ROUTINE
  12 /
  13 /
  14 /       TSAR SUBROUTINE - BUFFERED A/D
  15 /          COPYRIGHT 1973
  16 /          DIGITAL EQUIPMENT CORPORATION
  17 /          MAYNARD, MASSACHUSETTS 01754
  18 /
  19 /          THIS PACKAGE PROVIDES A FUNCTIONAL REPLACEMENT FOR
  20 / THE FOLLOWING FORTRAN IV LIBRARY SUBROUTINES: REALTM
  21 / AND ADB.  REALTM AND ADB ARE REPLACED BY THE SUBROUTINE
  22 / THRUPT.  A THRUPT CALL IS ILLUSTRATED BY THE FOLLOWING
  23 / FORTRAN PROGRAM.
  24 /
  25 /*************************************************************
  26 /
  27 /       EXTERNAL STAT1,STAT2
  28 /       INTEGER BUFF1(85),BUFF2(85),IPARMS(3),HASH(# OF CHANNELS)
  29 /       CALL THRUPT(BUFF1,BUFF2,IPARMS,HASH,NTRIG)
  30 /       CALL CLOCK(8,IRATE)     @ IF NO /1 SWITCH AT ASSEMBLY TIME
  31 /                               @ FOR A/D CONVERSION TIMED WITH FIRST DK8-EP
  32 /       CALL CLOCK1(8,IRATE)    @ IF /1 SWITCH SET AT ASSEMBLY TIME
  33 /                               @ THIS IS FOR A/D CONVERSION TIMED WITH 2ND DK8-EP
  34 /       IF YOU USE BOTH CLOCKS ON ONE SYSTEM, THEN YOU
  35 /       MAY SWITCH ON ONLY ONE CLOCK-TIMED A/D CONVERSION.
  36 /       THIS MEANS: ONLY ONE CLOCK MAY BE STARTED WITH FUNCTION=8 (BIT 9 SET)
  37 /       ...
  38 /  100  IF (STAT1-0.5) 100, 110, 999
  39 /  110  WRITE (5) BUFF1
  40 /       CALL RELEAS (1)
  41 /       ...
  42 /  999  WRITE (4,1000)
  43 / 1000  FORMAT (' SAMPLING TOO FAST')
  44 /       CALL CLOCK (0,0)
  45 /       ...
  46 /
  47 /************************************************************
  48 /
  49 / BUFF1 - ONE OF 2 BUFFERS FOR THE ANALOG DATA, 255  12 BIT
  50 /       WORDS ARE STORED IN EACH BUFFER
  51 /
  52 / STAT1 - DYNAMIC STATUS WORD OF BUFF1.  THE VALUES 0.25,
  53 /       0.5, AND +1. INDICATE THAT THE BUFFER IS NOT FILLED,
  54 /       BUFFER IS FILLED, AND BUFFER OVERFLOW.
  55 /
  56 / BUFF2 - THE SECOND BUFFER.
  57 /
  58 / STAT2 - THE DYNAMIC STATUS WORD OF BUFF2,  VALUES ARE THE
  59 /       SAME AS FOR STAT1.
  60 \f/
  61 / IPARMS - THE PARAMETER VECTOR WHICH CONTAINS IN ORDER THE
  62 /       STARTING CHANNEL, THE NUMBER OF CHANNELS, AND THE  NUMBER
  63 /       OF SAMPLES.
  64 / HASH  - OPTIONAL: A TABLE CONTAINING THE READ VALID INFORMATION FOR A/D CHANNELS AND STRIGG INPUTS
  65 / NTRIG - OPTIONAL BUT HASH MUST BE SPECIFIED:
  66 /       THE NUMBER OF SCHMITT TRIGGER CHANNELS TO SAMPLE
  67 /       CONFIGURATION REQUIRED FOR A/D AND STRIGG SAMPLING:
  68 /       FIRST DK8-EP: FREE RUNNING TIMER (10 KHZ OR 100 KHZ) FOR TRIGGER INPUT.
  69 /               CALL CLOCK4 (1 TO 7,3)  FOR 10 KHZ
  70 /               CALL CLOCK4 (1 TO 7,30) FOR 100 KHZ
  71 /       SECOND DK8-EP STARTS THE A/D VIA EXTERNAL EVENT: CALL CLOCK1(8,RATE)
  72 /       TIME WORD: THE INTERVALL BETWEEN TWO A/D CYCLES IS DIVIDED INTO
  73 /       12 SLICES CALLED S0 TO S11.
  74 /       AN EXTERNAL EVENT BETWEEN 0 AND S0 (SAMRAT/12) SETS THE LEFTMOST BIT 0.
  75 /       '     ''      ''      ''  S11 AND SAMRAT SETS THE RIGHTMOST BIT 11.
  76 /
  77 /       UPDATES:
  78 /
  79 /       WGET: THE THIRD PARAMETER (RESULT) IS OPTIONAL
  80 /       VALID CALLS:
  81 /       I=WGET(BUFF,PNTR,RESULT)
  82 /       I=WGET(BUFF,PNTR)
  83 /       CALL WGET (BUFF,PNTR,RESULT)
  84 /
  85 /       11-SEP-80  HA
  86 /
  87 /       INTERRUPT SERVICE ROUTINE FSMPLE:
  88 /       BEFORE THE READ ADRB WAIT FOR ADSE TO AVOID A NON VALID READ
  89 /       IF CLOCK DID'NT START THE AD CONVERTER.
  90 /       THEREFORE IN ANY CASE (ONE OR MORE CHANNELS) THE
  91 /       CLOCK MUST BE STARTED WITH CALL CLOCK(8,FREQU).
  92 /       FIRST PARAMETER OF CLOCK MUST BE 8 !
  93 /       29-SEP-80 HA
  94 /        1-OCT-82 HA REV 2.0 PACKS THE SAMPLE
  95 /       15-JUL-83 HA REV 2.1 REARANGES CODE FOR PDP12 LINC OPTION
  96 /       18-MAR-85 HA REV 3.0 ALLOWS TWO DK8-EP MODULES
  97 /               FOR A/D TRIGGED WITH DEV. CODE 13 CLOCK: /8 SWITCH
  98 /               FOR A/D TRIGG'D WITH DEV. CODE 17 CLOCK: /1 /8 SWITCH
  99 /               FOR A/D ON PDP-12                      : NO SWITCH
 100 /
 101 /       26-JUN-85 HA REV 3.1 ALLOWS SCMITT TRIGGER INPUT WITH DK8-EP DEV 13 AND CLOCKED A/D WITH DK8-EP DEV 17
 102 /       12-JUL-85 HA REV 4.0 EVERYTHING CONFUSED
 103 /       20-AUG-85 HA REV 4.1 REMOVES BUG IN TRIGG. TIME PICKUP ROUTINE
 104 /
 105 \f/
 106         CL1DEV=13*10    / FIRST DK8-EP
 107         CL2DEV=17*10    / SECOND DK8-EP
 108 /
 109         MQL=7421
 110         MQA=7501        / WE USE EAE MODE B
 111         ACL=7701
 112         SWP=7521
 113         CAM=7621
 114         SWAB=7431
 115         DAD=7443
 116         DST=7445
 117         DLD=DAD!CAM
 118         DDZ=DST!CAM
 119         DVI=7407
 120         DPIC=7573
 121         DPSZ=7451
 122         IFNSW   1 <
 123         EXTERN  #CLINT
 124 CLINT=  #CLINT
 125         IFSW    4 < BAD SWITCH /1/4 >
 126         >
 127         IFSW    1 <
 128         EXTERN  #CLIN1
 129 CLINT=  #CLIN1
 130         EXTERN  #CLINT
 131         >
 132         CSTAT=157       /CLOCK ROUTINE PUTS CLSA BITS IN HERE
 133         ENTRY   STAT1   /ALLOW FORTRAN ACCESS TO THES
 134         ENTRY   STAT2   /LOCATIONS
 135         COMMZ   #PAGE0
 136         ORG     2
 137 PBUFF,  0               /PNTR TO CURRENT BUFFER
 138 CURSTT, 0               /PNTR TO CURRENT STATUS WORD
 139 NXTSTT, 0               /PNTR TO NEXT STATUS WORD
 140 CURBUF, 0;0             /START OF CURRENT BUFFER PNTR
 141 NXTBUF, 0;0             /START OF NEXT BUFFER PNTR
 142                         /STATUS WORDS, VALUES
 143 STAT1,  F       0.25    /0.25, 0.5, & 1.0 INDICATE
 144 STAT2,  F       0.25    /STATUS WORD IS NOT FILLED,
 145                         /FILLED, AND OVERFLOWED
 146 /STATUS WORD:    F 0.25 = 7777;2000;0000   NOT FILLED
 147 /                F 0.5  = 0000;2000;0000       FILLED
 148 /                F 1.0  = 0001;2000;0000   OVERFLOWED
 149 /
 150                 IFSW 8 <
 151                 ADSK=6534
 152                 ADRB=6533
 153                 ADST=6532
 154                 ADLM=6531
 155                 ADLE=6536
 156                 ADCL=6530
 157         ADRS=6537
 158         ADSE=6535
 159         CLED=6134
 160                 CLAB=6003
 161                 CLBA=6006       / DO NOT FORGET TO INSERT THE DEVICE CODE
 162                 CLZE=6000
 163                 >
 164                 IFNSW 8 <
 165                 ESF=4
 166                 LINC=6141
 167                 PDP=2
 168                 SAM=100
 169                 CLEN=6134
 170                 >
 171
 172
 173 \f       FIELD1 FSMPLE
 174         0               /INTERRUPT TIME A/D SAMPLER
 175         ADDR    MQAC    /SAVE AC AND MQ --> MQAC
 176         ORG .-2; DST; ORG .+1
 177         ADDR    CLKOVR  / CLEAR OVERFLOW COUNTER FOR THE SCHMITT TRIGGER SERVICE ROUTINE
 178         ORG .-2; DDZ; ORG .+1
 179         IFSW 4  <       / IF TRIGGER INPUT THEN WE CLEAR THE CLOCK COUNTER
 180         CLAB    CL1DEV
 181         >
 182         IFNSW 4 < NOP > / HERE TO INSERT A WORD TO GET THE SAME WORD COUNT FOR BOTH PROGRAM VERSIONS
 183         TAD     NCHANL+2 /NUMBER OF CHANNELS
 184         DCA     NCHANL+1 /INTO COUNTER
 185         JMS%    ITSTVL+1 /TEST VALID FOR THE FIRST SAMPLE
 186         JMS     INVALID /AND DECLARE NOT VALID
 187 WAITSP,
 188         IFNSW 8<
 189         JMS     LNCSAM  /INITIATE SAMPLE
 190 NEXTCH, ISZ     SAMINS  /UPDATE SAM INST FOR NXT CHAN
 191         JMS     LNCSAM
 192         TAD     SAMTMP
 193         >
 194         IFSW 8 <
 195         ADSK            / WAIT FOR COMPLETION OF CONVERSION
 196         JMP     .-1
 197         ADRB            /READ SAMPLE
 198         JMS     PUTSAM  / INSERT INTO THE OUTPUT BUFFER AND TEST IF WORK DONE
 199         JMP     MORESM  /  SKIP TO MORESM
 200 /
 201 /
 202 SKIPSM,/                 SKIP ONE A/D SAMPLE
 203         JMS     UPDCNT  / INCREMENT THE TOTAL SAMPLE COUNTER (ALL CHNLS+STRIGS)*SAMRAT
 204         ADRS            / LOAD MUX REGISTER --> AC
 205         IAC             / AND INCREMENT- WE SKIPP THIS CHANNELS
 206         ADLM            /  BUMP BACK INTO THE A/D MUX REGISTER
 207 /
 208 MORESM,/
 209         ISZ     NCHANL+1 / ANY MORE CHANNELS TO SAMPLE?
 210         SKP             / START THE NEXT CONVERSION IF THERE IS ANY REMAINING
 211         JMP     NOTMOR  / NOTHING MORE TO A/D SAMPLE
 212         JMS%    ITSTVL+1 /HERE ONLY IF SOME MORE A/D TO SAMPLE!
 213         JMP     SKIPSM  / SKIP THE NEXT SAMPLE, RETURNS TO MORESM !!
 214         ADST            / AND START THE NEXT CONVERSION - AUTO INCREMENT MODE!
 215         >
 216         JMS     INCPTR / INCREMENT BUFFER POINTER
 217         JMP     WAITSP  / AND TAKE THE NEXT SAMPLE
 218 NOTMOR,/
 219         TAD     CSTART+2 /STARTING CHANNEL
 220         IFSW 8 <
 221         ADLM            / ELSE RESET MUX REGISTER
 222         >
 223         IFNSW 8 <
 224         DCA     SAMINS
 225         JMS     LNCSAM  /SET CHANNEL TO START IN CASE
 226                         /CLOCK INITIATED
 227         >
 228 /
 229 /       HERE WE INSERT THE STRIGG TIME WORDS
 230 /
 231         CLA
 232         TAD     IWSTRI+1 /HOLDS ADDR
 233         DCA     IWSTRI  /  HOLDS POINTER TO THE TIME WORD
 234         TAD     WSTRC   / -(NUMBER OF TRIGG INPUTS+1) --> AC
 235         DCA     IWSTRC  / HOLDS THE COUNTER
 236 IWLOP1,
 237         JMS     INCPTR / INCREMENT BUFFER POINTER
 238         ISZ     IWSTRC  / IF ANY MORE TRIGG INPUTS
 239         SKP             /   THEN SKIP
 240         JMP     IWLOP2  /  ELSE RESET AC AND MQ AT IWLOP2
 241         JMS%    ITSTVL+1 /TEST FOR VALID SAMPLE (INVALID MEANS CRAZY PROGRAMMER!)
 242         JMS     INVALID / SET THE INVALID FLAG
 243         TAD%    IWSTRI  / TRIGG TIME WORD --> AC
 244         JMS     PUTSAM  /INSERT TIME WORD INTO THE OUTPUT BUFFER, CLEARS AC
 245         DCA%    IWSTRI  / CLEAR THE TIME WORDS
 246         ISZ     IWSTRI  / INCREMENT POINTER TO THE TIME WORDS
 247         JMP     IWLOP1  / AND LOOK FOR THE NEXT TRIGG WORDS TO PROCESS
 248 IWLOP2,
 249         ADDR    MQAC    /RESTORE AC AND MQ
 250         ORG .-2; DLD; ORG .+1
 251         JMP%    FSMPLE  /DONE FOR THIS TIC
 252 \f/
 253 /       SAMPLING FINISHED
 254 /
 255 SAMDON,/
 256         JMS     INCPTR  /  INCREMENT BUFFER POINTER
 257         CLA             / CLEAR THE STATUS WORD
 258         DCAZ%   CURSTT  /SET STATUS OF CURRENT FULL
 259 SAMXIT,/                          STOP THE SAMPLING, DISABLE CLOCK INTERRUPT
 260         ADDR    CLINT
 261         ORG .-2; DDZ; ORG .+1
 262         IFSW    4 <
 263         ADDR    #CLINT
 264         ORG .-2; DDZ; ORG .+1 > / DISABLE CLOCK EXTENSION ROUTINE
 265         ADDR    MQAC    /RESTORE AC AND MQ
 266         ORG .-2; DLD; ORG .+1
 267         JMP%    FSMPLE
 268 /
 269 /
 270 /       HERE WE COUNT THE WHOLE NUMBER OF SAMPLES TOKEN
 271 /
 272 UPDCNT, 0
 273         ADDR    NPOINT+1 / NPOINT IS A 3 WORD FPP BASE PAGE VARIABLE, TAKE CARE
 274         ORG .-2; DLD; ORG .+1
 275         DPIC            / INCREMENT DOUBLE PREC. COUNTER TO TEST FOR MORE SAMPLES
 276         ADDR    NPOINT+1 / BUMP INTO COUNTER
 277         ORG .-2; DST; ORG .+1
 278         DPSZ            / SKIP IF WORK DONE
 279         JMP%    UPDCNT
 280         JMP     SAMDON  / SET STATUS OF CURRENT BUFFER FULL: SAMPLE DONE
 281 /
 282 /
 283 PUTSAM, 0               / INSERTS AC INTO OUTPUT BUFFER, ON RETURNS CLEARS AC!
 284         ISZ     AVALID  / VALID INPUT?
 285         SKP             / AVALID IS SET TO -1 FOR INVALID SAMPLE, SO SKIP
 286         JMP     PUTSA1  / NON VALID, RETURN WITHOUT ACTION
 287 BUFCDF, HLT             /REPLACED BY CDF TO BUFFER
 288         DCAZ%   PBUFF
 289         CDF     10      / USED FOR POINTER PVALID!
 290         CLA CMA         / -1 --> AC
 291         DCA     PUTFLG  / DON'T FORGET TO INCREMENT THE BUFFER POINTER -1 --> PUTFLG
 292         DCA     AVALID  / CLEAR VALID FLAG FOR NEXT CALL
 293 PUTSA1,/
 294         JMS     UPDCNT  / UPDATE THE TOTAL SAMPLE COUNT
 295         CLA             / CLEAR AC FOR RETURN
 296         JMP%    PUTSAM
 297 /
 298 /
 299 INVALID,0               / SET THE ACTUAL SAMPLE INVALID
 300         CLA CMA         / -1 --> AC
 301         DCA     AVALID
 302         JMP%    INVALID / ON RETURN AC=0
 303 PUTFLG, 0               / SET TO -1 IF WE HAVE TO INCREMENT THE BUFFER POINTER
 304
 305 AVALID, /               / ACTUAL VALID FLAG
 306 ITSTVL, ADDR    TSTVLD  / TEST FOR VALID READ
 307 IWSTRC, 0               / NEGATIVE NUMBER OF STRIGS EVENT CHANNELS -1 (FOR COUNTER)
 308 WSTRC,  0               / -(NUMBER OF STRIG INPUTS+1) PLACED HERE BY THRUPT
 309 IWSTRI, ADDR    TIMWRD  / POINTER TO THESE TIME WORDS
 310 NCHANL, 0;0;0
 311 SAMCNT,
 312 CSTART, 0;0;0
 313 \f/
 314 L10,    10
 315 /
 316 INCPTR, 0
 317         CLA             / CLEAR AC
 318         ISZ     PUTFLG  / IF WE HAVE TO INCREMENT THE BUFFER POINTER,
 319         JMP%    INCPTR  / THEN SKIP ELSE RETURN
 320         ISZZ    PBUFF   /ELSE INCR PNTR & SKIP IF WE
 321         JMP     FLDOK   /CROSSED A FIELD BOUNDARY
 322         TAD     BUFCDF  /UPDATE FIELD
 323         TAD     L10
 324         DCA     BUFCDF
 325 FLDOK,
 326         ISZ     SAMCNT  /INCR BUFFER CNTR & SKIP IF
 327         JMP%    INCPTR  /FILLED. BUFFER OK
 328         DCAZ%   CURSTT  /SET STATUS WORD TO 0.5
 329                         /FOR BUFFER FILLED
 330         TADZ    NXTSTT  /SWAP STATUS WORD PNTRS
 331         DCA     TMP     /  NXTSTT<=> CURSTT
 332         TADZ    CURSTT
 333         DCAZ    NXTSTT
 334         TAD     TMP
 335         DCAZ    CURSTT
 336         TADZ%   CURSTT  /HAS USER RELEASED THIS BUFFER
 337         SMA CLA
 338         JMP%    ITOOFST+1 /NO, SAMPLING TOO FAST!
 339         JMS%    ISWPBFR+1 / SWAP BUFFER
 340         JMP%    INCPTR  / BUFFER POINTER UPDATED
 341 ISWPBF, ADDR    SWPBFR
 342 /
 343 /
 344 TMP,
 345 ITOOFS, ADDR    TOOFST
 346 /
 347 \f       ORG     FSMPLE+200
 348 /
 349 /       HERE WE SWAP THE INPUT BUFFERS POINTERS
 350 /
 351 SWPBFR, 0
 352 /
 353 /       SWAP BUFFER POINTERS
 354 /
 355         TADZ    NXTBUF  /   NXTBUF <=> CURBUF
 356         DCA%    IBUFCDF /   BUFCDF, PBUFF = NXTBUF
 357         TADZ    NXTBUF+1
 358         DCAZ    PBUFF
 359         TADZ    CURBUF
 360         DCAZ    NXTBUF
 361         TADZ    CURBUF+1
 362         DCAZ    NXTBUF+1
 363         TAD%    IBUFCDF
 364         DCAZ    CURBUF
 365         TADZ    PBUFF
 366         DCAZ    CURBUF+1
 367         TAD%    IBUFSIZ /RESET BUFFER COUNTER
 368         DCA%    ISAMCNT
 369         JMP%    SWPBFR
 370 IBUFCDF=.+1
 371         ADDR    BUFCDF
 372 IBUFSIZ=.+1
 373         ADDR    BUFSIZ
 374 ISAMCNT=.+1
 375         ADDR    SAMCNT
 376 /
 377 /       SAMPLING RATE TOO FAST
 378 /
 379 TOOFST,/
 380         CLA IAC         /SET STATUS WORD TO 1.0
 381         DCAZ%   CURSTT
 382         IAC
 383         DCAZ%   NXTSTT
 384         JMP%    ISAMXIT+1 / DISABLES CLOCK INTERRUPTS
 385 ISAMXIT,/
 386         ADDR    SAMXIT
 387         IFNSW   8 <
 388 LNCSAM, 0               /LINC SAM SUBROUTINE
 389         LINC
 390 SAMINS, SAM     0       /SAMPLE AND SELECT NEXT CHANNEL
 391         PDP
 392         DCA     SAMTMP  /SAVE IT
 393         JMP%    LNCSAM
 394         >
 395 \f/
 396 /       INTERRUPT TIME SCHMITT TRIGGER INPUT HANDLER
 397 /
 398 FIREED, 0               / ON ENTRY AC IS CLEARED BY CLOCK RTN
 399         CLA CLL CMA RTL / -3 --> AC
 400         ADDR    MQSAVE  / SECOND: STRIG COUNTER, FIRST: SAVES MQ
 401         ORG .-2; DST; ORG .+1
 402         CLA
 403         TADZ    CSTAT   / LOOK AHEAD FOR CLOCK OVERFLOW
 404         RAL CLL         / LINKS GOES ON HERE IF CLOCK OVERFLOWED
 405         SNA CLA         / AND IF THERE IS NO STRIGG THEN JUMP TO CLOCK OVERFLOW HANDLING
 406         JMP     CLKINT
 407 /
 408         CAM             / MQ HOLDS # OF STRIGG FIRED, FIRST IS #0
 409         TADZ    CSTAT   / CLSA BITS OF FIRST CLOCK --> AC
 410 TRILOP, RAR             / STRIG BITS --> LINK
 411         SWP             /  NOW AC HOLDS # OF STRIGG
 412         SZL             / SKIP IF STRIGG DID NOT FIRE
 413         JMS     TRIGGD  / ELSE SET THE TRIGGER TIME WORD
 414         IAC             / INCREMENT FOR NEXT STRIGG
 415         SWP             / # OF STRIGG --> MQ,  CLSA BIT MASK --> AC
 416         ISZ     MQSAVE+1 / SOME MORE STRIGS?
 417         JMP     TRILOP  / YES, FETCH THE NEXT EVENT
 418         CAM             / STRIGS DONE, TEST FOR CLOCK OVERFLOW
 419         TADZ    CSTAT   / CLSA BITS --> AC
 420         RAL             / LINK GOES ON IF CLOCK OVERFLOWED
 421         SZL             / IF NO CLOCK OVERFLOW THEN RETURN
 422 CLKINT, ISZ     CLKOVR+1 / ELSE INCREMENT THE CLOCK OVERFLOW COUNTER (EAE HIGH ORDER WORD)
 423         NOP             / PROTECT ISZ
 424         ADDR    MQSAVE  / RESTORE MQ, CLEAR AC! TRICKSY!
 425         ORG .-2; DLD; ORG .+1
 426         CLA
 427         JMP%    FIREED  /  RETURN TO CLOCK ROUTINE
 428 /
 429 MQSAVE, 0;0             / SECOND WORD IS USED FOR STRIGG COUNTER, FIRST SAVES MQ ON ENTRY
 430 CLKOVR, 0;0             / HERE IS THE CLOCK OVERFLOW COUNTER, (SINGLE PRECISION, SECOND WORD HOLDS CLOCK COUNTER)
 431 /                       CLKOVR IS CLEARED AT EACH A/D INTERRUPT. WE ALSO CLEAR THE CLOCK COUNT REGISTER.
 432 /                       SINCE A/D CLOCK AS HIGHER INTERRUPT FREQUENCY THAN TRIGG CLOCK
 433 /                       THE TRIGGER CLOCK OVERFLOW SHOULD BE ZERO ALL THE TIME!
 434 /                       BUT WHAT'S SHURE IN A COMPUTER'S WORLD NOWADAYS????
 435 /
 436 MQAC,   0;0             / HERE FSMPLE AND TRIGGED ROUTINE SAVE MQ&AC ON ENTRY
 437 ITIMWR, ADDR    TIMWRD  / POINTER TO STRIGG TIME WORDS
 438 TIMWRD, 0;0;0           / TIME WORDS FOR 3 SCHMITT TRIGGER CHANNELS
 439 TIMBIT, 0;0             / THRUPT INSERTS CLOCKRATE/SAMRAT/12
 440 M15,    -15             / DEC 13: USED TO TEST TIME SLICE OVERFLOW
 441 IBITWR, TAD     BITWRD  / POINTER TO LOAD THE CORRECT BIT MASK FOR EACH TIME SLICE
 442         7777            / TOO MUCH EVENTS
 443 BITWRD, 4000
 444         2000
 445         1000
 446         0400
 447         0200
 448         0100
 449         0040
 450         0020
 451         0010
 452         0004
 453         0002
 454         0001
 455         0001            / HERE FOR SOME VERY LATE EVENTS
 456 /
 457 /       HERE WE COMPUTE THE STRIGG TIME WORD
 458 /
 459 TRIGGD, 0               / ON ENTRY AC HOLDS NUMBER OF SCHMITT TRIGGER FIRED
 460         ADDR    MQAC    / SAVE AC AND MQ
 461         ORG .-2; DST; ORG .+1
 462         TAD     ITIMWR+1 / COMPUTE CORRECT ADDRESS OF TIME WORD
 463         DCA     ITIMWR
 464         CLBA!CL1DEV     / LOAD CLOCK BUFFER --> AC
 465         MQL             / AND INTO MQ, CLEAR AC
 466         ADDR    CLKOVR  /AND ADD THE CLOCK OVERFLOW COUNTER REQUIRES MODE BITS OF CLOCK SET TO 10
 467         ORG .-2; DAD; ORG .+1
 468         ADDR    TIMBIT  / TIMBIT= RATE*12/SAMRAT   HERE WE COMPUTE THE TIME SLICES
 469         ORG .-2 ; DVI ; ORG .+1
 470         ACL             / MQ HOLDS QUOTIENT SO: TIME SLICE -> MQ -> AC
 471         TAD     M15     / IF THERE ARE ALLREADY 13 SLICES PASSED
 472         SMA SZA CLA     / THEN STOP, ELSE GOON
 473         JMS     OVRTRI  / STRIGG INPUT OVERFLOWED
 474         ACL             / TIME SLICE --> AC
 475         TAD     IBITWR  / HERE WE DO SOME COMPUTATIONS
 476         DCA     .+3     / IN ORDER TO FETCH THE
 477         TAD%    ITIMWR  / CORRECT BIT AND TIMEWORD.
 478         MQL             / PREP FOR .OR. TIMEWORD AND SLICE BIT
 479         TAD     BITWRD  / IS REPLACED BY CORRECT TAD BITWRD+SLICE
 480         MQA             / OR THE TIMEWORD AND THE BIT
 481         DCA%    ITIMWR  / AND PUSH BACK
 482         ADDR    MQAC    / RESET AC AND MQ
 483         ORG .-2; DLD; ORG .+1
 484         JMP%    TRIGGD  /       AND RETURN!
 485 /
 486 OVRTRI, 0               / HANDLES STRIGG OVERFLOWES
 487         HLT
 488 /       CLA CMA         / -1 --> AC
 489         MQL             / -1 --> MQ
 490         JMP%    OVRTRI  /
 491 \f       ORG     FSMPLE+400
 492 ADSETU, 0               /SET UP ROUTINE
 493         SWAB            / SWITCH EAE TO MODE B (USED FOR HARD FPP12)
 494         TADZ    CURBUF  /GET FIELD OF BUFFER
 495         JMS     MAKCDF  /MAKE 3 BITS FLD INTO CDF
 496         DCAZ    CURBUF
 497         TADZ    CURBUF
 498         DCA%    ABUFCDF+1 /SAVE IN SAMPLER CODE
 499         TADZ    CURBUF+1 /SET SAMPLER BUFFER POINTER
 500         DCAZ    PBUFF
 501         TADZ    NXTBUF  /GET FIELD OF ALTERNATE BUFFER
 502         JMS     MAKCDF
 503         DCAZ    NXTBUF
 504         TAD     BUFSIZ  /SET INITIAL COUNT
 505         DCA%    ASAMCNT+1
 506         TAD     ISTAT1+1
 507         DCAZ    CURSTT  / INSERT ADR. OF ACTUAL STATUS WORD
 508         TAD     ISTAT2+1
 509         DCAZ    NXTSTT  / AND THE ADR. OF NEXT STATUS WORD
 510         ADDR    NPOINT+1        / SINCE FPP AND EAE HAVE DIFFERENT HIGH ORDER AND LOW ORDER
 511         ORG .-2; DLD; ORG .+1 / WORD ORDER IN MEMORY
 512         SWP
 513         ADDR    NPOINT+1        / WE HAVE TO CHANGE IT
 514         ORG .-2; DST; ORG .+1
 515         ADDR    TIMWRD
 516         ORG .-2; DDZ; ORG .+1 / CLEAR THE STRIGG TIME WORDS
 517         ADDR    TIMWRD+1
 518         ORG .-2; DDZ; ORG .+1
 519         ADDR    CLKOVR  / CLEAR CLOCK OVERFLOW COUNTER
 520         ORG .-2; DDZ; ORG .+1
 521         IFSW    8 <
 522         CLA CMA         /STOP THE CLOCK
 523         IFSW 1 <
 524         CLZE  CL2DEV
 525         IFSW 4 <
 526         CLZE  CL1DEV > >
 527         IFNSW 1 <
 528         CLZE!CL1DEV >
 529         CLA
 530         ADCL            /CLEAR AD LOGIC JUST IN CASE
 531         TAD     L300    /SET AD ENABLE BITS, EXT START, AUTO INCREMENT
 532         ADLE
 533         TAD%    JCSTART+1 /STARTING CHANNEL NUMBER
 534         ADLM
 535         >
 536         IFNSW   8 <
 537         CLEN            /STOP THE CLOCK
 538         TAD%    JCSTART+1 /SET UP INITIAL SAM INSTRUCTION
 539         TAD     L100
 540         DCA%    JCSTART+1
 541         TAD%    JCSTART+1
 542         DCA     SAMINS
 543         TAD     L100    /SET FAST SAM BIT
 544         IOF             /TURN OFF INTERRUPTS IN LINC MODE
 545         LINC            /ENTER LINC MODE
 546         ESF
 547         PDP
 548         JMS     LNCSAM
 549         ION
 550         ADDR    MQAC    / SAVE MQ
 551         ORG .-2; DST; ORG .+1
 552         ADDR    TIMWRD
 553         ORG .-2; DDZ; ORG .+1
 554         DCA     TIMWRD+1 / CLEAR STRIGG TIME WORDS
 555         ADDR    CLKOVR  / AND CLEAR CLOCK OVERFLOW COUNTER
 556         ORG .-2; DDZ; ORG .+1
 557         >
 558         CIF CDF
 559         JMP%    ADSETU
 560 /
 561 ISTAT1, ADDR    STAT1
 562 ISTAT2, ADDR    STAT2
 563 JCSTAR, ADDR    CSTART+2
 564 ASAMCN, ADDR    SAMCNT
 565 ABUFCD, ADDR    BUFCDF
 566 \f/
 567 /       MAKE THREE BITS OF AC9-11 INTO CDF
 568 /
 569 /       COMPUTE THE NUMBER OF BITS SET IN THE TRIGGER TIME WORD
 570 /
 571 CMPBIT, 0               / ON ENTRY BITSCN HOLDS THE WORD TO SCAN
 572         CLA
 573         TAD     M14     / 12 BITS TO SCAN, PREP THE COUNTER
 574         DCA     BITLCN
 575         DCA     BITCNT  / CLEAR BIT COUNTER
 576         TAD     BITSCN  / TRIG TIME WORD --> AC
 577 BITLOP, RAL             / SHIFT BIT INTO THE LINK
 578         SZL
 579         ISZ     BITCNT
 580         ISZ     BITLCN
 581         JMP     BITLOP
 582         CDF CIF 0       / HOME TO FPP
 583         JMP%    CMPBIT  / FROM TRAP4
 584 /
 585 BITSCN, 0               / ON ENTRY: HOLDS THE WORD TO SCAN
 586 BITCNT, 0               / ON RETURN: HOLDS NUMBER OF BUTS SET
 587 BITLCN, 0               / LOOP COUNTER, ABOVE TWO LOCATIONS ARE ALSO USED AS INDEX REGS 0 AND 1
 588 M14,    -14             / DEC -12
 589 /
 590 /
 591 MAKCDF, 0
 592         AND     L7
 593         CLL RTL
 594 BASEX,  RAL
 595         TAD     CDF0
 596         JMP%    MAKCDF
 597 /
 598 NPOINT, 0;0;0
 599 CDF0,   CDF
 600         0;0
 601 L7,     7
 602 BUFSIZ, -377
 603         IFSW    8 <
 604 L300,   300
 605         >
 606         IFNSW   8 <
 607 L100,   100
 608         >
 609 /
 610 TEMP,   0;0;0
 611         ORG     10*3+BASEX
 612         0
 613         JA      NAME+3
 614         0
 615 SAMRTN, JA      .
 616 FP25,   F       0.25
 617 XVALID, F       114.    / LENGTH OF READ VALID VECTOR (MUST BE MULTIPLE OF 3)
 618 VALID,  ORG     .+162   / AND HERE IS THE BUFFER SPACE
 619 /
 620 /       ROUTINE TO TEST FOR VALID SAMPLE ( PACKED DATA)
 621 /
 622 PVALID, ORG     .+2     /POINTER TO ACTUAL POSITION INSIDE VALID VECTOR
 623 MVALID, ORG     .+2     /VALID VECTOR: LAST ADDRESS USED
 624 NVALID, ADDR    VALID-1 /HOLDS ADR. OF FIRST WORD OF VALID VECTOR -1
 625 /
 626 TSTVLD, ORG     .+1     /       JMS TSTVLD
 627                         /       SAMPLE NON VALID RETURN
 628                         /       SAMPLE VALID RETURN
 629 /                               ON RETURN AC=0
 630         ISZ     PVALID+1 / GET THE NEXT LOC. OF VALID VECTOR
 631         CLA
 632         TAD     PVALID+1
 633         TAD     MVALID+1 / IF WE REACHED THE END OF THE VECTOR THEN
 634         SPA CLA         / WE RESET TO THE START ELSE
 635         JMP     L1      /  CONTINUE AT L1
 636         TAD     NVALID+1
 637         IAC
 638         DCA     PVALID+1
 639 L1,     TAD%    PVALID+1 / READ VALID FLAG --> AC
 640         SNA CLA         / IF THIS READ WAS VALID THEN WE INCREMENT THE BUFFER POINTER ELSE
 641         JMP%    TSTVLD  /  WE TAKE THE NEXT SAMPLE INTO THIS LOCATION
 642         ISZ     TSTVLD  / TAKE THE NORMAL RETURN FOR VALID SAMPLE
 643         JMP%    TSTVLD
 644 \f       EXTERN  #ARGER
 645         SECT    THRUPT
 646         BASE    0
 647         STARTD
 648         FLDA    30              /GET RETURN ADDR
 649         FSTA    SAMRTN
 650         STARTF
 651         FLDA    0
 652         FSTA#   TRETU
 653         STARTD
 654         FLDA%   0               / COMPUTE THE NUMBER OF PARAMETERS
 655         FSUB    0
 656         FSUB#   TWO
 657         SETX    XR0
 658         LDX     1,X1
 659         ALN     X1              / DIVIDE BY TWO
 660         FNEG
 661         ATX     X2              / NEGATIVE NUMBER OF ARGUMENTS --> X2
 662         FLDA    0               /GET ARG POINTER
 663         BASE    BASEX
 664         SETB    BASEX
 665         FSTA    TEMP            /SAVE ARG POINTER
 666         LDX     4700,0
 667         FCLA
 668         FSTA    CLINT           /STOP ANY SAMPLING NOW!
 669         LDX     4701,0
 670         IFSW    4 <
 671         FSTA    #CLINT >        / DISABLE STRIGG EVENTS
 672         LDX     4702,0
 673         FLDA%   TEMP,1          /GET BUFF1 ADDRESS
 674         FSTA    CURBUF
 675         LDX     1,X0
 676         JXN     TH0,X2+
 677         TRAP4   #ARGER
 678 TH0,
 679         FLDA%   TEMP,1+         /GET BUFF2 ADDR
 680         FSTA    NXTBUF
 681         LDX     2,X0
 682         LDX     4703,0
 683         JXN     TH1,X2+         / IF THERE ARE ONLY TWO PARAMETERS THEN
 684         TRAP4   #ARGER          /  ARGUMENT ERROR # 2
 685 TH1,
 686         FLDA%   TEMP,1+         /ADDR OF PARAMETERS
 687         FSTA    PARAM           / SAVE ADDR. OF PARAMETERS
 688         STARTF
 689         FCLA
 690         FSTA    PACK            / CLEAR PACK & NTRIGG IF THERE ARE ONLY 3 PARAMS
 691         FSTA    NTRIG           / DISABLE TRIGG EVENTS
 692         FSTA    TIMRAT
 693         STARTD
 694         JXN     TH2,X2+         / IF THERE ARE 4 OR MORE PARAMETERS THEN FETCH THE LAST BUT ONE
 695         JA      TH3             / ELSE THERE ARE 3 ARGUMENTS
 696 TH2,    FLDA%   TEMP,X1+        / ADDR OF FOURTH ARGUMENT --> PACK
 697         FSTA    PACK
 698         JXN     TH6,X2+         / IF THERE ARE 5 PARAMETERS GOTO TH5
 699         JA      TH3             / ONLY FOUR PARAMETERS
 700 TH6,    FLDA%   TEMP,X1+
 701         FSTA    NTRIG           / ADDR OF STRIG COUNT --> WSTRC
 702         JXN     TH10,X2+        /  IF THERE ARE 5 PARAMETERS THEN THERE MUST BE A SIXTH ONE
 703         LDX     4,X0            / FIVE PARAMETERS ARE INVALID, ARGUMENT ERR 5
 704         TRAP4   #ARGER
 705 TH10,   FLDA%   TEMP,X1+
 706         FSTA    TIMRAT          / INSERT RATE/SAMRAT/12 --> TIMBIT
 707 TH3,/
 708         FLDA    PARAM           / RESTORE ADR. OF THIRD ARGUMENT
 709         FSTA    TEMP
 710         STARTF
 711         LDX     0,1
 712         FLDA%   TEMP,1          /STARTING CHANNEL
 713         ALN     0
 714         FSTA    CSTART
 715         FLDA%   TEMP,1+         /# CHANNELS
 716         FSTA    CHNLS
 717         FNEG
 718         ALN     0
 719         FSTA    NCHANL
 720         FLDA%   TEMP,1+         /NUMBER OF POINTS
 721         FNEG
 722         ALN     0
 723         FSTA    NPOINT
 724         FLDA    PACK
 725         JEQ     TH4             / ONLY THREE PARAMETERS, CLEAR PCKSIG
 726         FLDA%   TEMP,1+
 727         FNEG
 728         FSUB    FL1
 729         ALN     0
 730 TH4,    FSTA    PCKSIG
 731         ATX     X2
 732 /
 733 TBIN0,  SETX    VALID           / PREPARE THE VALID VECTOR
 734         LDX     1,X0
 735         SETX    XR0
 736         STARTD
 737         FLDA#   NVALID  / TAKE CARE, THESE LOCATION ARE IN BASE PAGE!
 738         FSTA#   PVALID
 739         FNEG
 740         FADD    PCKSIG+1
 741         FSTA#   MVALID
 742 /
 743         FLDA    PACK
 744         JEQ     TH5
 745         FSTA    TEMP
 746         LDX     -1,X1           / X2 HOLDS PCKSIG !
 747
 748         FLDA    TBIN0
 749         FSTA    TBIN1
 750         STARTF
 751 THL0,   FLDA%   TEMP,1+
 752 TBIN1,  SETX    VALID           / XR POINTER ONTO VALID VECTOR
 753         ATX     X0              / INSERT V. VALUE INTO THE VECTOR (WORD BY WORD)
 754         SETX    TBIN1           / NOW WE INCREMENT THE POINTER ABOVE
 755         JXN     .+2,X1+         / WITH THE X INCREMENT CMD AND
 756         SETX    XR0             / RESET TO THE INDEX REGISTER SET
 757         JXN     THL0,X2+        / AND NOW WE TEST IF THE WORK IS DONE
 758 \fTH5,   STARTF          / CLEAR ALL 36 BITS OF FAC SINCE
 759         FCLA            / IF NTRIG.EQ.0 THEN WE DO NOT LOAD INTO THE EXPONENT
 760         STARTD
 761         FLDA    NTRIG           / PREPARE THE STRIGG EVENT INPUT
 762         JEQ     TH7             / NOTHING DESIRED, SKIP TO TH7
 763         LDX     10,X0           / ERROR #10
 764         IFNSW   4 <             / IF THERE IS NO HANDLER THEN
 765         JA      TH9 >           /   WE ERROR OFF
 766         FSTA    TEMP            / PUT ADDR OF TRIGG COUNT --> TEMP
 767         STARTF
 768         FLDA%   TEMP            / # OF TRIGGER INPUTS --> FAC
 769         LDX     11,X0           / ERROR #11
 770         JAL     TH9             / IF NO FIXING POSSIBLE THE ERROR OFF!
 771         JLT     TH9             / IF TRIGGER NUMBER OUTSIDE RANGE 0 TO 3 THEN ERROR OFF
 772         FSUB    FL3             / TEST FOR UPPER LIMIT
 773         LDX     12,X0           / ERROR #12
 774         JGT     TH9
 775         FADD    FL3
 776 TH7,    STARTF                  / IF THERE ARE NO STRIGGS INPUT THEN WE COME HERE WITH FAC CLEARED!
 777         FADD    FL1             / ADD 1 FOR THE COUNTER OF THE IR SERVICE ROUTINE
 778         FNEG                    / AND HERE WE COMPUTE THE COUNTER
 779         SETX    WSTRC           / AND BUMP INTO PDP/8 CODE
 780         ATX     0
 781         SETX    XR0             / RESET INDEX REGIS POINTER
 782         STARTD                  / ADDR OF TIME RATIO --> TEMP
 783         FLDA    TIMRAT          / FETCH THE TIME RATIO
 784         JEQ     TH12            / NO STRIG EVENTS DISIRED, SKIP
 785         FSTA    TEMP
 786         STARTF
 787         FLDA%   TEMP            / TIMERATIO --> FAC
 788         FSTA    TIMRAT          / AND SAVE FOR SOMEBODY ELSE
 789         LDX     13,X0           / ERROR #13
 790         JLT     TH9             / NEGATIVE PARAMETER IS NOT NICE
 791         LDX     14,X0           / ERROR #14
 792         JAL     TH9             / WE HAVE TO FIX THE NUMBER
 793         JA      TH11
 794 TH9,/                             X0 HOLDS ERROR NUMBER (10 TO 13)
 795         TRAP4   #ARGERR         /  WE ERROR OFF
 796 /
 797 TH11,   SETX    TIMBIT          / FIX THE NUMBER INTO 12 BITS
 798         ATX     0               / FOR EAE DVI INSTRUCTION
 799         SETX    XR0
 800 /
 801 /       INDEX REGISTERS (PBUFF) 1&2 ARE STATUS WORD PNTRS!
 802 /
 803 TH12,   SETX    PBUFF
 804         LDX     11,1            /INITIALIZE STATUS WORD PNTRS
 805         LDX     14,2
 806         FLDA    FP25            /INITIALIZE STATUS WORDS
 807         FSTA    STAT1           /TO INDICATE BUFFERS
 808         FSTA    STAT2           /NOT FILLED
 809         TRAP4   ADSETU          /SET UP AD STUFF
 810         FLDA    NTRIG           / HERE WE SET UP THE STRIGGE EVENT INPUT
 811         STARTD
 812         JEQ     TH8             / IF NO TRIGG INPUTS THEN SKIP ELSE
 813         FLDA    TRGADR          /
 814         FSTA    #CLINT          / QUEUE THE STRIGG INTERRUPT SERVICE ROUTINE INTO THE CLOCK TERMINATION ROUTINE
 815 TH8,/
 816         FLDA    SAMADR          /SET UP SAMPLER INTRPT HNDLR
 817         FSTA    CLINT
 818         STARTF
 819         JA      SAMRTN          /RETURN
 820 NAME,   TEXT    +THRUPT+
 821         SETX    XR0
 822         SETB    BASEX
 823 TRETU,  F       0.
 824 SAMADR, ADDR    FSMPLE
 825 TRGADR, ADDR    FIREED  / ADDR OF SCHMITT TRIGGER EVENT INTERRUPT SERVICE
 826 /
 827 XR0,    0
 828 XR1,    0                       / HOLDS NUMBER OF ARGUMENTS
 829 XR2,    0
 830 XR3,    0
 831 X0=     0
 832 X1=     X0+1
 833 X2=     X1+1
 834 X3=     X2+1
 835 ONE,            0;1;0
 836 TWO,            0;2;0
 837 FL1,    F       1.
 838 FL3,    F       3.
 839 PARAM,
 840 CHNLS,  F       0.
 841 PCKSIG, F       0.
 842 PACK,   F       0.              / HOLDS ADR. OF FOURTH ARGUMENT
 843 NTRIG,  F       0.      / HOLDS ADDR. OF FIFTH ARGUMENT
 844 TIMRAT, F       0.      /HOLDS CLOCK/SAMRAT/12, CLOCK IS RATIO OF SCHMITT TRIGGER TIMER
 845 \f/****  WORD SUBROUTINES ****
 846 /
 847 WPCNT,  0;0
 848 WC1,    0;6
 849         BASE    WDBASE
 850 WDBASE, F       0.              /PNTR TO ARGS
 851 WDINDX, F       0.              /INDEX TO WORD IN ARRAY
 852 WDOPER, F       0.              /TARGET OR SOURCE ADDR
 853 F1,     F       1.
 854 STXMJA, 0;1100-1030;0           /STX - JA
 855 WORDOP, TEXT    +WORDOP+
 856         0
 857 WDRTN,  JA      .
 858 WINDEX, F       0.              /INDEX REGS 0-2
 859 /
 860         ORG     10*3+WDBASE
 861         0
 862         JA      WORDOP+3
 863 /
 864 /****  WGET - WORD GET ****
 865 /
 866 /       CALL WGET(BUFF1,NWORD,Y)
 867 /
 868         ENTRY   WGET
 869 WGET,   JSA     WDSET           /INIT REGISTERS
 870         FLDA    WPCNT           / LOOK IF CALLED WITH TWO PARAMETERS
 871         JEQ     W2PAR           / TWO PARAMETERS ONLY, OUPUT VIA FAC
 872         XTA     0               /GET WORD FROM BUFF1
 873         FSTA%   WDOPER          /STICK IT IN X
 874         JA      WDRTN
 875 W2PAR,  XTA     0
 876         JA      WDRTN
 877 /
 878 /****  WPUT - WORD PUT ****
 879 /
 880 /       CALL WPUT(BUFF1,NWORD,Y)
 881 /
 882         ENTRY   WPUT
 883 WPUT,   JSA     WDSET           /INIT REGISTERS
 884         FLDA%   WDOPER          /GET Y
 885         ATX     0               /FIX AND STORE IN BUFF1
 886         JA      WDRTN
 887 /
 888 /       WGET & WPUT INITIALISATION
 889 /
 890         BASE    0
 891 WDSET,  0;0
 892         STARTD
 893         FLDA    30              /GET RTN ADDR
 894         FSTA    WDRTN
 895         FLDA    0               /PNTR TO ARGS
 896         SETB    WDBASE
 897         BASE    WDBASE
 898         SETX    WINDEX
 899         FSTA    WDBASE
 900         LDX     0,1             / COMPUTE NUMBER OF PARAMETERS
 901         FLDA%   WDBASE,1        / ADR. FOLLOWING THE PARAMETER LIST --> FAC
 902         FSUB    WDBASE          / SUBTRACT THE START ADR. OF PARAMETER LIST
 903         FSUB    WC1             / FAC-5 --> FAC
 904         FSTA    WPCNT           / WPCNT=0 <==> TWO PARAMETERS, =2 <==> THREE PARAMETERS
 905         FLDA%   WDBASE,1+       /BUFFER ADDR
 906         FADD    STXMJA          /MAKE SETX INST
 907         FSTA    WDSETX
 908         FLDA%   WDBASE,1+       /WORD INDEX ADDR
 909         FSTA    WDINDX
 910         FLDA    WPCNT           / TEST IF THERE ARE MORE THAN 2 PARAMETERS
 911         JEQ     WCONT           /
 912         FLDA%   WDBASE,1+       /RESULT OR VALUE ADDR
 913         FSTA    WDOPER
 914 WCONT,
 915         STARTF
 916         FLDA%   WDINDX          /WORD INDEX
 917         FSUB    F1              /COMPUT ADDR OF WORD
 918         ALN     0
 919         STARTD
 920         FADDM   WDSETX
 921 WDSETX, SETX    0               /MODIFIED DURING EXEC
 922         STARTF
 923         JA      WDSET
 924 /       SUBROUTINE TO RELEASE A BUFFER BY RESETTING
 925 /  THE STATUS REGISTER
 926 /
 927 /               CALL RELEAS(N)
 928 /
 929 /  N DESIGNATES THE STATUS REGISTER,  N SHOULD BE 1
 930 /  OR 2.  IF N .NE. 1, 2 IS ASSUMED.
 931 /
 932         ENTRY   RELEAS
 933         BASE    0
 934 RELEAS, STARTD
 935         FLDA    30              /GET RTN ADDR
 936         FSTA    WDRTN
 937         FLDA    0               /GET ARG PNTR
 938         BASE    WDBASE
 939         SETB    WDBASE
 940         SETX    WINDEX
 941         FSTA    WDBASE
 942         LDX     1,1
 943         FLDA%   WDBASE,1        /N ADDR
 944         FSTA    WDBASE
 945         SETX    STAT1           /MODIFY STATUS VIA INDEX
 946         STARTF
 947         FLDA%   WDBASE          /N
 948         FSUB    F1              /TEST FOR NOT 1
 949         JNE     CLR2            /ASSUME STAT2
 950         LDX     -1,0            /CHANGE EXPONENT
 951                                 /TO -7 TO MAKE 0.25
 952         JA      WDRTN
 953 CLR2,   LDX     -1,3            /STAT2 EXP TO -1
 954         JA      WDRTN
 955 \f/      COMPUTE THE NUMBER OF BITS SET IN THE TRIGGER WORD
 956 /       INTEGER FUNCTION TRGWRD
 957 /       BITCNT=TRGWRD(TIMEWORD)
 958 /
 959         ENTRY   TRGWRD
 960         BASE    0
 961 TRGWRD, STARTD          / STAY ON CALLER S  BASE
 962         FLDA    3*10
 963         FSTA    RETS    /  SAVE RETURN ADR.
 964         SETX    BITSCN  /  SET UP X REGISTER TO 8-MODE CODE
 965         LDX     1,1     /  INDEX TO FIRST ARGUMENT
 966         FLDA%   0,1
 967         FSTA    3
 968         STARTF
 969         FLDA%   3       / FIRST ARGUMENT --> FAC
 970         ATX     0       / AND INTO 8-MODE CODE
 971         TRAP4   CMPBIT  / THE WORK IS DONE BY PDP8
 972         XTA     1       / GET THE RESULT
 973 RETS,   JA      .-.     / AND HOME
 974         END
 975 \f\1a