ASMB,L,C
      HED HP2313 RTE VERIFICATION -- MAIN 
      NAM !2313,3,90 02313-16002   REV. 1926
      SUP 
* 
* 
*     SOURCE TAPE HP PART NO. 02313-18002 
*     BINARY TAPE HP PART NO. 02313-16002 
* 
* 
* 
      EXT A2313,B2313,D2313,E2313,P2313,R2313,S2313 
      EXT EXEC,SQRT,SIN,FLOAT,IFIX
* 
!2313 NOP 
START EQU * 
      LDA D2        MUST READ AT LEAST 2 CHARS
      CLB           NORMAL PROMPTER 
      JSB CREAD     READ COMMAND INPUT
      LDA INBFR     FETCH TWO CHARS 
* DECODE COMMON COMMANDS
      CPA AD        IS IT AD? 
      JMP .AD       EXECUTE AD
      CPA CL        IS IT CL? 
      JMP .CL       EXECUTE CL
      CPA CO        IS IT CO? 
      JMP .CO       EXECUTE CO
      CPA DA        IS IT DA? 
      JMP .DA       EXECUTE DA
      CPA EX        IS IT EX? 
      JMP !TERM     TERMINATE 
      CPA NO        IS IT NO? 
      JMP .NO       EXECUTE NO
      CPA SE        IS IT SE? 
      JMP .SE       GO FIND IF SET OR SEQ 
      CPA TR        IS IT TR? 
      JMP .TR       EXECUTE TR
* 
      LDB .ADC      CHECK ADC OR DAC MODE 
      SSB           IF ADC
      JMP ADC        GO TO ADC DECODE 
      SKP 
DAC   EQU *         DAC COMMAND DECODE
      CPA AL        IS IT AL? 
      JMP .AL       EXECUTE AL
      CPA ER        IS IT ER? 
      JMP .ER       EXECUTE ER
      CPA GR        IS IT GR? 
      JMP .GR       EXECUTE GR
      CPA LI        IS IT LI? 
      JMP .LI       EXECUTE LI
      CPA RA        IS IT RA? 
      JMP .RA       EXECUTE RA
      CPA RE        IS IT RE? 
      JMP .RE       EXECUTE RE
      CPA SI        IS IT SI? 
      JMP .SI       EXEECUTE SI 
      JMP RREAD     COMMAND NOT VALID IN DAC MODE 
      SKP 
ADC   EQU *         ADC COMMAND DECODE
      CPA LI        IS IT LI? 
      JMP ..LI      EXECUTE LI
      CPA RE        IS IT RE? 
      JMP ..RE      EXECUTE RE
      CPA SI        IS IT SI? 
      JMP ..SI      EXECUTE SI
      CPA TW        IS IT TW? 
      JMP ..TW      EXECUTE TW
      JMP RREAD     COMMAND NOT VALID IN ADC MODE 
      SKP 
.AD   EQU *         SET ADC MODE
      LDA ADPMT     GET ADC PROMPTER
      STA PRMT      STORE AS NORMAL PROMPT
      CCA           SET 
      STA .ADC       ADC MODE FLAG
      CLA 
      STA DRPOK     DISALLOW DAC REPEAT 
      JMP START     GET NEXT COMMAND
      SPC 5 
.DA   EQU *         SET DAC MODE
      LDA DAPMT     GET DAC PROMPTER
      STA PRMT      STORE AS NORMAL PROMPT
      CLA           CLEAR 
      STA .ADC       ADC MODE FLAG
      STA RPTOK     DISALLOW ADC REPEAT 
      STA LSTOK     DISALLOW ADC LIST 
      JMP START     GET NEXT COMMAND
      SKP 
.AL   EQU *         DAC ALTERNATE 
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .ALT      SET AL TEST FLAG
      JSB DACEX     INTIALIZE FOR TEST
      LDB D5
      JSB BCCG      GET BOX,CARD,CHANL
      JMP DABRT     IF ANY < 0 ABORT
      IOR D1        SET WAIT BIT
      STA CHNLS     SAVE
      STA CHNL1     SAVE FOR IMMEDIATE
      JSB DDATA     GET FIRST DATA VALUE
      JMP DABRT     IF OUT OF RANGE ABORT 
      STA DATA      SAVE
      STA GAIN1     SAVE FOR IMMEDIATE
      JSB .CNVT     SET IMMEDIATE 
      JSB DDATA     GET SECOND DATA VALUE 
      JMP DABRT     IF OUT OF RANGE ABORT 
      STA GAIN1     SAVE FOR IMMEDIATE
      XOR DATA      SET UP DATA SWITCH
      STA ALTMP     SAVE MASK 
      JSB .CNVT     SET IMMEDIATE 
ALLUP EQU * 
.ALRP EQU * 
      CLA 
      CLB,INB 
      JSB .DAC.     SET TO A VALUE
      LDA DATA      GET DATA
      XOR ALTMP     CHANGE TO OTHER VALUE 
      STA DATA      SAVE
      JMP ALLUP     REPEAT
ALTMP NOP 
      SKP 
.CL   EQU *         CLEAR CONDITION 
      LDA T.LOG     IF < 7 CHARS
      ADA DM7        THEN NOT A 
      SSA             VALID CLEAR 
      JMP RREAD        SO READ A NEW COMMAND
      LDA INBFR+1   \ 
      CPA EA         \
      RSS             \ 
      JMP RREAD        IS CLEAR SPELLED OUT?
      LDA INBFR+2     / 
      CPA R!         /
      RSS           / 
      JMP RREAD     NO - READ NEW COMMAND 
      LDA INBFR+3   CLEAR WHICH FLAG? 
      AND UPPER     FETCH CHARACTER AND MASK
      IOR B40        AND STICK A BLANK IN LOW HALF
      LDB .ADC      ADC MODE? 
      SSB           TEST
      JMP C.ADC     YES - GO CLEAR ADC FLAG(S)
C.DAC EQU *         CLEAR DAC FLAG(S) 
      CPA A!        CLEAR ALL?
      JMP CLDA      YES - DO IT 
      CPA P!        CLEAR PACER?
      JMP CLDP      YES - DO IT 
      CPA R!        CLEAR REPEAT? 
      JMP CLDR      YES - DO IT 
      JMP RREAD     NOT VALID DAC CLEAR 
CLDA  EQU * 
      STB DREPT     CLEAR DAC REPEAT
CLDP  EQU * 
      STB DPACR     CLEAR DAC PACER 
      JMP START     GET NEXT COMMAND
CLDR  EQU * 
      STB DREPT     CLEAR DAC REPEAT
      JMP START     GET NEXT COMMAND
C.ADC EQU *         CLEAR ADC FLAG(S) 
      CLB 
      CPA A!        CLEAR ALL?
      JMP CLAA      YES - DO IT 
      CPA P!        CLEAR PACER?
      JMP CLAP      YES - DO IT 
      CPA L!        CLEAR LAD?
      JMP CLAL      YES - DO IT 
      CPA R!        CLEAR REPEAT? 
      JMP CLAR      YES - DO IT 
      CPA G!        CLEAR GAIN? 
      JMP CLAG      YES - DO IT 
      CPA D!        CLEAR DELAY?
      JMP CLAD      YES - DO IT 
      JMP RREAD     NOT VALID ADC CLEAR 
CLAP  EQU * 
      STB PACER     CLEAR PACER 
      JMP START     GET NEXT COMMAND
CLAL  EQU * 
      STB LAD       CLEAR LAD 
      JMP START     GET NEXT COMMAND
CLAR  EQU * 
      STB RPEAT     CLEAR REPEAT
      STB LSTOK     DISALLOW LIST 
      JMP START     GET NEXT COMMAND
CLAG  EQU * 
      STB GAIN      CLEAR GAIN
      STB RPTOK     DISALLOW REPEAT 
      STB LSTOK     DISALLOW LIST 
      JMP START     GET NEXT COMMAND
CLAA  EQU *         CLEAR ALL 
      LDA GAIN      CHECK FOR GAIN
      SSA 
      STB RPTOK     GAIN SET - DISALLOW REPEAT
      SSA 
      STB LSTOK     GAIN SET - DISALLOW LIST
      LDA RPEAT     CHECK FOR REPEAT
      SSA 
      STB LSTOK     REPEAT SET - DISALLOW LIST
      STB PACER     CLEAR PACER 
      STB LAD       CLEAR LAD 
      STB RPEAT     CLEAR REPEAT
      STB GAIN      CLEAR GAIN
CLAD  EQU * 
      STB DELAY     CLEAR DELAY 
      JMP START     GET NEXT COMMAND
      SKP 
.CO   EQU *         LIST CONDITIONS 
      LDA DM5       \ 
      STA CNTR1      \
      LDA BLANK       \ 
      LDB AINBF        \
CLR   EQU *             CLEAR PRINT BUFFER
      STA B,I          /
      INB             / 
      ISZ CNTR1      /
      JMP CLR       / 
      LDB AINBF     GET PRINT BUFFER ADDR 
      LDA .ADC      CHECK FOR ADC OR DAC MODE 
      SSA 
      JMP ADCCO     ADC MODE - PRINT ADC COND 
      LDA DPACR     GET DAC PACER FLAG
      SSA,RSS       TEST
      JMP TDR       NOT SET 
      LDA P!        PUT "P" IN BUFFER 
      STA B,I       : 
      INB           : 
TDR   EQU * 
      LDA DREPT     FETCH DAC REPEAT FLAG 
      SSA,RSS       TEST
      JMP DCO       NOT SET 
      LDA R!        PUT "R" IN BUFFER 
      STA B,I       : 
      INB           : 
DCO   EQU * 
      LDA AINBF     COMPARE BEGIN & END BUFFER ADDRS
      CMA,INA       : 
      ADA B         : 
      SZA,RSS       IF EQUAL
      JMP NOCO       THEN NO CONDITIONS - PRINT NONE
COOUT EQU *         PRINT CONDITIONS BUFFER 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF LU.FB 
AINBF DEF INBFR 
      DEF DM10
      JMP START     GET NEXT COMMAND
ADCCO EQU *         ADC CONDITION REQUEST 
      LDA PACER     GET ADC PACER FLAG
      SSA,RSS       TEST
      JMP TAR       NOT SET 
      LDA P!        PUT "P" IN BUFFER 
      STA B,I       : 
      INB           : 
TAR   EQU * 
      LDA RPEAT     GET ADC REPEAT FLAG 
      SSA,RSS       TEST
      JMP TAL       NOT SET 
      LDA R!        PUT "R" IN BUFFER 
      STA B,I       : 
      INB           : 
TAL   EQU * 
      LDA LAD       GET ADC LAD FLAG
      SSA,RSS       TEST
      JMP TAG       NOT SET 
      LDA L!        PUT "L" IN BUFFER 
      STA B,I       : 
      INB           : 
TAG   EQU * 
      LDA GAIN      GET ADC GAIN FLAG 
      SSA,RSS       TEST
      JMP TAD       NOT SET 
      LDA G!        PUT "G" IN BUFFER 
      STA B,I       : 
      INB           : 
TAD   EQU * 
      LDA DELAY     GET ADC DELAY FLAG
      SSA,RSS       TEST
      JMP ACO       NOT SET 
      LDA D!        PUT "D" IN BUFFER 
      STA B,I       : 
      INB           : 
ACO   EQU * 
      LDA AINBF     COMPARE BEGIN & END BUFFER ADDRS
      CMA,INA       : 
      ADA B         : 
      SZA,RSS       IF EQUAL
      JMP NOCO       THEN NO CONDITIONS - PRINT NONE
      JMP COOUT     PRINT CONDITIONS BUFFER 
NOCO  EQU *         NO CONDITIONS SET 
      LDA NO        STORE "NONE"
      STA INBFR      IN THE CONDITIONS
      LDA NE          BUFFER
      STA INBFR+1      AND PRINT
      JMP COOUT 
NE    ASC 1,NE
      SKP 
.ER   EQU *         DAC ERASE 
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .ERS      SET ERASE  TEST FLAG
      JSB DACEX     INITIALIZE FOR TEST 
      LDA RDGS      GET # OF CHANLS 
      CMA,INA       SET UP LOOP 
      STA XCNTR      TO READ CHANL #'S
      LDA ACHLS     POINT TO
      STA XTEMP      CHANL BUFFER 
ERLUP EQU * 
      ISZ XTEMP     BUMP ADDR POINTER 
      CLB,INB       GET BOX,CARD
      JSB BCCG      : 
      JMP DABRT     IF ANY < 0 ABORT
      STA XTEMP,I   SAVE ADDR 
      ISZ XCNTR     DONE? 
      JMP ERLUP     NO - CONTINUE 
.ERRP EQU * 
      JSB E2313     CALL I/F TO DO ERASES 
      DEF *+5 
      DEF LU.SS 
      DEF RETRN 
      DEF CHNLS 
      DEF RDGS
      CLA,INA       GET EXPECTED RETURN CODE
      JSB C2313     CHECK RETURN CODE 
      JMP .ERRP     ERROR 
      JMP .ERRP     ERROR 
      LDA DREPT     CHECK FOR 
      SSA            REPEAT 
      JMP .ERRP     REPEAT
      JMP START     GET NEXT COMMAND
      SKP 
.GR   EQU *         DAC GROUP 
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .GRP      SET GROUP TEST FLAG 
      JSB DACEX     INITIALIZE FOR TEST 
      LDA ACHLS     GET CHANL STORE ADDR
      STA XTEMP     SAVE
      LDA ADATA     GET DATA STORE ADDR 
      STA CNTR1     SAVE
      LDA RDGS      GET # CHANLS IN 1ST GR
NXTGR EQU * 
      CMA,INA       SET UP LOOP 
      STA XCNTR      TO GET DATA
GRLUP EQU * 
      ISZ XTEMP     BUMP ADDR POINTER 
      ISZ CNTR1     BUMP DATA POINTER 
      LDB D5        GET BOX,CARD,CHANL
      JSB BCCG      : 
      JMP DABRT     IF ANY < 0 ABORT
      STA XTEMP,I   SAVE
      JSB DDATA     GET DATA
      JMP DABRT     IF OUT OF RANGE ABORT 
      STA CNTR1,I   SAVE
      ISZ XCNTR     DONE? 
      JMP GRLUP     NO - CONTINUE 
      LDA XTEMP,I   GET LAST CHANL
      IOR D1         AND TURN ON WAIT BIT 
      STA XTEMP,I   SAVE
      CLA,INA       READ >= 1 CHAR
      LDB M13       PRMPT W/MESSAGE 13
      JSB CREAD     GET REPLY 
      LDA IMAX      GET MAX INTEGER 
      STA FF1       DEFAULT RESPONSE
      JSB FFIN      CONVERT # 
      LDA FF1       GET # 
      SSA           IF < 0
      JMP DABRT      THEN ABORT 
      ADA RDGS      ADD TO TOTAL
      LDB A         MOVE TO (B) 
      CMB,INB       NEGATE
      ADB D200      IF
      SSB            > 200
      JMP RREAD     THEN BAD - REREAD 
      STA RDGS      SAVE TOTAL
      LDA FF1       GET # 
      SZA           IF = 0 THEN DONE
      JMP NXTGR      OTHERWISE NEXT GROUP 
      LDA DPACR     CHECK FOR PACER 
      SSA,RSS       PACER?
      JMP NOPCE     NO - ERROR
.GRRP EQU * 
      LDA D1        MODE IS 1 
      LDB RDGS      CONVERT RDGS CHANLS 
      JSB .DAC.     CONVERT 
      LDA DREPT     GET REPEAT FLAG 
      SSA           REPEAT? 
      JMP .GRRP     YES - DO IT AGAIN 
      JMP START     GET NEXT COMMAND
      SPC 5 
NOPCE EQU * 
      LDA LU.FB     GET FALL BACK LU
      LDB M5        GET MESSAGE ADDR
      JSB PRMPT     WRITE NO PACE MESSAGE 
      JMP START     GET NEXT COMMAND
      JMP START 
      SKP 
.LI   EQU *         DAC LISSAJOUS 
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .LISA     SET LI TEST FLAG
      JSB DACEX     INITIALIZE FOR TEST 
      CLB,INB       GET BOX,CARD
      JSB BCCG      : 
      JMP DABRT     IF ANY < 0 ABORT
      IOR BIT12     SET PACE BIT ON CHANL 0 
      STA CHNLS     SAVE
      XOR BIT12     CLEAR PACE BIT
      IOR D17       SET WAIT BIT ON CHANL 1 
      STA CHNLS+1   SAVE
      LDA LU.IN     GET INPUT LU
      LDB M24       GET MESSAGE ADDR
      JSB PRMPT     PRINT "FOR" 
      LDA LU.IN     GET INPUT LU
      LDB M25       GET MESSAGE ADDR
      JSB PRMPT     PRINT "X=SIN(W1*T)" 
      LDA LU.IN     GET INPUT LU
      LDB M26       GET MESSAGE ADDR
      JSB PRMPT     PRINT "Y=SIN(W2*T+@)" 
      LDB M27       PROMPT W/"W1 = "
      JSB RFFIN     READ W1 
      DST W1        SAVE
      LDB M28       PROMPT W/"W2 = "
      JSB RFFIN     READ W2 
      DST W2        SAVE
      LDB M29       PROMPT W/"@ = " 
      JSB RFFIN     READ PHASE
      DST PHASE     SAVE
      CLA 
      STA TIME      START AT
      STA TIME+1     T = 0
      LDA RDGS      GET # OF POINTS 
      JSB FLOAT     MAKE REAL 
      DST DEL.T     SAVE
      DLD TWOPI 
      FDV DEL.T     DIVIDE INTO PARTS 
      DST DEL.T     SAVE DELTA T
      LDA RDGS      SET UP
      CMA,INA        LOOP TO
      STA XCNTR       CALCULATE POINTS
      LDA ADATA     SET UP
      STA XTEMP      DATA POINTER 
LILUP EQU * 
      ISZ XTEMP     BUMP DATA POINTER 
      DLD W1        FETCH W1
      FMP TIME      W1*T
      JSB SIN       FIND SIN(W1*T)
      HLT 0 
      FMP LIFCT     CONVERT VOLTS 
      JSB IFIX       TO BITS
      AND DDMSK     MASK JUNK 
      STA XTEMP,I   SAVE
      ISZ XTEMP     MOVE TO Y VALUE 
      DLD W2        FETCH W2
      FMP TIME      W2*T
      FAD PHASE     W2*T+@
      JSB SIN       FIND SIN(W2*T+@)
      HLT 0 
      FMP LIFCT     CONVERT VOLTS 
      JSB IFIX       TO BITS
      AND DDMSK     MASK JUNK 
      STA XTEMP,I   SAVE
      DLD TIME
      FAD DEL.T     T + DELTA T 
      DST TIME
      ISZ XCNTR     DONE? 
      JMP LILUP     NO - CONTINUE 
