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:    DCT08 -- 7225A DEVICE COMMAND TABLE 
*      SOURCE:  92840-18094 
*      RELOC:   92840-16009 
* 
* 
************************************************************* 
* 
      NAM DCT08,7  92840-16009 REV.1913 790123
* 
      ENT DCT08 
* 
      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 7225A PLOTTER. 
* 
*     COMMAND LINK TABLE (CLTBL)
* 
************************************************************* 
* 
DCT08 NOP 
      DEF EML08 
      DEF RESET     01 - RESET PLOTTER
      DEF DEFLT     02 - DEFAULT P1,P2
      DEF CLEAR     03 - CLEAR SCREEN 
      NOP           04 - FLUSH BUFFER 
      DEF HOME      05 - HOME PEN 
      DEC -19       06 - DEVICE ID
      NOP           07 - CLOSE FILES,FLUSH BUFFER (2608A) 
      DEF PLTUN     08 - GET PLOT UNITS 
      OCT -1        09 - GET CHARACTER INFORMATION
      DEF PNLOC     10 - GET PEN LOCATION 
      DEF PNLOC     11 - CURSOR 
      DEC -4        12 - DIGITIZE 
      NOP           13 - LORG 
      DEC -7        14 - LDIR 
      DEC -8        15 - SLANT ON 
      DEF SLOFF     16 - SLANT OFF
      DEC -9        17 - CHARACTER SIZE 
      DEC -13       18 - SET RELATIVE ORIGIN
      NOP           19 - SET ANGLE
      NOP           20 - SET SCALING
      NOP           21 - SET ORIGIN = CURSOR
      NOP           22 - SET ORIGIN = PEN POSITION
      NOP           23 - DRAW TO CURSOR 
      NOP           24 - SELECT CHARACTER SET 
      NOP           25 - SELECT PEN  0 (RETURN TO HOLDER) 
      NOP           26 - ERASE PEN (PEN = -1) 
      NOP           27 - COMPLEMENT PEN (PEN = -2)
      DEC -10       28 - SELECT PEN (PEN = 1 --> N) 
      DEC -5        29 - GET NUMBER OF PENS 
      NOP           30 - DEFINE LINE TYPE 
      DEC -10       31 - LINE TYPE
      DEC -10       32 - LINE TYPE WITH LENGTH
      DEF PENUP     33 - PEN UP 
      DEF PENDN     34 - PEN DOWN 
      DEF PLTAB     35 - PLOT ABSOLUTE
      NOP           36 - PLOT RELOCATABLE 
      DEF PLTIN     37 - PLOT INCREMENTAL 
      DEF LGLAB     38 - SHORT LABEL
      DEF LGLAB     39 - LABEL MODE 
      DEF STPLB     40 - LABEL MODE TERMINATOR
      DEC -3        41 - FLOAT TO ASCII CONVERSION
      DEC -11       42 - DISPLAY SURFACE SIZE IN MM 
      NOP           43 - POSITION CURSOR ABSOLUTE 
      NOP           44 - POSITION CURSOR RELATIVE 
      DEC -24       45 - SET P1,P2
      DEC -12       46 - GET MU/MM
      DEC -14       47 - GET DEVICE CLEARING CHARACTERISTICS
      DEC -15       48 - NUMBER OF PHYSICALLY DIFFERENT PENS
      DEC -20       49 - NUMBER OF CURSORS
      DEC -16       50 - LORGABILITY
      DEC -17       51 - MAX. CHARACTER SLANT 
      DEC -18       52 - HARD CLIPPING CAPABILITY 
      DEC -25       53 - INQUIRE CHARACTER PLACEMENT
      DEC -21       54 - GET CHARACTER SIZE 
      DEC -22       55 - GET LABEL DIRECTION
      DEC -23       56 - GET LABEL ORIGIN RANGE 
      SKP 
