ASMB,R,L,C
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*      NAME:    DCT02 - 9872A/B/S DEVICE COMMAND TABLE
*      SOURCE:  92840 - 18086 
*      RELOC:   92840 - 16005 
* 
* 
* 
************************************************************* 
* 
      NAM DCT02,7  92840-16005 REV.1940 790720
      ENT DCT02 
* 
      EXT EXEC,TAN,COS,SIN,FLOAT,.IENT
      EXT ABS 
      EXT FLTAS 
      EXT CONVT 
      EXT LNGTH,GIC,DCTAD 
      EXT GCBIM,INTX,BYTE,INDCK 
      EXT REIO
*     THIS IS THE DEVICE COMMAND TABLE FOR THE 9872 HARD COPY 
*  PLOTTER. 
* 
* 
*     COMMAND LINK TABLE (CLTBL)
* 
      SPC 3 
DCT02 NOP 
      DEF EML02 
      DEF RESET   RESET PLOTTER 
      DEF DEFLT   DEFAULT P1,P2 
      DEC -26     PAGE FEED 
      NOP           FLUCH 
      DEF HOME      HOME PEN
      DEC -19       DEVICE ID 
      NOP 
      DEF PLTUN     GET PLOT UNITS
      OCT -1           "     (GET CHARACTER INFORMATION)
      DEF PNLOC     GET PEN LOCATION
      DEF PNLOC     CURSOR
      DEC -4        DIGITIZE
      NOP           LORG
      DEC -7        LDIR
      DEC -8        SLANT ON
      DEF SLOFF     SLANT OFF 
      DEC -9        CHAR. SIZE
      DEC -13       SET RELATIVE ORIGIN 
      NOP           NOPS
      NOP 
      NOP 
      NOP 
      NOP 
      NOP 
      DEF SELPN     SELECT PEN  0(RETURN TO HOLDER) 
      NOP           PEN = -1
      NOP           PEN = -2
      DEF SELPN     PEN = 1-N 
      DEC -5        GET NUMBER OF PENS
      DEC -6        DEFINE LINE TYPE
      DEC -10       LINE TYPE 
      DEC -10       LINE TYPE WITH LENGTH 
      DEF PENUP 
      DEF PENDN 
      DEF PLTAB 
      DEC -2        PLOT RELOCATABLE
      DEF PLTIN 
      DEF LGLAB     SHORT LABEL 
      DEF LGLAB     LABEL MODE
      DEF STPLB     LABEL MODE TERMINATOR 
      DEC -3   FLT TO ASCII 
      DEC -11       DISPLAY SURFACE SIZE IN MM
      NOP 
      NOP 
      DEC -24       SET P1,P2 
      DEC -12       GET MU/MM 
      DEC -14       GET DEVICE CLEARING CHARACTERISTICS 
      DEC -15       NUMBER OF PHYSICALLY DIFFERENT PENS 
      DEC -20       # OF CURSORS
      DEC -16       LORGABILITY 
      DEC -17       MAX. CHARACTER SLANT
      DEC -18       HARD CLIPPING CAPABILITY
      DEC -25       INQUIRE CHARACTER PLACEMENT 
      DEC -21 
      DEC -22 
      DEC -23 
* 
* 
*     ASCII COMMAND STRINGS 
* 
      SPC 3 
RESET DEC -2        6 BYTES, WRITE
      DEF SEMCL 
      ASC 1,DF          COMMAND STRING
* 
DEFLT DEC -5
      DEF SEMCL 
      ASC 3,IP;IW 
* 
HOME  DEC -16 
      DEF SEMCL 
      ASC 8,PU;PA15720,10380
* 
PLTUN DEC 2 
      DEF SEMCL 
      ASC 1,OP
PNLOC DEC 2 
      DEF SEMCL 
      ASC 1,OC
* 
LNTYP DEC -2
      DEF SEMCL 
      ASC 1,LT