.LIRP EQU * 
      LDA D2        MODE IS 2 (SEQ) 
      LDB RDGS      RDGS PAIRS
      BLS           MULTIPLY BY 2 
      JSB .DAC.     CONVERT POINTS
      LDA DREPT     REPEAT? 
      SSA           : 
      JMP .LIRP     REPEAT - DO IT AGAIN
      JMP START     GET NEXT COMMAND
BIT12 OCT 10000 
D17   DEC 17
LIFCT DEC 32752.
TWOPI DEC 6.2832
      SPC 5 
      SKP 
..LI  EQU *         ADC LIST
* LISTER
      LDA LSTOK     CHECK IF LIST ALLOWED 
      SSA,RSS 
      JMP RREAD     NOT ALLOWED 
      LDA LU.PO     DEFAULT TO DEFAULT LIST DEVICE
      JSB GETLU      BUT SEE IF ALTERNATE SUPPLIED
      JMP RREAD     ALTERNATE IS BAD
      STA LSTDV     SAVE LU OF LIST DEVICE
      LDA D2        READ >= 2 CHARS 
      LDB M11       PROMPT W/MSG 11 
      JSB CREAD     READ LIMITS FOR LIST
      LDA IMAX      GET MAX INTEGER 
      STA FF1       DEFAULT START 
      STA FF2       DEFAULT FINISH
      JSB FFIN      CONVERT START AND FINISH
      LDA FF2       FETCH FINISH
      LDB FF1       FETCH START 
      IOR B         COMBINE 
      SSA           CHECK FOR < 0 
      JMP START     IF < 0 THEN QUIT
      SZB,RSS       CHECK FOR ZERO
      JMP RREAD     ZERO INVALID - ERROR
      CMB,INB       SEE IF
      ADB FF2        START > FINISH 
      SSB              IF SO
      JMP RREAD        THEN ERROR 
      LDA RDGS      SEE IF
      MPY GRUPS      CHNLS GROUP*GROUPS 
      LDB .SCLD       (IF SCALED SEQUENTIAL)
      SSB,RSS 
      LDA RDGS        OR RDGS (IF NOT)
      LDB FF1 
      CMB,INB 
      ADB A 
      SSB              < START
      JMP RREAD         THEN ERROR
      LDB FF2       SET FINISH =
      CMB,INB 
      ADB A          MIN(RDGS,FINISH) 
      SSB,RSS 
      LDA FF2 
      STA FF2 
      JSB LF        OUTPUT LINE FEED
      LDA .TC       CHECK FOR TWO CHANNEL LIST
      SSA 
      JMP TCLST     TWO CHANNEL LIST - TWO COLUMNS
      CLA 
FBLST EQU *         \ 
      ADA RDGS       \
      LDB FF1         \ 
      CMB,INB          \
      ADB A             \ 
      SSB                \
      JMP FBLST           FIND WHICH GROUP START IS IN
      ADA D2              FOR SCALED SEQUENTIAL 
      LDB FF1           / 
      CMB,INB          /
      ADA B           / 
      CMA,INA        /
      STA CTEMP     / 
LLP1  EQU * 
      ISZ CTEMP     IF DONE WITH A GROUP
      JMP NOLF      NOT DONE SO NO LINE FEED
      JSB LF         THEN OUTPUT LINE FEED
      LDA RDGS      RESTORE COUNTER 
      CMA,INA 
      STA CTEMP 
NOLF  EQU *         NOT END OF GROUP
      LDA BLANK     GET BLANK 
      STA INBFR     BLANK FIRST CHAR
      JSB DFTCH     FETCH NEXT VALUE
      LDA D2        GET BUFFER OFFSET 
      LDB AINBF     GET BUFFER ADDR 
      JSB FMTOT       AND CALL FORMAT OUTPUT
      LDA DM11      OUTPUT 11 CHARS 
      JSB LISTO      ON LIST DEVICE 
      LDA FF1       DONE? 
      CPA FF2       : 
      JMP DOLF      YES - FINISH UP 
      ISZ FF1       INCREMENT COUNTER 
      JMP LLP1      DO NEXT VALUE 
TCLST EQU *         TWO COLUMN LIST FOR T.C.
      CLB           SET INITIAL 
      LDA FF1        VALUE OF COLUMN
      SLA,RSS         NUMBER
      CCB              (1 OR 2(-1)) 
      STB CTEMP     : 
      LDA DM8 
      STA XCNTR     SET UP LOOP-BLANK PRINT BUFFER
      LDA BLANK     BLANK 
      LDB AINBF     BUFFER ADDR 
TCLBL EQU * 
      STA B,I       STORE BLANK 
      INB           MOVE POINTER
      ISZ XCNTR     DONE? 
      JMP TCLBL     NO-CONTINUE 
LLP2  EQU * 
      LDA CTEMP     FETCH COLUMN FLAG 
      SSA           CHECK 
      JMP CLMN2     SET FOR COLUMN 2
      JSB DFTCH     FETCH VALUE 
      LDA D2        GET BUFFER OFFSET 
      LDB AINBF     GET BUFFER ADDR 
      JSB FMTOT     CALL FORMAT OUTPUT
      LDA CTEMP     REVERSE 
      CMA            COLUMN 
      STA CTEMP       FLAG
      JMP ELLP2     CHECK FOR DONE
CLMN2 EQU *         COLUMN 2
      JSB DFTCH     FETCH VALUE 
      LDA D16       GET 2ND COLUMN BUFFER OFFSET
      LDB AINBF     GET BUFFER ADDR 
      JSB FMTOT     CALL FORMAT OUTPUT
      LDA DM25      OUTPUT 25 CHARS 
      JSB LISTO      ON LIST DEVICE 
      LDA CTEMP     REVERSE 
      CMA           COLUMN
      STA CTEMP       FLAG
ELLP2 EQU * 
      LDA FF1       CHECK 
      CPA FF2        FOR END
      JMP LDONE       OF LIST 
      ISZ FF1       MORE SO BUMP COUNTER
      JMP LLP2       AND CONTINUE 
LDONE EQU *         LIST DONE 
      LDA CTEMP     IF SOMETHING IN 
      SSA,RSS        COLUMN 1 
      JMP DOLF
      LDA DM11        THEN OUTPUT 11 CHARS
      JSB LISTO        ON LIST DEVICE 
DOLF  EQU *         OUTPUT LINE FEED
      JSB LF         AT END OF LIST 
      JMP START     GET NEXT COMMAND
D16   DEC 16
DM25  DEC -25 
DM8   DEC -8
LSTDV NOP 
      SKP 
.NO   EQU *         SYSTEM NORMALIZE
      JSB S2313     CALL I/F ROUTINE
      DEF *+3 
      DEF LU.SS 
      DEF RETRN 
      JSB C2313     CHECK RETURN CODE 
      JMP .NO       ERROR - REPEAT REQUEST
      JMP .NO       ERROR - REPEAT REQUEST
      JMP START     GET NEXT COMMAND
      SKP 
.RA   EQU *         DAC RANDOM
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .RAN      SET RA TEST FLAG
      JSB DACEX     INITIALIZE FOR TEST 
      LDA RDGS      GET # OF POINTS 
      CMA,INA       SET UP LOOP TO
      STA XCNTR      READ CHANLS AND DATA 
      LDA ACHLS     POINT TO
      STA XTEMP      CHANL BUFFER 
      LDA ADATA     POINT TO
      STA CNTR1      DATA BUFFER
RALUP EQU * 
      ISZ XTEMP     BUMP CHANL POINTER
      ISZ CNTR1     BUMP DATA POINTER 
      LDB D5        SET BOX,CARD,CHANL
      JSB BCCG      : 
      JMP DABRT     IF ANY < 0 ABORT
      IOR D1        TURN ON WAIT BIT
      STA XTEMP,I   SAVE CHANL ADDR 
      STA CHNL1     SAVE FOR IMMEDIATE CONVERT
      JSB DDATA     GET DATA
      JMP DABRT     IF OUT OF RANGE ABORT 
      STA CNTR1,I   SAVE DATA 
      STA GAIN1     SAVE FOR IMMEDIATE CONVERT
      JSB .CNVT     CONVERT NOW 
      ISZ XCNTR     DONE? 
      JMP RALUP     NO - CONTINUE 
.RARP EQU * 
      LDA DREPT     REPEAT? 
      SSA,RSS 
      JMP START     GET NEXT COMMAND
RA.RP EQU * 
      LDA D1        MODE IS 1 (RANDOM)
      LDB RDGS
      JSB .DAC.     CONVERT POINTS
      JMP .RARP 
      SKP 
.RE   EQU *         DAC REPEAT
      LDA DRPOK     SEE IF
      SSA,RSS        REPEAT ALLOWED 
      JMP RREAD     REPEAT NOT ALLOWED
      LDA .ALT      LAST TEST AL? 
      SSA 
      JMP .ALRP     GO DO IT AGAIN
      LDA .ERS      LAST TEST ER? 
      SSA 
      JMP .ERRP     GO DO IT AGAIN
      LDA .GRP      LAST TEST GR? 
      SSA 
      JMP .GRRP     GO DO IT AGAIN
      LDA .LISA     LAST TEST LI? 
      SSA 
      JMP .LIRP     GO DO IT AGAIN
      LDA .RAN      LAST TEST RA? 
      SSA 
      JMP RA.RP     GO DO IT AGAIN
      LDA .SICH     LAST TEST SI? 
      SSA 
      JMP SI.RP     GO DO IT AGAIN
      JMP RREAD     NOTHING TO REPEAT 
      SPC 5 
..RE  EQU *         ADC REPEAT
      LDA RPTOK     SEE IF
      SSA,RSS       REPEAT ALLOWED
      JMP RREAD     REPEAT NOT ALLOWED
      LDA .SC       LAST TEST SI? 
      SSA 
      JMP SIRD      GO DO IT AGAIN
      LDA .TC       LAST TEST TC? 
      SSA 
      JMP TWX       GO DO IT AGAIN
      LDA .SCLD     LAST TEST SCALED SEQ? 
      SSA 
      JMP SCS       GO DO IT AGAIN
      LDA .SS       LAST TEST SE? 
      SSA 
      JMP SEQS      GO DO IT AGAIN
      JMP RREAD     NOTHING TO REPEAT 
      SKP 
.SE   EQU *         SET CONDITION OR SEQ
      LDA T.LOG     FETCH T-LOG 
      CPA D2        IF = 2
      JMP SEQ       THEN SEQ
      LDA INBFR+1   FETCH COMMAND CHAR 3
      AND UPPER     MASK CHAR 4 
      IOR B40       PUT IN BLANK
      CPA T!        IF NOT A T
      RSS 
      JMP SEQ       THEN SEQ
      LDA T.LOG     FETCH T-LOG (ASSUME "SET")
      ADA DM5       CHECK FOR < 5 
      SSA 
      JMP RREAD     < 5 - NOT VALID SET 
      LDA INBFR+1   FOR SET BLANK 
      CPA T!        MUST FOLLOW T 
      RSS 
      JMP RREAD     NOT "T " SO ERROR 
      LDA INBFR+2   SET WHICH FLAG? 
      AND UPPER     FETCH CHAR AND MASK 
      IOR B40        STICK BLANK IN LOW HALF
      LDB .ADC      ADC MODE? 
      SSB           TEST
      JMP S.ADC     YES - GO SET ADC FLAG 
S.DAC EQU *         SET DAC FLAG
      CPA P!        SET PACER?
      JMP SDP       YES - DO IT 
      CPA R!        SET REPEAT? 
      JMP SDR       YES - GO DO IT
      JMP RREAD     NOT VALID DAC SET 
S.ADC EQU *         SET ADC FLAG
      CPA P!        SET PACER?
      JMP SAP       YES - GO DO IT
      CPA L!        SET LAD?
      JMP SAL       YES - GO DO IT
      CPA R!        SET REPEAT? 
      JMP SAR       YES - GO DO IT
      CPA D!        SET DELAY?
      JMP SAD       YES - GO DO IT
      CPA G!        SET GAIN? 
      JMP SAG       YES - GO DO IT
      CPA K!        PROGRAM GAIN IMMEDIATE? 
      JMP SAK       YES - GO DO IT
      JMP RREAD     NOT VALID ADC SET 
SDP   EQU * 
      LDA DACPP 
      JSB PPRAM     GET DAC PACER PARAMS
      JMP DABRT     ABORT IF ANY < 0
      JMP START     GET NEXT COMMAND
SDR   EQU * 
      CCA 
      STA DREPT     SET DAC REPEAT
      JMP START     GET NEXT COMMAND
SAP   EQU * 
      LDA ADCPP 
      JSB PPRAM     GET ADC PACER PARAMS
      JMP AABRT     ABORT IF ANY < 0
      JMP START     GET NEXT COMMAND
SAR   EQU * 
      CCA 
      STA RPEAT     SET ADC REPEAT
      CLA 
      STA LSTOK     DISALLOW LIST 
      JMP START     GET NEXT COMMAND
SAL   EQU * 
      LDA DELAY     DELAY SET?
      SSA 
      JMP DLYER     YES - CAN'T HAVE LAD
      CCA 
      STA LAD       SET ADC LAD 
      CLB,INB 
      JSB BCCG      GET LAD ADDR
      JMP LABRT     ABORT IF ANY < 0
      STA LADAD     SAVE LAD ADDR 
      JMP START     GET NEXT COMMAND
LABRT EQU * 
      CLA 
      STA LAD       CLEAR ADC LAD ON ABORT
      JMP AABRT 
SAG   EQU * 
      CCA 
      STA GAIN      SET ADC GAIN
      CLA 
      STA RPTOK     DISALLOW ADC REPEAT 
      JMP START     GET NEXT COMMAND
T1    NOP 
T2    NOP 
SAK   EQU *         PROGRAM GAIN IMMEDIATE
      LDB D4
      JSB BCCG      GET BOX,CARD,GAIN 
      JMP AABRT     ABORT IF ANY < 0
      STA T1        SAVE ADDR 
      STB T2        SAVE GAIN CODE
PGAIN EQU *         PROGRAM GAIN
      JSB A2313     CALL I/F
      DEF *+6 
      DEF LU.SS 
      DEF RETRN 
      DEF D0
      DEF T1
      DEF T2
      CLA,INA 
      JSB C2313     CHECK RETURN CODE 
      JMP PGAIN     BAD - RETRY 
      JMP PGAIN     BAD - RETRY 
      JMP START     GET NEXT COMMAND
SAD   EQU * 
      LDA LAD       LAD SET?
      SSA 
      JMP DLYER     YES - CAN'T HAVE GAIN 
      CLA,INA 
      LDB M9
      JSB CREAD     ASK FOR DELAY 
      JSB FFIN      CONVERT DELAY 
      LDA FF1       IF DELAY
      SSA            < 0
      JMP AABRT     BAD SO ABORT
      CMA,INA       DELAY SHOULD BE < 10000 
      STA DCNTR     SAVE -DELAY 
      ADA D10K      < 10000 ? 
      SSA 
      JMP RREAD     NO  SO ABORT
      CCA 
      STA DELAY     SET DELAY 
      JMP START     GET NEXT COMMAND
      SKP 
SEQ   EQU *         ADC SEQUENTIAL SCAN 
      LDA .ADC      GET ADC FLAG
      SSA,RSS       CHECK FOR ADC MODE
      JMP RREAD     DAC MODE -- NO SEQ
      JSB ADCCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .SS       SET SEQ TEST FLAG 
      JSB ADCEX     INITIALIZE FOR TEST 
      LDA .SCLD     SEE IF
      SSA            SCALED SEQUENTIAL
      JMP SCSEQ     SCALED SEQUENTIAL 
      LDA LU.IN 
      LDB M15 
      JSB PRMPT     ASK FOR FIRST CHANL 
      LDB D2        GET BOX,CARD,CHANL
      JSB BCCG
      JMP AABRT     IF ANY < 0 ABORT
      STA CHNL1     SAVE CHANL ADDR 
      STA CHNL2 
      STB GAIN1     SAVE GAIN CODE
      STB GAIN2 
      LDA LAD       GET LAD FLAG
      SSA,RSS       IF NO LAD 
      JMP NOLAD     THEN SKIP LAD SECTION 
      LDA LU.IN 
      LDB M21 
      JSB PRMPT     ASK FOR LAST CHANL
      LDB D2
      JSB BCCG      GET BOX,CARD,CHANL
      JMP AABRT     IF ANY < 0 ABORT
      STA LSTCH     SAVE LAST CHANL 
NOLAD EQU * 
      LDB M14 
      JSB QYNA      ASK IF DIFFERENTIAL 
      SZA,RSS       AB? 
      JMP AABRT     ABORT 
      CLB 
      SSA,RSS 
      STB DIFF      NO - CLEAR DEFAULT
SEQS  EQU * 
      LDA RDGS      GET READINGS
      STA MPX1      STORE FOR MPX CALL
      JSB MPX       CALL FOR MPX
      DEF D2
      DEF CHNL1 
      DEF GAIN1 
      DEF EXTSS 
MPX1  NOP 
      DEC 1 
      DLD RD1       SET REAL GAIN = 1 
      DST RG1 
      DST RG2 
      LDA RDGS      GET READINGS
      CLB,INB       SET ORIGIN
      JSB CNVRT     CONVERT TO VOLTS
      JMP PCERR     PACE FAST ERROR 
      LDA RPEAT     GET REPEAT FLAG 
      SSA,RSS 
      JMP TAKEN 
      JMP SEQS
      SPC 5 
TAKEN EQU * 
      LDA LU.IN 
      LDB M17 
      JSB PRMPT     OUTPUT "RDGS TAKEN" 
      JMP START     GET NEXT COMMAND
      SKP 
SCSEQ EQU *         ADC SCALED SEQUENTIAL 
      LDA D1        READ >= 1 CHARACTERS
      LDB M19 
      JSB CREAD     READ # OF GROUPS
      LDA IMAX      GET MAX INTEGER 
      STA FF1       DEFAULT # OF GROUPS 
      JSB FFIN      CONVERT # OF GROUPS 
      LDA FF1       GET # OF GROUPS 
      SSA           IF < 0
      JMP AABRT      THEN ABORT 
      SZA,RSS       IF ZERO 
      JMP RREAD      THEN BAD 
      STA GRUPS     SAVE # OF GROUPS
      CMA,INA       NEGATE
      ADA D25       ADD 25
      SSA           IF > 25 
      JMP RREAD      THEN BAD 
      LDA RDGS      GET CHNLS/GRP 
      MPY GRUPS     FIND CHNLS/GRP*GROUPS 
      SZB           CHECK FOR OVERFLOW
      JMP RREAD     OVERFLOW - BAD
      CMA,INA       NEGATE
      ADA D200      ADD 200 
      SSA           IF > 200
      JMP RREAD      THEN BAD 
      CLA           SET UP LOOP 
      STA XCNTR      TO GET START CHANLS