************************************************************* 
* 
*     ASCII COMMAND STRINGS 
* 
*     FORMAT:  FIRST WORD = NUMBER OF BYTES (NEG = WRITE
*                                            POS = READ)
* 
*              SECOND WORD = TERMINATOR 
* 
*              NEXT N WORDS = DATA
* 
************************************************************* 
* 
RESET DEC -2        RESET (GIC 1) 
      DEF SEMCL     SEMICOLON 
      ASC 1,DF      DF = DEFAULT VALUES 
* 
DEFLT DEC -5        DEFAULT P1, P2 (GIC 2)
      DEF SEMCL     SEMICOLON 
      ASC 3,IP;IW   IP = INPUT P1 AND P2; IW = INPUT WINDOW 
* 
CLEAR DEC -18       CLEAR SCREEN (GIC 3)
      DEF SEMCL     SEMICOLON 
      ASC 9,PU;IW;PA10328,7479   PU=PNUP;IW=IPTWND;PA=PLTABS
* 
HOME  DEC -16       HOME PEN (GIC 5)
      DEF SEMCL     SEMICOLON 
      ASC 8,PU;PA10328,7479      PU=PEN UP; PA=PLOT ABSOLUTE
* 
PLTUN DEC 2         PLOT UNITS (GIC 8)
      DEF SEMCL     SEMICOLON 
      ASC 1,OP      OP = OUTPUT P1 AND P2 
* 
PNLOC DEC 2         PEN LOCATION (GIC 10,11)
      DEF SEMCL     SEMICOLON 
      ASC 1,OC      OC = OUTPUT CURSOR
      SKP 
PENDN DEC -2        PEN DOWN (GIC 34) 
      DEF SEMCL     SEMICOLON 
      ASC 1,PD      PD = PEN DOWN 
* 
PENUP DEC -2        PEN UP (GIC 33) 
      DEF SEMCL     SEMICOLON 
      ASC 1,PU      PU = PEN UP 
* 
PLTAB DEC -2        PLOT ABSOLUTE (GIC 35)
      DEF SEMCL     SEMICOLON 
PA    ASC 1,PA      PA = PLOT ABSOLUTE
* 
PLTIN DEC -2        PLOT INCREMENTAL (GIC 37) 
      DEF SEMCL     SEMICOLON 
      ASC 1,PR      PR = PLOT RELATIVE
* 
LGLAB DEC -2        LABEL MODE (GIC 38,39)
      DEF HT        HT = BACK ARROW 
LB    ASC 1,LB      LB = LABEL
* 
STPLB DEC -1        STOP LABEL (GIC 40) 
      DEF HT        HT = BACK ARROW 
      OCT 1400      DECIMAL 3 (ETX) 
* 
SLOFF DEC -2        SLANT OFF (GIC 16)
      DEF SEMCL     SEMICOLON 
      ASC 1,SL      SL = ABSOLUTE CHARACTER SLANT 
* 
SEMCL OCT 73        SEMICOLON 
HT    OCT 137       BACK ARROW
.3    OCT 3         ETX (DECIMAL 3) 
      SKP 
************************************************************* 
* 
*     UTILITY ROUTINES FOR EMULATORS
* 
************************************************************* 
* 
*     SETUP -- SET UP IOBUF ADDRESS, GET LUN AND DEVICE 
*              SUBROUTINE SAVE AREA IN GCB
*------------------------------------------------------------ 
* 
SETUP NOP 
      JSB GCBIM     RETRIEVE IOBUF ADDR, IOBL FROM THE GCB
      DEF CONT1 
      DEF .2        CODE IN IGTBL, FOR IOBUF,IOBL,AND LUN 
      DEF .3        TWO CODES, THREE WORDS
      DEF LUN       START AT BUFFER NAME = LU NUMBER
      DEF .0        DEFAULT LENGTH
      DEF .1        READ