* 
PENDN DEC -2
      DEF SEMCL 
      ASC 1,PD
* 
PENUP DEC -2
      DEF SEMCL 
      ASC 1,PU
* 
PLTAB DEC -2
      DEF SEMCL 
PA    ASC 1,PA
* 
PLTIN DEC -2        PLOT INCREMENTAL
      DEF SEMCL 
      ASC 1,PR
* 
SELPN DEC -2
      DEF SEMCL 
      ASC 1,SP
LGLAB DEC -2
      DEF HT
LB    ASC 1,LB
STPLB DEC -1
      DEF HT
      OCT 1400      DECIMAL 3 
* 
SLOFF DEC -2
      DEF SEMCL 
      ASC 1,SL
STP12 DEC -2
      DEF SEMCL 
      ASC 1,IW
* 
* 
SEMCL OCT 73
HT    OCT 137 
.3    OCT 3 
* 
      SKP 
* 
      SPC 3 
* 
*     UTILITY ROUTINES FOR EMULATORS
* 
SETUP NOP 
      JSB GCBIM     RETRIEVE IOBUF ADDRESS AND IOBL FROM THE GCB
      DEF CONT1 
      DEF .2        CODE IN IGTBL, FOR IOBUF,IOBL,AND LUN 
      DEF .3        TWO CODES 
      DEF LUN 
      DEF .0        THREE WORDS 
      DEF .1        READ
CONT1 LDA IOBUF 
      JSB INDCK 
      STA IOBUF 
      STA IOB 
      STA ADCNT     INITIALIZE ADDRESS COUNTER
      STA INTIO 
      LDA SEMCL     TERMINATOR
      STA TERM
      CLA 
      STA NBYTE     BYTE COUNTER
      STA IBYTE 
* 
      JMP SETUP,I 
* 
*     CONVERT INCOMING DATA FROM ASCII TO INTEGER 
* 
INTEG NOP 
      LDA LNGTH     SET TO CONVERT FROM ASCII TO INTEGER
      CMA,INA 
      STA LNTH
      CLA 
      STA IBYTE 
      LDA INX 
      STA INTAD 
INTLP JSB INTX      BEGIN TO CONVERT DATA 
      DEF RTINT 
INTIO NOP 
INTAD NOP 
      DEF IBYTE 
RTINT LDA FIRST     SEE IF WE ARE RETRIEVING PLOT UNITS 
      CPA OP
      JMP FIXIT     YES 
CONIN ISZ INTAD 
      ISZ LNTH
      JMP INTLP     CONTINUE
      JMP INTEG,I 
FIXIT LDA INTAD,I   CONVERT INTEGER TO FLOATING POINT 
      JSB FLOAT 
      DST INTAD,I 
      ISZ INTAD 
      ISZ LNTH
      JMP CONIN     CONTINUE
* 
*     TAKE VALUES PLACED IN INTX1(1) TO INTX1(LNGTH) AND TRANSFER 
*  THIS DATA TO GICB. 
* 
GB2   NOP 
      STA GCBCD 
      JSB GCBIM     TRANSFER DATA TO AGL
      DEF RTX 
      DEF GCBCD 
      DEF .1
      DEF INTX1 
      DEF LNGTH 
      DEF .2
RTX   JMP GB2,I 
* 
*     RETRIEVE DATA FROM GICB AND PLACE IT IN INTX1(1) TO INTX1(LNTH) 
* 
GB1   NOP 
      STA GCBCD     GCB POINTER 
      JSB GCBIM     RETRIEVE INTEGER VALUES FROM
      DEF RTGB1     GCB 
      DEF GCBCD 
      DEF .1
      DEF INTX1 
      DEF LNTH
      DEF .1