GLOOP EQU * 
      ISZ XCNTR     BUMP LOOP COUNTER 
      LDA XCNTR     \ 
      JSB I.OUT      \
      JSB CMOVE       \ 
      DEC 1         CALL FRMTR TO 
      DEF I.B       CONVERT GROUP # 
      DEC 6           / 
      DEF GR.FT      /
      DEC 6         / 
      LDA LU.IN     OUTPUT GROUP #
      LDB GRFMT     : 
      JSB PRMPT     : 
      LDB D3        GET BOX,CARD, 
      JSB BCCG       CHANL,GAIN 
      JMP AABRT     IF ANY < 0 THEN ABORT 
      STA XTEMP     SAVE CHANL ADDR 
      LDA XCNTR     COMPUTE STORE 
      ADA AGANS      ADDR & 
      STB A,I         STORE GAIN
      LDB XTEMP     GET CHANL ADDR
      LDA XCNTR     COMPUTE CHANL 
      ADA ACHLS      STORE ADDR & 
      STB A,I         STORE CHANL 
      LDA XCNTR     GET LOOP COUNT
      CPA GRUPS     DONE? 
      RSS 
      JMP GLOOP     NO - CONTINUE 
      CCA 
      STA DIFF      LLMPX ALWAYS DIFFERENTIAL 
SCS   EQU * 
      CLA           SET UP LOOP 
      STA XCNTR      TO TAKE READINGS 
SCSLP EQU * 
      ISZ XCNTR     BUMP LOOP COUNTER 
      CCA           \ 
      ADA XCNTR      \
      MPY RDGS      COMPUTE BUFFER ADDR 
      INA            /
      STA FIRST     / 
      LDA RDGS      SET UP
      STA CHPGP      NUMBER OF READINGS 
      LDA XCNTR     COMPUTE GAIN ADDR 
      ADA AGANS      & SET
      STA SCSGN       IN CALL 
      LDA XCNTR     COMPUTE CHANL ADDR
      ADA ACHLS      & SET
      STA SCSCH       IN CALL 
      JSB MPX       CALL FOR READINGS 
      DEF D2
SCSCH NOP 
SCSGN NOP 
      DEF EXTSS 
CHPGP NOP 
FIRST NOP 
      LDA XCNTR     GET LOOP COUNTER
      CPA GRUPS     DONE? 
      RSS 
      JMP SCSLP     NO - CONTINUE 
      CLA           SET UP LOOP 
      STA XCNTR      TO CONVERT READINGS
SCSCV EQU * 
      ISZ XCNTR     BUMP LOOP COUNTER 
      LDA XCNTR     COMPUTE 
      CMA,INA        GAIN 
      ADA GRUPS       ADDR
      STA XTEMP 
      INA              AND
      ADA AGANS         GET 
      LDA A,I            GAIN 
      JSB GETGN     LOOK UP REAL GAIN 
      DST RG1       STORE GAIN FOR CONVERSION 
      DST RG2       STORE GAIN FOR CONVERSION 
      LDA XTEMP     COMPUTE BUFFER
      MPY RDGS       SUBSCRIPT FOR
      INA             CONVERSION (LAST GROUP FIRST) 
      LDB A             : 
      LDA RDGS      GET # OF READINGS 
      JSB CNVRT     CONVERT DATA
      JMP PCERR     PACE FAST - ABORT 
      LDA XCNTR     GET LOOP COUNTER
      CPA GRUPS     DONE? 
      RSS 
      JMP SCSCV     NO - CONTINUE 
      LDA RPEAT     GET REPEAT FLAG 
      SSA,RSS       TEST
      JMP TAKEN     NO REPEAT 
      JMP SCS       REPEAT
D200  DEC 200 
D25   DEC 25
XTEMP NOP           EXECUTION TEMPORARY 
XCNTR NOP           EXECUTION COUNTER 
GRFMT DEF *+1 
DM11  DEC -11 
GR.FT ASC 6,GROUPXXXXXX 
      SKP 
.SI   EQU *         DAC SINGLE
      JSB DACCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .SICH     SET SI TEST FLAG
      JSB DACEX     INITIALIZE FOR TEST 
      LDA RDGS      SET UP
      CMA,INA        LOOP TO
      STA XCNTR       GET DATA
      LDA ADATA     SET UP
      STA XTEMP      ADDR POINTER 
      LDB D5        SET BOX,CARD,CHANL
      JSB BCCG      : 
      JMP DABRT     IF ANY < 0 ABORT
      IOR D1        TURN ON WAIT BIT
      STA CHNLS     SAVE
      STA CHNL1     SAVE FOR IMMEDIATE CONVERT
SILUP EQU * 
      ISZ XTEMP     BUMP DATA POINTER 
      JSB DDATA     READ DATA 
      JMP DABRT     IF OUT OF RANGE ABORT 
      STA XTEMP,I   SAVE
      STA GAIN1     SAVE FOR IMMEDIATE CONVERT
      JSB .CNVT     CONVERT NOW 
      ISZ XCNTR     DONE? 
      JMP SILUP     NO - CONTINUE 
.SIRP EQU * 
      LDA DREPT     REPEAT? 
      SSA,RSS 
      JMP START     GET NEXT COMMAND
SI.RP EQU * 
      CLA           MODE IS 0 (SINGLE)
      LDB RDGS
      JSB .DAC.     CONVERT CHANLS
      JMP .SIRP     REPEAT
      SKP 
..SI  EQU *         ADC SINGLE CHANNEL TEST 
      LDA LU.PO     DEFAULT TO DEFAULT LIST DEVICE
      JSB GETLU      BUT SEE IF ALTERNATE SUPPLIED
      JMP RREAD     ALTERNATE IS BAD
      STA LSTDV     SAVE LU OF LIST DEVICE
      JSB ADCCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .SC       SET SINGLE CHANNNEL TEST FLAG 
      JSB ADCEX     INTIALIZE FOR TEST
      LDB D2        \ 
      LDA GAIN       GET BOX,CARD,
      SSA             CHANL & 
      INB              GAIN IF NECESSARY
      JSB BCCG      / 
      JMP AABRT     IF ANY < 0 ABORT
      STA CHNL1     SAVE CHANL ADDR 
      STA CHNL2 
      STB GAIN1     SAVE GAIN 
      STB GAIN2 
SIRD  EQU * 
      LDA RDGS      SET # OF READINGS 
      LDB DELAY     DELAY?
      SSB,RSS 
      JMP SIMPX     NO
      CMA,INA       YES 
      STA D.CNT       SAVE # READINGS 
      CLA,INA       SET UP FOR 1 READING
SIMPX EQU * 
      STA SIRGS 
      CLA           SET UP
      STA SIOFS       DATA BUFFER OFFSET
MPXSI EQU * 
      ISZ SIOFS     INCREMENT BUFFER OFFSET 
      JSB MPX       CALL FOR READINGS 
      DEF ZERO
      DEF CHNL1 
      DEF GAIN1 
      DEF EXTSS 
SIRGS NOP 
SIOFS NOP 
      LDB DELAY     DELAY?
      SSB,RSS 
      JMP SISTS     NO
      ISZ D.CNT     YES - DECREMENT READINGS COUNT
      JMP MPXSI     IF NOT DONE, CONTINUE READINGS
      JMP SISTS     IF DONE, PRINT STATS
SISTS EQU * 
      LDA GAIN1     GET GAIN
      JSB GETGN     LOOK UP REAL GAIN 
      DST RG1       STORE GAIN FOR CONVERSION 
      DST RG2       STORE GAIN FOR CONVERSION 
      LDA RDGS      GET # OF READINGS 
      CLB,INB       POINT TO START OF DATA BUFFER 
      JSB CNVRT     CONVERT DATA
      JMP PCERR     PACE FAST - ABORT 
      LDA RDGS
      CLB 
      JSB STATS     CALCULATE & OUTPUT STATISTICS 
      LDA RPEAT     GET REPEAT FLAG 
      SSA,RSS       IF FLAG IS CLEAR, 
      JMP START     GET NEXT COMMAND
      JMP SIRD       ELSE REPEAT
      SKP 
.TR   EQU *         TRANSFER INPUT CONTROL
      CLA           DEFAULT TO POP
      JSB GETLU     GET LU IF ANY 
      JMP RREAD     BAD LU
      SZA,RSS       IF NO LU
      JMP POP        THEN POP LU STACK
      LDB LU.IN     PUSH CURRENT LU 
      STA LU.IN      ON STACK 
      STB LUSTK       AND SET CURRENT LU TO NEW 
      JSB DVR       IS NEW LU A KEYBOARD? 
      CPA D5        DVR05 SAME AS DVR00 
      CLA 
      LDB LU.IN     GET NEW LU
      SZA           IF DVR00
      JMP START     GET NEXT COMMAND
      LDA LU.FB     SAVE FALLBACK LU
      STB LU.FB      SET NEW LU AS FALLBACK ALSO
      CPA LU.PO     FB SAME AS LIST LU? 
      STB LU.PO     YES - SET NEW LIST LU ALSO
      JMP START     GET NEXT COMMAND
POP   EQU * 
      JSB POPLU     POP LU STACK
      JMP START     GET NEXT COMMAND
      SPC 1 
D.CNT NOP 
      SKP 
..TW  EQU *         ADC TWO CHANNEL TEST
      LDA LU.PO     DEFAULT TO DEFAULT LIST DEVICE
      JSB GETLU      BUT SEE IF ALTERNATE SUPPLIED
      JMP RREAD     ALTERNATE IS BAD
      STA LSTDV     SAVE LU OF LIST DEVICE
      JSB ADCCL     CLEAR PAST TEST FLAGS 
      CCA 
      STA .TC       SET TWO CHANNEL TEST FLAG 
      JSB ADCEX     INITIALIZE FOR TEST 
      LDB D2        \ 
      LDA GAIN       GET BOX,CARD,
      SSA             CHANL & 
      INB              GAIN IF NECESSARY
      JSB BCCG      / 
      JMP AABRT     IF ANY < 0 ABORT
      STA CHNL1     SAVE FIRST CHANL ADDR 
      STB GAIN1     SAVE FIRST CHANL GAIN 
      LDB D2        \ 
      LDA GAIN       GET BOX,CARD,
      SSA             CHANL & 
      INB              GAIN IF NECESSARY
      JSB BCCG      / 
      JMP AABRT     IF ANY < 0 ABORT
      STA CHNL2     SAVE SECOND CHANL ADDR
      STB GAIN2     SAVE SECOND CHANL GAIN
      LDA DM100     SET UP LOOP 
      STA XCNTR      TO CONSTRUCT CHANL BUFFER
      LDA ACHLS 
GCLUP EQU * 
      INA           COMPUTE 1ST CH ADDR STORE ADDR
      LDB CHNL1     GET CHANL ADDR
      STB A,I       STORE CHANL ADDR
      INA           COMPUTE 2ND CH ADDR STORE ADDR
      LDB CHNL2     GET CHANL ADDR
      STB A,I       STORE CHANL ADDR
      ISZ XCNTR     DONE? 
      JMP GCLUP     NO - CONTINUE 
TWX   EQU * 
      LDA RDGS
      STA TWRGS     SET # OF READINGS 
      JSB MPX       CALL FOR READINGS 
      DEF D1
      DEF CHNLS 
      DEF GAINS 
      DEF EXTSS 
TWRGS NOP 
      DEC 1 
      LDA GAIN1     GET GAIN FOR CHANL 1
      JSB GETGN     LOOK UP REAL GAIN 
      DST RG1       STORE GAIN FOR CONVERSION 
      LDA GAIN2     GET GAIN CHANL 2
      JSB GETGN     LOOK UP REAL GAIN 
      DST RG2       STORE GAIN FOR CONVERSION 
      LDA RDGS
      CLB,INB 
      JSB CNVRT     CONVERT DATA
      JMP PCERR     PACE FAST - ABORT 
      LDA RPEAT     GET REPEAT FLAG 
      SSA           TEST
      JMP TWWT      REPEAT
      LDA LSTDV 
      CMA,INA       \ 
      LDB M31        OUTPUT "1ST CH"
      JSB PRMPT     / 
      LDA RDGS      \ 
      CLB,INB        COMPUTE & OUTPUT STATISTICS
      JSB STATS     / 
      LDA LSTDV 
      CMA,INA       \ 
      LDB M16        OUTPUT "2ND CH"
      JSB PRMPT     / 
      LDA RDGS      \ 
      LDB D2         COMPUTE & OUTPUT STATISTICS
      JSB STATS     / 
      JMP START     GET NEXT COMMAND
TWWT  EQU * 
      JMP TWX 
DM100 DEC -100
      SKP 
PCERR EQU *         PACE FAST 
      LDA LU.FB     \ 
      LDB PCMSG      OUTPUT "PACE ERROR"
      JSB PRMPT     / 
AABRT EQU *         ADC TEST ABORT
      LDA LU.FB     \ 
      LDB ABMSG      OUTPUT "ABORT" 
      JSB PRMPT     / 
      CLA 
      STA LSTOK     DISALLOW LIST 
      STA RPTOK     DISALLOW REPEAT 
      JMP .NO       NORMALIZE AND GET NEXT COMMAND
DABRT EQU *         DAC TEST ABORT
      CLA 
      STA DRPOK     DISALLOW REPEAT 
      LDA LU.FB     \ 
      LDB ABMSG      OUTPUT "ABORT" 
      JSB PRMPT     / 
      JMP .NO       NORMALIZE AND GET NEXT COMMAND
DLYER EQU * 
      LDA LU.FB     \ 
      LDB DLMSG      OUTPUT "CAN'T HAVE LAD AND DELAY"
      JSB PRMPT     / 
      JMP START 
!TERM EQU *         TERMINATE VERIFICATION
      JSB EXEC
      DEF *+2 
      DEF D6
ADPMT ASC 1,>_      ADC MODE PROMPTER 
DAPMT ASC 1,<_      DAC MODE PROMPTER 
ABMSG DEF *+1 
      DEC -5
      ASC 3,ABORT 
PCMSG DEF *+1 
      DEC -10 
      ASC 5,PACE ERROR
DLMSG DEF *+1 
      DEC -22 
      ASC 11,CAN'T HAVE LAD & DELAY 
      SKP 
      HED HP2313 RTE VERIFICATION -- LISTER UTILITIES 
LF    NOP           OUTPUT A LINE FEED ON LIST DEVICE 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF LSTDV 
      DEF BLANK 
      DEF DM1 
      JMP LF,I
      SPC 5 
LISTO NOP           LIST (A) CHARS ON LIST DEVICE 
      STA CNTR1 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF LSTDV 
      DEF INBFR 
      DEF CNTR1 
      JMP LISTO,I 
      SPC 5 
DFTCH NOP           FETCH REAL VALUE AND STUFF IN FMTO1 
      LDB FF1 
      BLS 
      ADB ADTA2 
      DLD B,I 
      DST FMTO1 
      JMP DFTCH,I 
      SKP 
* EXTRACT LU FROM COMMAND IN BUFFER 
* 
*     LDA DFLT
*     JSB GETLU 
*     (ERROR RETURN)
*         : 
* 
*          DFLT  - DEFAULT VALUE FOR LU IF NONE GIVEN 
* 
* 
DFLT  NOP 
GETLU NOP 
      STA DFLT      SAVE DEFAULT VALUE
      LDA T.LOG     FETCH T-LOG 
      CPA D2        IF = 2
      JMP ENDLU     THEN RETURN DEFAULT VALUE 
      STA CTEMP     SAVE T-LOG
      ADA DM80      SUBTRACT 80 
      SSA,RSS       IF > 80 
      JMP NOFIL     THEN  NO BLANK FILL 
      STA CNTR1     SET COUNT = 80-T-LOG
BFILL EQU *         BLANK FILL
      ISZ CTEMP     BUMP CHARACTER POINTER
      LDA CTEMP     GET CHARACTER POINTER 
      LDB AINBF     GET BUFFER ORIGIN 
      JSB CSTOR     STORE CHARACTER 
      OCT 40        BLANK 
      ISZ CNTR1     BUMP COUNTER
      JMP BFILL     DO NEXT CHAR
NOFIL EQU * 
      LDA INBFR+1   3 RD COMMAND CHARACTER
      AND UPPER     MUST BE A BLANK 
      ALF,ALF 
      CPA B40 
      RSS 
      JMP GETLU,I   ERROR RETURN
      LDA D4        \ 
      LDB AINBF      \
      JSB .FFB.     CALL FRMTR TO CONVERT LU
      JSB .FFI.      /
      JMP LUOK?     / 
ENDLU EQU * 
      LDA DFLT      SEND BACK 
      JMP GRTRN     DEFAULT LU
LUOK? EQU * 
      JSB LUCHK     CHECK LU FOR VALID
      JMP GETLU,I   ERROR RETURN - NOT VALID
GRTRN EQU * 
      ISZ GETLU     GOOD VALUE
      JMP GETLU,I   RETURN
DM80  DEC -80 
      HED HP2313 RTE VERIFICATION -- UTILITIES
      SKP 
ADCCL NOP           CLEAR PAST ADC TEST FLAGS 
      CLB 
      STB .SC       CLEAR SINGLE CH FLAG
      STB .TC       CLEAR 2 CH FLAG 
      STB .SS       CLEAR SEQ SCAN FLAG 
      STB .SCLD     CLEAR SCALED SEQ FLAG 
      JMP ADCCL,I   RETURN
      SKP 
ADCEX NOP           ADC EXECUTION INITIALIZATION
      CCA 
      STA RPTOK     ALLOW REPEAT
      STA LSTOK     ALLOW LIST
      STA DIFF      DEFAULT TO DIFFERENTIAL 
      LDA .SS       GET SEQUENTIAL SCAN FLAG
      AND GAIN      IF SEQ AND GAIN 
      STA .SCLD      THEN SCALED SEQUENTIAL 
      LDB M13       ASK FOR RDGS
      SSA 
      LDB M18        OR CHANLS/GROUP
      LDA D1        READ >= 1 CHAR
      JSB CREAD     READ REPLY
      LDA .SCLD     GET SCALED SEQ FLAG 
      CLB 
      SSA           IF SET
      STB .SS        THEN CLEAR SEQ FLAG
      JSB .NUMR     GET NO =
      JMP AABRT     IF < 0 ABORT
      LDA .TC       GET TWO CHANNEL FLAG
      SSA           IF TWO CHANNEL
      JMP TCCHK     MUST BE # 1 
      LDA .SCLD     GET SCALED SEQ FLAG 
      SSA,RSS       IF SCALED SEQ 
      JMP ADCEX,I   NOT SCALED SEQ
      ADB D25       THEN MUST BE <=25 
      SSB 
      JMP RREAD     > 25
      JMP ADCEX,I   RETURN
TCCHK EQU *         TWO CHANNEL 
      CPB DM1       READINGS CANNOT BE 1
      JMP RREAD     = 1 - ERROR 
      JMP ADCEX,I   RETURN
      SKP 
DACCL NOP           CLEAR PAST DAC TEST FLAGS 
      CLB 
      STB .ALT      CLEAR AL FLAG 
      STB .ERS      CLEAR ER FLAG 
      STB .GRP      CLEAR GR FLAG 
      STB .LISA     CLEAR LI FLAG 
      STB .RAN      CLEAR RA FLAG 
      STB .SICH     CLEAR SI FLAG 
      JMP DACCL,I   RETURN
      SKP 