CONT1 LDA IOBUF 
      JSB INDCK     PUT ABSOLUTE ADDR INTO A REGISTER 
      STA IOBUF 
      STA IOB       VARIABLE CTR FOR I/O BUFFER 
      STA ADCNT     INITIALIZE ADDRESS COUNTER
      STA INTIO 
      LDA SEMCL     TERMINATOR (SEMICOLON)
      STA TERM
      CLA 
      STA NBYTE     BYTE COUNTER
      STA IBYTE     TEMPORARY STORAGE FOR READ
RTSUP JMP SETUP,I 
* 
*------------------------------------------------------------ 
*     INTEG -- 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     ARE WE RETRIEVING PLOT UNITS? 
      CPA OP
      JMP FIXIT        YES
CONIN ISZ INTAD 
      ISZ LNTH
      JMP INTLP     CONTINUE
RTING JMP INTEG,I 
      SKP 
*------------------------------------------------------------ 
*     FIXIT 
*------------------------------------------------------------ 
* 
FIXIT LDA INTAD,I   CONVERT INTEGER TO FLOATING POINT 
      JSB FLOAT 
      DST INTAD,I 
      ISZ INTAD 
      ISZ LNTH
      JMP CONIN     CONTINUE
* 
*------------------------------------------------------------ 
*     GB2 -- TAKE VALUES PLACED IN INTX1(1) TO INTX1(LNGTH) 
*            AND TRANSFER THIS DATA TO GICB.
* 
*            ON ENTRY:  A = GCB CODE
*------------------------------------------------------------ 
* 
GB2   NOP 
      STA GCBCD     GCB POINTER 
      JSB GCBIM     TRANSFER DATA TO AGL
      DEF RTGB2 
      DEF GCBCD     GCB CODE (POINTER)
      DEF .1        LENGTH OF CODE
      DEF INTX1     BUFFER NAME 
      DEF LNGTH     BUFFER LENGTH 
      DEF .2        WRITE 
RTGB2 JMP GB2,I 
* 
*------------------------------------------------------------ 
*     GB1 -- RETRIEVE DATA FROM GICB AND PLACE IT IN INTX1(1) 
*            TO INTX1(LNTH) 
* 
*            ON ENTRY:  A = GCB CODE
*------------------------------------------------------------ 
* 
GB1   NOP 
      STA GCBCD     GCB POINTER 
      JSB GCBIM     RETRIEVE INTEGER VALUES FROM GCB
      DEF RTGB1 
      DEF GCBCD     GCB CODE (POINTER)
      DEF .1        LENGTH OF CODE
      DEF INTX1     BUFFER NAME 
      DEF LNTH      BUFFER LENGTH 
      DEF .1        READ
RTGB1 JMP GB1,I 
      SKP 
*------------------------------------------------------------ 
*     FINI:  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     LENGTH OF # ITEMS IN GIC
RTCON JSB TRBYT     INSERT TERMINATOR 
      LDA NBYTE     NUMBER OF BYTES TO BE SENT
      LDB .2        WRITE 
      JSB OUTPT     OUTPUT RESULT VIA EXEC CALL 
RTFIN JMP FIN,I 
* 
*------------------------------------------------------------ 
*     TRBYT -- INSERT TERMINATOR INTO THE I/O BUFFER
*------------------------------------------------------------ 
* 
TRBYT NOP           INSERT TERMINATOR INTO OUTPUT BUFFER
      LDA TERM      GET TERMINATOR CODE = SEMICOLON 
      JSB PTBYT     SEND IT TO OUTPUT BUFFER
RTTBT JMP TRBYT,I 
* 
*------------------------------------------------------------ 
*     PTBYT -- PUT A BYTE INTO THE I/O BUFFER 
* 
*              ON ENTRY:  A = BYTE TO BE SENT 
*------------------------------------------------------------ 
* 
PTBYT NOP 
      STA BITE
      JSB UPDTE     UPDATE ADDRESS COUNTER (ADCNT)
      JSB BYTE      PUT CURRENT BYTE INTO NEXT AVAILABLE
      DEF RTBYT        SPACE
      DEF NBYTE     NUMBER OF BYTES 
      DEF BITE      BYTE TO BE SENT 
      DEF ADCNT,I   I/O BUFFER
