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: ABSAD (PART 1 GRAPHICS LINKAGE MODULE) 
*      SOURCE:  92840 - 18081 
*      RELOC:  92840 - 16002
* 
* 
* 
************************************************************* 
* 
      NAM ABSAD,7  92840-16002 REV.2013 790904
      EXT .ENTR,PLTER,FLOAT,IFIX
      EXT .FLUN,..FCM,.IENT,BYTE
      EXT .PLTR,DPTR,GCBIM
      EXT ABS 
      ENT ABSAD 
      ENT DCTIM,EMULX,LNGTH,GIC,DCTAD 
      ENT GSWCH,DCTXX,INDCK                                             EM1913
      ENT .OPTN,INTX,FLTAS,GETID,GTNAM
      ENT GRIFX 
* 
*     THIS IS THE ABSOLUTE ADDRESS ROUTINE FOR THE GRAPHICS 
*  ITS RESPONSIBILITY IS TO SAVE THE FIRST WORD ADDRESS 
*  OF THE GRAPHICS CONTROL BLOCK (GCB), AND TO TRANSMIT 
*  DATA TO AND FROM THE GCB.  THIS ROUTINE IS ALSO CAPABLE
*  OF TRANSFERRING DATA TO AND FROM OTHER BUFFERS WHOSE 
*  ABSOLUTE ADDRESSES RESIDE IN THE GCB (E.G. IOBUF). 
* 
*     CALLING SEQUENCE: 
*       CALL ABSAD(IPTR,IRW,IBUFR,IBLNT,IND)
* 
*     WHERE: IPTR = 0 SAVE FWA OF GCB 
*                 >0   POINTER INTO BUFFER OF INTEREST
*       IRW = 1(READ),2(WRITE)
*       IBUFR = ADDRESS OF MSTERY BUFFER
*       IBLNT = IBUFR LENGTH
* 
*     IND = ERROR INDICATOR 
* 
********************************************************* 
      SKP 
      SPC 3 
IPTR  NOP 
IRW   NOP 
IBUFR NOP 
IBLNT NOP 
IND   NOP 
ABSAD NOP 
      JSB .ENTR 
      DEF IPTR
      LDA IPTR,I    POINTER INTO BUFFER 
      SZA,RSS       =  0? 
      JMP INIT      YES THEN GO INITIALIZE FWABF
      CPA M99 
      JMP CLR       CLEAR GCB, PLOTR(0) CALL MAYBE
      CPA .99 
      JMP CHK 
TRGCB LDA FWABF     GCB FWA 
XFER  ADA IPTR,I    COMPUTE FWA(BUFFER) + IPTR - 1
      ADA M1
      LDB IRW,I 
      CPB .1        READ? 
      JMP READ
      STA TO        WRITE 
      LDA IBUFR 
      STA FROM
      JMP XFER1 
READ  STA FROM
      LDA IBUFR 
      STA TO
XFER1 LDA IBLNT,I 
      CMA,INA 
      STA ABCTR 
* 
*     NOW TRANSFER DATA FROM > TO 
* 
XLOP  LDA FROM,I
      STA TO,I
      ISZ TO
      ISZ FROM
      ISZ ABCTR 
      JMP XLOP
      JMP ABSAD,I   ALL DONE
* 
*     INITIALIZE FWABF
* 
INIT  LDA IBUFR 
      STA FWABF 
INIT1 LDA M99       SAVE -99 INTO FWA OF GCB
      STA IBUFR,I 
      JMP ABSAD,I 
* 
      SPC 3 
CLR   LDA FWABF 
      SZA,RSS 
      JMP ERR 
      CLA 
      STA IBUFR,I 
      STA FWABF 
      JMP ABSAD,I 
* 
*     CHECK TO MAKE SURE THAT BUFFER HAS BEEN INITIALIZED AND 
*   SAVE CURRENT ADDRESS OF GCB.
* 
CHK   LDA IBUFR,I 
      CPA M99 
      JMP CKON      OK
      JMP ERR       SOMETHING WRONG 
CKON  LDA IBUFR     SAVE ADDRESS
      STA FWABF 
      JSB INDCK 
      STA B 
      ADA .7        STATUS WORD 
      LDA A,I 
      AND .1000     I/O BUFFERING FLAG
      SZA 
      JMP AXIT
      LDA B 
      ADA GCIO      REINITIALIZE I/O BUFFERING POINTER
      ADB .5
      STA B,I 
AXIT  JMP ABSAD,I 
* 
ERR   LDA IBUFR 
      STA FWABF 
      JSB PLTER 
      DEF RTN 
      DEF .199
      DEF .100
RTN   LDA M99 
      STA IND,I 
      JMP ABSAD,I 
      JMP ABSAD,I 
      SKP 
      SPC 3 
* 
*     GRAPHICS INTEGERIZING ROUTINE 
* 
NUMBR NOP 
GRIFX NOP 
      JSB .ENTR 
      DEF NUMBR 
      DLD NUMBR,I 
      JSB ABS 
      DST ASAV
      JSB IFIX      INTEGERIZE
      NOP 
      STA ATEMP 
      JSB FLOAT     FLOAT IT
      DST SUBT
      DLD ASAV
      FSB SUBT      NUMBER - FLOATED INTEGER
      FMP .10E1     FRACTIONAL VALUE * 10.
      DST SUBT
      DLD D5
      FSB SUBT      5 - FRACTION * 10.
      SSA           > 5 
      ISZ ATEMP 
      SZA,RSS       =5
      ISZ ATEMP 
      DLD NUMBR,I   SEE IF NUMBER IS POSITIVE OR NEGATIVE 
      SSA,RSS       <0
      JMP GREND 
      LDA ATEMP 
      CMA,INA 
      JMP GRIFX,I 