DACEX NOP           DAC EXECUTION INITIALIZATION
      CCA 
      STA DRPOK     ALLOW REPEAT
      LDA .ALT      IF AL 
      SSA 
      JMP DACEX,I    SKIP "NO" REQUEST
      LDA D1        READ >= 1 CHAR
      LDB M13       PROMPT W/M13
      JSB CREAD     READ REPLY
      JSB .NUMR     GET NO =
      JMP DABRT     IF < 0 THEN ABORT 
      JMP DACEX,I   RETURN
      SKP 
.NUMR NOP 
      LDA IMAX      GET LARGEST INTEGER 
      STA FF1       DEFAULT RDGS
      JSB FFIN      CONVERT REPLY 
      LDA FF1       FETCH RDGS
      SSA           IF < 0
      JMP .NUMR,I   THEN ABORT
      SZA,RSS       IF = 0
      JMP RREAD     THEN BAD
      STA RDGS      SET RDGS
      CMA,INA       NEGATE
      LDB A         MOVE TO B 
      ADA D200      ADD 200 
      SSA           IF RDGS>200 
      JMP RREAD     THEN ERROR
      ISZ .NUMR     ADJUST RETURN ADDR
      JMP .NUMR,I   RETURN
      SKP 
* LOOK UP GAIN IN GAIN TABLE FROM GAIN CODE 
* 
*      LDA GAIN 
*      JSB GETGN
* 
*          GAIN  - GAIN CODE (0-8)
* 
* 
GETGN NOP 
      ALS           MULTIPLY BY 2 
      ADA GTABL     ADD GAIN TABLE BASE 
      DLD A,I       LOAD VALUE
      JMP GETGN,I   RETURN
* 
GTABL DEF *+1 
      DEC 1000. 
      DEC 500.
      DEC 250.
      DEC 125.
      DEC 100.
      DEC 50. 
      DEC 25. 
      DEC 12.5
RD1   DEC 1.
      SKP 
* LOGICAL UNIT VALIDITY CHECK 
* 
*     LDA LU
*     JSB LUCHK 
*     (ERROR RETURN)
*         : 
* 
* 
LUCHK NOP           LU VALIDITY CHECK 
      LDB A         MOVE LU TO (B)
      CMB,INB       NEGATE
      SSB,RSS       IF <= 0 
      JMP LUCHK,I    THEN ERROR 
      ADB 1653B     IF > MAX LU 
      SSB            IN SYSTEM
      JMP LUCHK,I   THEN ERROR
      ISZ LUCHK     GOOD
      JMP LUCHK,I    RETURN 
      SKP 
* DVR62 INTERFACE RETURN CHECK
* 
*     LDA XPCTD 
*     JSB C2313 
*     (ERROR RETURN IF XPCTD = 0) 
*     (ERROR RETURN IF XPCTD = 1) 
*         : 
* 
*          XPCTD - RETURN CODE EXPECTED 
* 
* 
C2313 NOP           DVR62-I/F RETURN CODE CHECKER 
      CPA RETRN     RETURN CODE = EXPECTED? 
      JMP RGOOD     YES - GOOD
      CPA D1        NO - EXPECTED = 1?
      JSB RSTQ      YES - RE-ISSUE ALL CALLS
      LDA RETRN     WAS ERROR 
      CPA DM4        TRANSMISSION ERROR?
      JMP XMSNR     YES - PRINT ERROR MESSAGE 
      LDA RETRN     \ 
      JSB I.OUT      \
      JSB CMOVE       \ 
      DEC 1         CALL FRMTR TO 
      DEF I.B        CONVERT ERROR NUMBER 
      DEC 16          / 
      DEF M.23       /
      DEC 6         / 
      LDA LU.FB     \ 
      LDB M23        OUTPUT ERROR MESSAGE 
      JSB PRMPT     / 
      JMP C2313,I   RETURN
XMSNR EQU * 
      LDA LU.FB     \ 
      LDB M22        OUTPUT ERROR MESSAGE 
      JSB PRMPT     / 
      JMP C2313,I   RETURN
RGOOD EQU * 
      ISZ C2313     ADJUST
      ISZ C2313      RETURN ADDR &
      JMP C2313,I     RETURN
      SPC 5 
RSTQ  NOP           RESET 2313 Q BUFFER 
      JSB B2313 
      DEF *+3 
      DEF Q 
      DEF QLEN
      ISZ C2313     TAKE SECOND ERROR EXIT
      JMP RSTQ,I
      SPC 3 
M23   DEF *+1 
      DEC -21 
M.23  ASC 11,INTERNAL ERROR XXXXXX
      SKP 
* FREE FIELD INPUT ROUTINE
* 
*  ENTRY POINTS:
* 
*      LDA OFSET
*      LDB BUFFR
*      JSB .FFB.
* 
*          OFSET - STARTING CHARACTER POSITION IN BUFFER
*          BUFFR - CHARACTER BUFFER 
* 
* 
*     JSB .FFI. 
*     (NORMAL RETURN) 
*     (DEFAULT RETURN)
* 
*          INTEGER RETURNED IN (A)
* 
* 
*     JSB .FFR. 
*     (NORMAL RETURN) 
*     ----- 
*     (DEFAULT RETURN)
* 
*          REAL VALUE RETURNED IN (B,A) 
* 
* 
.FFB. NOP           INITIALIZATION ENTRY
      STA .OFS.     SAVE OFFSET 
      STB B.F.R     SAVE BUFFER ADDR
      CCA 
      STA E.O.C     SET END ON COMMA FLAG 
      JMP .FFB.,I   RETURN
.I.R. NOP            INT/REAL FLAG
* 
* 
.FFI. NOP           INTEGER ENTRY 
      CCA 
      STA DPA?      SET DEC PT ALLOWED FLAG 
      CLA 
      STA .I.R.     SET INT/REAL FLAG TO INT
      JMP .SKP.     GO CONVERT
* 
* 
.FFR. NOP           REAL ENTRY
      CCA 
      STA DPA?      SET DEC PT ALLOWED FLAG 
      STA .I.R.     SET INT/REAL FLAG TO REAL 
      SKP 
.SKP. EQU * 
      CCA 
      STA .NEG.     CLEAR < 0 FLAG
      STA #NEG# 
#SKP# EQU * 
      LDA .OFS.     GET OFFSET
      LDB B.F.R     GET BUFFER ADDR 
      JSB CFTCH     GET A CHAR
      CPA COMMA     COMMA?
      JMP DFLT?     MAY BE DEFAULT
      CPA MINUS     MINUS?
      JMP LTZRO     YES - SET < 0 FLAG
      CPA PLUS      PLUS? 
      JMP .BMP.     YES - IGNORE
      CPA DOT       DEC PT? 
      JMP .GO.      YES - GO CONVERT
      CPA E         "E"?
      JMP .GO.      YES - GO CONVERT
      JSB D.CHK     DIGIT CHECK 
      RSS 
      JMP .GO.      NUMERIC - GO CONVERT
.BMP. EQU * 
      ISZ .OFS.     BUMP CHAR POINTER 
      JMP #SKP#     TRY NEXT CHAR 
LTZRO EQU * 
      CLA 
      STA .NEG.     SET < 0 FLAG
      STA #NEG# 
      JMP .BMP.     TRY ANOTHER CHAR
DFLT? EQU *         POSSIBLE DEFAULT
      LDB E.O.C     GET END ON COMMA FLAG 
      SSB           SET?
      JMP D.FLT     YES - ITS A DEFAULT 
      CCA 
      STA E.O.C     SET END ON COMMA FLAG 
      JMP .BMP.     NO - SKIP THIS COMMA
D.FLT EQU * 
      ISZ .OFS.     POINT PAST COMMA
      ISZ .FFI.     ADJUST INT RETURN ADDR
      ISZ .FFR.     ADJUST REAL 
      ISZ .FFR.      RETURN ADDR
      LDA .I.R.     GET INT/REAL FLAG 
      SSA,RSS       SET?
      JMP .FFI.,I   NO - RETURN INTEGER 
      JMP .FFR.,I   YES - RETURN REAL 
.NEG. NOP           NEGATIVE MANTISSA FLAG
#NEG# NOP 
      SKP 
.GO.  EQU * 
      CLA 
      STA DECXP     ZERO DEC EXPONENT 
      CLB 
      JSB .INT.     INPUT INTEGER 
      STA .RR.+1    SAVE
      STB .RR.       RESULT 
      LDB DGTS      GET DIGIT COUNT 
      SZB           0?
      JMP XDGTS     NO - MUST BE OVERFLOW DIGITS
      LDA .OFS.     GET OFFSET
      LDB B.F.R     GET BUFFER ADDR 
      JSB CFTCH     GET CHAR
      ISZ .OFS.     BUMP CHAR POINTER 
      CPA DOT       DEC PT? 
      JMP .FRAC     YES - GO GET FRACTION 
      JMP .XPNT     MUST BE "E" - GO GET EXP
      SPC 2 
.DX.  EQU * 
      ADA DECXP     UPDATE DEC EXPONENT 
      STA DECXP     SAVE
XDGTS EQU *         GET OVERFLOW DIGITS-DISCARD 
      CLA 
      CLB 
      JSB .INT.     COUNT DIGITS FOR EXPONENT 
      LDA DGTS      GET DIGIT COUNT 
      SZA           ANY?
      JMP .DX.      YES - ADD TO EXPONENT 
      LDA .OFS.     \ 
      LDB B.F.R      GET CHAR THAT TERM INTEGER 
      JSB CFTCH     / 
      CPA COMMA     COMMA?
      JMP F.C       YES - DONE INPUTTING
      CPA DOT       DEC PT? 
      JMP FRAC.     YES - GET FRACTION
      CPA E         "E"?
      JMP X.PNT     YES - GET EXPONENT
      CPA PLUS      PLUS? 
      JMP .XSGN     YES - GET EXPONENT
      CPA MINUS     MINUS?
      JMP .XSGN     YES - GET EXPONENT
F.C   EQU * 
      ISZ .OFS.     POINT PAST COMMA
      CCA,RSS       SET END ON COMMA FLAG 
B.PNT EQU * 
      CLA           CLEAR END ON COMMA FLAG 
      STA E.O.C     SAVE END ON COMMA FLAG
      LDA D31       INITIALIZE BINARY POINT 
      STA BINXP     : 
      DLD .RR.      GET INTEGER 
      JSB NORML     NORMALIZE 
      LDA DECXP     GET DEC EXPONENT
      CMA,SSA,RSS   CHECK FOR < 0 
      JMP NEGXP     DEC EX < 0
      STA DECXP     SAVE COMPLEMENT 
      RSS           INCREMENT FIRST TIME TO NEGATE
POSXP EQU * 
      JSB MPY10     MULTIPLY BY 10
      ISZ DECXP     DONE? 
      JMP POSXP     NO - CONTINUE 
      LDA .RR.      RESTORE (A) - (B) OK
      JMP .PACK     EXIT
NEGXP EQU * 
      JSB DIV10     DIVIDE BY 10
      ISZ DECXP     DONE? 
      JMP NEGXP     NO - CONTINUE 
      JMP .PACK     EXIT
      SKP 
* 
* 
* EXPONENT INPUT SECTION
* 
* 
X.PNT EQU * 
      ISZ .OFS.     POINT PAST E
      RSS 
.XPNT EQU * 
      ISZ .RR.+1    IF NO MANTISSA SET TO 1 
.XSGN EQU * 
      CLA 
      STA DPA?      CLEAR DEC PT ALLOWED FLAG 
      STA .NXP.     CLEAR XP < 0 FLAG 
X.SLP EQU * 
      LDA .OFS.     GET OFFSET
      LDB B.F.R     GET BUFFER ADDR 
      JSB CFTCH     GET CHAR
      CPA COMMA     COMMA?
      JMP F.C       YES - DONE
      CPA SPACE     BLANK?
      JMP B.PNT     YES - DONE
      CPA MINUS     MINUS?
      JMP LZROX     SET XPNT < 0
      CPA PLUS      PLUS? 
      JMP .BP.      YES - IGNORE
      JSB D.CHK     DIGIT CHECK 
      RSS 
      JMP X.SGN     NUMERIC - CONVERT EXPONENT
.BP.  EQU * 
      ISZ .OFS.     BUMP CHAR POINTER 
      JMP X.SLP     TRY ANOTHER CHAR
LZROX EQU * 
      CCA 
      STA .NXP.     SET XP < 0 FLAG 
      JMP .BP.      TRY NEXT CHAR 
X.SGN EQU * 
      CLA 
      CLB 
      JSB .INT.     INPUT EXPONENT
      SZB 
      LDA IMAX      GET MAX INTEGER 
      AND B77       DON'T KEEP MORE THAN NEEDED 
      LDB .NXP.     GET XP < 0 FLAG 
      SSB           SET?
      CMA,INA       YES - NEGATE
      ADA DECXP     UPDATE DEC EXPONENT 
      STA DECXP     SAVE
XSGN. EQU * 
      LDA DGTS      GET DIGIT COUNT 
      SZA,RSS       0?
      JMP X.X       YES - DONE
      CLA 
      CLB 
      JSB .INT.     THROW AWAY OTHER DIGITS 
      JMP XSGN.     SEE IF DONE 
X.X   EQU * 
      LDA .OFS. 
      LDB B.F.R 
      JSB CFTCH 
      CPA COMMA     END ON COMMA? 
      JMP F.C       YES - SET FLAG
      JMP B.PNT     NO - NO FLAG, SAVE CHAR 
.NXP. NOP           NEGATIVE EXPONENT FLAG
      SKP 
* 
* 
* FRACTION INPUT SECTION
* 
* 
.FRAC EQU * 
      CLA 
      STA DPA?      CLEAR DEC PT ALLOWED FLAG 
      CLB 
      JSB .INT.     INPUT FRACTION
      JMP F.RAC 
FRAC. EQU * 
      ISZ .OFS.     POINT PAST DEC PT 
      CLA 
      STA DPA?      CLEAR DEC PT ALLOWED FLAG 
      LDA .RR.+1    GET INTEGER 
      LDB .RR.       PART 
      JSB .INT.       CONTINUE INPUTTING NUMBER 
F.RAC EQU * 
      STA .RR.+1    SAVE
      STB .RR.       RESULT 
      LDA DGTS      GET DIGIT COUNT 
      CMA,INA       NEGATE
      ADA DECXP     UPDATE DEC XPNT 
      STA DECXP     SAVE
FRA.C EQU * 
      CLA 
      STA DPA?      CLEAR DEC PT ALLOWED FLAG 
      CPA DGTS      CHECK FOR NO DIGITS 
      JMP FR.AC     IF NONE THEN DONE 
      CLB 
      JSB .INT.     THROW AWAY UNUSED PRECISION 
      JMP FRA.C     SEE IF DONE 
FR.AC EQU * 
      LDA .OFS.     \ 
      LDB B.F.R      GET CHAR THAT TERM FRAC
      JSB CFTCH     / 
      CPA COMMA     COMMA?
      JMP F.C       YES - DONE
      CPA E         "E"?
      JMP X.PNT     YES - GET EXPONENT
      CPA PLUS      PLUS? 
      JMP .XSGN     YES - GET EXPONENT
      CPA MINUS     MINUS?
      JMP .XSGN     YES - GET EXPONENT
      JMP B.PNT     DONE
      SKP 
.PACK EQU * 
      ISZ #NEG#     CHECK < 0 FLAG
      RSS           - (SKIP)
      JMP .P1       + CONTINUE BELOW
      CMA           DOUBLE WORD NEGATE
      CMB,INB,SZB,RSS 
      INA 
.P1   CLE,SZA,RSS   IF ZERO, THEN EXIT
      JMP .P3 
* 
* ROUNDING SECTION
* 
      ADB B177      ADD IN ROUND FOR NEGATIVE NUM 
      SSA,RSS       IF POSITIVE 
      INB           1 MORE IS NECESSARY 
      CLO           CLEAR TO TEST FOR A OVFL
      SEZ           TEST FOR OVFLO OUT OF B 
      CLE,INA         IF SO, BUMP A REG 
      SOS           IF THE BUMP CAUSES OVERFLO
      RAL           SKIP THIS SHIFT(A=100000,B=0) 
      STA .RR.      SAVE UPPER MANTISSA 
      SSA,SLA,RSS   TEST FOR TOP 2 BITS=1 
      JMP .P2       IF STILL NORMALIZED, SKIP 
* 
* IF ROUND CAUSED UNNORMALIZED NUMBER 
* 
      CCA           THEN DECREMENT EXPONENT 
      ADA BINXP 
      STA BINXP 
      LDA .RR.
      ARS,SLA,ALS   DUMP LO BIT, AND SKIP(UNCOND) 
.P2   RAR           UNDOES "RAL" ABOVE IF N NORMAL
* 
* AT THIS POINT, A&B ARE NORMALIZED & ROUNDED, AND THE
* TRUE EXPONENT WILL BE "BINXP" 
* 
      STA .RR.      SAVE MANTISSA AGAIN 
      LDA B       REMOVE LOW ORDER 8 BITS OF B. 
      AND BM400      (177400) MASK
      STA B       REPLACE 
      LDA BINXP 
      SOC 
      INA 
      ADA B200      TEST FOR EXPON UNDERFLOW
      SSA 
      JMP XUNDR 
      ADA BM400      TEST FOR EXPON OVERFLOW
      SSA,RSS 
      JMP XOVER 
      ADA B200      RESTORE ORIGINAL EXPON
      RAL           POSITION SIGN TO LSB
      AND B377      MASK TO 8 BITS
      ADB A       PACK INTO B 
      LDA .RR.      RESTORE HIGH PART 
      JMP .P3       EXIT
B177  OCT 177 
B200  OCT 200 
B377  OCT 377 
BM400 OCT -400
* 
* OVERFLOW UNDERFLOW SECTION *****
* 
XUNDR CLA           RETURN ZERO FOR UNDERFLOW 
      CLB 
      JMP .P3 
XOVER LDA IMAX
      LDB DM2       INFIN= 77777 177776 
* INSURE PROPER SIGN ON OVERFLOW
      ISZ .NEG.     TEST < 0 FLAG 
      RSS           <0
      JMP .P3       > 0 
      LDA RMAXN 
      LDB RMAXN+1 
.P3   EQU * 
      DST .RR.      SAVE VALUE
      LDA .I.R.     GET INT/REAL FLAG 
      SSA           SET?
      JMP .REAL     YES - RETURN REAL 
      DLD .RR.      GET VALUE 
      JSB IFIX      FIX IT
      SOS           CHECK OVERFLOW
      JMP .FFI.,I   NO OVERFLOW - RETURN
* INSURE PROPER SIGN WHEN OVERFLOW
      LDB .RR.      GET SIGN
      SSB           <0? 
      CMA,INA       YES - RETURN BIG NEGATIVE 
      JMP .FFI.,I   RETURN