RTBYT ISZ NBYTE 
      JSB UPDTE 
RTPBT JMP PTBYT,I 
* 
BITE  NOP           PTBYT TEMPORARY 
      SKP 
*------------------------------------------------------------ 
*     UPDTE -- UPDATE BYTE COUNTER FOR I/O BUFFER 
*------------------------------------------------------------ 
* 
UPDTE NOP 
      LDA NBYTE     GET NUMBER OF BYTES 
      CLE,ERA       CLEAR E AND RIGHT SHIFT E, A ONE BIT
      ADA IOBUF     ADD TO I/O BUFFER ADDRESS 
      STA ADCNT     STORE IT AS AN ADDRESS COUNT
RTUDT JMP UPDTE,I 
* 
*------------------------------------------------------------ 
*     OUTPT -- INPUT/OUTPUT OF DATA (EXEC READ/WRITE CALLS) 
* 
*              ON ENTRY:  A = NUMBER OF BYTES TO BE SENT
*------------------------------------------------------------ 
* 
OUTPT NOP           I/O TRANSFER ROUTINE
      CMA,INA       CHANGE SIGN 
      STA IOCNT     BYTE COUNTER FOR OUTPUT 
      STB RW
      JSB REIO
      DEF RTOUT 
      DEF RW        READ/WRITE CODE 
      DEF LUN       CONTROL INFO (ICNWD = LU #) 
IOB   NOP           BUFFER LOCATION 
      DEF IOCNT     BUFFER LENGTH 
RTOUT JMP OUTPT,I 
* 
*------------------------------------------------------------ 
*     GB -- ON ENTRY:  A = ADDRESS OF DATA (CONSTANTS)
*                      B = ADDRESS OF NUMBER OF WORDS 
*------------------------------------------------------------ 
* 
GB    NOP           GRAPHICS BUFFER 
      STA ADDR      ADDRESS OF DATA 
      STB NUM       ADDRESS OF NUMBER OF DATA ITEMS 
      JSB GCBIM 
      DEF *+6 
GB16  DEF .16       GCB POINTER 
      DEF .1        LENGTH OF POINTER 
ADDR  NOP           BUFFER NAME 
NUM   NOP           BUFFER LENGTH 
      DEF .2        WRITE 
RTGB  JMP GB,I
      SKP 
*------------------------------------------------------------ 
*     WRDST -- STORE A WORD INTO THE I/O BUFFER 
* 
*              ON ENTRY:  A = COMMAND TO BE SENT
*------------------------------------------------------------ 
* 
WRDST NOP 
      STA ADCNT,I 
      ISZ ADCNT 
      ISZ NBYTE 
      ISZ NBYTE 
RTWST JMP WRDST,I 
      SKP 
************************************************************* 
* 
*     EMULATORS 
* 
************************************************************* 
* 
EML08 NOP 
      JSB SETUP     INITIALIZE INTERNAL VARIABLES 
      LDA GIC       GET GRAPHICS INTERPRETIVE CODE
      CPA .177      DO WE NEED TO PERFORM ERRCK?
      JMP ERRCK        YES
      LDA DCTAD     EMULATOR NUMBER (NEGATIVE)
      CMA,INA       CHANGE SIGN TO POSITIVE 
      STA B         STORE NUMBER IN B 
      LDA EM0       GET ADDRESS OF SUBROUTINE TABLE 
      JSB INDCK     GET RID OF INDIRECT BIT 
      ADA B         COMPUTE THE POINTER 
      LDB LNGTH     NUMBER OF ITEMS IN GIC
      INB           INCREMENT TO ACCOMODATE CONTROL WORD AND
      STB LNTH         STORE IT AS TOTAL LENGTH 
      LDA A,I       GET ABSOLUTE ADDRESS OF EMULATOR
      JMP A,I       JUMP TO EMULATOR TABLE
* 
EM0   DEF * 
      DEF EMUL1     GET CHARACTER INFORMATION 
      NOP 
      DEF EMUL3     FLOAT TO ASCII CONVERSION 
      DEF EMUL4     DIGITIZE
      DEF EMUL5     GET NUMBER OF PENS
      NOP 
      DEF EMUL7     LDIR
      DEF EMUL8     SLANT ON
      DEF EMUL9     CHARACTER SIZE
      DEF EML10     LINE TIME 
      DEF EML11     DISPLAY SURFACE SIZE IN MM
      DEF EML12     GET MU/MM 
      DEF EML13     SET RELATIVE ORIGIN 
      DEF EML14     GET DEVICE CLEARING CHARACTERISTICS 
      DEF EML15     NUMBER OF PHYSICALL DIFFERENT PENS
      DEF EML14     LORGABILITY 
      DEF EML17     MAX. CHARACTER SLANT
      DEF EML18     HARD CLIPPING CAPABILITY
      DEF EML19     DEVICE ID 
      DEF EML20     NUMBER OF CURSORS 
      DEF EML21     GET CHARACTER SIZE
      DEF EML22     GET LABEL DIRECTION 
      DEF EML23     GET LABEL ORIGIN RANGE
      DEF EML24     SET P1,P2 
      DEF EML25     CHARACTER PLACEMENT 
      SKP 
*------------------------------------------------------------ 
*     EMULATOR #1 (GIC 9) -- CHARACTER SPACING INFORMATION
*------------------------------------------------------------ 
* 
EMUL1 LDA .7
      JSB GB1       GET CURRENT CHARACTER SIZE
      LDA .16 
      JSB GB2 
      JMP EML08,I 
* 
*     DEFAULT VALUES = WIDTH * 1.5 * 400 MU/MM
*                      HEIGHT * 2. * 400 MU/MM
* 
CHRW  DEC 171.
CHRH  DEC 300.
CHW   DEC 2.4   .004 * 600
      DEC 4.0   .005 * 800
      DEC 10328.
      DEC 7479. 
      OCT 0 
D1.5  DEC 1.5 
D2.0  DEC 2.0 
* 
*------------------------------------------------------------ 
*     EMULATOR #3 (GIC 41) -- FLOAT TO ASCII CONVERSION 
*------------------------------------------------------------ 
* 
EMUL3 LDA .3        ETX 
      STA TERM
      LDA LB        LB = LABEL
      JSB WRDST 
      LDA .16 
      JSB GB1 
      JSB GLIDE 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EML08,I 
      SKP 
* 
*     GLIDE -- FLOAT TO ASCII CONVERSION
* 
GLIDE NOP 
      JSB FLTAS 
      DEF RTGLD 
      DEF INTX2     DATA TO BE CONVERTED
      DEF IOBUF,I   RESULT
      DEF NBYTE     NUMBER OF BYTES 
      DEF FXDN      FORMAT F7.N 
      DEF SKPBK 
RTGLD JMP GLIDE,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #4 (GIC 12) -- DIGITIZE
*------------------------------------------------------------ 
* 
EMUL4 LDA DP        DP = DIGITIZE POINT - TURN ON ENTER LIGHT 
      JSB PROUT 
EM4LP LDA OS        OS = OUTPUT STATUS
      JSB PROUT 
      LDA .40       NOW CHECK STATUS WORD BIT 2 TO SEE IF 
      LDB .1           POINT HAS BEEN ENTERED 
      JSB OUTPT 
      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 POINT IS DIGITIZED 
GETPT LDA OD        OD = OUTPUT DIGITIZED POINT 
      JSB PROUT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .3
      STA LNGTH 
      JSB INTEG 
      LDA .16 
      JSB GB2 
      JMP EML08,I 
      SKP 
* 
*     PROUT 
* 
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 
RTPOT JMP PROUT,I 
* 
OD    ASC 1,OD      OD = OUTPUT DIGITIZED POINT 
OS    ASC 1,OS      OS = OUTPUT STATUS
DP    ASC 1,DP      DP = DIGITIZE POINT 
* 
*------------------------------------------------------------ 
*     EMULATOR #5 (GIC 15) -- NUMBER OF PENS (SIMULATED OR
*                 OTHERWISE)
*------------------------------------------------------------ 
* 
EMUL5 LDA .6        SIMULATED PENS (LINE TYPES) 
      STA INTX1 
      LDA .16 
      JSB GB2 
      JMP EML08,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #7 (GIC 14) -- LABEL DIRECTION 