GREND LDA ATEMP 
      JMP GRIFX,I 
      SKP 
      SPC 3 
*CONSTANTS AND TEMPORARY STORAGE
* 
FWABF NOP 
TO    NOP 
ASAV  BSS 2 
FROM  NOP 
ABCTR NOP 
GCIO  DEC 103 
.1000 OCT 1000
.5    OCT 5 
.99   DEC 99
M99   DEC -99 
.100  DEC 100 
* 
ATEMP  NOP
D5    DEC 5.
.199  DEC 199 
      SKP 
* 
* 
*     THIS MODULE IS PART OF THE INTERFACE BETWEEN USER 
*  PROGRAMS AND THE AGL GRAPHICS PACKAGE.  THIS PORTION 
*  OF THE INTERFACE PROCESSES THE PARAMETER STRINGS BY
*  CHECKING FOR THE PRESENCE OF THE LEGAL NUMBER OF PARAMETERS
*  AND THE SETTING UP OF DEFAULT VALUES.
* 
.OPTN NOP 
      STA RETRN     ADDRESS OF P+1
      CLA 
      STA MESS
      LDA PADR
      JSB INDCK 
      STA PAD 
      STA B 
      LDA .PCNT 
      JSB CLEAR 
      LDA .OPTN     P+1 RETURN ADDRESS
      JSB INDCK 
      STA B 
      LDA B,I 
      STA .OPTN     ADDRESS OF RETURN POINT 
      INB           ADDRESS OF PARAMETER BUFFER 
      LDA B,I 
      JSB INDCK 
      STA TFBF      FWA OF PARM BUFFER
      INB 
      STB SAVB
      LDA B,I 
      LDA A,I       # OF WORDS IN PARM BUFFER 
      LDB TFBF
      JSB CLEAR 
      ISZ SAVB
      LDA SAVB,I
      STA TFBF,I    CODE FOR AGL ROUTINE TO DETERMINE THE APPROPRIATE 
      ISZ TFBF
      JMP ENTER 