.REAL EQU * 
      DLD .RR.      GET VALUE 
      JMP .FFR.,I   RETURN
.OFS. NOP 
B.F.R NOP 
.R.   BSS 2 
.RR.  BSS 2 
BINXP NOP 
DECXP NOP 
DGTS  NOP 
DPA?  NOP 
E.O.C NOP 
COMMA OCT 54
DOT   OCT 56
E     OCT 105 
MINUS OCT 55
PLUS  OCT 53
SPACE OCT 40
      SKP 
D.CHK NOP 
      ADA BM60      CHAR < "0"? 
      SSA 
      JMP D.CHK,I   YES - RETURN
      LDB A         MOVE TO (B) 
      ADB DM10      > "9"?
      SSB 
      ISZ D.CHK     DIGIT IS OK 
      JMP D.CHK,I   RETURN
BM60  OCT -60 
      SKP 
.INT. NOP 
      DST .R.       SAVE INITIAL VALUE
      CLA 
      STA DGTS      CLEAR DIGIT COUNT 
OCHK  EQU * 
      RRL 5         CHECK IMPENDING OVERFLOW
      SZA 
      JMP R.INT     OVERFLOW RETURN 
      LDA .OFS.     \ 
      LDB B.F.R      GET CHAR 
      JSB CFTCH     / 
      JSB D.CHK     DIGIT CHECK 
      JMP .SCHK     CHECK FOR VALID SPEC CHAR 
      STA .TMP.     SAVE DIGIT VALUE
      ISZ DGTS      BUMP DIGIT COUNTER
      ISZ .OFS.     BUMP CHAR POINTER 
      DLD .R.       \ 
      LSL 1          \
      DST .R.         *10 (*2+*8) 
      LSL 2          /
      JSB .ADD.     / 
      DEF .R. 
      CLE 
      ADA .TMP.     ADD NEW DIGIT VALUE 
      SEZ           OVERFLOW LOW 16 BITS? 
      INB           YES - INCREMENT HI 16 BITS
      DST .R.       SAVE
      CLA 
      JMP OCHK      TRY NEXT DIGIT
R.INT EQU * 
      DLD .R.       GET VALUE TO RETURN 
      JMP .INT.,I   RETURN
.TMP. NOP 
.SCHK EQU *         IGNORE INVALID CHARS
      LDA .OFS.     \ 
      LDB B.F.R      GET CHAR 
      JSB CFTCH     / 
      CPA E         "E"?
      JMP R.INT     YES - OK
      CPA PLUS      PLUS? 
      JMP R.INT     YES - OK
      CPA COMMA     COMMA?
      JMP R.INT     YES - OK
      CPA MINUS     MINUS?
      JMP R.INT     YES - OK
      CPA SPACE     BLANK?
      JMP R.INT     YES - OK
      LDB DPA?      GET DEC PT ALLOWED FLAG 
      SSB,RSS       CLEAR 
      JMP NODPA     YES - DEC PT NOT ALLOWED
      CPA DOT       DEC PT? 
      JMP R.INT     YES - OK
NODPA EQU * 
      ISZ .OFS.     SKIP CHAR 
      CLA 
      JMP OCHK      TRY NEXT CHAR 
      SKP 
NORML NOP 
      SZA,RSS       IF A=B=0
      SZB 
      JMP NRML1 
      STA BINXP        SET EXP=0 ALSO 
      JMP NRML3            AND RETURN 
NRML2 STA .RR.      COME HERE TO SHIFT LEFT.
      CCA           THIS GOES ONE SHIFT TOO FAR,
      ADA BINXP      WE BACK UP LATER 
      STA BINXP      SUBTRACT ONE FROM EXPONENT 
      LDA .RR.
      CLE,ELB 
      ELA 
NRML1 SSA,RSS       SHIFTED INTO SIGN BIT?? 
      JMP NRML2     NO, SHIFT LEFT SOME MORE. 
      CLE,ERA       SHIFT RIGHT ONE.
      ERB 
      ISZ BINXP      BUMP EXPONENT AND
      NOP 
NRML3 STA .RR.      STORE NORMALIZED VALUE
      STB .RR.+1
      JMP NORML,I   RETURN
      SKP 
.ADD. NOP           32 BIT ADD
      STB T.M.P     SAVE HI BITS
      LDB .ADD.,I   GET ADDR
      CLE 
      ADA B,I       ADD LOW BITS
      SEZ,INB       OVERFLOW? 
      ISZ T.M.P     BUMP HI BITS ON OVERFLOW
      LDB B,I       GET HI BITS 
      ADB T.M.P     ADD HI BITS 
      ISZ .ADD.     ADJUST RETURN ADDR
      JMP .ADD.,I   RETURN
T.M.P NOP 
      SKP 
MPY10 NOP           MULTIPLIES MANTISSA BY 10 
      LDA .RR.      IF NUMBER IS ZERO,
      SZA,RSS 
      JMP MPY10,I   RETURN. 
      LDB BINXP      ELSE MULTIPLY BY 8 
      ADB D3
      STB BINXP 
      LDB .RR.+1    GET MANTISSA
      CLE,ERA       DIVIDE
      ERB            BY 
      CLE,ERA         4.
      ERB,CLE 
      ADB .RR.+1    DOUBLE ADD, GIVING 1.25*.RR.
      SEZ 
      INA           CARRY TO HIGH ORDER 
      ADA .RR.
      JSB NORML     NORMALIZE AND STORE BACK
      JMP MPY10,I   RETURN
TENTH OCT 63146 
      SKP 
DIV10 NOP           DIVIDES MANTISSA BY 10
      LDA .RR.      IF NUMBER IS ZERO,
      SZA,RSS 
      JMP DIV10,I   RETURN. 
      LDB DM2       ADJUST EXPONENT 
      ADB BINXP 
      STB BINXP 
      LDA .RR.+1    MULTIPLY LOWER MANTISSA 
      CLE,ERA       BY 63146B AFTER SHIFTING
      MPY TENTH     SO THAT SIGN BIT IS ZERO
      CLE,ELA       SHIFT BACK
      ELB,CLE       THE [B,A] RESULT
      ADA B       ADD HIGH PART OF RESULT TO LOW
      SEZ            PART FOR CROSS PRODUCT 
      INB 
      STB .RR.+1
      LDA .RR.      MULTIPLY HIGH MANTISSA
      MPY TENTH     THE SAME WAY
      CLE 
      ADA B 
      ADA .RR.+1
      SEZ 
      INB           CARRY 
      STB .RR.      & EXCHANGE
      STA B         THE REGISTERS 
      LDA .RR.          AND 
      JSB NORML           NORMALIZE 
      JMP DIV10,I 
      SKP 
* FREE FIELD INPUT
* 
*     CLA OR CCA
*     JSB FFIN
* 
* 
FF1   NOP 
FF2   NOP 
FF3   NOP 
FF4   NOP 
      NOP 
FFIN  NOP           FREE FIELD INPUT ROUTINE
      STA FF3       SAVE "ACCEPT 3RD INTEGER" FLAG
      CLA,INA       \ 
      LDB AINBF       INITIALIZE FORMATTER
      JSB .FFB.      /
      JSB .FFI.     READ 1 ST INTEGER 
      STA FF1       SAVE 1 ST INTEGER 
      JSB .FFI.     READ 2 ND INTEGER 
      STA FF2       SAVE 2 ND INTEGER 
      ISZ FF3       CHECK "3 RD INTEGER" FLAG 
      RSS 
      JMP FREAL     SKIP 3 RD INTEGER READ
      JSB .FFI.     READ 3 RD INTEGER 
      STA FF3       SAVE 3 RD INTEGER 
FREAL EQU *         READ A REAL 
      JSB .FFR.     READ REAL 
      STA FF4       SAVE UPPER
      STB FF4+1     SAVE LOWER
      JMP FFIN,I    RETURN
      SKP 
* FORMATTED OUTPUT
* 
*     DLD VALUE 
*     DST FMTO1 
*     LDA OFFST 
*     LDB BUFR
*     JSB FMTOT 
* 
*          VALUE - VALUE TO BE PRINTED
*          FMTO1 - PARAM STORE FOR FMTOT
*          OFFST - CHARACTER NO. IN BUFFER TO START FIELD 
*          BUFR  - BUFFER ADDR
* 
* 
FMTO1 NOP 
      NOP 
FMTOT NOP 
      STA .OFF.     SAVE OFFSET 
      STB .BFR.     SAVE BUFFER ADDR
      DLD FMTO1     \ 
      JSB R.OUT      \
      JSB CMOVE       \ 
      DEC 1            CALL FORMATTER 
      DEF R.B          TO CONVERT REAL DATA 
.OFF. NOP             / 
.BFR. NOP            /
      DEC 10        / 
      JMP FMTOT,I   RETURN
      SKP 
* YES,NO,ABORT READER 
* 
*      LDB AMESS
*      JSB QYNA 
* 
*          AMESS - MESSAGE ADDRESS
* 
* 
* 
QYNA  NOP 
      LDA D2
      JSB CREAD     CALL READER TO READ RESPONSE
      CLA 
      LDB INBFR     FETCH FIRST TWO INPUT CHARS 
      CPB YE        CHECK FOR YES 
      CCA           YES - RETURN -1 
      CPB NO        CHECK FOR NO
      CLA,INA       NO - RETURN 1 
      SZA           IF NEITHER YES OR NO
      JMP QYNA,I    YES OR NO SO RETURN 
      CPB AB          THEN MUST BE AB 
      JMP QYNA,I    OK
      JMP RREAD     ELSE ERROR
YE    ASC 1,YE
AB    ASC 1,AB
      SKP 
* INTEGER OUTPUT FORMATTER
* 
*     LDA VALUE 
*     JSB I.OUT 
* 
*          VALUE - INTEGER VALUE TO BE CONVERTED TO ASCII 
*                  CHARS WILL BE IN BUFFER "I.B"
* 
* 
I.V   NOP 
I.OUT NOP 
      STA I.V       SAVE VALUE TO CONVERT 
      CPA MXNEG     =-32768?
      JMP BIGM      YES - SPECIAL CASE
      SSA,RSS       > 0?
      JMP I.POS     YES - NO SIGN 
      CMA,INA       NEGATE
      STA I.V       SAVE
      CCA,RSS       SET < 0 FLAG
I.POS EQU * 
      CLA           CLEAR < 0 FLAG
      STA I.M?      SAVE < 0 FLAG 
      CLA,INA       INITIALIZE LEADING
      STA I.LZ       ZERO COUNT 
      LDB AI.B      GET BUFFER ADDR 
      JSB CSTOR     STORE BLANK IN FIRST CHAR 
      OCT 40
      LDA DM5       SET UP LOOP 
      STA I.CNT      TO CONVERT 
I.LUP EQU * 
      CLB           CLEAR FOR DIVIDE
      LDA I.V       GET VALUE 
      DIV D10       DIVIDE BY 10
      STA I.V       SAVE REST OF NUMBER 
      SZB           = 0?
      JMP N.Z       # 0 
      SZA           ALL OTHER DIGITS 0? 
      JMP N.Z       NO -
      ISZ I.LZ      YES - BUMP LEADING ZERO COUNT 
      LDB BM20      BLANK LEADING ZERO
N.Z   EQU * 
      ADB B60       MAKE CHARACTER
      STB I.CHR     SAVE FOR STORE
      LDA I.CNT     FIND CHARACTER
      CMA,INA       POSITION TO 
      INA           STORE CHARACTER 
      LDB AI.B      GET ADDR
      JSB CSTOR     STORE CHARACTER 
I.CHR NOP 
      ISZ I.CNT     DONE? 
      JMP I.LUP     NO - CONTINUE 
      LDA I.B+2 
      IOR B60 
      STA I.B+2 
      LDA I.M?      SEE IF NEED "-" 
      SSA,RSS 
      JMP I.OUT,I   RETURN
      LDA I.LZ      GET CHAR POSITION FOR "-" 
      LDB AI.B      GET BUFFER ADDR 
      JSB CSTOR     STORE "-" 
      OCT 55
      JMP I.OUT,I   RETURN
BIGM  EQU * 
      LDA BIG.M     GET "-3"
      STA I.B       PUT IN BUFFER 
      LDA BIG.M+1   GET "27"
      STA I.B+1     PUT IN BUFFER 
      LDA BIG.M+2   GET "68"
      STA I.B+2     PUT IN BUFFER 
      JMP I.OUT,I   RETURN
B60   OCT 60
D10   DEC 10
BM20  OCT -20 
I.LZ  NOP 
I.M?  NOP 
I.CNT NOP 
MXNEG OCT 100000
I.B   BSS 3 
BIG.M ASC 3,-32768
      SKP 
* REAL OUTPUT FORMATTER 
* 
*     DLD VALUE 
*     JSB R.OUT 
* 
*          VALUE - REAL VALUE TO BE CONVERTED TO ASCII (ABS VALUE 
*                  MUST BE < 99.999999 TO AVOID FORMAT OVRFLO)
*                  CHARS WILL BE IN BUFFER "R.B"
* 
* 
R.V   BSS 2 
R.OUT NOP 
      DST R.V       SAVE VALUE
      SSA,RSS       < 0?
      JMP R.POS     NO - NO MINUS SIGN
      CLA 
      CLB 
      FSB R.V       NEGATE VALUE
      DST R.V       SAVE
      CCA,RSS       SET < 0 FLAG
R.POS EQU * 
      CLA           CLEAR < 0 FLAG
      STA R.M?      SAVE < 0 FLAG 
      LDA BL.NK     GET BLANK 
      LDB .DOT.       GET DEC PT
      STA R.B       RESTORE BUFFER
      STB R.B+1     : 
      STA R.B+2     : 
      STA R.B+3     : 
      STA R.B+4     : 
      DLD R.V       GET VALUE 
      FSB R.MAX     SUBTRACT MAX
      SSA,RSS       > MAX?
      JMP R.BAD     YES - BAD 
      DLD R.V       GET VALUE 
      JSB IFIX      EXTRACT INTEGER PART
      STA R.T       SAVE INTEGER PART 
      SZA,RSS       = 0?
      JMP R.ZI      YES - SKIP CONVERSION 
      LDB R.M?      GET < 0 FLAG
      SSB           SET?
      CMA,INA       YES - MAKE SURE TO GET "-"
      JSB I.OUT     CONVERT INTEGER PART
      JSB CMOVE     MOVE TO BUFFER
      DEC 4 
AI.B  DEF I.B 
      DEC 1 
AR.B  DEF R.B 
D3    DEC 3 
R.ZR  EQU * 
      LDA R.T       GET INTEGER PART
      JSB FLOAT     FLOAT 
      DST R.T       SAVE
      DLD R.V       GET VALUE 
      FSB R.T       SUBTRACT INTEGER PART 
      FMP D.1K      MULTIPLY BY 1000
      DST R.V       SAVE AS VALUE 
      JSB IFIX      EXTRACT NEXT 3 DIGITS 
      STA R.T       SAVE
      JSB I.OUT     CONVERT 
      JSB CMOVE     PUT CHARS IN BUFFER 
      DEC 4 
      DEF I.B 
      DEC 5 
      DEF R.B 
      DEC -3        TURN BLANKS TO ZEROES 
      LDA R.T       GET 3 DIGITS
      JSB FLOAT     FLOAT 
      DST R.T       SAVE
      DLD R.V       GET VALUE 
      FSB R.T       SUBTRACT OUT DIGITS 
      FMP D.1K      MULTIPLY BY 1000
      FAD ROUND     ROUND LAST DIGIT
      JSB IFIX      EXTRACT 3 DIGITS
      JSB I.OUT     CONVERT 
      JSB CMOVE     MOVE CHARS TO BUFFER
      DEC 4 
      DEF I.B 
      DEC 8 
      DEF R.B 
      DEC -3        TURN BLANKS TO ZEROES 
      JMP R.OUT,I   RETURN
R.ZI  EQU * 
      LDB R.M?      NO INTEGER PART SO
      SSB,RSS        CHECK IF NEED "-"
      JMP R.ZR      NO "-" NEEDED 
      LDA D3
      LDB AR.B      GET BUFFER ADDR 
      JSB CSTOR     STORE "-" 
      OCT 55
      JMP R.ZR      FINISH FRACTION 
R.BAD EQU *         FORMAT OVERFLOW 
      LDA DM10      SET UP LOOP 
      STA I.CNT      TO STORE "$" 
R.BLP EQU * 
      LDA I.CNT     GET CHAR # TO 
      CMA,INA        STORE INTO 
      LDB AR.B      GET BUFFER ADDR 
      JSB CSTOR     STORE "$" 
      OCT 44
      ISZ I.CNT     DONE? 
      JMP R.BLP     NO - CONTINUE 
      JMP R.OUT,I   RETURN
.DOT.   ASC 1, .
BL.NK ASC 1,
R.M?  NOP 
R.T   NOP 
      NOP 
R.MAX DEC 99.999999 
ROUND DEC .5
D.1K  DEC 1000. 
R.B   ASC 5,XXX.XXXXXX
      SKP 
* CHARACTER MOVE
* 
*     JSB CMOVE 
*     DEC FOFST 
*     DEF FBUFR 
*     DEC SOFST 
*     DEF SBUFR 
*     DEC NUMBR 
* 
*          FOFST - FETCH CHARACTER OFFSET 
*          FBUFR - FETCH BUFFER ORIGIN
*          SOFST - STORE CHARACTER OFFSET 
*          SBUFR - STORE BUFFER ORIGIN
*          NUMBR - # OF CHARS TO MOVE (IF < 0 OR ALL
*                  MOVED CHARS WITH "0")
* 
* 
FOFST NOP 
FBUFR NOP 
SOFST NOP 
SBUFR NOP 
CMOVE NOP 
      LDA CMOVE,I   GET FETCH BUFFER OFFSET 
      STA FOFST     SAVE
      ISZ CMOVE     POINT TO NEXT PARAM 
      LDA CMOVE,I   GET FETCH BUFFER ADDR 
      STA FBUFR     SAVE
      ISZ CMOVE     POINT TO NEXT PARAM 
      LDA CMOVE,I   GET STORE BUFFER OFFSET 
      STA SOFST     SAVE
      ISZ CMOVE     POINT TO NEXT PARAM 
      LDA CMOVE,I   GET STORE BUFFER ADDR 
      STA SBUFR     SAVE
      ISZ CMOVE     POINT TO NEXT PARAM 
      LDA CMOVE,I   GET COUNT 
      CLB 
      SSA           CHECK FOR "OR" OPTION 
      CCB           SET "OR" OPTION FLAG
      STB C.FLG     SAVE FLAG 
      SSA,RSS       IF NO "OR" OPTION 
      CMA,INA       NEGATE COUNT
      STA CCNTR     SAVE
      ISZ CMOVE     ADJUST RETURN ADDR