*------------------------------------------------------------ 
*                    GICB = DEGREES - 7225 WANTS RUN, RISE
* 
EMUL7 LDA .3
      STA FXDN      SET UP FOR FLOAT TO ASCII CONVERSION
      LDA DI        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 
      SKP 
      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 EML08,I 
* 
*     CLGCK -- 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 
* 
*------------------------------------------------------------ 
*     EMULATOR #8 (GIC 15) -- CHARACTER SLANT 
*------------------------------------------------------------ 
* 
EMUL8 LDA .3
      STA FXDN      SET UP FOR 3 CHARACTER TO RIGHT OF .
      LDA SL        SL = ABSOLUTE CHARACTER SLANT 
      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 EML08,I 
* 
SL    ASC 1,SL      SL = ABSOLUTE CHARACTER SLANT 
      SKP 
*------------------------------------------------------------ 
*     EMULATOR #9 (GIC 17) -- CHARACTER SIZE
*                 GICB = WIDTH/HEIGHT 
*------------------------------------------------------------ 
* 
EMUL9 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1 
      DLD INTX4     GET HEIGHT AND SAVE 
      DST TEMP
      LDA SI        SI = ABSOLUTE CHARACTER SIZE
      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 EML08,I 
* 
CSIZW DEC 600.      MU/CM 
CSIZH DEC 800.
SI    ASC 1,SI      SI = ABSOLUTE CHARACTER SIZE
      SKP 