RTGB1 JMP GB1,I 
* 
*     FINI DOES THE FOLLOWING:
*  1. CONVERTS INTEGERS TO ASCII
*  2. TRANSFERS THIS ASCII TO THE DEVICE (VIA OUTPT). 
*  3. RETURNS TO CALLER 
* 
FIN   NOP 
FINI  JSB CONVT 
      DEF RTCON 
      DEF INTX2     FWA FOR INTEGERS TO BE CONVERTED
      DEF IOBUF,I   I O BUFFER
      DEF NBYTE 
      DEF LNGTH 
RTCON JSB TRBYT     INSERT TERMINATOR 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP FIN,I 
* 
*     EXIT DVG10 AND SET MODE TO LABEL IF NOT ALREADY SET 
* 
      SPC 3 
      SPC 3 
* 
* 
TRBYT NOP           INSERT TERMINATOR INTO OUTPUT BUFFER
      LDA TERM      SEMI-COLON
      JSB PTBYT 
      JMP TRBYT,I 
* 
PTBYT NOP 
      STA BITE
      JSB UPDTE     UPDATE ADDRESS COUNTER (ADCNT)
      JSB BYTE
      DEF RTBYT 
      DEF NBYTE 
      DEF BITE
      DEF ADCNT,I 
RTBYT ISZ NBYTE 
      JSB UPDTE 
      JMP PTBYT,I 
* 
* 
UPDTE NOP 
      LDA NBYTE 
      CLE,ERA 
      ADA IOBUF 
      STA ADCNT 
      JMP UPDTE,I 
* 
* 
BITE  NOP 
* 
OUTPT NOP           I/O TRANSFER ROUTINE
      CMA,INA 
      STA IOCNT     BYTE COUNTER FOR OUTPUT 
      STB RW
      JSB REIO
      DEF RTOUT 
      DEF RW
      DEF LUN 
IOB   NOP 
      DEF IOCNT 
RTOUT JMP OUTPT,I 
* 
* 
      SKP 
      SPC 3 
* 
*     EMULATORS 
* 
EML02 NOP 
      JSB SETUP     GO GET IOBUF,IOBL,LUN AND FXD N 
      LDA GIC 
      CPA .177
      JMP ERRCK 
      LDA DCTAD     EMULATOR NUMBER (NEGATIVE)
      CMA,INA 
      STA B 
      LDA EM0       TOP OF LIST OF EMULATORS AND OTHER THINGS.
      JSB INDCK     GET RID OF INDIRECT BIT 
      ADA B         COMPUTE POINTER 
      LDB LNGTH 
      INB 
      STB LNTH
      LDA A,I 
      JMP A,I 
* 
EM0   DEF * 
      DEF EMUL1 
      DEF EMUL2 
      DEF EMUL3 
      DEF EMUL4 
      DEF EMUL5 
      NOP           DEFINE LINE TYPE
      DEF EMUL7 
      DEF EMUL8 
      DEF EMUL9 
      DEF EML10 
      DEF EML11 
      DEF EML12 
      DEF EML13 
      DEF EML14 
      DEF EML15 
      DEF EML16 
      DEF EML17 
      DEF EML18 
      DEF EML19 
      DEF EML20 
      DEF EML21 
      DEF EML22 
      DEF EML23 
      DEF EML24 
      DEF EML25 
      DEF EML26 
* 
      SKP 
      SPC 2 
* 
*     CHARACTER SPACING INFORMATION 
* 
EMUL1 LDA .7
      JSB GB1       GET CURRENT CHARACTER SIZE
      LDA .16 
      JSB GB2 
      JMP EML02,I 
* 
* 
*     DEFAULT VALUES = WIDTH * 1.5 * 400 MU MM
*                      HEIGHT * 2. * 400MU/MM 
* 
* 
CHRW  DEC 171.
CHRH  DEC 300.
CHW   DEC 2.4   .004 * 600
      DEC 4.0   .005 * 800
      DEC 15720.
      DEC 10380.
      OCT 0 
D1.5  DEC 1.5 
D2.0  DEC 2.0 
      SPC 3 
