ASMB,A,B,L HED UTILITY PACKAGE (EXCLUDING MATRIX ROUTINES) ORG 65B STADD EQU 11431B STARTING ADDR - ON TOP OF MATRIX SIZE EQU FIN-STADD SIZE OF PACKAGE ********************************************* * UTILITY PACKAGE (EXCLUDING MATRIX ROUTINES) * HP 25104G -- SERIAL PREFIX 1008 ********************************************* SPC 1 * THE UTILITY PACKAGE CONTAINS THE FOLLOWING SUBROUTINES: * * BCD TO FLOATING POINT CONVERSION * FLOATING POINT TO BCD CONVERSION * TYPE ERROR MESSAGE * LOAD NEXT CALL PARAMETER * CHECK CALL PARAMETER ADDRESS * WAIT * * THE UTILITY PACKAGE ALSO MAKES 5 MODIFICATIONS TO * AND CORRECTS 4 BUGS IN THE BASIC INTERPRETER 20883B: * * MOD 1 PUTS A HLT 0 (102000) IN LOCATION 2000 SO THAT A PROGRAM * ERROR THAT STORES INTO OR JUMPS TO AN UNDEFINED LOCATION * INDIRECTLY WILL NOT DESTROY CORE, PROVIDED THAT CORE IS * INITIALIZED TO 102000 BEFORE LOADING. WHEN THIS HAPPENS,THE * COMPUTER GOES INTO A TIGHT LOOP THAT LOOKS LIKE A HLT -- BUT * THE RUN LIGHT WILL BE ON. * * MOD 2 ALLOWS THE LINE NUMBER X TO BE VARIABLE OR A FORMULA AS * WELL AS A CONSTANT IN THE FOLLOWING STATEMENTS: * GO TO X * GO SUB X * IF RELATIONSHIP THEN X * * MOD 3 SAVES THE CALL NUMBER (SUBROUTINE IDENTIFIER) OF A * USER-CALLED SUBROUTINE. * * MOD 4 SUPPRESSES THE TRAILING DECIMAL POINT OF INTEGERS * BEING PRINTED THAT ARE 32768 TO 999999 (ABSOLUTE). * * MOD 5 DOES NOT ALLOW ANY MATRIX STATEMENT TO BE RECOGNIZED; * THEN OVERLAYS THE MATRIX ROUTINES AND THE MATRIX * SYNTAX WITH THE UTILITY ROUTINES. * * * BUG 1 THE PARAMETER OF A PROGRAMMER-DEFINED FUNCTION IS NOT * RECOGNIZED IF IT FOLLOWS A SUBSCRIPTED VARIABLE IN THE * DEFINING FORMULA. * * BUG 2 EXECUTION OF EACH AND EVERY PROGRAMMER-DEFINED FUNCTION * WASTES 2 WORDS OF WORKING SPACE, CAUSING SOME PROGRAMS * TO RUN OUT OF SPACE. * * BUG 4 IF A PRINT STATEMENT HAD A CLOSING QUOTATION MARK * FOLLOWED BY A LETTER FROM P TO Z, THE STATEMENT WOULD * NOT RUN OR LIST. * * BUG 5 IF A TAB FUNCTION CALL EVALUATED TO THE CURRENT POSITION * OF THE TELEPRINTER (REQUESTING THE PRINTING OF ZERO BLANKS), * A SPURIOUS CARRIAGE RETURN-LINE FEED WOULD BE ISSUED. * * BASE PAGE LINKS TO SUBROUTINES IN PACKAGE * .WAIT DEF WAIT WAIT ROUTINE BSS 2 RESERVED .EMSG DEF EMSG TYPE ERROR MESSAGE .ACHK DEF ACHK CHECK ADDR OF CALL PARAMETERS TM1 BSS 1 TEMP STORAGE FOR .DL .DL DEF DL LOAD NEXT CALL PARAMETER BSS 2 RESERVED .BCD6 DEF BCD6 FLOATING-PT/BCD CONVERSION .CONV DEF CONV BCD/FLOATING-PT CONVERSION SPC 1 .2 EQU 167B DEC 2 .3 EQU 170B DEC 3 .6 EQU 172B DEC 6 .8 EQU 174B DEC 8 .10 EQU 176B DEC 10 .15 EQU 200B DEC 15 .31 EQU 206B DEC 31, OCT 37 .32 EQU 207B DEC 32, OCT 40, OR ASCII BLANK .46 EQU 217B DEC 46, OCT 56, OR ASCII DEC PT. ARBAS EQU 402B ADDR BASE OF FORM OPERATOR TABLE ASBTB EQU 121B ADDR OF DRIVER LINKAGE TABLE ATAB EQU 431B ADDR OF TAB IN OPERATOR TABLE B17 EQU 200B OCT 17 B177 EQU 232B OCT 177 B60 EQU 221B OCT 60 BADDR EQU 126B ADDR OF OUTPUT BUFFER BLANK EQU 323B ASCII BLANK .BUFA EQU 123B I/O BUFFER ADDR CCNT EQU 125B NO. OF CHAR IN OUTPUT BUFFER CONST EQU 1211B INPUT A CONSTANT D53 EQU 275B OCT -53 DASH EQU 216B ASCII -, OCT 55 DFLAG EQU 2314B ESYMT EQU 5515B TEMP STORAGE OR SYBOL TABLE SUB .FADA EQU 353B FLOATING ADD FETCA EQU 346B EVALUATE A FORMULA FLGBT EQU 253B OCT 100000 FOPBS EQU 403B FORM1 EQU 5563B FORMX EQU 5560B EVALUATE A FORMULA FPOP EQU 3320B RESTORE FSC LOCAL VARIABLES FRCUR EQU 3343B SAVE FSC LOCAL VARIABLES .FSBA EQU 354B FLOATING SUBTRACT FSC EQU 3101B FORMULA SYNTAX CHECKER GETCR EQU 1443B GET CHARACTER HSTPT EQU 143B HIGH STACK PTR IFIX EQU 1511B CONVERT TO INTEGER LBUFA EQU 375B ADDR OF LINE NO. OUTPUT BUFFER LNBFA EQU 376B ADDR OF WORD BEFORE LINE NO. BUF LIST2 EQU 4636B .LNUM EQU 132B BASIC STATEMENT LINE NO. LSTPT EQU 145B LOW STACK PTR M1 EQU 255B DEC -1 M2 EQU 256B DEC -2 M.2 EQU 256B DEC -2 M3 EQU 257B DEC -3 M8 EQU 264B DEC -8 M9 EQU 265B DEC -9 M.10 EQU 266B DEC -10 M15 EQU 270B DEC -15 M1000 EQU 306B DEC -1000 MSFLG EQU 2312B MSK0 EQU 310B OCT 377 MSK1 EQU 311B OCT 777 NUMDT EQU 10051B OUTCR EQU 1561B PUT CHAR IN OUTPUT BUFFER OUTIA EQU 350B OCTAL/ASCII DECIMAL, IN BUFFER ARYAD EQU OUTCR OUTIN EQU 5013B OUTPUT AN INTEGER PDFBS EQU 434B ADDR OF PRE-DEFINED FUNCTION TAB RSCHK EQU 1715B ALLOT SPACE FOR RESULT SBPTR EQU 127B SYNTAX BUFFER POINTER SBSC2 EQU 3445B SBSCK EQU 3373B CHECK FOR SUBSCRIPT PART SCMMA EQU 2253B ADDR OF ENTRY FOR COMMA SLWST EQU 1462B TEMP STORAGE OR ENTRY TO STACKER SSOV EQU 3361B PUT ON S-STACK, CHECK OV STTOP EQU 1672B FETCH TOP OF STACK STTYP EQU 412B ADDR OF OPERATOR NAME TABLE SYMCK EQU 1414B FIND & STORE 1-CHAR OPERATORS TEMP2 EQU 153B TEMP TEMPS EQU 150B TEMP STORAGE TSTPT EQU 144B TEMP STACK PTR .TTY EQU 102B PRINT ON TELETYPE SKP ********************************************* * CORRECTIONS & MODIFICATIONS TO BASIC 20883B ********************************************* * ORG 410B BUG 2 DEF FOR12 BSS 7 DEF FORM0 DEF FOR11 BSS 1 DEF FOR10 SPC 1 ORG 1372B MOD 3 JSB CALLN,I SAVE CALL NUMBER CALLN DEF SCALL BSS 4 CPA CALLN,I CALL NO. PUT IN ENTRY PT OF SUBR SPC 1 ORG 1777B MOD 1 LFEED DEF LF DEFINE LINE FEED HLT 0 PROVIDE FOR LOOP IN CASE OF ERROR SPC 1 ORG 2431B MOD 2 JSB FSC MODIFY SYNTAX PHASE OF NOP GOTO & GOSUB SPC 1 ORG 3412B BUG 1 JMP SBSC3 SPC 1 ORG 3424B BUG 1 JMP *+4 4 INSTRUCTIONS DELETED NOP NOP LF OCT 5000 LINE FEED & RIGHT BRACKET IND SPC 1 ORG 3451B BUG 1 LDA LF YES, RECORD A STA SBPTR,I RIGHT BRACKET ISZ SBPTR ADJUST S-BUFFER POINTER JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER LDB DFLAG DIM OR CON SZB STATEMENT? JMP SBSCK,I YES JSB FPOP RESTORE FSC LOCAL VARIABLES LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB FETCH LDB 1,I RETURN ADDRESS JMP 1,I AND EXIT SBSC3 LDA SBSCK SAVE LDB TEMPS RETURN ADDRESS JSB SSOV ON S-STACK JSB FRCUR SAVE FSC LOCAL VARIABLES LDB M9 SET MULTIPLE STORE FLAG STB MSFLG TO FALSE LDA ARYAD SAVE LDB TEMPS OPERAND JSB SSOV ADDRESS JSB FSC GET SUBSCRIPT FORMULA CCB CANCEL ADB SBPTR END-OF-FORMULA STB SBPTR OPERATOR LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB RESTORE LDB 1,I OPERAND STB ARYAD ADDRESS CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC2 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB FSC GET SUBSCRIPT FORMULA SPC 1 ORG 4105B MOD 5 MAT OCT 0 REMOVE REFERENCE TO MATRIX OCT 0 SPC 1 ORG 4775B BUG 4 JMP OUTS1 SPC 1 ** OUTPUT A STRING ORG 5054B BUG 4 OUTST NOP " ENTRY POINT OUTS1 LDA TEMPS,I REM ENTRY POINT AND B177 OUTPUT SECOND CHARACTER SZA OF WORD IF JSB OUTCR NOT NULL ISZ TEMPS BUMP POINTER ISZ SLWST REM COMPLETED? RSS NO JMP LIST2 YES LDA TEMPS,I EXTRACT ALF,ALF FIRST CHARACTER AND B177 OF WORD CPA .2 EXIT JMP OUTST,I IF A CPA .3 CLOSING JMP OUTST,I QUOTE (") JSB OUTCR OUTPUT JMP OUTS1 CHARACTER SPC 1 ** EVALUATE A FORMULA ORG 5573B BUG 2 JMP FORM4 A MAJORITY OF THE SUBROUTINE BSS 5 TO EVALUATE A FORMULA JMP FORM6 IS CHANGED & SUBROUTINE FNEVL BSS 1 IS ELIMINATED. FORM2 BSS 3 LDB 0 LOAD ADDRESS OF ADB FOPBS OPERATOR'S INFORMATION WORD ADA M8 NON-FORMULA SSA OPERATOR? CLB YES ADA D53 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I LOAD INFORMATION WORD AND MSK1 SAVE STA TEMPS+7 PRECEDENCE XOR 1,I SAVE ARS STA TEMPS+6 IDENTIFICATION JMP FOR11 FORM0 STA TSTPT,I STACK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS INA STORE STB 0,I LOW WORD FOR11 LDA LSTPT,I DOES OPERATOR AND MSK0 ON TOP OF CMA OPERATOR STACK ADA TEMPS+7 HAVE HIGHER SSA PRECEDENCE? JMP FORM9 YES, EXECUTE IT RSS NO FOR10 ISZ LSTPT LDB TEMPS+7 RETRIEVE PRECEDENCE ADB M15 NO, LEFT PARENTHESIS SSB OR LEFT BRACKET? ADB .15 NO, RESTORE PRECEDENCE ADB TEMPS+6 COMBINE IDENTIFICATION JSB SLWST WITH PRECEDENCE AND STACK JMP FORM1 FORM4 CPA FLGBT CONSTANT? JMP FORM5 YES AND .15 NO, PRE-DEFINED CPA .15 FUNCTION JMP FORM7 YES LDB TEMPS+9 NO, MUST BE A JMP FORM2-1 PARAMETER FORM5 LDB TEMPS LOAD CONSTANT ADDRESS ISZ TEMPS MOVE POINTER TO ISZ TEMPS NEXT CODE WORD JMP FORM2-1 FORM6 STB TEMPS+6 SAVE SYMBOL TABLE POINTER LDB TSTPT SAVE CURRENT POINTER JSB SLWST TO TEMPORARY STACK LDB TEMPS+6,I JSB SLWST SAVE FUNCTION ADDRESS LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS LDA TEMPS SWITCH LDB LSTPT,I FORMULA POINTER STB TEMPS TO FUNCTION'S STA LSTPT,I FORMULA LDB TEMPS+9 SET LDA HSTPT,I PARAMETER POINTER ISZ LSTPT TO NEW PARAMETER, ISZ HSTPT SAVING PREVIOUS STB LSTPT,I SETTING ON STA TEMPS+9 LOW-CORE STACK CPA TSTPT PROTECT PARAMETER IF JSB RSCHK ON TEMPORARY STACK JSB FORMX EVALUATE FUNCTION LDA LSTPT,I RESTORE OLD STA TEMPS+9 PARAMETER POINTER LDA LSTPT CUT BACK ADA M3 LOW-CORE STA LSTPT STACK INA RESTORE ORIGINAL LDB 0,I TEMPORARY STACK STB TSTPT POINTER INA RESTORE LDB 0,I ORIGINAL STB TEMPS FORMULA POINTER JSB STTOP POP RESULT * ** PRE-DEFINED FUNCTIONS RETURN HERE WITH RESULT * FOR12 STA TSTPT,I STORE HIGH WORD LDA TSTPT INA STORE STB 0,I LOW WORD ISZ HSTPT LDB HSTPT,I RESTORE FORMX STB FORMX RETURN ADDRESS ADA M1 STACK ADDRESS STA HSTPT,I OF RESULT JMP FORM2 FORM7 LDA TEMPS+6 COMPUTE ALF,ALF ALF FUNCTION ADDRESS AND .31 ADA PDFBS ADDRESS LDB 0,I JSB SLWST SAVE FUNCTION ADDRESS LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS LDB LSTPT,I POP CCA FUNCTION ADA LSTPT ENTRY STA LSTPT ADDRESS STB ESYMT SAVE JSB STTOP POP PARAMETER JMP ESYMT,I EVALUATE FUNCTION FORM9 LDA LSTPT,I UNSTACK CCB OPERATOR ADB LSTPT INFORMATION STB LSTPT WORD ALF,ALF COMPUTE AND B177 SUBROUTINE ADA ARBAS ADDRESS JMP 0,I EXECUTE SPC 1 ORG 6221B MOD 2 JSB *+1,I MODIFY EXECUTION PHASE OF DEF GOMOD GOTO SPC 1 ORG 6367B MOD 2 JSB *+1,I MODIFY EXECUTION PHASE OF DEF GOMOD GOSUB SPC 1 ORG 6611B BUG 5 JSB *+1,I PATCH INSERTS ONE WORD DEF PATCH SZA DO NOT WRITE IF COUNT =0 SPC 1 ORG 10353B MOD 4 JMP *+1,I SUPPRESS TRAILING DEC PT. DEF START SKP ORG 2640B * (OVERLAYS MATRIX SYNTAX) ********************************** * SUBROUTINE TO TYPE ERROR MESSAGE ********************************** * * *CALLING SEQUENCE: SPC 1 * NORMAL ERROR CODES * DECIMAL ERROR CODE N IN A * JSB .EMSG,I * MESSAGE--"(CR-LF) ERR DI-N IN LINE XXX" WHERE * DI IS DRIVER IDENTIFIER (CALL NO.) SPC 1 * SYSTEM OR SPECIAL ERROR CODES * NEGATIVE OF DEC. ERROR CODE N IN A * ALPHANUMERIC CODE AA IN B * JSB .EMSG,I * MESSAGE-- "(CR-LF) ERR AA-N IN LINE XXX" SPC 1 EMSG NOP ***ENTER*** SSA ERROR NO. NEG? JMP SPECL YES, TAKE ASCII FORM OF ROUTINE STA ERCOD NO LDA SCALL GET CALL NO., LDB .6 STB CCNT CONVERT TO ASCII DECIMAL, LDB BUFAD STB BADDR JSB OUTIA,I & PUT IN OUTPUT BUFFER SEP LDA DASH JSB OUTCR PUT "-" IN OUTPUT BUFFER LDA ERCOD CONVERT ERR CODE TO ASCII DEC, JSB OUTIA,I & PUT IN OUTPUT BUFFER LDA CCNT CMA,INA LDB .MSG TYPE MESSAGE JSB .TTY,I ON TELEPRINTER LDA LNBFA STA BADDR LDA .10 STA CCNT LDA .LNUM CONVERT BASIC PROGRAM LINE NO. JSB OUTIA,I TO ASCII, PUT IN OUTPUT BUFFER LDB LBUFA LDA CCNT JSB .TTY,I TYPE "IN LINE NO XXX" JMP EMSG,I ***RETURN*** SPC 1 SPECL CMA,INA GET ABS VALUE OF ERR CODE STA ERCOD STB BUF PUT ASCII CHARS (IN B) INTO LDA .8 OUTPUT BUFFER INSTEAD OF STA CCNT CALL NO. LDA BUFAD INA STA BADDR JMP SEP SPC 1 * SUBROUTINE SCALL IS A PATCH TO BASIC SUBROUTINE * "FIND CALLED SUBROUTINE" THAT SAVES THE CALL NO. SPC 1 SCALL NOP THIS LOC WILL CONTAIN CALL NO. LDA SCALL INA STA RETRN GET RETURN ADDR STB SCALL SAVE CALL NO. LDB ASBTB PATCH "FIND CALLED SUB" JMP RETRN,I SPC 1 BUFAD DEF BUF-1 ADDR OF BUFFER ERCOD BSS 1 ERROR CODE RETRN EQU ERCOD RETURN ADDR FOR SCALL .MSG DEF MSG MSG OCT 6412 CR-LF ASC 2,ERR BUF BSS 3 OUTPUT BUFFER * SKP *********************************************** * PATCHES FOR BASIC CORRECTIONS & MODIFICATIONS *********************************************** * * SUPPRESS TRAILING DECIMAL POINT * START CPA .46 MOD 4 LDA .32 JSB OUTCR JMP .NUM,I .NUM DEF NUMDT,I SPC 1 * SUBROUTINE GOMOD ALLOWS LINE NUMBERS IN * 'GOTO','GOSUB' & 'IF' STATEMENTS TO BE * REPRESENTED AS VARIABLES & FORMULAS AS WELL * AS CONSTANTS. * GOMOD NOP MOD 2 JSB FETCA,I EVALUATE FORMULA JSB IFIX CONVERT TO INTEGER NOP STB 0 RETURN THE LINE NO. IN A ISZ GOMOD JMP GOMOD,I SPC 1 * PATCH ALLOWS THE INSERTION OF ONE WORD * INTO THE PRINT STATEMENT EXECUTION SO THAT * CR-LF NOT GIVEN WHEN CHAR COUNT =0. * PATCH NOP BUG 5 SLB ADA M1 LDB .BUFA ISZ PATCH JMP PATCH,I SKP ************************************************** *SUBROUTINE TO LOAD NEXT CALL STATEMENT PARAMETER * INTO A AND B,AND ADVANCE POINTER ************************************************** * * CALLING SEQUENCE: * ADDRESS OF PARAMETER STACK IS IN A ON ENTRY * TO A BASIC- CALLED SUBROUTINE. IMMEDIATLY: * STA TM1 * THEN WHEN PARA WANTED: * JSB .DL,I * DL NOP LDB TM1,I LDA TM1 ADVANCE ADA M1 POINTER STA TM1 LDA 1,I MS PART OF ARGUMENT INB LDB 1,I LS PART OF ARGUMENT JMP DL,I RETURN SKP * ***************************** * WAIT UTILITY SUBROUTINE * ***************************** * WAIT NOP STB K SAVE B STA WSAVA SAVE A IOR SFS FORM SFS SSB,RSS FLAG OPERATION? CLA NO, LET SKIP = NOP STA SKIP INSTRUCTION SFS OR NOP SSB,RSS FLAG OPERATION? CMB,INB NO, COMPLEMENT POSITIVE # ADB M1 TO TEST FOR ZERO DELAY MORE INB,SZB,RSS JMP END NO MORE WAIT LDA LDA M208 INNER LOOP COUNT INA,SZA,RSS JMP MORE END OF A MILLISECOND SKIP NOP SKIP ON FLAG SET OR NOP JMP LDA+1 CONTINUE INNER LOOP ISZ WAIT BUMP RETURN FOR FLAG SET END LDA WSAVA RESTORE A LDB K RESTORE B JMP WAIT,I EXIT * WSAVA NOP STORAGE FOR A K NOP STORAGE FOR B M208 DEC -208 SFS SFS 0 SKP **************************************** *SUBROUTINE TO CHECK PARAMETER ADDRESSES * IN A BASIC CALL STATEMENT **************************************** * * G.WOODLEY * 30 JAN 69 * *CALLING SEQUENCE: * ADDRESS OF PARAMETER IN B * JSB .ACHK,I * DEF TYPE * 1=CONSTANT * 2=VARIBLE * 3=ARRAY (COMMON) * 4=ARRAY (NOT IN COMMON) * 5=EXPRESSION * ERROR RETURN (TYPE IS WRONG) * NORMAL RETURN (A,B INTACT) * ACHK NOP ***ENTER*** STA TEMPA SAVE A STB TEMPB SAVE B LDA ACHK,I GET TYPE ISZ ACHK ADVANCE TO ERROR RETURN ALS ADA .TAB ADD ADDRESS OF TABLE CMB -VAR. ADDRESS ADB 0,I COMPARE WITH LOWER LIM SSB,RSS GREATER? JMP BACK NO-ERROR INA STEP TO ADDRESS OF UPPER LIM LDA 0,I GET UPPER LIM CMA,INA ADA TEMPB COMPARE WITH ADDRESS SSA,RSS LESS? JMP BACK NO-ERROR ISZ ACHK ADVANCE TO NORMAL RETURN BACK LDA TEMPA LDB TEMPB RESTORE REGISTERS JMP ACHK,I ***RETURN*** .TAB DEF TAB-2,I ADDRESS OF TABLE TEMPA BSS 1 TEMPB BSS 1 REGISTER STORAGE TAB OCT 00112 POINTERS TO ADDRESSES OF PARAMS OCT 00113 CONSTANT OCT 00116 OCT 00117 VARIBLE OCT 00110 OCT 00112 COMMON OCT 00113 OCT 00115 ARRAY OCT 00115 OCT 00120 EXPRESSION SKP ORG STADD ORIGIN OF UTILITY PACKAGE ****************************************** *BCD/FLOATING POINT CONVERSION SUBROUTINES ******************************************-:* * ***BCD TO FLOATING POINT CONVERSION*** * * CALLING SEQUENCE: * * LDA (RG FN D6 D5) * LDB (D4 D3 D2 D1) * JSB .CONV,I * JMP ERROR * - (A=MS B=LS FLOATING PT NO.) * CONV NOP ***ENTER*** STA SAVA STB SAVB SAVE OPERANDS AND HIMSK ISOLATE RG LDB M.12 INIT. COUNT ARS ISZ 1 JMP *-2 SHIFT R 12 STA 1 RG IS ARITHMETICALLY CORRECT LDA SAVA ALF SHIFT INTO MS CHAR AND HIMSK ISOLATE FN SSA FN >7? LDA FN1 CHANGE TO FN 1 (+DCV) ALF SHIFT INTO LS CHAR STA FN SAVE FUNCTION ADA .MTAB ADD BASE ADDRESS OF MOD TABLE ADB 0,I MODIFY RANGE LDA EMNS E- SSB RANGE IS POS ADA M.2 CHANGE TO E+ STA ESTR STORE E AND PROPER SIGN SSB CMB,INB ABS RG LDA 1 TRANSFER TO A AND B17 -910? JMP CONV,I ***ERROR RETURN*** ADA .10 RESTORE ADB 0 PR INTP B ADB B60 ASCII ZERO JMP CHEK,I *RETURN * * RANGE MODIFICATION TABLE MTAB DEC 3 MSEC DEC 0 VOLTS DEC 0 -VOLTS DEC -3 KHZ DEC -3 KOHM DEC -6 MOHM DEC +6 MUSEC DEC -9 GHZ .MTAB DEF MTAB * * BUFFER AREAS DEST BSS 2 DESTINATION FOR CONV.RTN .DEST DEF DEST-1 SIGN BSS 1 SIGN OF VALUE SORCE BSS 3 SOURCE FOR CONV.RTN ESTR ASC 1,E+ E+OR- XSTR BSS 1 EXPONENT SPSP ASC 1, TWO SPACES .SCR DEF SIGN * * CONSTANTS AND STORAGE HIMSK OCT 170000 ISOLATES MS CHAR M.12 DEC -12 M.13 DEC -13 SPPLS ASC 1, + EMNS ASC 1,E- FN1 OCT 10000 FUNCTION 1 (+DCV) FN BSS 1 FUNCTION IN LS 4 BITS TEMP BSS 1 TEMP STORAGE SAVA EQU DEST REDEFINE TEMP STORAGE SAVB EQU DEST+1 * * SKP * * ****FLOATING POINT TO BCD CONVERSION**** * * ENTER WITH FLOATING POINT NUMBER * IN A AND B .RETURNS WITH 6 BCD DIGITS * 4 LSD-S IN A * 2 MSD-S IN B BITS 0 - 7 * BCD6 NOP ***ENTER*** LP1 JSB .FSBA,I DEF .100K SUB. 100,000 FROM NO. SSA RESULT POS.? JMP *+3 NO. ISZ TCNTA YES. JMP LP1 DO AGAIN JSB .FADA,I DEF .100K ADD 100,000 TO NO. STA .T1. STORE # IN TEMP STB .T1.+1 LDA TCNTA POSITION ALF FIRST STA TCNTA DIGIT. LDA .T1. GET NO. LDB .T1.+1 LP2 JSB .FSBA,I DEF .10K SUB 10,000 SSA RESULT POS.? JMP *+3 ISZ TCNTA JMP LP2 JSB .FADA,I ADD BACK 10,000 DEF .10K JSB IFIX CONVERT REMAINING NOP LDA 1 STA .T1. DIGITS TO INTEGER. LDA TCNTA STA .T1.+1 CLA STA TCNTA LDA .T1. CONVERT LAST FOUR CLB,RSS DIGITS TO BINARY INB FROM INTEGER ADA M1000 -1000 SSA,RSS JMP *-3 BLF ADA ..E3 RSS INB ADA ..ME2 -100 SSA,RSS JMP *-3 BLF ADA ..E2 +100 RSS INB ADA M.10 -10 SSA,RSS JMP *-3 BLF ADA .10 ADA 1 LSD'S LDB .T1.+1 GET MSD,S JMP BCD6,I ***RETURN*** * .100K DEC 1.0E+5 .10K DEC 1.0E+4 ..E3 DEC 1000 ..ME2 DEC -100 ..E2 DEC 100 TCNTA OCT 0 .T1. BSS 2 FIN EQU * END