* 
*------------------------------------------------------------ 
*     EMULATOR #10 (GIC 28,31,32) -- LINE TYPES - GICB = LT#, 
*------------------------------------------------------------ 
* 
EML10 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1       GET DATA FROM GCB 
      LDA LT        LT = LINE TYPE
      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 EML08,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 
      SKP 
* 
*     LINE TYPES AND PERCENT VALUES 
* 
LT    ASC 1,LT      LT = LINE TYPE
DI    ASC 1,DI      DI = ABSOLUTE DIRECTION 
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
* 
*------------------------------------------------------------ 
*     EMULATOR #11 (GIC 42)-- GET DISPLAY SIZE IN MM
*------------------------------------------------------------ 
* 
EML11 LDA SIZMM     LENGTH
      LDB DF8 
      JSB GB
      JMP EML08,I 
* 
SIZMM DEF SZMM
* 
*------------------------------------------------------------ 
*     EMULATOR #12 (GIC 46) -- GET MACHINE UNIT/MM VALUES 
*------------------------------------------------------------ 
* 
EML12 LDA DF40
      LDB DF4 
      JSB GB
      JMP EML08,I 
      SKP 
*------------------------------------------------------------ 
*     EMULATOR #13 (GIC 18) -- SET RELATIVE ORIGIN
*------------------------------------------------------------ 
* 
EML13 LDA .16 
      JSB GB1 
      LDA .32       IOSAV 
      JSB GB2 
      JMP EML08,I 
*------------------------------------------------------------ 
*     EMULATOR #14 (GIC 47) -- DEVICE CLEARING CAPABILITY 
*                  (GIC 50) -- LORGABILITY (NONE) 
*------------------------------------------------------------ 
* 
EML14 LDA DVCLR     NO CLEAR
      LDB DF1 
      JSB GB
      JMP EML08,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #15 (GIC 48) -- PHYSICAL PENS
