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 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