MLOOP EQU * 
      LDA FOFST     GET FETCH OFFSET
      LDB FBUFR      AND BUFFER ADDR
      JSB CFTCH     FETCH CHARACTER 
      LDB C.FLG     GET "OR" OPTION FLAG
      SSB           SET?
      IOR B60       YES - OR
      STA M.CHR     SAVE FOR STORE
      LDA SOFST     GET STORE OFFSET
      LDB SBUFR      AND BUFFER ADDR
      JSB CSTOR     STORE CHARACTER 
M.CHR NOP 
      ISZ FOFST     BUMP FETCH OFFSET 
      ISZ SOFST     BUMP STORE OFFSET 
      ISZ CCNTR     DONE? 
      JMP MLOOP     NO - CONTINUE 
      JMP CMOVE,I   RETURN
C.FLG NOP 
CCNTR NOP 
      SKP 
* CHARACTER FETCH 
* 
*     LDA OFSET 
*     LDB BUFR
*     JSB CFTCH 
* 
*          BUFR  - CHARACTER BUFFER 
*          OFSET - CHARACTER NUMBER (FIRST IS 1)
* 
CFTCH NOP 
      CLE,ELB       SHIFT TO MAKE CHAR ADDR 
      ADA DM1       ADJUST OFFSET 
      ADB A         COMPUTE CHAR ADDR 
      CLE,ERB       COMPUTE WORD ADDR 
      LDA B,I       GET WORD WITH CHAR
      SEZ,RSS       HI OR LO NEEDED?
      ALF,ALF       HI NEEDED 
      AND LOWER     MASK
      JMP CFTCH,I   RETURN
      SKP 
* CHARACTER STORE 
* 
*     LDA OFSET 
*     LDB BUFR
*     JSB CSTOR 
*CHAR NOP (SET TO CHARACTER)
* 
*          CHAR  - CHARACTER TO STORE 
*          BUFR  - BUFFER TO STORE INTO 
*          OFSET - CHARACTER NUMBER (FIRST IS 1)
* 
* 
CSTOR NOP 
      CLE,ELB       SHIFT TO MAKE CHAR ADDR 
      ADA DM1       ADJUST OFFSET 
      ADB A         COMPUTE CHAR ADDR 
      CLE,ERB       COMPUTE WORD WITH CHAR
      LDA LOWER     FETCH MASK
      AND CSTOR,I   MASK CHAR TO STORE
      SEZ,RSS       HI OR LO CHAR 
      ALF,ALF       HI CHAR 
      STA TEMP      SAVE
      LDA LOWER     GET MASK
      SEZ           MASK OUT LO OR HI CHAR? 
      ALF,ALF       MASK OUT LO CHAR
      AND B,I 
      IOR TEMP      PUT IN NEW CHAR 
      STA B,I       STORE IT
      ISZ CSTOR     ADJUST RETURN ADDR
      JMP CSTOR,I   RETURN
* 
LOWER OCT 377 
TEMP  NOP 
      SKP 
* CHARACTER STRING READER 
* 
* 
*     LDA CMIN
*     LDB AMESS 
*     JSB CREAD 
* 
*          CMIN  - MINIMUM NUMBER OF CHARS THAT MUST BE READ
*          AMESS - MESSAGE ADDRESS (OR 0) 
* 
* 
CMESS NOP 
CMIN  NOP 
CREAD NOP           READ CHARACTER STRING 
      STA CMIN      SAVE MINIMUM READ LENGTH
      STB CMESS     STORE PROMPT MESSAGE ADDR 
READ  EQU * 
      LDB CMESS     GET MESSAGE ADDR
      SSB           CHECK FOR NO PROMPT 
      JMP NOPMT     NO PROMPT 
      LDA LU.IN     \ 
      LDB CMESS      PROMPT W/SPECIFIED MESSAGE 
      JSB PRMPT     / 
NOPMT EQU * 
      LDA DM40      SET UP
      STA CTEMP      TO BLANK 
      LDA BLANK       INPUT 
      LDB AINBF        BUFFER 