*------------------------------------------------------------ 
* 
EML15 LDA DF1       ONE PEN 
      LDB DF1 
      JSB GB
      JMP EML08,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #17 (GIC 51) -- MAXIMUM CHARACTER SLANT
*------------------------------------------------------------ 
* 
EML17 LDA CHSLT 
      LDB DF4 
      JSB GB
      JMP EML08,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #18 (GIC 52) -- DEVICE HARD CLIPPING CAPABILITY
*------------------------------------------------------------ 
* 
EML18 LDA DF1 
      LDB DF1 
      JSB GB
      JMP EML08,I 
DF40  DEF D40 
* 
*------------------------------------------------------------ 
*     EMULATOR #19 (GIC 6) -- DEVICE ID 
*------------------------------------------------------------ 
* 
EML19 LDA IDCD
      LDB DF3 
      JSB GB
      JMP EML08,I 
      SKP 
*------------------------------------------------------------ 
*     EMULATOR #21 (GIC 54) -- MIN/MAX CHARACTER SIZES
*------------------------------------------------------------ 
* 
EML21 LDA DFCHR 
      LDB DF9 
      JSB GB
      JMP EML08,I 
* 
DFCHR DEF CHW 
DF9   DEF .9
.9    DEC 9 
*------------------------------------------------------------ 
*     EMULATOR #22 (GIC 55) -- LABEL DIRECTION INFORMATION
*                  FOR DSTAT OR WHOEVER 
*------------------------------------------------------------ 
* 
EML22 LDA LBLDR 
      LDB DF3 
      JSB GB
      JMP EML08,I 
* 
LBLDR DEF *+1 
      OCT 2 
DBL0  DEC 0.
* 
IDCD  DEF .725A     ID CODE (7225A) 
.725A ASC 3,7225A 
* 
*------------------------------------------------------------ 
*     EMULATOR #20 (GIC 49) -- SET SCALING
*------------------------------------------------------------ 
* 
EML20 LDA DFL0
      LDB DF1 
      JSB GB
      JMP EML08,I 
* 
*------------------------------------------------------------ 
*     EMULATOR #23 (GIC 56) -- LORG RANGE 
*------------------------------------------------------------ 
* 
EML23 LDA DFL0
      LDB DF2 
      JSB GB
      JMP EML08,I 
* 
DFL0  DEF DBL0
      SKP 
*------------------------------------------------------------ 
*     EMULATOR #24 (GIC 45) -- SET HARD CLIP LIMITS 
*------------------------------------------------------------ 
* 
EML24 LDA .16 
      JSB GB1       GET LIMITS G1,G2
      LDA IP        IP = INPUT P1 AND P2
      JSB WRDST 
      JSB FIN       OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      LDA IW        IW = INPUT WINDOW 
      JSB WRDST 
      JSB FIN 
      JMP EML08,I 
* 
IP    ASC 1,IP      IP = INPUT P1 AND P2
IW    ASC 1,IW      IW = INPUT WINDOW 
* 
*------------------------------------------------------------ 
*     EMULATOR #25 (GIC 53) -- INQUIRE CHARACTER PLACEMENT
*------------------------------------------------------------ 
* 
EML25 LDA ACINF 
      LDB DF8 
      JSB GB
      JMP EML08,I 
* 
ACINF DEF CINFO 
* 
CINFO DEC 0.00000 
      DEC 0.66667 
      DEC 0.00000 
      DEC 0.50000 
      SKP 
************************************************************* 
* 
*     ERROR CHECKING
* 
************************************************************* 
* 
ERRCK JSB EXEC
      DEF *+3 
      DEF .3
      DEF LUN 