PARMS BSS 10        BUFFER WHICH WILL CONTAIN PARAMETER ADDRESSES 
RETRN NOP           RETURN ADDRESS TO CALLING ROUTINE 
ENTER JSB .ENTR     GET ADDRESES FROM UP YONDER 
PADR  DEF PARMS 
      LDA .OPTN     COMPUTE ADDRESS OF STORAGE FOR RETURN POINT 
      JSB INDCK 
      ADA M1
      LDA A,I 
      STA RTNAD 
      ISZ SAVB      BUMP TO P+3 (#OF PARAMETERS - #DEFAULTS)
      LDA SAVB,I
      LDA A,I 
      LDB PAD 
      SZA,RSS    ARE THERE ANY PARAMETERS THAT ARE REQ'D
      JMP DF     NO 
      CMA,INA 
      STA CNTR
* 
*     NOW CHECK FOR MISSING GCB PARAMETER 
* 
      LDA .PLTR     SEE IF PLOTR CALL 
      SZA 
      JMP PLOOP 
      LDA PARMS,I   FW OF GCB 
      CPA M99 
      JMP PLOOP 
      JSB PLTER     MISSING GCB WARN PLTER TO GET READY FOR ERROR 99
      DEF RTNER 
      DEF .6
      DEF .PCNT 
RTNER JMP MESUP 
* 
*     NOW CHECK FOR THE EXISTENCE OF PARAMETERS THAT SHOULD BE
*  THERE. 
* 
PLOOP LDA B,I       B POINTS TO PARM BUFFER (DEFAULTS)
      SZA,RSS       IS THERE A PARAMETER THERE? 
      JMP MESUP     NO THEN AN ERROR - REPORT IT. 
      STA TFBF,I
      ISZ TFBF
      INB           BUMP TO NEXT PARAMETER ADDRESS
      ISZ CNTR
      JMP PLOOP     CONTINUE
DF    ISZ SAVB      NOW CHECK OUT EXISTENCE OF DEFAULTS 
      LDA SAVB,I    SHOULD THERE BE ANY ANYHOW? 
      LDA A,I 
      SZA,RSS 
      JMP EXIT      NO -THEN EXIT STAGE LEFT
      CMA,INA 
      STA CNTR      GET #OF DEFAULTS COMPLEMENT AND SET IN COUNTER
      ISZ SAVB      BUMP TO TOL FOR DEFAULTS
      LDA SAVB,I
      STA SAVB      SAVE ADDRESS FOR TOL
DLOOP LDA B,I 
      SZA           DID THE PERSON ABOVE SUPPLY A DEFAUL PARAM? 
      JMP SKPDF     YES 
SETDF LDA SAVB,I    DEFAULT VALUE ADDRESS 
      STA TFBF,I    SET DEFAULT ADDRESSES INTO TFPRM BUFFER 
      ISZ TFBF
      ISZ SAVB
      ISZ CNTR
      JMP SETDF 
      JMP EXIT      ALL DONE
SKPDF ISZ SAVB
      STA TFBF,I
      ISZ TFBF
      INB           BUMP POINTER TO USER PARAMETERS 
      ISZ CNTR
      JMP DLOOP 
EXIT  LDA RETRN 
      STA RTNAD,I 
      LDA CNTR
      LDB MESS      ERROR?
      SZB,RSS 
      ISZ .OPTN 
      JMP .OPTN,I 
* 
* 
* 
      SPC 3 
CLEAR NOP 
      STA CNTR
      CLA 
ENDLP STA B,I 
      INB 
      ISZ CNTR
      JMP ENDLP 
      JMP CLEAR,I 
      SPC 3 
MESUP ISZ MESS      P+1 RETURN ERROR
      JMP EXIT
* 
*     POSSIBLE GOOD GCB - NOW CHECK OUT IF THERE ARE HARD ERRORS
*  OTHER THAN TYPE 6 ERROR. 
* 
CKOUT STB TEMP
      JSB PLTER 
      DEF CKRTN 
      DEF M98       RETRIEVE ERROR
      DEF IERR
CKRTN LDA IERR
      CPA .6        TYPE 6? 
      JMP *+2       SOME WORK TO DO 
      JMP CKEXT 
      JSB PLTER 
      DEF CKRT2 
      DEF M99       CLEAR ERRORS
      DEF IERR
CKRT2 LDB PARMS 
      INB 
      LDA IERR
      STA B,I       MAY CRASH IF USER REALLY BLEW IT
CKEXT LDB TEMP
      JMP PLOOP 
      SKP 
      SPC 3 
* 
*     PARAMETERS AND CONSTANTS
* 
B     EQU 1 
SAVB  NOP 
.PCNT DEC -10 
ADCNT NOP 
TFBF  NOP 
RTNAD NOP 
MESS  NOP 
M98   DEC -98 
PAD   NOP 
IERR  NOP 
* 
      SKP 
*     THIS IS THE MODULE USED TO CONNECT THE AGL FUNCTIONAL MODULE
*  TO THE CORRECT DEVICE SUBROUTINE.
*     IF FOR SOME REASON THE USER DID NOT FORMAT THE DUMMY TABLE (DTBL) 
*  CORRECTLY OR THAT HE IS USING THE WRONG DEVICE ID, THEN AN ERROR 
*  MESSAGE IS EMITTED.
* 
*     GET DEVICE ID NUMBER. 
* 
IDCK  NOP 
GSWCH NOP                                                               EM1913
      JSB .ENTR 
      DEF IDCK
      LDA IDCK,I
      SZA 
      JMP RTG0      JUST CHECK OUT ID 
      JSB GCBIM 
      DEF RTG 
      DEF .3        CODES FOR LUN AND ID. 
      DEF .1        ONE VALUES
      DEF ID
      DEF .0
      DEF .1
* 
      SPC 3 
* 
*     GET THE DEVICE SUBROUTINE ADDRESS FROM THE DEVICE COMMAND TABLE.
* 
* 
RTG   LDA DP,I      DUMMY TABLE POINTER 
      SSA           SEE IF DUMMY PUT NEGATIVE NUMBER
      JMP ERROR 
      CLE,ERA       #WORDS/2
      LDB ID
      CMB,INB 
      ADB A         ID # > # ENTRIES IN TABLE 
      SSB           IF POSITIVE EVERYTHING OK 
      JMP ERROR 
* 
*     NOW COMPUTE ADDRESS FOR DEVICE SUBROUTINE AND DEVICE COMMAND
*  TABLE
* 
      LDA ID
      ADA M1        (ID # -1) > A 
      ALS           A*2 > A 
      STA ID
      LDA DP
      JSB INDCK     INDIRECT CHECK
      ADA .1
      ADA ID        ADDR(D.S) = ADDR(DPTR) + (ID-1)/2 
      LDB A,I       DEVICE SUBROUTINE ADDRESS 
      SZB,RSS       SEE IF ZERO 
      JMP ERROR 
      STB DVGXX     SAVE IT 
      INA 
      LDA A,I       DEVICE COMMAND TABLE ADDRESS
      SZA,RSS       SEE IF ZERO 
      JMP ERROR 
      JSB INDCK 
      STA DCTXX 
      LDA IDCK,I
      SZA,RSS 
      JSB DVGXX,I 
SWEXT JMP GSWCH,I                                                       EM1913
* 
* 
* 
ERROR JSB PLTER 
      DEF *+2 
      DEF .2
      JMP GSWCH,I                                                       EM1913
* 
RTG0  STA ID
      JMP RTG 
* 
* 
      SPC 3 
INDCK NOP 
      RSS 
      LDA 0,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      JMP INDCK,I 
* 
* INDIRECT CHECK USING REGISTER B 
INDCB NOP                                                               CL1901
      RSS                                                               CL1901
      LDB 1,I                                                           CL1901
      RBL,CLE,SLB,ERB                                                   CL1901
      JMP *-2                                                           CL1901
      JMP INDCB,I                                                       CL1901
* 
* DO NOT CHANGE POSITION OF CONSTANTS 
* 
.0    OCT 0 
.1    OCT 1 
.2    OCT 2 
.3    OCT 3 
.4    OCT 4 
.6    OCT 6 
.19   DEC 19
A     EQU 0 
ID    NOP 
DCTXX NOP 
DP    DEF DPTR
DVGXX NOP 
      OCT 3 
      SKP 
*     THIS ROUTINE IS RESPONSIBLE FOR RETRIVING AND SAVING CERTAIN
*  INFORMATION NEEDED BY THE DEVICE SUBROUTINES. NAMELY:
* 
*     GIC = GRAPHIC INTERPRETIVE CODE 
*     LNGTH = LENGTH OF GICB -1 
*     DCTAD = POINTER TO LOCATION IN COMMAND LINK TABLE (CLTBL(GIC))
* 
* 
DCTIM NOP 
      JSB GCBIM     GET GIC AND LENGTH
      DEF RTND
      DEF .16       GICB CODE 
      DEF .1        ONE CODE
      DEF GICBL     WHERE TO PUT IT 
      DEF .1
      DEF .1        READ
RTND  LDA GICBL 
      AND LOBIT     MASK OFF BITS 0-7 
      STA LNGTH 
      LDA GICBL 
      AND UPBIT     BITS 8-15 
      ALF,ALF 
      STA GIC 
      LDA DCT 
      JSB INDCK     INDIRECT ADDRESS CHECK
      LDB A,I 
* 
* 
      INB           EMULATOR ADDRESS
      LDA B,I 
      STA EMULX 
      LDA GIC 
      CPA .177
      JMP DCTIM,I 
      ADB GIC       COMPUTE CLTBL(GIC)
      LDA B,I 
      STA DCTAD 
      JMP DCTIM,I 
* 
* 
DCT   DEF DCTXX 
.16   DEC 16
GICBL NOP 
UPBIT OCT 177400
LOBIT OCT 377 
LNGTH NOP 
GIC   NOP 
DCTAD NOP 
EMULX NOP 
.177  OCT 177 
* 
      SKP 
*     THIS ROUTINE IS RESPONSIBLE FOR RETRIEVING THE NAME OF THE
*  PROGRAM THAT HAS COMMITED A HARD ERROR.
* 
BUFG  NOP 
JL    NOP 
GETID NOP 
      JSB .ENTR 
      DEF BUFG
      LDA BUFG      SET UP ADDRESS COUNTER
      STA AGCTR 
      LDA M3        WORD COUNTER
      STA IDCNT 
      LDB XEQT      ADDRESS OF ID SEGMENT FOR PROGRAM 
      ADB IDNAM 
GOOP  XLA B,I 
      STA AGCTR,I 
      INB 
      ISZ AGCTR 
      ISZ JL,I
      ISZ IDCNT 
      JMP GOOP
      ADB M1
      LDA B,I 
      AND .1740 
      IOR .40 
      LDB AGCTR 
      ADB M1        PUT LAST CHARACTER INTO BUFFER WITH BLANK 
      STA B,I 
      ISZ JL,I
      JMP GETID,I 
* 
XEQT  EQU 1717B 
.1740 OCT 17400 
.40   OCT 40
AGCTR NOP 
M3    OCT -3
IDNAM DEC 12
IDCNT NOP 
* 
      SKP 
* 
*     THIS ROUTINE IS RESPONSIBLE FOR RETRIEVING THE NAME OF AN 
*  AGL COMMAND IN WHICH A MISSING PARAMETER ERROR WAS 
*  DETECTED.
* 
*     THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING 
*  MEANINGS:
*     ICD = ERROR CODE ASSOCIATED WITH THE COMMAND
*     MSBUF = BUFFER IN WHICH THE ASCII CHARACTERS FOR THE
*             COMMAND WILL BE PLACED. 
*     JJ = WORD COUNTER (INCREMENTED FOR EACH WORD PLACED IN BUFFER). 
* 
      SPC 3 
ICD   NOP 
MSBUF NOP 
JJ    NOP 
GTNAM NOP 
      JSB .ENTR 
      DEF ICD       GET PARAMETER ADDRESSES 
      LDA ICD,I 
      ADA M40       COMPUTE (ICD -40) -->A
      STA SAVE
      ALS           A * 2 --> A 
      ADA SAVE       SAVE + A -->A
      STA SAVE
      LDA TOP       TOP OF LIST FOR AGL COMMAND NAMES 
      JSB INDCK     INDIRECT ADDRESS CHECK
      ADA SAVE
      STA SAVE      POINTER TO CORRECT STRING 
      LDA MSBUF     SET UP ADDRESS COUNTER
      STA AGCTR 
      LDA M3
      STA IDCNT 
NAMLP LDA SAVE,I
      STA AGCTR,I 
      ISZ JJ,I
      ISZ AGCTR 
      ISZ SAVE
      ISZ IDCNT 
      JMP NAMLP 
      JMP GTNAM,I 
* 
      SPC 2 
SAVE  NOP 
M40   DEC -40 
      SKP 
* 
*     ASCII STRINGS 
* 
TOP   DEF *+1 
N40   ASC 3,PLOTR 
N41   ASC 3,MARGIN
N42   ASC 3,VIEWP 
N43   ASC 3,LIMIT 
N44   ASC 3,WINDW 
N45   ASC 3,GCLR
N46   ASC 3,CLIP
N47   ASC 3,PLOT
N48   ASC 3,RPLOT 
N49   ASC 3,IPLOT 
N50   ASC 3,CSIZE 
N51   ASC 3,CPLOT 
N52   ASC 3,POINT 
N53   ASC 3,CURSOR
N54   ASC 3,DIGTZ 
N55   ASC 3,WHERE 
N56   ASC 3,DSIZE 
N57   ASC 3,HDERR 
N58   ASC 3,LDIR
N59   ASC 3,PDIR
N60   ASC 3,
N61   ASC 3,LGERR 
N62   ASC 3,LAXES 
N63   ASC 3,LGRID 
N64   ASC 3,PEN 
N65   ASC 3,LINE
N66   ASC 3,LABEL 
N67   ASC 3,GPON
N68   ASC 3,SETAR 
N69   ASC 3,DRAW
N70   ASC 3,MOVE
N71   ASC 3,DRAWI 
N72   ASC 3,MOVEI 
N73   ASC 3,DRAWR 
N74   ASC 3,MOVER 
N75   ASC 3,MSCAL 
N76   ASC 3,CLPON 
N77   ASC 3,CLPOF 
N78   ASC 3,SHOW
N79   ASC 3,LORG
N80   ASC 3,FXD 
N81   ASC 3,PENUP 
N82   ASC 3,PENDN 
N83   ASC 3,PORG
N84   ASC 3,XMIT
N85   ASC 3,GDSTT                                                       EM1913
N86   ASC 3,GSTAT 
N87   ASC 3,GPMM
N88   ASC 3,FRAME 
N89   ASC 3,SETUU 
N90   ASC 3,SETGU 
N91   ASC 3,IGERR 
N92   ASC 3,PICSV                                                       EM1901
N93   ASC 3,PICRP                                                       EM1901
N94   ASC 3,PICAD                                                       EM1901
N95   ASC 3,GFONT                                                       SY2013
N96   ASC 3,GTEXT                                                       SY2013
N97   ASC 3,GLEN                                                        SY2013
* 
*     INDIRECT CHECK
* 
      SKP 
* 
*     THIS ROUTINE TAKES AN ASCII STRING IN THE FOLLOWING FORMAT
* 
*     STRING (OCTAL ASCII VALUE)      ACTUAL VALUE
*           26461                          -1 
*           30464                          14 
*           20040                        SPACE,SPACE
* 
* AND STRIPS OFF THE ASCII FORMAT AND PLACES THE SIGN AND NUMERIC 
* IN THE FOLLOWING FORMAT:
* QUANTITIES INTO A BUFFER IN THE FOLLOWING FORMAT. 
* 
*   OUTPT WORD 1 = 4
*              2 = 1
*              3 = 1
*              4 = 55 = ASCII MINUS 
* 
* 
*      A BYTE COUNTER IS   INCREMENTED AND IS UPDATED EACH TIME 
*   THIS ROUTINE IS CALLED. IF IN THE ABOVE EXAMPLE BYTE = 4
*   UPON ENTERRING ROUTINE, UPON EXIT THE VALUE WOULD BE 8. 
* 
*     THE DATA IN THE BUFFER SHOWN IS TAKEN AND CONVERTED TO OCTAL INTEGER
* USING THE FOLLOWING ALGORITHM:
* 
*     INT = SUM((12BASE8)*I*IBUF(I+1), WHERE I = 0-4 AND IBUF IS THE BUFFER 
*  DEFINED ABOVE.  THE EXAMPLE ABOVE WOULD LOOK LIKE: 
* 
*   1 *(4) + 12 * (1) + 144 * (1) = 162BASE 8 = VALUE 
* 
*     CALLING SEQUENCE: 
* 
*       CALL INTX(INPUT,VALUE,BYTE) 
* 
*     WHERE:   INPUT = ASCII INPUT BUFFER 
*              VALUE = INTEGER VALUE RETURNED 
*              BYTE = BYTE COUNTER
* 
* 
****************************************************************
* 
      SKP 
      SPC 3 
INPUT NOP 
VALUE NOP 
BITE  NOP 
INTX  NOP 
      JSB .ENTR 
      DEF INPUT 
      CLA 
      STA SGNFL 
      STA NUMF
      LDA BITE,I    UPDATE POINTER INTO INPUT BUFFER
      CLE,ERA 
      ADA INPUT 
      STA INP 
      LDB ADEND     ADDRESS OF END OF BUFFER WHERE DATA IS TO GO
MLOOP ADB N1
      LDA BITE,I    SEE IF THIS IS A RIGHT OR LEFT BITE 
      SLA,RSS 
      JMP EVEN      LEFT  BITE
      LDA INP,I 
      AND LOMSK     MASK OFF BITS 0-7 
      ISZ INP 
      JMP CKLOP     CHECK IT OUT
EVEN  LDA INP,I 
      AND UPMSK     MASK OFF BITS 8-15
      ALF,ALF       SHIFT TO BITS 0-7 
CKLOP CPA PLUS      PLUS SIGN?
      JMP STFLG     GO SET SIGN FLAG
      CPA MINUS     - SIGN
      JMP STFLG     DO SAME 
      ADA M60       GET RID OF ASCII
      STA TEMP
      SZA,RSS       MUST BE A NUMBER OR SOME OTHER ASCII CHARACTER
      JMP CONT      A NUMBER
      SSA           A<0?
      JMP CKNUM     YES 
      CMA,INA 
      ADA .11 
      SSA 
      JMP CKNUM     NOT A NUMBER
CONT  LDA SGNFL     SEE IF SIGN FLAG HAS BEEN SET 
      SZA,RSS 
      JMP PTSGN     GO INSERT SIGN THEN DIGIT 
      ISZ NUMF      LEGITIMATE NUMBER 
      LDA NUMF
      CPA .6        MAKE SURE WE HAVEN'T GONE PAST 5 DIGITS 
      JMP CONVT 
      LDA TEMP
      STA B,I 
      JMP LOOP
* 
* 
PTSGN LDA PLUS      DEFAULT SIGN
      STA B,I 
      ADB N1
      LDA TEMP
      STA B,I 
      ISZ SGNFL 
      ISZ NUMF
      JMP LOOP
* 
* 
CKNUM LDA NUMF
      SZA 
      JMP CONVT 
      JMP LOOP
* 
* 
* 
STFLG ISZ SGNFL 
      STA B,I 
      JMP LOOP
      SPC 3 
LOOP  ISZ BITE,I
      JMP MLOOP 
      SKP 
      SPC 3 
* 
*     THIS PORTION OF THE ROUTINE CONVERTS THE VALUES IN BUFR TO INTEGER. 
*  THE B REGISTER AT THIS TIME POINTS TO THE FIRST VALU TO BE CONVERTED 
*  IN BUFR. 
* 
CONVT CLA 
      STA VALUE,I 
      LDA NUMF
      CMA,INA 
      STA CNTR      SET UP COUNTER
      INB            POINT B TO FIRST NUMBER
      STB ADRPT 
      LDA MPLR      TOP OF LIST OF MULTIPLIER CONSTANTS 
      STA MPADR     ADDRESS COUNTER 
CLOOP CLB 
      LDA ADRPT,I 
      MPY MPADR,I   C(BUFR) * MCON(I) 
      STA TEMP
      ADA VALUE,I   VALUE = VALUE + TEMP
      STA VALUE,I 
      ISZ ADRPT 
      ISZ MPADR 
      ISZ CNTR
      JMP CLOOP 
      LDA ADRPT,I   SEE IF LAST WORD IS A MINUS 
      CPA MINUS 
      JMP COMP
      JMP INTX,I
COMP  LDA VALUE,I 
      CMA,INA       VALUE =-VALUE 
      STA VALUE,I 
      JMP INTX,I
* 
* 
      SKP 
* 
*TEMPORARY STORAGE AND CONSTANTS
* 
LOMSK OCT 377 
UPMSK OCT 177400
BUFR  BSS 10
ADEND DEF * 
NUMF  NOP 
CNTR  NOP 
MPADR NOP 
MPLR  DEF MCON
MCON  DEC 1 
      DEC 10
      DEC 100 
      DEC 1000
      DEC 10000 
ADRPT NOP 
INP   NOP 
M60   OCT -60 
.11   DEC 9 
SGNFL NOP 
N1    DEC -1
TEMP  NOP 
M5    OCT -5
COUNT NOP 
* 
      SKP 
* 
*     THIS ROUTINE CONVERTS A FLOATING POINT VALUE CONTAINED
*  IN NUM TO ASCII AND STORES THE RESULT IN IOBUF.
*  THE RESULTING FLOATING POINT VALUE IS FORMATTED
*  ACCORDING TO F7.N FORMAT, WHERE N HAS BEEN SPECIFIED 
*  THE FXD(N) COMMAND.
* 
NUM   NOP 
IOBUF NOP 
IBYTE NOP 
N     NOP 
SKPBK NOP 
FLTAS NOP 
      JSB .ENTR 
      DEF NUM 
      LDA N,I 
      STA RIGHT 
      LDA IBYTE,I 
      CLE,ERA 
      ADA IOBUF 
      STA FLTAD 
      CLA 
      STA UNFLG     UNDERFLOW FLAG
      STA SIGN      SIGN FLAG 1= MINUS
      STA EXPFL 
      STA IN
RTNR  LDA RIGHT     COMPUTE 7-(N+1) NUMBER OF DIGITS TO LEFT OF DECIMAL 
      INA           POINT.
      ADA M7
      STA LEFT
      DLD NUM,I     NOW CHECK TO SEE IF NUMBER IS WITHIN A FEASIBLE RANGE FOR 
      DST SAVOU 
      STA SAVA      FOR F7.N FORMAT.
      STB SAVBB 
      SZA           SEE IF NUM = 0
      JMP CONT0 
      SZB,RSS 
      JMP FLT0      NUM = 0.0 
CONT0 SSA,RSS       SEE IF NUMBER IS NEGATIVE AND IF SO INSERT A MINUS
      JMP CONTF     SIGN INTO THE I/O BUFFER AND COMPLEMENT THE NUMBER
      ISZ SIGN      SET SIGN FLAG TO INDICATE MINUS 
      JSB ..FCM     COMPLMENT 
      DST SAVA
      DST SAVOU 
      ISZ LEFT      ONE LESS DIGIT TO LEFT OF DECIMAL POINT 
      NOP 
      LDA MINUS 
      JSB PACK      INSRT MINUS SIGN INTO IOBUF 
CONTF LDA RIGHT     ROUND OFF 
      CLE,ALS 
      LDB RNDOF     INDIRECT CHECK                                      CL1901
      JSB INDCB                                                         CL1901
      ADA B                                                             CL1901
      DLD A,I 
      FAD SAVA      NUMB + (.5) **N 
      DST SAVA
FCONT LDA RIGHT 
      CPA .6        NOW CHECK FOR UNDERFLOW 
      JMP SPLCS     IF N=6 OR 7 WE HAVE A SPECIAL SITUATION 
      CPA .7
      JMP SPLCS 
      LDA RIGHT     COMPUTE (N*2) 
      CLE,ALS 
      STA FLTMP 
      LDB UNFLW     INDIRECT CHECK                                      CL1901
      JSB INDCB                                                         CL1901
      ADA B         GET ADDRESS OF TOL OF UNDERFLOW CONSTANTS           CL1901
      DLD A,I 
      DST SUBT
      DLD SAVA
      FSB SUBT      NOW SEE IF NUM<CONSTANT 
      SSA      < CONSTANT?
      JMP UNDER     YES THEN WE HAVE AN UNDERFLOW 
      LDA SIGN
      ALS 
      ADA FLTMP 
      LDB OVFLW     INDIRECT CHECK                                      CL1901
      JSB INDCB                                                         CL1901
      ADA B         NOW CHECK FOR OVERFLOW CASE                         CL1901
      DLD A,I 
      DST SUBT
      DLD SAVA
      FSB SUBT      COMPUTE (NUMBER - CONSTANT) 
      SSA,RSS 
      JMP OVER      NUM > CONSTANT
      SZA,RSS 
      JMP OVER      NUM = CONSTANT
      JMP REGLR     REGULAR CASE -SO GO DO F7.N 
* 
* 
SPLCS LDA SIGN
      SZA 
      JMP LOWER 
      DLD .EM6
      DST SUBT
      JMP CHECK 
LOWER DLD .EM5
      DST SUBT
CHECK DLD SAVA
      FSB SUBT
      SSA 
      JMP SPEN1     UNDERFLOW 
      DLD SAVA
      FSB D1
      SSA,RSS 
      JMP SPEND 
      SZA 
      JMP SPEND 
      JMP OVER
SPEND LDA MINUS 
      JMP OVER+1
SPEN1 LDA PLUS
      JMP UNDER+1 
* 
      SKP 
      SPC 3 
* 
*     FORMAT PORTION FOR REGULAR F7.N 
* 
      SPC 2 
REGLR ISZ RIGHT 
      LDA RIGHT     COMPLEMENT COUNTER FOR NUMBER OF DIGITS TO THE
      CMA,INA       RIGHT OF THE DECIMAL POINT. 
      STA RIGHT 
      JSB EXTCT     SEPERATE THE INTEGER PORTION OF THE NUMBER FROM THE 
      LDB SAVBB      FRACTIONAL,
      JSB .FLUN     EXTRACT EXPONENT AND MANTISSA(A=EXP,B=MANTISSA) 
      SZA,RSS       LOOK FOR 0 OR NEGATIVE EXPONENT 
      JMP FRACT     = 0 
      SSA 
      JMP FRACT     < 0 
      DLD SAVA
REGLP ISZ IN       COUNT THE NUMBER OF DIVISIONS
      FSB .10E1     MAKE NUMBER < 10.0 IF IT IS NOT ALREADY 
      SSA 
      JMP REG2      < 10.0
      DLD SAVA      DIVIDE BY TEN UTIL NUM IS < 10.0
      FDV .10E1 
      DST SAVA
      JMP REGLP 
REG2  LDB IN
      CMB,INB 
      STB IN
REG3  JSB GCIN      FIND GREATEST CONTAINED INTEGER (INTEGERIZE)
      ISZ LEFT
      JMP *+2       MORE DIGITS TO THE LEFT OF DECIMAL POINT
      JMP FRACT     GO DO FRACTIONAL PART.
      ISZ IN        NUMBER OF DIVIDES RUN OUT?
      JMP REG3      NO
      JMP FRACT 
* 
      SKP 
      SPC 3 
* 
*     FRACTIONAL PART OF CONVERSION 
* 
      SPC 2 
FRACT LDA EXPFL     CHECK FOR EXPONENT NECESSITY
      LDB UNFLG 
      SZA 
      JMP OVER1 
      SZB 
      JMP UNDR1     UNDERFLOW 
      LDA DECPT 
      JSB PACK      INSERT DECIMAL POINT INTO IOBUF 
FRAC1 DLD FRAC      GET FRACTIONAL PART OF NUMBER 
      FMP .10E1     MAKE FRACTION > 1 
      DST SAVA
FRLP  ISZ RIGHT 
      JMP *+2 
      JMP END 
      JSB GCIN      GET INTEGER AND INSERT INTO IOBUF 
      JMP FRLP
END   LDA EXPFL 
      SZA 
      JMP UNDER 
      JMP FLTAS,I 
* 
* 
*     FORMAT 0 TO 0.XXX 
* 
      SPC 2 
FLT0  LDA RIGHT 
      CMA,INA 
      STA RIGHT 
      LDA ASCN      ASCII 0 
      JSB PACK
      LDA DECPT     DECIMAL POINT 
      JSB PACK
      LDA RIGHT 
      SZA,RSS       N=0 
      JMP FLTAS,I 
FLTLP LDA ASCN
      JSB PACK
      ISZ RIGHT 
      JMP FLTLP 
      JMP FLTAS,I 
* 
      SPC 3 
* 
*     FIND GREATEST INTEGER AND INSERT INTO IOBUF 
* 
GCIN  NOP 
      DLD SAVA
      JSB .IENT     GET GREATEST CONTAINED INTEGER
      NOP 
      STA FLTMP 
      ADA ASCN
      JSB PACK
      LDA FLTMP      FLOAT INTEGER
      JSB FLOAT 
      DST SUBT
      DLD SAVA      COMPUTE NUM - FLTMP 
      FSB SUBT
      FMP .10E1 
      DST SAVA
      JMP GCIN,I
* 
      SKP 
      SPC 3 
* 
PACK  NOP 
      STA NIBLE   SAVE BYTE 
      JSB BYTE
      DEF RTN1
      DEF IBYTE,I 
      DEF NIBLE 
      DEF FLTAD,I 
RTN1  ISZ IBYTE,I 
      LDA IBYTE,I 
      CLE,ERA       INCREMENT IOBUF ADDRESS 
      ADA IOBUF 
      STA FLTAD 
      JMP PACK,I
* 
NIBLE NOP 
      SPC 3 
* 
*     PACK BYTES INTO TEMPORARY BUFFER
* 
* 
*     SEPERATE INTEGER AND FRACTION PART OF NUMBER
* 
EXTCT NOP 
      DLD SAVA
      JSB .IENT     GET INTEGER 
      NOP 
      JSB FLOAT 
      DST SUBT
      DLD SAVA
      FSB SUBT      GET FRACTION
      DST FRAC
      JMP EXTCT,I 
* 
FRAC  BSS 2 
      SKP 
      SPC 3 
* 
*     THIS ROUTINE FORMATS NUMBERS WHICH HAVE BEEN FOUND TO OVER- 
*  FLOW THE F7.N FORMAT. THE NUMBERS ARE REFORMATTED ACCORDING
*  TO E7.0 FORMAT.
* 
*     FORMATS= XXXE+XX OR -XXE+XX 
* 
      SPC 2 
OVER  LDA PLUS
      STA SPSGN     SAVE ASCII PLUS SIGN IS TEMPORARY STORAGE 
      ISZ EXPFL     FLAG INDICATING EXPONENT
      DLD .10E2     100.0 
      DST TMPA
      LDB .3        NUMBER OF DIGITS TO LEFT OF DECIMAL POINT 
      LDA SIGN      NOW DETERMINE WHICH E7.0 FORMAT TO USE
      SZA,RSS 
      JMP OVER0 
      DLD .10E1     10.0
      DST TMPA
      LDB .2
OVER0 CMB,INB 
      STB LEFT
      JMP REGLR 
OVER1 CLA 
      STA IN        COUNTER FOR NUMBER OF DIVIDES 
      DLD SAVOU 
      DST SAVA
OVRLP FSB TMPA      NUMBER - CONSTANT 
      SZA,RSS 
      JMP EXCNT 
      SSA 
      JMP EXCN0 
      DLD SAVA
      FDV .10E1     DIVIDE UNTIL NUMBER IS WITHIN RANGE 
      DST SAVA
      ISZ IN
      JMP OVRLP 
* 
EXCN0 LDA IN
      ADA M1
      STA IN
* 
*     NOW STORE AWAY .E+-XX 
* 
EXCNT LDA E 
      JSB PACK
      LDA SPSGN     SIGN + -
      JSB PACK
      LDA IN
      CLB 
      DIV .10E1 
      STB TMPA
      ADA ASCN
      JSB PACK
      LDA TMPA
      ADA ASCN
      JSB PACK
      JMP FLTAS,I 
      SPC 3 
* 
*     THIS SECTION OF CODE DEALS WITH THE UNDERFLOW CASE WHERE
* A NUMBER UNDERFLOWS THE F7.N FORMAT.  THE RESULTING NUMBERS 
* ARE FORMATTED ACCORDING TO THE FOLLOWING FORMATS: 
*     -XXE-XX 
*     XXXE-XX 
* 
UNDER LDA MINUS 
      STA SPSGN 
      ISZ UNFLG 
      DLD XXX5
      DST SAVA      ROUND OFF VALUE 
      DLD D99 
      DST TMPA
      LDB .3
      LDA SIGN      + OR - SIGN 
      SZA,RSS 
      JMP UNDR0     USE XX.E-XX FORMAT
      DLD XX5 
      DST SAVA
      DLD .9
      DST TMPA
      LDB .2        USE -X.E-XX FORMAT
UNDR0 CMB,INB       NUMBER OF CHARACTERS TO LEFT OF DECIMAL POINT 
      STB LEFT
      CLA 
      STA MPCNT 
      DLD SAVOU 
      FAD SAVA
      DST SAVA
UNDLP ISZ MPCNT 
      DLD SAVA      MULTIPLY NUMBER UNTIL 
      FMP .10E1     IT IS > CONSTANT 9 OR 99
      DST SAVA
      FSB TMPA
      SSA           < CONSTANT
      JMP UNDLP 
      JMP REGLR 
      SPC 2 
UNDR1 LDA MPCNT 
      STA IN
      JMP EXCNT 
      SKP 
      SPC 3 
* 
*     CONSTANTS AND TEMPORARY STORAGE 
* 
OVFLW DEF .10E6 
RNDOF DEF D.5 
UNFLW DEF D1
M1    OCT -1
M2    OCT -2
SAVA  NOP 
SAVBB  NOP
SIGN  NOP 
RIGHT NOP 
LEFT  NOP 
M7    OCT -7
SUBT  BSS 2 
IN    NOP 
BLANK OCT 40
FLTMP  NOP
ENFLG NOP 
.7    OCT 7 
MINUS OCT 55
FLTAD  NOP
DECPT OCT 56
ASCN  OCT 60
TMPA  BSS 2 
SAVOU BSS 2 
PLUS  OCT 53
E     OCT 105 
I1    OCT 1 
EXPFL NOP 
SPSGN NOP 
.9    DEC 9.
D99   DEC 99. 
MPCNT NOP 
UNFLG NOP 
.95   DEC .95 
* 
*     UNDERFLOW AND OVERFLOW CONSTANTS
* 
.10E6 DEC 1000000.0 
.10E5 DEC 100000.0
.10E4 DEC 10000.0 
.10E3 DEC 1000.0
.10E2 DEC 100.0 
.10E1 DEC 10.0
D1    DEC 1.0 
      DEC .1
      DEC .01 
      DEC .001
      DEC .0001 
.EM5  DEC .00001
.EM6  DEC .000001 
.26   DEC 26
D.5   DEC .5
      DEC .05 
XX5   DEC .005
XXX5  DEC .0005 
      DEC 5.E-5 
      DEC 5.E-6 
      DEC 5.E-7 
      DEC 5.E-8 
* 
* 
      END 
1 
                                                                            