*     RELATIVE PLOTTING (RPLOT(X,Y) 
* 
EMUL2 LDA .32       GET PORGX,PORGY 
*     JSB GB1 
*     LDA INTX1 
*     STA PORGX 
*     LDA INTX2 
*     STA PORGY 
*     LDA .16       NOW GET NEW POINTS
*     JSB GB1 
*     LDA PORGX     COMPUTE PORG(X,Y) + NEWPOINTS 
*     ADA INTX2 
*     STA INTX2 
*     LDA PORGY 
*     ADA INTX3 
*     STA INTX3 
*     LDA PA
*     JSB WRDST     INSERT PLOT ABSOLUTE COMMAND INTO IOBUF 
*     JSB FIN       CONVERT VALUES TO ASCII AND OUTPUT
*     JMP EML02,I 
* 
      SPC 3 
* 
*     FLOAT TO ASCII
* 
EMUL3 LDA .3        ETX 
      STA TERM
      LDA LB
      JSB WRDST 
      LDA .16 
      JSB GB1 
      JSB GLIDE 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EML02,I 
* 
* 
*     FLOAT TO ASCII CONVERSION 
* 
GLIDE NOP 
      JSB FLTAS 
      DEF RTGLD 
      DEF INTX2 
      DEF IOBUF,I 
      DEF NBYTE 
      DEF FXDN      F7.N
      DEF SKPBK 
RTGLD JMP GLIDE,I 
* 
* 
* 
* 
      SPC 3 
* 
*     DIGITIZE
* 
EMUL4 LDA DP        DIGITIZE POINT -TURN ON ENTER LIGHT 
      JSB PROUT 
EM4LP LDA OS        OUTPUT STATUS 
      JSB PROUT 
      LDA .40       NOW CHECK STATUS WORD BIT 2 TO SEE IF POINT 
      LDB .1
      JSB OUTPT    HAS BEEN ENTERRED
      LDA .1
      STA LNGTH 
      STA LNTH
      JSB INTEG     CONVERT ASCII TO INTEGER
      LDA INTX1 
      AND .4
      SZA 
      JMP GETPT     BIT 2 IS SET GO GET POINT 
      JMP EM4LP     CONTINUE LOOPING UNTIL WHATS -ITS ENTERS POINT
GETPT LDA OD        OUTPUT DIGITIZED POINT
      JSB PROUT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .3
      STA LNGTH 
      JSB INTEG 
      LDA .16 
      JSB GB2 
      JMP EML02,I 
* 
PROUT NOP           OUTPUT ASCII COMMAND IN THE A REGISTER
      JSB WRDST     STORE WORD IN IOBUF 
      JSB TRBYT 
      LDA .3
      LDB .2
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      JMP PROUT,I 
* 
*     ASCII COMMANDS
* 
OD    ASC 1,OD
OS    ASC 1,OS
DP    ASC 1,DP
* 
*     NUMBER OF PENS SIMULATED OR OTHERWISE 
* 
EMUL5 LDA .4        FOUR PENS 
      STA INTX1 
      LDA .16 
      JSB GB2 
      JMP EML02,I 
**
*     LABEL DIRECTION 
*     GICB = DEGREES- 9872 WANTS RUN,RISE 
* 
* 
EMUL7 LDA .3
      STA FXDN      SET UP FOR FLOAT TO ASCII CONVERSION
      LDA DI        ABSOLUTE DIRECTION
      JSB WRDST 
      LDA .16 
      JSB GB1       GO GET THETA
      DLD INTX2 
      DST INTX4     SAVE FOR RISE COMPUTATION 
      JSB COS      COMPUTE RUN
      NOP 
      DST INTX2 
      JSB CLGCK 
EML71 JSB GLIDE     CONVERT TO FLOATING POINT 
      LDA COMA
      JSB PTBYT 
      DLD INTX4 
      JSB SIN 
      NOP           COMPUTE RISE
      DST INTX2 
      JSB CLGCK 
EML72 JSB GLIDE 
      JSB TRBYT     INSERT TERMINATOR 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EML02,I 
      SPC 3 
* 
*     CLUGE BECAUSE OF PROBLEMS WITH 1.57 RADIANS (90 DEGREES)
* 
CLGCK NOP 
      JSB ABS 
      FSB SMALL 
      SSA,RSS 
      JMP CLGCK,I 
      DLD DBL0
      DST INTX2 
      JMP CLGCK,I 
* 
SMALL DEC .0009 
* 
*     CHARACTER SLANT 
* 
EMUL8 LDA .3
      STA FXDN      SET UP FOR 3 CHARACTER TO RIGHT OF .
      LDA SL        SLANT MNEMONIC
      JSB WRDST 
      LDA .16 
      JSB GB1       GET ANGLE 
      DLD INTX2 
      JSB TAN       COMPUTE TAN(THETA)
      NOP 
      DST INTX2 
      JSB GLIDE     FLOAT TO ASCII
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EML02,I 
* 
SL    ASC 1,SL
* 
*     CHARACTER SIZE
*     GICB = WIDTH/HEIGHT 
* 
EMUL9 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1 
      DLD INTX4     GET HEIGHT AND SAVE 
      DST TEMP
      LDA SI
      JSB WRDST 
      DLD INTX2     WIDTH 
      FDV CSIZW     MU/CM/MU
      DST INTX2 
      JSB GLIDE 
      LDA COMA
      JSB PTBYT 
      DLD TEMP
      FDV CSIZH 
      DST INTX2 
      JSB GLIDE 
      JSB TRBYT 
      LDB .2
      LDA NBYTE 
      JSB OUTPT 
      JMP EML02,I 
* 
CSIZW DEC 600.      MU/CM 
CSIZH DEC 800.
SI    ASC 1,SI
* 
*     LINE TYPES - GICB = LT#, <LENGTH> 
* 
EML10 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1       GET DATA FROM GCB 
      LDA LT        LINE TYPE COMMAND 
      JSB WRDST 
      LDA INTX2     LT = 0 FOR SOLID
      SZA,RSS 
      JMP FIN11 
      ADA LT0       GET LINE TYPE EQUIVALENCE FOR 9872
      LDA A,I 
      JSB PTBYT 
      LDA LNGTH     IS THERE A LENGTH SPECIFICATION 
      CPA .1
      JMP FIN12 
FIN10 LDA INTX2 
      CPA .5
      JMP FIN11 
      LDA INTX2 
      IOR .1
      ADA PCLT0 
      STA TEMP      ADDRESS OF PERCENT DIVIDER
      DLD INTX3 
      FDV TEMP,I
      DST INTX2 
      LDA COMA
      JSB PTBYT 
      JSB GLIDE     FLOAT TO ASCII
FIN11 JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EML02,I 
FIN12 LDA INTX2     IS LT = 1(DIM)
      CPA .1
      JMP *+2       YES 
      JMP FIN14 
      DLD D22 
      DST INTX3 
      JMP FIN10     CONTINUE
* 
FIN14 LDA COMA
      JSB PTBYT     SET DEFAULT LINE TYPE LENGTH BACK TO 4% 
      LDA ASC4
      JSB PTBYT 
      JMP FIN11 
* 
*     LINE TYPES AND PERCENT VALUES 
* 
LT    ASC 1,LT
DI    ASC 1,DI
LT0   DEF * 
LT1   OCT 61
LT2   OCT 62
LT3   OCT 63
LT4   OCT 65
LT5   OCT 60
LT6   OCT 66
* 
* 1% VALUES OF LINE TYPE LENGTHS
* 
PCLT0 DEF * 
PCLT1 DEC 45. 
      DEC 60. 
      DEC 135.
      DEC 180.
      BSS 2 
      DEC 180.
* 
ASC4  OCT 64
D22   DEC 22.5
      SPC 3 
*     GET DISPLAY SIZE IN MM
* 
EML11 LDA SIZMM     LENGTH
      LDB DF8 
      JSB GB
      JMP EML02,I 
* 
SIZMM DEF SZMM
* 
      SPC 3 
*     GET MACHINE UNIT/MM VALUES
* 
EML12 LDA DF40
      LDB DF4 
      JSB GB
      JMP EML02,I 
* 
* 
*     SET RELATIVE ORIGIN 
* 
EML13 LDA .16 
      JSB GB1 
      LDA .32       IOSAV 
      JSB GB2 
      JMP EML02,I 
*     DEVICE CLEARING CAPABILITY
* 
EML14 LDA DVCLR     NO CLEAR  
      LDB DF1 
      JSB GB
      JMP EML02,I 
* 
      SPC 2 
*     PHYSICAL PENS 
* 
EML15 LDA DF4 
      LDB DF1 
      JSB GB
      JMP EML02,I 
* 
      SPC 2 
* 
*     LORGABILITY - NONE
* 
EML16 JMP EML14 
      SPC 2 
* 
*     MAX. CHAR SLANT 
* 
EML17 LDA CHSLT 
      LDB DF4 
      JSB GB
      JMP EML02,I 
* 
      SPC 2 
* 
*     DEVICE HARD CLIPPING CAPABILITY 
* 
EML18 LDA DF1 
      LDB DF1 
      JSB GB
      JMP EML02,I 
DF40  DEF D40 
* 
      SPC 2 
* 
*     DEVICE ID 
* 
EML19 LDA IDCD
      LDB DF3 
      JSB GB
      JMP EML02,I 
* 
*     MIN/MAX CHARACTER SIZES 
* 
EML21 LDA DFCHR 
      LDB DF9 
      JSB GB
      JMP EML02,I 
* 
DFCHR DEF CHW 
DF9   DEF .9
.9    DEC 9 
* 
*     LABEL DIRECTION INFO. FOR DSTAT OR WHOEVER
* 
EML22 LDA LBLDR 
      LDB DF3 
      JSB GB
      JMP EML02,I 
* 
LBLDR DEF *+1 
      OCT 2 
DBL0  DEC 0.
* 
IDCD  DEF .987A 
.987A ASC 3,9872A 
* 
EML20 LDA DFL0
      LDB DF1 
      JSB GB
      JMP EML02,I 
* 
*     LORG RANGE
* 
EML23 LDA DFL0
      LDB DF2 
      JSB GB
      JMP EML02,I 
* 
DFL0  DEF DBL0
* 
* 
*     SET HARD CLIP LIMITS
* 
EML24 LDA .16 
      JSB GB1       GET LIMITS G1,G2
      LDA IP        SET SCALING POINTS P1,P2
      JSB WRDST 
      JSB FIN       OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      LDA IW        SET WINDOW
      JSB WRDST 
      JSB FIN 
      JMP EML02,I 
* 
IP    ASC 1,IP
IW    ASC 1,IW
* 
*     CHARACTER PLACEMENT 
* 
EML25 LDA ACINF 
      LDB DF8 
      JSB GB
      JMP EML02,I 
* 
*     CLEAR PAGE FEED ETC 
* 
EML26 CLA              CLEAR THE I/O COUNT
      STA NBYTE          BYTE COUNTER=0 
      LDA IOBUF        GET ADR OF I/O BUFFER
      STA ADCNT          AND STORE IT 
* 
*     SEND THE FOLLOWING COMMAND SEQ (PU IW PA15720,10380 PG) 
*     TO PICK UP PEN AND MOVE IT TO THE UPPER RIGHT HAND EDGE OF
*     THE PLOTTER, AND DO A PAGE FEED.
* 
      CLA              SET THE BYTE COUNT TO ZERO 
MTOP  STA MYCNT        SAVE CURRENT COUNT 
      LDA CMDAR        GET ADR OF STRING TO SEND
      ADA MYCNT        ADD OFFSET INTO STRING 
      LDA A,I          GET WORD OF DATA FROM STRING 
* 
      JSB WRDST        STORE IT IN THE IO BUFFER
* 
      LDA MYCNT        GET COUNT AND INC IT 
      ADA .1           MYCNT=MYCNT+1
      CPA .11          CK FOR 11 (END OF STRING)
      JMP MOUT           FOUND IT, ALL DONE 
      JMP MTOP           NOPE, KEEP ON LOOPING
* 
* 
MOUT  JSB TRBYT        STORE A TERMINATOR INTO I/O BUF
* 
      LDA NBYTE        GET NUMBER OF BYTES TO TRANSFER
      LDB .2           SET READ/WRITE CODE TO WRITE 
      JSB OUTPT        WRITE I/0 BUFFER TO DEVICE 
* 
*SINCE THE 9872A OR B WILL GIVE AN ERROR WITH THE PG COMMAND
*WE MUST SEND A OE (OUTPUT ERROR) COMMAND TO CLEAR THE POSSIBLE 
*ERROR STATE. 
* 
      CLA              CLEAR THE I/O COUNT
      STA NBYTE          BYTE COUNTER=0 
      LDA IOBUF        GET ADR OF I/O BUFFER
      STA ADCNT          AND STORE IT 
* 
      LDA OE           LOAD AND SEND OE COMMAND 
      JSB WRDST        STORE OP CODE IN I/O BUFFER
* 
      JSB TRBYT        STORE A TERMINATOR INTO I/O BUF
* 
      LDA NBYTE        GET NUMBER OF BYTES TO TRRANSFER 
      LDB .2           SET READ/WRITE CODE TO WRITE 
      JSB OUTPT        WRITE I/O BUFFER TO DEVICE 
* 
*NEXT WE READ BACK TO RESULT TO CLEAR THE BUS.
* 
      LDA .40          GET NUMBER OF BYTES TO TRANSFER
      LDB .1           SET READ/WRITE CODE TO READ
      JSB OUTPT        READ 40 BYTES FROM DEVICE
* 
*ALL DONE LETS RETURN 
* 
      JMP EML02,I 
* 
*     COMMAND STRING FOR CLEAR
* 
CMDAR DEF *+1          ADR OF START OF STRING 
      ASC 12,PU;IW;PA15720,10380;PG 
* 
* 
ACINF DEF CINFO 
* 
CINFO DEC 0.00000 
      DEC 0.66667 
      DEC 0.00000 
      DEC 0.50000 
      SPC 2 
      SKP 
GB    NOP 
      STA ADDR      ADDRESS OF DATA 
      STB NUM       NUMBER OF DATA ITEMS
      JSB GCBIM 
      DEF *+6 
GB16  DEF .16 
      DEF .1
ADDR  NOP 
NUM   NOP 
      DEF .2
      JMP GB,I
* 
*     STORE A WORD INTO THE IOBUF 
* 
WRDST NOP 
      STA ADCNT,I 
      ISZ ADCNT 
      ISZ NBYTE 
      ISZ NBYTE 
      JMP WRDST,I 
      SKP 
* 
* 
*     ERROR CHECKING
* 
ERRCK JSB EXEC
      DEF *+3 
      DEF .3
      DEF LUN 
* 
      LDA OE        CLEAR OUT ANY PENDING ERRORS
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
      LDA OI        OUTPUT IDENTIFICATION 
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
      LDA OE        OUTPUT ERROR
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .1
      STA LNGTH 
      JSB INTEG     CONVERT TO INTEGER
      LDA INTX1     BIT ONE BETTER BE SET 
      AND .1
      SZA              IS BIT 1 EQUAL TO 0? 
      JMP OKAY         IF SO THEN DEVICE MUST BE 9872A
* 
*NOTE THAT THE ABOVE TEST (OI COMMAND RESULTS IN ERROR) IS THE ONLY 
*KNOWN WAY TO IDENTIFY THE 9872A.  THE OI COMMAND WILL NOT RESULT 
*IN AN ERROR FOR THE 9872B/S SO THE RETURNED STRING IS CKED.
* 
*IS DEVICE 9872B/S ?
* 
      CLA              CLEAR I/O COUNT
      STA NBYTE          NBYTE=0
      LDA IOBUF        GET THE ADDR OF IO BUFFER
      STA ADCNT          AND STORE IT 
* 
      LDA OI           SEND THE OUTPUT IDENTIFICATION COMMAND 
      JSB WRDST        STORE INTO IO BUFFER 
      JSB TRBYT          TERMINATOR TO IO BUFFER
      LDA NBYTE        GET BYTE COUNT 
      LDB .2           SET R W FLAG TO WRITE
      JSB OUTPT        SEND COMMAND (OI)
* 
*NOW SET UP TO READ IN ID STRING
* 
      LDA .40          SET UP TO READ 40 BYTES
      LDB .1           SET R W FLAG TO READ 
      JSB OUTPT        READ DATA
* 
      LDA IOB          GET THE ADR OF IO BUFFER 
      STA BUFAD        GET THE FIRST 2 WORDS
      DLD BUFAD,I 
      CPA PART1        IS WORD 1 OF IO BUF AN ASCII 98
      JMP CHEK2             YES - CONTINUE DEVICE CK
      JMP ERR3              NO  - A GPS 3 ERROR HAS OCCURRED
CHEK2 CPB PART2        IS WORD 2 OF IO BUF AN ASCII 72
      JMP OKAY              YES - DEVICE ID OKAY, NO ERROR
ERR3  LDA .3                NO  - A GPS 3 ERROR HAS OCCURRED
      JMP EML02,I      RETURN TO DVG
OKAY  LDA .9872        GET DEVICE ID CODE INTEGER 
      JMP EML02,I      AND RETURN TO DVG
* 
OE    ASC 1,OE
PG    ASC 1,PG
OI    ASC 1,OI
.177  OCT 177 
.9872 DEC 9872
M7    DEC -7
PART1 ASC 1,98
PART2 ASC 1,72
BUFAD NOP 
      SPC 3 
* 
*     CONSTANTS AND TEMPORARY STORAGE 
* 
A     EQU 0 
B     EQU 1 
NBYTE NOP 
LUN   NOP 
IOBUF NOP 
IOBL  NOP 
FXDN  NOP 
FIRST NOP 
INTX1 NOP 
INTX2 NOP 
INTX3 NOP 
INTX4 NOP 
PORGX BSS 2 
PORGY BSS 2 
INTXX BSS 4 
RW    NOP 
IOCNT NOP 
TEMP  BSS 2 
MYCNT BSS 1 
*     DO NO CHANGE POSITION OF THESE CONSTANTS
.0    OCT 0 
.1    OCT 1 
.2    OCT 2 
.4    OCT 4 
.26   DEC 26
.16   DEC 16
.32   DEC 32
.40   DEC 40
.5    OCT 5 
INX   DEF INTX1 
.17   DEC 17
.21   DEC 21
.7    DEC 7 
.137  OCT 137 
TERM  NOP 
DF7   DEF .7
.600  OCT 6000
PR    ASC 1,PR
.11   DEC 11
SZMM  DEC 0.
      DEC 0.
.400  DEC 400.      MACHINE LENGTH IN MM
.285  DEC 285.      MACHINE HEIGHT IN MM
DF8   DEF .8
.8    DEC 8 
DVCLR DEF .0
CHSLT DEF .155
.155  DEC 1.56      89 DEGREES
      DEC -1.56 
COMA  OCT 54
GCBCD NOP 
DF4   DEF .4
DF1   DEF .1
DF3   DEF .3
DF2   DEF .2
ADCNT NOP 
IBYTE NOP 
LNTH  NOP 
SKPBK NOP 
.6    DEC 6 
OP    ASC 1,OP
D40   DEC 40.0
      DEC 40. 
      END 
                                                                                                                      