CLEAR EQU *         \ 
      STA B,I        \
      INB             BLANK INPUT BUFFER
      ISZ CTEMP      /
      JMP CLEAR     / 
      LDA LU.IN     READ DEVICE 
      IOR BIT08     WITH ECHO 
      STA CLU 
      JSB EXEC      CALL EXEC TO DO READ
      DEF *+5 
      DEF D1
      DEF CLU 
      DEF INBFR 
      DEF DM80      READ UP TO 80 CHARS 
      STB T.LOG     SAVE T-LOG (# OF CHARS) 
      STA TEMP      SAVE STATUS 
      LDA LU.IN 
      JSB DVR       FIND OUT DVR TYPE 
      LDB A         PUT RESULT IN (B) 
      LDA BIT05     SET UP TO CHECK BIT 5 
      CPB D1        DVR01?
      CLB           YES-SAME AS DVR00 
      CPB D5        DVR05?
      CLB           YES-SAME AS DVR00 
      SZB           FOR DVR00 CHECK BIT 5 
      LDA BIT07     FOR OTHERS CHECK BIT 7
      AND TEMP      MASK EOF BIT IN STATUS
      SZA,RSS       CHECK FOR EOF 
      JMP NOEOF     NO EOF
      JSB POPLU     ON EOF POP LU STACK 
      JMP READ       & READ FROM NEW LU 
NOEOF EQU * 
      LDA T.LOG     FETCH # OF CHARS READ 
STRIP EQU *         STRIP TRAILING BLANKS FR INPUT
      SZA,RSS       IF NO CHARS 
      JMP READ       THEN REREAD
      LDA T.LOG 
      LDB AINBF 
      JSB CFTCH     FETCH LAST CHAR IN LINE 
      CPA BIT05     COMPARE FOR BLANK 
      RSS           BLANK SO DELETE 
      JMP FDLET     NOT BLANK SO DELETE DONE
      CCA           \ 
      ADA T.LOG      DELETE CHARACTER 
      STA T.LOG     / 
      JMP STRIP     CHECK NEXT CHARACTER
FDLET EQU * 
      LDA LU.IN     FETCH INPUT LU
      CPA LU.FB     COMPARE TO ECHO LU
      JMP CKSTR     EQUAL SO NO ECHO
      LDA T.LOG     GET NUMBER OF CHARS 
      CMA,INA       NEGATE
      STA CTEMP     STORE AS OUTPUT COUNT 
      JSB EXEC      CALL EXEC TO OUTPUT ECHO
      DEF *+5 
      DEF D2
      DEF LU.FB 
      DEF INBFR 
      DEF CTEMP 
CKSTR EQU * 
      LDA INBFR     CHECK CHAR 1
      AND UPPER      FOR A
      CPA STAR        STAR "*"
      JMP READ      STAR = COMMENT SO IGNORE
      LDA CMIN      CHECK FOR 
      CMA,INA        MINIMUM
      ADA T.LOG       # OF CHARACTERS 
      SSA              IN READ
      JMP RREAD     < MIN SO ERROR
      JMP CREAD,I   RETURN
RREAD EQU * 
      JSB ??        PRINT ERROR MESSAGE "??"
      JMP READ       AND READ AGAIN 
* 
CLU   NOP 
T.LOG NOP 
CTEMP NOP 
DM40  DEC -40 
BIT05 OCT 40
BIT07 OCT 200 
BIT08 OCT 400 
UPPER OCT 177400
STAR  OCT 25000 
D1    DEC 1 
B7    OCT 7 
B17   OCT 17
B37   OCT 37
BLANK OCT 20040 
      SPC 5 
* POP LU STACK
* 
*     JSB POPLU 
* 
* 
POPLU NOP           POP LU FROM LU STACK
      LDA LUSTK     GET LUSTK 
      SSA           IF < 0 (EMPTY)
      LDA LU.FB      THEN POP TO FALLBACK LU
      STA LU.IN     SET NEW LU
      CCB 
      STB LUSTK     MARK STACK EMPTY
      JSB DVR       IS NEW LU A KEYBOARD? 
      CPA D5        DVR05 SAME AS DVR00 
      CLA 
      LDB LU.IN     GET NEW LU
      SZA           IF KEYBOARD 
      JMP POPLU,I   RETURN
      LDA LU.FB     SAVE FALLBACK LU
      STB LU.FB      THEN MAKE FALLBACK LU NEW
      CPA LU.PO     LIST LU SAME AS FB? 
      STB LU.PO     YES - SET LIST LU NEW ALSO
      JMP POPLU,I   RETURN
      SKP 
* PROMPT AND MESSAGE PRINTER
* 
* 
*     LDA LU
*     LDB AMESS 
*     JSB PRMPT 
* 
*          LU    - DEVICE TO OUTPUT TO (IF < 0 THEN NO
*                                       DRIVER TYPE CHECK)
*          AMESS - MESSAGE ADDRESS (OR 0) 
* 
* 
PLU   NOP 
PMESS NOP 
PRMPT NOP 
      STA PLU       SAVE LU TO PROMPT 
      SZB,RSS       IF MESSAGE ADDR = 0 
      LDB APRMT      THEN USE NORMAL COMMAND PROMPT 
      STB PMESS     SAVE MESSAGE ADDR 
      SSA           CHECK FOR UNCONDITIONAL OUTPUT
      JMP UNCND     SKIP DRIVER TYPE CHECK
      JSB DVR       CHECK DRIVER TYPE 
      CPA D5        DVR05 SAME AS DVR00 
      CLA           : 
      SZA           IF NOT DVR00
      JMP PRMPT,I    THEN DON'T PROMPT
MSGLK EQU * 
      LDA PMESS,I   GET MESSAGE LENGTH
      STA PLEN      SAVE
      ISZ PMESS     POINT TO MESSAGE CHARS
      JSB EXEC      CALL EXEC TO OUTPUT MESSAGE 
      DEF *+5 
      DEF D2
      DEF PLU 
      DEF PMESS,I 
      DEF PLEN
      JMP PRMPT,I   RETURN
UNCND EQU *         OUTPUT TO LU UNCONDITIONAL
      CMA,INA       SET LU POSITIVE 
      STA PLU       SAVE
      JMP MSGLK     LOOK UP MESSAGE 
PLEN  NOP 
APRMT DEF *+1 
      DEC -2
PRMT  ASC 1,>_: 
      SKP 
* DRIVER TYPE EXTRACTER 
* 
* 
*     LDA LU
*     JSB DVR 
* 
* 
*          LU    - LOGICAL UNIT OF DRIVER 
* 
* 
DLU   NOP 
DVR   NOP 
      STA DLU       SAVE LU 
      JSB EXEC      FETCH EQT5
      DEF *+4 
      DEF D13 
      DEF DLU 
      DEF DLU 
      LDA DLU       GET EQT5
      ALF,ALF       MOVE DRIVER CODE TO LOW HALF
      AND B77       MASK
      JMP DVR,I     RETURN
B77   OCT 77
D13   DEC 13
      SKP 
* ERROR PRINTER 
* 
*     JSB ??
* 
* 
??    NOP           ENTRY ERROR MESSAGE PRINTER 
      LDA LU.FB     GET FALLBACK DEVICE LU
      LDB .??.      GET ADDR OF ERROR MESSAGE 
      JSB PRMPT     OUTPUT ERROR MESSAGE
      JMP ??,I      RETURN
.??.  DEF *+1 
      DEC -2
      ASC 1,??
      SKP 
* BOX,CARD,CHANL,GAIN GETTER, CHECKER AND ASSEMBLER 
* 
*     LDB INDEX 
*     JSB BCCG
*     (ABORT RETURN)
*        :
* 
*          INDEX - MODE SETTER 1 = BOX,CARD 
*                              2 = BOX,CARD,CHANL 
*                              3 = BOX,CARD,CHANL,GAIN
*                              4 = BOX,CARD,GAIN
*                              5 = BOX,CARD,CHANL (DAC) 
* 
* 
INDEX NOP 
BCCG  NOP 
      STB INDEX     SAVE MODE 
      CPB D5        MODE 5
      LDB D2         SAME AS MODE 2 
      ADB AM        LOOKUP MESSAGE
      LDB B,I 
      LDA D2        READ AT LEAST 2 CHARS 
      JSB CREAD     READ INPUT
      LDA IMAX      GET MAX INTEGER 
      STA FF1 
      STA FF2 
      STA FF3 
      CLA 
      STA FF4 
      STA FF4+1 
      LDB INDEX     FETCH MODE
      CLA           PREPARE TO READ ALL 4 VARIABLES 
      CPB D4
      CCA           IF MODE=4 READ ONLY 3 VARIABLES 
      JSB FFIN      CONVERT INPUT 
      LDA FF1       GET FIRST PARAM 
      IOR FF2       OR IN SECOND
      SSA           CHECK FOR <0
      JMP BCCG,I
      LDA FF1       GET FIRST PARAM 
      CMA,INA       NEGATE
      ADA D7        CHECK FOR >7
      SSA 
      JMP RREAD      >7 
      LDA FF2       GET SECOND PARAM
      CMA,INA       NEGATE
      ADA D11       CHECK FOR >11 
      SSA 
      JMP RREAD     >11 
      CLB 
      LDA INDEX     FETCH MODE
      CPA D1        IF MODE = 1 
      STB FF3        SET CHANL = 0
      LDB FF1 
      ADB FF2       IF BOX+CARD 
      SZB,RSS        =0 THEN
      JMP RREAD       ERROR 
      CPA D1        IF MODE=1 
      JMP RTN3       THEN DONE
      CLB 
      CPA D4        IF MODE=4 
      STB FF3        SET CHANL=0
      CPA D4
      JMP ONLY3 
      LDB FF3       FETCH THIRD PARAM 
      SSB           IF < 0
      JMP BCCG,I    THEN ABORT
      CPA D5        DAC?
      JMP .DAC      YES 
      CMB,INB       NEGATE
      ADB D31       CHECK FOR >31 
      SSB           IF CHANL >31
      JMP RREAD      THEN ERROR 
      CPA D2
      JMP RTN3
ONLY3 EQU * 
      LDA FF4       FETCH GAIN MSB'S
      SSA           CHECK SIGN
      JMP BCCG,I    ABORT IF < 0
      LDB FF4+1     GET LSB'S 
* CHECK FOR VALID GAIN
      STB RGAIN     SAVE EXPONENT 
      LDB DM4       SET COUNT TO 4
      STB TEMP       FOR LOOP 
      CPA MANT1     COMPARE WITH MANTISSA 1?
      JMP GT100     YES - > 100 
      CPA MANT2     COMPARE WITH MANTISSA 2?
      JMP LT125     YES - < 125 
BADGN EQU * 
      CCA           BAD GAIN - RETURN -1
      JMP CHKD
GT100 EQU * 
      CCA 
      LDB B26 
LOOPX EQU * 
      INA           BUMP GAIN CODE
      ADB DM2       SUBTRACT 2 FROM EXPONENT
      CPB RGAIN     EXPONENTS COMPARE?
      JMP CHKD      YES - RETURN GAIN CODE
      ISZ TEMP      CHECK FOR 4 TIMES 
      JMP LOOPX     NOT DONE - TRY NEW EXPONENT 
      JMP BADGN     NO EXPONENT COMPARE - BAD 
LT125 EQU * 
      LDB B20 
      LDA D3
      JMP LOOPX 
CHKD  EQU * 
      SSA           IF BAD GAIN 
      JMP RREAD     THEN ERROR
      LDB A         SAVE GAIN CODE IN B 
      RSS 
RTN3  EQU * 
      LDB D8        IF NO GAIN SET GAIN CODE TO 8 
      LDA FF1       FETCH BOX 
      AND B7        MASK
      ALF,ALF       SHIFT 
      RAL           SHIFT 
      STA TEMP      SAVE IT 
      LDA FF2       FETCH CARD
      AND B17       MASK
      ALF,RAL       SHIFT 
      IOR TEMP      COMBINE WITH BOX
      STA TEMP      SAVE IT 
      LDA FF3       FETCH CHANL 
      AND B37       MASK
      IOR TEMP      COMBINE WITH BOX AND CARD 
      ISZ BCCG
      JMP BCCG,I    RETURN
.DAC  EQU * 
      CMB,INB       NEGATE
      INB           ONLY 0 OR 1 
      SSB            ALLOWED
      JMP RREAD     BAD 
      LDA FF3       GET CHANL 
      ALF           ADJUST TO BIT 4 
      STA FF3       SAVE
      JMP RTN3
AM    DEF * 
      DEF M10+1 
      DEF M12+1 
      DEF M20+1 
      DEF M6+1
MANT1 OCT 76400 
MANT2 OCT 62000 
B26   OCT 26
B20   OCT 20
DM4   DEC -4
RGAIN NOP 
      SKP 
* PACER PARAMETER FETCHER 
* 
*     LDA ADDR
*     JSB PPRAM 
*     (ABORT RETURN)
*         : 
* 
*          ADDR  - ADDRESS OF PACER PARAMETER LIST
*                  (EXTSS,PACER,PRATE,PMULT)
* 
* 
PLST  NOP 
PPRAM NOP 
      STA PLST      SAVE PARAM POINTER
      CLB 
      INA 
      STB A,I       CLEAR PACER CONDITION 
      LDA D2        READ AT LEAST 2 CHARS 
      LDB M7        PROMPT W\MESSAGE 7
      JSB CREAD     READ REPLY
      LDA IMAX      FETCH MAX INTEGER 
      STA FF1       SET FIRST PARAM 
      STA FF2       SET SECOND PARAM INVALID
      JSB FFIN      CONVERT REPLY 
      LDA FF1       FETCH FIRST PARAM 
      IOR FF2       AND SECOND
      SSA           CHECK FOR < 0 
      JMP PPRAM,I   ABORT IF < 0
      LDA FF1       GET FIRST PARAM 
      CMA,INA       NEGATE
      ADA D255      CHECK FOR > 255 
      SSA 
      JMP RREAD     > 255 SO ERROR
      LDA FF2       F ETCH SECOND PARAM 
      CMA,INA       NEGATE
      ADA D7        CHECK FOR > 7 
      SSA 
      JMP RREAD     >7 SO ERROR 
      LDB M8        PROMPT W/MESSAGE 8
      JSB QYNA      GET ANSWER
      SZA,RSS       CHECK FOR AB
      JMP PPRAM,I   ABORT 
      CLB 
      SSA           CHECK FOR YE
      CCB           YE
      STB PLST,I    SET EXTSS 
      CCB 
      ISZ PLST
      STB PLST,I    SET PACER CONDITION 
      ISZ PLST      BUMP POINTER
      LDA FF1       FETCH PRATE 
      STA PLST,I    SET PRATE 
      ISZ PLST      BUMP POINTER
      LDA FF2       FETCH PMULT 
      STA PLST,I    SET PMULT 
      ISZ PPRAM 
      JMP PPRAM,I   RETURN
      SKP 
* CONVERT 2313 READINGS TO VOLTS
* 
*     DLD GAINA 
*     DST RG1 
*     DLD GAINB 
*     DST RG2 
*     LDA COUNT 
*     LDB VOLTS 
*     JSB CNVRT 
*     (PACE ERROR RETURN) 
*        :
* 
*          GAINA - GAIN FOR CHANL 1 
*          RG1   - STORE FOR GAIN1
*          GAINB - GAIN FOR CHANL 2 
*          RG2   - STORE FOR GAIN2
*          COUNT - NUMBER OF DATA POINTS AVAILABLE
*          VOLTS - BASE SUBSCRIPT FOR DATA ARRAY
* 
* 
VOLTS NOP 
CCNT  NOP 
CNVRT NOP 
      STA CCNT      STORE # OF READINGS TO CONVERT
      STB VOLTS     STORE SUBSCRIPT OF DATA 
      LDA G1        INITIALIZE
      STA G          GAIN ADDR
      XOR G2         MAKE MASK FOR GAIN SWAP
      STA BMSK      SAVE MASK 
      CLA           SET UP LOOP FOR 
      STA CNTR1      CONVERSION 
      STA PCFST     CLEAR PACE FAST ERROR FLAG
CVTLP EQU * 
      ISZ CNTR1     BUMP LOOP COUNTER 
      LDA CNTR1     \ 
      CMA,INA        \
      ADA VOLTS       FIND DATA ADDR (LAST TO FIRST)
      ADA CCNT       /
      LDB A         / 
      BLS           COMPUTE REAL DATA ADDR
      ADB ADTA2     : 
      STB TEMP      SAVE
      ADA ADATA     COMPUTE READING ADDR
      CCB 
      LDA A,I       FETCH DATA
      ARS,SLA       CHECK FOR PACE FAST 
      STB PCFST     PACE FAST ERROR 
      ARS,ARS       DUMP JUNK BITS
      ARS           : 
      JSB FLOAT     CONVERT TO REAL 
      FMP VOLT      CONVERT TO VOLTS
      FDV G,I       FACTOR IN GAIN
      DST TEMP,I    STORE AT REAL DATA ADDR 
      LDA G         GET GAIN ADDR 
      XOR BMSK      FLIP TO ALTERNATE GAIN
      STA G         SAVE
      LDA CNTR1     GET LOOP COUNTER
      CPA CCNT      DONE? 
      RSS 
      JMP CVTLP     NO - CONTINUE 
      ISZ PCFST     ADJUST RETURN 
      ISZ CNVRT      DEPENDING ON PACE FAST ERROR FLAG
      JMP CNVRT,I   RETURN
BMSK  NOP 
PCFST NOP 
G     NOP 
G1    DEF RG1 
G2    DEF RG2 
VOLT  DEC .005
RG1   NOP 
      NOP 
RG2   NOP 
      NOP 
      SKP 
* MULTIPLEXER CALL
* 
*     JSB MPX 
*     DEF MODE
*     DEF CHNL
*     DEF GAIN
*     DEF PPRAM 
*     DEC NUMBR 
*     DEC OFSET 
* 
*          MODE  - MULTIPLER MODE 
*          CHNL  - MULTIPLEXER CHANL ARRAY
*          GAIN  - GAIN CODE
*          PPRAM - LIST OF PACER PARAMETERS 
*                  (EXTSS,PACER,PRATE,PMULT)
*          NUMBR - NUMBER OF READINGS TO TAKE 
*          OFSET - OFSET IN DATA BUFFER TO STORE READINGS 
* 
* 
MPX   NOP 
      LDA MPX,I     GET MODE ADDR 
      STA !MODE     STORE IN CALL 
      ISZ MPX       POINT TO NEXT PARAM 
      LDA MPX,I     GET CHANL ADDR ADDR 
      STA !CHNL     STORE IN CALL 
      LDB A,I       GET CHANL ADDR
      STB .CHNL     SAVE
      INA           POINT TO SECOND CHANL ADDR
      LDB A,I       GET SECOND CHANL ADDR 
      STB .CH2      SAVE
      ISZ MPX       POINT TO NEXT PARAM 
      LDA MPX,I     GET GAIN ADDR 
      LDB A,I       GET GAIN
      STB .GAIN     SAVE
      INA           POINT TO SECOND GAIN
      LDB A,I       GET SECOND GAIN 
      STB .GN2      SAVE
      ISZ MPX       POINT TO NEXT PARAM 
      LDA MPX,I     GET PACER PARAM ADDR
      STA P.SET     SAVE
      INA           POINT TO PACER FLAG 
      LDA A,I       GET PACER FLAG
      STA .PCR      SAVE
      ISZ MPX       POINT TO NEXT PARAM 
      LDA MPX,I     GET NUMBER OF READINGS
      STA !CNT      STORE FOR CALL
      ISZ MPX       POINT TO NEXT PARAM 
      LDA MPX,I     FETCH DATA OFFSET 
      ADA ADATA     CALCULATE BUFFER ADDR 
      STA .DATA     STORE IN CALL 
      ISZ MPX       ADJUST RETURN ADDR
MPXRP EQU * 
      LDA LAD       GET LAD FLAG
      AND .SS        AND SEQUENTIAL SCAN FLAG 
      SSA,RSS       BOTH? 
      JMP SGMPX     NO - DON'T SET LAD
MPXLD EQU *         TURN ON LAD 
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE 
      STA XTEMP       LU
      JSB A2313     CALL I/F TO TURN ON LAD 
      DEF *+6 
      DEF XTEMP 
      DEF RETRN 
      DEF DM1 
      DEF LADAD 
      DEF LSTCH 
      CLA           CHECK 
      JSB C2313      I/F CALL 
      JMP MPXLD     ERROR 
      JMP MPXRP     ERROR 
SGMPX EQU *         GAIN? 
      LDA GAIN      GET GAIN FLAG 
      SSA,RSS       GAIN? 
      JMP RPMPX     NO - DON'T PROGRAM GAIN 
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE 
      LDB G.ON        LU
      JSB SETGN     PROGRAM 1 ST CH GAIN
      DEF MPXRP 
      LDA !MODE     GET MODE ADDR 
      LDA A,I       GET MODE
      CPA D1        IF RANDOM 
      RSS            MUST BE 2 CH 
      JMP RPMPX     NOT 2 CH
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE 
      LDB G.ON2       LU
      JSB SETGN     PROGRAM 2 ND CH GAIN
      DEF MPXRP 
RPMPX EQU * 
      LDA .PCR      GET PACER FLAG
      SSA,RSS       PACER?
      JMP RRSS      NO - DON'T REPROGRAM
      LDA P.SET,I   GET EXTSS FLAG
      SSA           IF SET
      JMP PRXTN     THEN DON'T PREPROGRAM PACER                  (EXTSS)
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE 
      LDB P.ON        LU
      CMB,INB 
      JSB STPCR     PREPROGRAM
      DEF MPXRP 
PRXTN EQU *                                                (EXTSS)
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE 
      LDB P.SET       LU
      JSB STPCR     PROGRAM PACER TO FINAL VALUES 
      DEF MPXRP 
RRSS  EQU * 
      LDB LU.SS 
      LDA LAD       IF LAD
      AND .SS        AND SEQUENTIAL 
      IOR .PCR        OR PACER
      SSA 
      CMB,INB       THEN USE -LU : THIS IS NOT LAST CALL
      STB XTEMP 
      JSB R2313     CALL I/F FOR READINGS 
      DEF *+9 
      DEF XTEMP 
      DEF RETRN 
      DEF .PCR
!MODE NOP 
!CHNL NOP 
      DEF !CNT
.DATA NOP 
      DEF DIFF
      CLA           \ 
      LDB XTEMP      \
      SSB,RSS         CHECK I/F RETURN CODE 
      INA            /
      JSB C2313     / 
      JMP RRSS      ERROR 
      JMP MPXRP     ERROR 
      LDA DELAY     DELAY?
      SSA,RSS 
      JMP CKLAD     NO
      LDA DCNTR     SAVE DELAY COUNTER
DLYLP LDB MSEC      GET 1 MSEC COUNTER
      ISZ B         \ 
      JMP *-1        \ EXECUTE
      ISZ DCNTR      /  DELAY 
      JMP DLYLP     / 
      STA DCNTR     RESTORE DELAY COUNTER 
CKLAD LDA LAD       IF LAD
      AND .SS        AND SEQUENTIAL 
      SSA,RSS       : 
      JMP POFF      NO - SKIP LAD TURNOFF 
      LDB LU.SS     TURN OFF LAD
      LDA .PCR       BUT CHECK FOR PACER
      SSA             IF PACER THIS IS NOT LAST CALL
      CMB,INB 
      STB XTEMP 
LADOF EQU * 
      JSB A2313     CALL I/F TO TURN OFF LAD
      DEF *+6 
      DEF XTEMP 
      DEF RETRN 
      DEF ZERO
      DEF LADAD 
      DEF ZERO
      CLA           \ 
      LDB XTEMP      \
      SSB,RSS         CHECK I/F RETURN CODE 
      INA            /
      JSB C2313     / 
      JMP LADOF     ERROR 
      JMP MPXRP     ERROR 
POFF  EQU * 
      LDA .PCR      IF
      SSA,RSS        PACER
      JMP MPX,I     NO - DONE SO RETURN 
      LDA LU.SS 
      LDB P.OFF 
      CMB,INB 
      JSB STPCR     TURN OFF PACER
      DEF MPXRP 
      JMP MPX,I 
!CNT  NOP 
P.SET NOP 
P.ON  DEF *+1 
      NOP 
.PCR  NOP 
      DEC 10
      DEC 3 
P.X   NOP 
G.ON  DEF *+1 
.CHNL NOP 
.GAIN NOP 
P.OFF DEF *+1 
      NOP 
      NOP 
      NOP 
      NOP 
G.ON2 DEF *+1 
.CH2  NOP 
.GN2  NOP 
MSEC  DEC -450      MUST LOOP 450 TIMES FOR FASTEST 
*                                   COMPUTER: F-SERIES W\HP MEMORY
      SKP 
* DAC DATA GETTER 
* 
*     JSB DDATA 
*     (ABORT RETURN)
* 
*          DATA WORD RETURNED IN (A)
* 
* 
DDATA NOP 
      LDB M30       PROMPT WITH MESSAGE 30
      JSB RFFIN     GET DATA VALUE
      DST VALUE     SAVE
      DLD DCMAX     GET MAX 
      FSB VALUE     IF DATA 
      SSA            > 10.235 
      JMP DDATA,I   ABORT 
      DLD VALUE     GET DATA
      FSB DCMIN     IF DATA 
      SSA            < -10.240
      JMP DDATA,I   ABORT 
      DLD VALUE     CONVERT VALUE 
      FDV CVOLT      TO BITS
      JSB IFIX      FIX 
      AND DDMSK     MASK JUNK 
      ISZ DDATA     ADJUST RETURN ADDR
      JMP DDATA,I   RETURN
DDMSK OCT 177760
      SKP 
RFFIN NOP 
      CLA,INA       \ 
      JSB CREAD     / 
      CLA,INA       \ 
      LDB AINBF      \
      JSB .FFB.     CONVERT DATA
      JSB .FFR.      /
      JMP RFFIN,I   / 
      NOP 
      JMP RREAD 
      SPC 5 
DCMAX DEC 10.235
DCMIN DEC -10.240 
CVOLT DEC .0003125
      SKP 
.CNVT NOP           OUTPUT 1 DAC DATA POINT 
CN.VT EQU * 
      JSB D2313     CALL I/F ROUTINE TO OUTPUT
      DEF *+8 
      DEF LU.SS 
      DEF RETRN 
      DEF ZERO
      DEF ZERO
      DEF CHNL1 
      DEF D1
      DEF GAIN1 
      CLA,INA       CHECK 
      JSB C2313      I/F RETURN CODE
      JMP CN.VT     ERROR 
      JMP CN.VT     ERROR 
      JMP .CNVT,I 
      SKP 
* DAC OUTPUT
* 
*     LDA MODE
*     LDB RDGS
*     JSB .DAC. 
* 
*          MODE - DAC MODE
*          RDGS - NUMBER OF POINTS TO OUTPUT
* 
* 
.DAC. NOP 
      STA !MODE     SAVE MODE 
      STB !CNT      SAVE #
DACRP EQU * 
      LDA DPACR     GET PACER FLAG
      SSA,RSS       PACER?
      JMP .CVT.     NO PACER
      LDA DXTSS     GET EXTERNAL START/STOP FLAG
      IOR .SICH      SINGLE CHANL 
      IOR .ALT        ALTERNATE 
      IOR .RAN         RANDOM 
      SSA           ANY SET?
      JMP .XTRN     YES - NO PACE DELAY 
      LDA LU.SS     USE 
      CMA,INA        NEGATIVE LU
      LDB P.ON      CHANGE PACE 
      CMB,INB        IMMEDIATE
      JSB STPCR     TURN ON PACER 
      DEF DACRP 
.XTRN EQU * 
      LDA LU.SS     USE 
      CMA,INA       NEGATIVE LU 
      LDB DACPP     CHANGE PACE ON NEXT PULSE 
      JSB STPCR     REPROGRAM PACER 
      DEF DACRP 
.CVT. EQU * 
      LDA DPACR     GET PACER FLAG
      LDB LU.SS     GET LU
      SSA           IF PACER
      CMB,INB       USE NEGATIVE LU 
      STB XTEMP     SAVE LU 
      JSB D2313     CALL I/F TO OUTPUT POINTS 
      DEF *+8 
      DEF XTEMP 
      DEF RETRN 
      DEF DPACR 
      DEF !MODE 
      DEF CHNLS 
      DEF !CNT
      DEF DATA
      CLA           \ 
      LDB XTEMP      \
      SSB,RSS         CHECK I/F RETURN CODE 
      INA            /
      JSB C2313     / 
      JMP .CVT.     ERROR 
      JMP DACRP     ERROR 
      LDA DPACR     GET PACER FLAG
      SSA,RSS       PACER?
      JMP .DAC.,I   NO - DONE 
      LDA LU.SS 
      LDB P.OFF 
      CMB,INB       TURN OFF IMMEDIATE
      JSB STPCR     TURN OFF PACER
      DEF DACRP 
      JMP .DAC.,I   RETURN
      SKP 
* MPX GAIN SETTER 
* 
*     LDA SSLU
*     LDB PRMAD 
*     JSB SETGN 
*     DEF BAD 
* 
*          SSLU  - SUBSYSTEM LU 
*          PRMAD - ADDR OF PARAMETER TABLE
*                  (CHANL,GAIN) 
*          BAD   - RETURN ADDR TO REPEAT ALL I/F CALLS
* 
* 
SETGN NOP 
      STA ST.LU     SAVE LU 
      STB G.ADR     SAVE CH ADDR
      INB           FIND GAIN ADDR
      STB G.COD     SAVE GAIN ADDR
      CLB           \ 
      SSA,RSS        SET EXPECTED RETURN CODE 
      INB           / 
      STB P.X       SAVE
      LDA SETGN,I   FETCH REPEAT ALL ADDR 
      STA BRTN1     SAVE
G.    EQU * 
      JSB A2313     CALL I/F TO PROGRAM GAIN
      DEF *+6 
      DEF ST.LU 
      DEF RETRN 
      DEF ZERO
G.ADR NOP 
G.COD NOP 
      LDA P.X       GET EXPECTED RETURN CODE
      JSB C2313     CHECK I/F RETURN CODE 
      JMP G.        ERROR 
      JMP BRTN1,I   ERROR 
      ISZ SETGN     ADJUST RETURN ADDR
      JMP SETGN,I   RETURN
BRTN1 NOP 
      SKP 
* PACER SETTER
* 
*     LDA SSLU
*     LDB PRMAD 
*     JSB STPCR 
*     DEF BAD 
* 
*          SSLU  - SUBSYSTEM LU 
*          PRMAD - ADDRESS OF PACER PARAM TABLE 
*                  (IF < 0 THEN IMMED PACE CHANGE OTHERWISE 
*                   CHANGE ON NEXT PACE PULSE)
*                  (EXTSS,PACER,PRATE,PMULT)
*          BAD   - RETURN ADDR TO REPEAT ALL I/F CALLS
* 
* 
STPCR NOP 
      STA ST.LU     SAVE LU 
      LDA AZERO     SET FOR IMMED. PACE CHANGE
      SSB,RSS       IF > 0 THEN 
      LDA ADM1       NEXT PACE CHANGE 
      STA PCHNG     SAVE
      SSB           IF < 0
      CMB,INB       NEGATE
      STB P.XSS     SAVE EXTSS FLAG ADDR
      ADB D2        FIND PACE RATE ADDR 
      STB P.RAT     SAVE
      INB           FIND PACE MULTIPLIER ADDR 
      STB P.MLT     SAVE
      LDA ST.LU     GET LU FOR TEST 
      CLB           \ 
      SSA,RSS        SET EXPECTED RETURN CODE 
      INB           / 
      STB P.X       SAVE
      LDA STPCR,I   GET REPEAT ALL ADRR 
      STA BRTN1     SAVE
P.    EQU * 
      JSB P2313     CALL I/F TO PROGRAM PACER 
      DEF *+8 
      DEF ST.LU 
      DEF RETRN 
PCHNG NOP 
P.XSS NOP 
P.RAT NOP 
P.MLT NOP 
      DEF ZERO
      LDA P.X       GET EXPECTED RETURN CODE
      JSB C2313     CHECK I/F RETURN CODE 
      JMP P.        ERROR 
      JMP BRTN1,I   ERROR 
      ISZ STPCR     ADJUST RETURN ADDR
      JMP STPCR,I   RETURN
      SPC 5 
ST.LU NOP 
ZERO  DEC 0 
ADM1  DEF DM1 
AZERO DEF ZERO
      SKP 
* STATISTICS CALCULATOR 
* 
*     LDA NUMBR 
*     LDB MODE
*     JSB STATS 
* 
*          NUMBR - NUMBR OF VALUES IN BUFFER
*          MODE  - =0 SINGLE CHANNEL
*                  =1 TWO CNANNEL CHANNEL 1 
*                  =2 TWO CHANNEL CHANNEL 2 
* 
*          ASSUMED ON CALL THAT LSTDV IS SET UP 
* 
* 
SCNTR NOP 
STEP  NOP 
STATS NOP 
      STA SCNTR     SAVE COUNT
      CLA,INA 
      SZB           IF 2 CH MODE
      INA 
      STA STEP       THEN STEP SIZE IS 2 ELSE 1 
      CLA,INA 
      CPB D2        IF 2 CH 
      INA 
      STA CTEMP      THEN START VALUE IS VALUE 2
      STA TEMP
      CLA           \ 
      STA RMS        \
      STA RMS+1       ZERO RMS
      STA AVG          AND AVERAGE
      STA AVG+1      /
      STA CNTR1     / 
      DLD RMAXP     SET LO TO 
      DST LO         MAX POSITIVE 
      DLD RMAXN     SET HI TO 
      DST HI         MAX NEGATIVE 
      LDA CTEMP     LOOK UP 
      ALS            FIRST DATA 
      ADA ADTA2       VALUE AND 
      DLD A,I          USE FOR
      DST BIAS          BIAS
STAT1 EQU *         SUMMING LOOP FOR AVERAGE
      ISZ CNTR1     BUMP VALUE COUNTER
      LDA CTEMP     GET DATA VALUE
      ALS           : 
      ADA ADTA2     : 
      DLD A,I       : 
      DST VALUE     SAVE
      FSB LO
      SSA,RSS       VALUE < LO? 
      JMP $LOOK     NO
      DLD VALUE     YES - MAKE LO 
      DST LO         = VALUE
$LOOK EQU * 
      DLD HI
      FSB VALUE 
      SSA,RSS       VALUE > HI? 
      JMP $HIOK      NO 
      DLD VALUE     MAKE HI 
      DST HI         = VALUE
$HIOK EQU * 
      DLD VALUE     FETCH VALUE 
      FSB BIAS      SUBTRACT OUT BIAS 
      FAD AVG       ADD TO SUM
      DST AVG       SAVE SUM
      LDA CTEMP     GET DATA SUBSCRIPT
      ADA STEP      ADD STEP
      STA CTEMP     SAVE
      CMA,INA       \ 
      ADA SCNTR      DONE?
      SSA,RSS       / 
      JMP STAT1     NO - CONTINUE 
      LDA CNTR1     CONVERT VALUE 
      JSB FLOAT      COUNT TO REAL
      DST VALUE     SAVE FOR DIVIDE 
      DLD AVG       GET SUM 
      FDV VALUE     DIVIDE
      FAD BIAS      ADD BIAS TO GET AVERAGE 
      DST AVG       SAVE FOR PRINT
STAT2 EQU *         LOOP TO FIND RMS
      LDA TEMP      GET DATA VALUE
      ALS           : 
      ADA ADTA2     : 
      DLD A,I       : 
      FSB AVG       SUBTRACT AVERAGE
      DST BIAS      SAVE DEVIATION
      FMP BIAS      SQUARE DEVIATION
      FAD RMS       ADD TO SUM
      DST RMS       SAVE SUM
      LDA TEMP      GET DATA SUBSCRIPT
      ADA STEP      ADD STEP
      STA TEMP      SAVE
      CMA,INA       \ 
      ADA SCNTR      DONE?
      SSA,RSS       / 
      JMP STAT2     NO - CONTINUE 
      DLD RMS       FETCH SUM 
      FDV VALUE     DIVIDE BY COUNT 
      JSB SQRT      TAKE SQ ROOT TO FIND RMS
      HLT 0         : 
      DST RMS       SAVE FOR PRINT
      DLD HI        TAKE HI 
      FSB LO         - LO 
      DST PTOP      = PEAK TO PEAK
* OUTPUT
      DLD AVG       GET AVERAGE 
      DST FMTO1     SAVE
      LDA D6        \ 
      LDB AFRMT     CONVERT 
      JSB FMTOT     / 
      DLD PTOP      GET PEAK TO PEAK
      DST FMTO1     SAVE
      LDA D20       \ 
      LDB AFRMT     CONVERT 
      JSB FMTOT     / 
      DLD HI        GET HI
      DST FMTO1     SAVE
      LDA D34       \ 
      LDB AFRMT     CONVERT 
      JSB FMTOT     / 
      DLD LO        GET LO
      DST FMTO1     SAVE
      LDA D48       \ 
      LDB AFRMT     CONVERT 
      JSB FMTOT     / 
      DLD RMS       GET RMS 
      DST FMTO1     SAVE
      LDA D63       \ 
      LDB AFRMT     CONVERT 
      JSB FMTOT     / 
      JSB CMOVE     MOVE TO OUTPUT BUFFER 
      DEC 1 
AFRMT DEF FORMT 
      DEC 1 
      DEF INBFR 
      DEC 72
      LDA DM72
      JSB LISTO     OUTPUT RESULTS ON LIST DEVICE 
      JMP STATS,I 
AVG   NOP 
      NOP 
BIAS  NOP 
      NOP 
RMS   NOP 
      NOP 
RMAXP OCT 77777,177776
RMAXN OCT 100000,000376 
DM72  DEC -72 
D20   DEC 20
D34   DEC 34
D48   DEC 48
D63   DEC 63
HI    NOP 
      NOP 
LO    NOP 
      NOP 
PTOP  NOP 
      NOP 
VALUE NOP 
      NOP 
FORMT ASC 18, AVG=XXXXXXXXXX PP=XXXXXXXXXX HI=XXX 
      ASC 18,XXXXXXX LO=XXXXXXXXXX RMS=XXXXXXXXXX 
      HED HP2313 RTE VERIFICATION -- MESSAGES 
      SKP 
      SUP 
M5    DEF *+1 
      DEC -14 
      ASC  7,NO PACE SIGNAL 
M6    DEF *+1 
      DEC -14 
      ASC  7,BX,CD,GAIN = _:
M7    DEF *+1 
      DEC -15 
      ASC  8,PERIOD,MULT = _: 
M8    DEF *+1 
      DEC -15 
      ASC  8,EXT STRT/STP? _: 
M9    DEF *+1 
      DEC -9
      ASC  5,DELAY = _: 
M10   DEF *+1 
      DEC -9
      ASC  5,BX,CD = _: 
M11   DEF *+1 
      DEC -16 
      ASC  8,START,FINISH = _:
M12   DEF *+1 
      DEC -12 
      ASC  6,BX,CD,CH = _:
M13   DEF *+1 
      DEC -6
      ASC  3,NO = _:
M14   DEF *+1 
      DEC -7
      ASC  4,DIFF? _: 
M15   DEF *+1 
      DEC -6
      ASC  3,1ST CH 
M16   DEF *+1 
      DEC -7
      ASC  4, 2ND CH
M17   DEF *+1 
      DEC -10 
      ASC  5,RDGS TAKEN 
M18   DEF *+1 
      DEC -11 
      ASC  6,CH'S/GP = _: 
M19   DEF *+1 
      DEC -13 
      ASC  7,NO OF GPS = _: 
M20   DEF *+1 
      DEC -17 
      ASC  9,BX,CD,CH,GAIN = _: 
M21   DEF *+1 
      DEC -7
      ASC  4,LAST CH
M22   DEF *+1 
      DEC -18 
      ASC 9,TRANSMISSION ERROR
M24   DEF *+1 
      DEC -5
      ASC 3, FOR: 
M25   DEF *+1 
      DEC -12 
      ASC 6, X=SIN(W1*T)
M26   DEF *+1 
      DEC -14 
      ASC 7, Y=SIN(W2*T+@)
M27   DEF *+1 
      DEC -7
      ASC 4, W1 = _ : 
M28   DEF *+1 
      DEC -7
      ASC 4, W2 = _ : 
M29   DEF *+1 
      DEC -7
      ASC 4, @  = _ : 
M30   DEF *+1 
      DEC -9
      ASC 5, DATA = _ : 
M31   DEF *+1 
      DEC -7
      ASC 4, 1ST CH 
      HED HP2313 RTE VERIFICATION -- CONSTANTS,STORAGE,EQUATES
      SKP 
* CONSTANTS,STORAGE,EQUATES 
A     EQU 0 
B     EQU 1 
W1    EQU VALUE 
W2    EQU BIAS
PHASE EQU AVG 
TIME  EQU RMS 
DEL.T EQU HI
LU.IN NOP           CURRENT INPUT LU
LU.FB NOP           FALLBACK LU (ERRORS & OP MSGS)
LU.PO NOP           DEFAULT LIST DEVICE LU
LU.SS NOP           2313 SUBSYSTEM LU 
LUSTK DEC -1        1-LEVEL LU STACK FOR TR 
AD    ASC 1,AD      \ 
AL    ASC 1,AL       \
CL    ASC 1,CL        \ 
CO    ASC 1,CO         \
DA    ASC 1,DA          \ 
ER    ASC 1,ER           \
EX    ASC 1,EX            \ 
GR    ASC 1,GR      COMMAND 
LI    ASC 1,LI       MATCH TABLE
NO    ASC 1,NO            / 
RA    ASC 1,RA           /
RE    ASC 1,RE          / 
SE    ASC 1,SE         /
SI    ASC 1,SI        / 
TR    ASC 1,TR       /
TW    ASC 1,TW      / 
DM10  DEC -10 
DM7   DEC -7
DM5   DEC -5
DM2   DEC -2
DM1   DEC -1
D0    DEC 0 
D2    DEC 2 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D8    DEC 8 
D11   DEC 11
D31   DEC 31
B62   OCT 62
D255  DEC 255 
D10K  DEC 10000 
IMAX  OCT 77777     MAXIMUM POSITIVE INTEGER
INBFR BSS 40        INPUT BUFFER
      ASC 3,,,,,,,  EOF FOR FORMATTER CONVERSIONS 
QSIZE EQU 100       SETS SIZE OF QUEUE BUFFER 
Q     BSS QSIZE     QUEUE BUFFER FOR 2313 CALLS 
QLEN  ABS QSIZE     QUEUE BUFFER LENGTH 
.ADC  DEC -1        ADC MODE FLAG 
RETRN NOP           RETURN CODE FROM I/F ROUTINES 
A!    ASC 1,A 
D!    ASC 1,D 
G!    ASC 1,G 
K!    ASC 1,K 
L!    ASC 1,L 
P!    ASC 1,P 
R!    ASC 1,R 
T!    ASC 1,T 
EA    ASC 1,EA
B40   OCT 40
ADINT DEF FWINT 
FWINT EQU * 
CNTR1 NOP 
.SICH NOP           DAC SINGLE CHANL FLAG 
.ALT  NOP           DAC ALTERNATE FLAG
.ERS  NOP           DAC ERASE FLAG
.GRP  NOP           DAC GROUP FLAG
.LISA NOP           DAC LISSAJOUS FLAG
.RAN  NOP           DAC RANDOM FLAG 
DELAY NOP           ADC DELAY FLAG
DREPT NOP            DAC REPEAT FLAG
DRPOK NOP           DAC REPEAT OK FLAG
GAIN  NOP           ADC GAIN FLAG 
LAD   NOP           ADC LAD FLAG
LADAD NOP           ADC LAD ADDR
LSTCH NOP           ADC LAST CHANL (FOR LAD)
LSTOK NOP           ADC LIST OK FLAG
RPEAT NOP           ADC REPEAT FLAG 
RPTOK NOP           ADC REPEAT OK FLAG
DCNTR NOP           DELAY COUNTER 
EXTSS NOP           ADC EXTERNAL START/STOP FLAG
PACER NOP           ADC PACER FLAG
PRATE NOP           ADC PACE RATE 
PMULT NOP           ADC PACE MULTIPLIER 
DXTSS NOP           DAC EXTERNAL START/STOP FLAG
DPACR NOP           DAC PACER FLAG
DPRAT NOP           DAC PACE RATE 
DPMLT NOP           DAC PACE MULTIPLIER 
.SCLD NOP           ADC SCALED SEQUENTIAL FLAG
.SC   NOP           ADC SINGLE CHANNEL FLAG 
.TC   NOP           ADC TWO CHANNEL FLAG
.SS   NOP           ADC SEQUENTIAL FLAG 
DIFF  NOP           ADC DIFFERENTIAL CHANNEL FLAG 
CHNL1 NOP           FIRST CHANL ADDR
CHNL2 NOP           SECOND CHANL ADDR 
GAIN1 NOP           FIRST CHANL GAIN
GAIN2 NOP           SECOND CHANL GAIN 
GRUPS NOP           # OF GROUPS FOR SCALD SEQ 
RDGS  NOP           # OF READINGS 
LWINT EQU * 
INCNT ABS FWINT-LWINT 
ADCPP DEF EXTSS     ADC PACER PARAMETER TABLE 
DACPP DEF DXTSS     DAC PACER PARAMETER TABLE 
ADTA2 DEF DATA-2
ADATA DEF DATA-1
ACHLS DEF CHNLS-1 
AGANS DEF GAINS-1 
!DATA EQU * 
DATA  BSS 400       DATA BUFFER 
CHNLS BSS 200       CHANNEL BUFFER
GAINS EQU CHNLS+100 GAINS BUFFER
      HED HP2313 RTE VERIFICATION -- INITIALIZATION 
      SKP 
INITL EQU * 
* FETCH SCHEDULE PARAMS 
      LDA DM5 
      STA CNTR
      LDA APRMS 
      STA PNTR
PFLP  EQU * 
      LDA B,I       FETCH PARAM 
      STA PNTR,I    STORE PARAM 
      ISZ PNTR      BUMP STORE POINTER
      INB           BUMP FETCH POINTER
      ISZ CNTR      DONE? 
      JMP PFLP      NOT DONE - MORE 
      LDB ADPMT 
      STB PRMT
      CCB 
      STB LUSTK     CLEAR LU STACK
      STB .ADC      SET ADC MODE
      LDB INCNT     SET UP LOOP 
      STB CNTR       TO CLEAR FLAGS 
      CLB 
      LDA ADINT 
INLUP EQU * 
      STB A,I       CLEAR FLAG
      INA           BUMP ADDR 
      ISZ CNTR      DONE? 
      JMP INLUP     NOT DONE - CONTINUE 
      LDA PRMS      FETCH CONTROL DEVICE LU 
      SZA,RSS       IF = 0
      CLA,INA        THEN DEFAULT TO 1
      STA LU.IN     SET INPUT DEVICE
      STA LU.FB     SET FALLBACK DEVICE 
      LDB PRMS+1    FETCH LIST DEVICE LU
      SZB,RSS       IF = 0
      LDB A         THEN DEFAULT TO FALLBACK DEVICE 
      STB LU.PO     SET LIST DEVICE 
      LDB PRMS+2    FETCH IMMEDIATE XFER LU 
      SZB,RSS       IF = 0
      JMP NOITR      THEN NO IMMED. XFER
* DO IMMEDIATE TRANSFER OF CONTROL
      STA LUSTK     SAVE INPUT LU ON STACK
      STB LU.IN     SET INPUT DEVICE TO NEW LU
NOITR EQU * 
      LDA LU.FB     FETCH OUTPUT LU 
      LDB M1        OUTPUT MESSAGE 1
      JSB PRMPT     OUTPUT MESSAGE
      CLA,INA       READ AT LEAST 1 CHAR
      LDB M2        PROMPT W/MESSAGE 2
      JSB CREAD     GET REPLY 
      JSB FFIN      CONVERT SUBSYSTEM LU
      LDA FF1       FETCH LU
      JSB LUCHK     CHECK FOR VALIDITY
      JMP RREAD     ERROR 
      JSB DVR       FETCH DRIVER TYPE 
      CPA B62       MUST BE 62
      RSS 
      JMP RREAD     ELSE ERROR
      LDA FF1       GET LU
      STA LU.SS     SET SUBSYSTEM LU
      LDB M3        SET FOR MESSAGE 3 
      JSB QYNA      GET REPLY 
      SZA,RSS       AB? 
      JMP !TERM     AB SO TERMINATE 
      SSA,RSS       NO
      JMP NRML      NO SO NORMALIZE 
      LDA LU.FB 
      LDB M4        SET MESSAGE 4 
      JSB PRMPT     OUTPUT DIRECTIONS 
NRML  EQU * 
      JSB B2313     SET UP QUEUE BUFFER 
      DEF *+3 
      DEF Q 
      DEF QLEN
      JMP .NO       GO NORMALIZE
APRMS DEF PRMS
PRMS  EQU DATA
CNTR  EQU CHNLS 
PNTR  EQU CHNLS+1 
M1    DEF *+1 
      DEC -35 
      ASC 18,HP2313 ON-LINE VERIFICATION (1926) 
M2    DEF *+1 
      DEC -23 
      ASC 12,HP2313 LOGICAL UNIT = _: 
M3    DEF *+1 
      DEC -18 
      ASC  9,WANT DIRECTIONS? _:
M4    DEF *+1 
      ABS FM4-SM4 
SM4   EQU * 
      ASC 18,ADC: PROMPT ">"  1-200 RDGS TOTAL
      ASC 18,DAC: PROMPT "<"  1-200 DATA OUTPUTS
      OCT 6412
      ASC 18, DA   = CHANGE TO DAC MODE 
      ASC 18, AD   = CHANGE TO ADC MODE 
      OCT 6412
      ASC 18, EX   = TERMINATE VERIFICATION 
      ASC 18, EX   = TERMINATE VERIFICATION 
      OCT 6412
      ASC 18, TR X = TRANSFER CONTROL TO LU=X 
      ASC 18, TR X = TRANSFER CONTROL TO LU=X 
      OCT 6412
      ASC 18, *    = COMMENT - IGNORE LINE
      ASC 18, *    = COMMENT - IGNORE LINE
      OCT 6412
      ASC 18, CO   = PRINT CURRENT ADC CONDITIONS 
      ASC 18, CO   = PRINT CURRENT DAC CONDITIONS 
      OCT 6412
      ASC 18, NO   = ISSUE SYSTEM NORMALIZE 
      ASC 18, NO   = ISSUE SYSTEM NORMALIZE 
      OCT 6412
      ASC 18, RE   = REPEAT LAST TEST 
      ASC 18, RE   = REPEAT LAST TEST 
      OCT 6412
      ASC 18, SI W = 1 OR MORE RDGS ON 1 CHNL 
      ASC 18, SI   = 1 OR MORE OUTPUTS ON 1 CHNL
      OCT 6412
      ASC 18, TW W = RDGS ON 2 ALTERNATING CHNLS
      ASC 18, RA   = OUTPUT ON SPECIFIED CHNL(S)
      OCT 6412
      ASC 18, SE   = RDGS ON SEQUENTIAL CHNLS 
      ASC 18, GR   = OUTPUT TO CH GROUPS ON PACE
      OCT 6412
      ASC 18, LI W = LIST DATA BUFFER CONTENTS
      ASC 18, AL   = ALTERNATE OUTPUTS ON 1 CHNL
      OCT 6412
      ASC 18,    W = LIST LU FOR TEST RESULTS 
      ASC 18, ER   = ERASE SPECIFIED CHNL(S)
      OCT 6412
      ASC 18, SET D OR CLEAR D = ADC DELAY COND 
      ASC 18, LI   = PLOT LISSAJOUS PATTERN 
      OCT 6412
      ASC 18, SET G OR CLEAR G = ADC GAIN COND
      ASC 18, SET P OR CLEAR P = PAC PACER COND 
      OCT 6412
      ASC 18, SET L OR CLEAR L = ADC LAD COND 
      ASC 18, SET R OR CLEAR R = DAC REPEAT COND
      OCT 6412
      ASC 18, SET P OR CLEAR P = ADC PACER COND 
      ASC 18, CLEAR A = CLEAR ALL DAC COND
      OCT 6412
      ASC 18, SET R OR CLEAR R = ADC REPEAT COND
      OCT 6412
      ASC 18, SET K = PROGRAM GAIN IMMEDIATE
      OCT 6412
      ASC 18, CLEAR A = CLEAR ALL ADC COND
      ASC 18, REPEAT COND CONTINUOUSLY REPEATS
      OCT 6412
      OCT 6412
      ASC 18, REPEAT COND CONTINUOUSLY REPEATS
FM4   EQU * 
      END INITL 
                                                                                                                                                                                                                                                        