* 
*     CLEAR ANY ERRORS THAT MAY BE AROUND WITH AN OE
* 
      LDA OE        OE = OUTPUT ERROR 
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2        WRITE 
      JSB OUTPT     SEND THE OE TO THE DEVICE 
      LDA .40 
      LDB .1        READ
      JSB OUTPT     READ BACK THE RESPONSE
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
* 
*     SEE IF DEVICE CHOKES ON AN OI -- IF SO ITS A 9872A
* 
      LDA OI        OI = OUTPUT IDENTIFICATION
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2        WRITE 
      JSB OUTPT     SEND THE OI TO THE DEVICE 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
*     CHECK TO SEE IF THE OI CAUSED AN ERROR
* 
      LDA OE        OE = OUTPUT ERROR 
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2        WRITE 
      JSB OUTPT     SEND THE OE TO THE DEVICE 
      LDA .40 
      LDB .1        READ
      JSB OUTPT     READ THE RESPONSE 
      LDA .1
      STA LNGTH 
      JSB INTEG     CONVERT TO INTEGER
      SKP 
      LDA INTX1     IF BIT ONE IS SET AN ERROR HAS OCCURED
      AND .1           (THAT MAKES IT A 9872A NOT A 7225A)
      SZA,RSS 
      JMP LAST1     DO ONE MORE OI -- THIS TIME TO GET THE DEVICE NAME
      LDA .3
      JMP EML08,I   WRONG DEVICE FOR SUBROUTINE -- RETURN 
* 
*     SEND DEVICE OI AND GET DEVICE NAME BACK 
* 
LAST1 CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      LDA OI        OI = OUTPUT IDENTIFICATION
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2        WRITE 
      JSB OUTPT     SEND THE OI TO THE DEVICE 
      LDA .40 
      LDB .1        READ
      JSB OUTPT     READ BACK RESPONSE
* 
*     NOW CHECK TO SEE IF WE HAVE A 7225A 
* 
      LDA IOB 
      STA BUFAD 
      DLD BUFAD,I 
      CPA PART1 
      JMP CHEK2 
      JMP ERR3
CHEK2 CPB PART2 
      JMP OKAY
ERR3  LDA .3
      JMP EML08,I 
OKAY  LDA .7225 
      JMP EML08,I 
* 
* 
PART1 ASC 1,72
PART2 ASC 1,25
* 
OE    ASC 1,OE      OE = OUTPUT ERROR 
OI    ASC 1,OI      OI = OUTPUT IDENTIFICATION
.177  OCT 177 
.7225 DEC 7225
M7    DEC -7
      SKP 
************************************************************* 
* 
*     CONSTANTS AND TEMPORARY STORAGE 
* 
************************************************************* 
A     EQU 0         A REGISTER
B     EQU 1         B REGISTER
* 
NBYTE NOP           # OF BYTES TO BE STORED IN I/O BUFFER 
LUN   NOP           LU NUMBER 
IOBUF NOP           I/O BUFFER ADDRESS
IOBL  NOP           I/O BUFFER LENGTH 
FXDN  NOP           FORMAT F7.N  WHERE N = FXDN 
FIRST NOP 
INTX1 NOP           GCB INTERFACE TEMPORARIES 
INTX2 NOP 
INTX3 NOP 
INTX4 NOP 
PORGX BSS 2 
PORGY BSS 2 
INTXX BSS 4 
RW    NOP           READ/WRITE CODE 
IOCNT NOP           I/O COUNT 
TEMP  BSS 2 
BUFAD NOP           TEMPORARY FOR IOB ADDRESS 
* 
*     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           TERMINATOR
DF7   DEF .7
.600  OCT 6000
PR    ASC 1,PR
      SKP 
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        COMMA 
GCBCD NOP           GRAPHICS CONTROL BLOCK CODE 
DF4   DEF .4
DF1   DEF .1
DF3   DEF .3
DF2   DEF .2
ADCNT NOP           ADDRESS COUNT 
IBYTE NOP           SETUP TEMPORARY 
LNTH  NOP 
SKPBK NOP 
.6    DEC 6 
OP    ASC 1,OP
D40   DEC 40.0
      DEC 40. 
      END 
                                                                                                                