Directory of image this file is from
This file as a plain text file
/NUMB.SB / / G.G. 24-FEB-77 / FUNCTION NUMB(RLNUMB,ALFA,IWIDE,IDEC) / / CONVERTS RLNUMB TO AN ALFA (A1) STRING / IWIDE PLACES WIDE / WITH IDEC PLACES AFTER THE DECIMAL POINT / / IF IDEC = -1 THEN NO DECIMAL POINT IS ADDED / / IF IDEC = -2 THEN RLNUMB IS ASSUMED TO BE AN INTEGER / AND INTEGER CONVERSION IS DONE. (+2047, -2048) / / IF A CONVERSION ERROR OCCURS ( NUMBER TOO LARGE FOR FIELD) / THE FIELD IS '*' FILLED AND THE FUNCTION RETURNS A -1 / NORMAL VALUE RETURNED IS 0 / / ....( MOST OF THE CODE IS STOLEN FROM 'IOH').... /////////////////////////////////////////////////////////////////// OPDEF TADI 1400 OPDEF DCAI 3400 OPDEF ANDI 0400 OPDEF JMPI 5400 OPDEF JMSI 4400 OPDEF ISZI 2400 ABSYM SACH 23 ABSYM SACM 24 ABSYM SACL 25 ABSYM N2 175 ABSYM ARGUMT 176 DUMMY ARGUMT LAP /WE KNOW WHAT WE ARE DOING (DON'T WE?) /////// DATA AREA / BA, 0 CRX, 0 FN, 0 CH, 0 CHCH, 0 CX, 0 FPNT, 0;0 GFRM, 0 N3, 0 DADP, 0 / / IARG: GET NEXT INTEGER ARG INTO AC IARG, 0 CF, HLT /CALLING FIELD TADI R INC R DCA ARGF /GET ARG FIELD TADI R INC R DCA ARGA /GET ARG ADDR ARGF, HLT TADI ARGA JMP I IARG /RETURN WITH ARG ARGA, 0 ENTRY NUMB NUMB, 0 R, 0 /ENTRY POINT TAD NUMB DCA CF JMS IARG /GET REAL NUMBER CLA CLL /IGNORE INTEGER TAD ARGF DCA ARGUMT TAD ARGA DCA ARGUMT# JMS IARG CLA CLL /GET ALFA ADDR, IGNORE VALUE TAD ARGF DCA LITF TAD ARGA DCA LITA /MOVE ALFA ADDRESS JMS IARG DCA N3 JMS IARG DCA DADP /GET IWIDE, IDEC TAD DADP SPA CLA DCA N2 CLA STL RTL /=2 TAD DADP SNA CLA JMP INTOUT /YES CALL 0,CLEAR FF, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1] TAD DADP RAL CLA /SAVE SIGN BIT TAD C /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER SMA CLA CMA /0 MULTS NEEDED OR ALREADY THERE SZL IAC /IF NO D.P. DESIRED FFAKE, TAD N3 /NUMB3 IS THE FIELD WIDTH CIA /MINUS SPACE FOR DADP+DP TAD N2 JMS SA /PUT OUT REQUIRED BLANKS + SIGN TAD C SMA JMP PRZRO /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS CIA JMS DT PRQDCP, TAD DADP SPA CLA / PRINT "."? JMP FX /NO, RETURN NOW.. PRDCPT, TAD (56 JMS LETTER TAD C /GET MULTIPLY COUNT SPA SNA JMP PAS2 CMA /THEY WERE MULTIPLIES, 0 TO N OF THEM DCA CRX TAD N2 /DIGITS AFTER DEC POINT, DADP CMA DCA NR JMP PASA /TEST FOR 0 MULTIPLIES RETR, TAD (60 /PUT OUT A ZERO JMS LETTER /ALL MULTIPLIES REPRESENTED PASA, ISZ CRX /NO, TRY RUN OFF FIELD SKP JMP PASS /YES ISZ NR /ALL WIDTH ACCOUNTED FOR% JMP RETR /NO, TRY NEXT POSITION PASS, TAD C /YES, GET MULT COUNT CIA /-MULT COUNT SKP PAS2, CLA TAD N2 /N2-MULT COUNT SMA SZA /IS MULT COUNT .GE. N2? JMS DT /NO - PRINT REMAINING DIGITS JMP FX /NO PRZRO, CLA TAD (60 JMS LETTER JMP PRQDCP /GO BACK TO PRINT THE DECIMAL POINT PAGE /GG / GET REAL # INTO [0.1,1.0] NR, 0 CALL 1,IFAD /OUTPUT - LOAD NUMBER INTO FLOATING AC ARG ARGUMT DCA SN /CLEAR THESE LOCS DCA C TAD ACH SNA JMP NREX /NUMBER IS ZERO SMA /IS IT A MINUS F P NUMBER JMP RETM TAD (4000 /YES-- MAKE IT POSITIVE ISZ SN /SET SIGN DCA ACH RETM, CLA /MULTIPLY BY 10 UNTIL NR .GT. (1.0) TAD ACH TAD (5764 SMA CLA JMP TB /GOT IT IT IS .GE.1 CALL 1,FMP ARG TN ISZ C /AND COUNT JMP RETM /GO TRY TO DO IT AGAIN TB, JMS SE /NOTE SE ' XR-1 CALL 1,STO ARG SV TAD (2004 DCA ACH /200400000000=.50000 IN AC TAD C CIA TAD N2 /< DADP SMA CMA /NUMBER OF TIMES TO DIVIDE .5 BY 10 TO RND JMS DH /DO THE DIVIDES CALL 1,FAD ARG SV JMS SE /REDUCE TO NORMAL RANGE AGAIN GD, TAD ACH RAL SPA CLA JMP ZP /NUMBER IS ? 1/2 TAD ACH CLL RAR /WE ARE GETTING EXP TO 200 DCA ACH TAD ACM RAR DCA ACM TAD ACL RAR DCA ACL TAD ACH AND (7774 TAD ACH TAD (10 DCA ACH JMP GD ZP, TAD ACH AND (7 DCA ACH NREX, JMP I NR SN, 0 C, 0 /COUNTER FOR DEC. EXP. SE, 0 /DIVIDE BY 10 UNTIL N < 1.0 XR, TAD ACH /TEST NUMBER FOR .GE. 1 TAD (5764 SPA CLA JMP I SE /NUMBER IS IN RANGE, RETURN CLA CLL CMA RAL JMS DH CLA CMA /REDUCE COUNT TAD C DCA C JMP XR SV, BLOCK 3 TN, 2045;0;0 / LETTER: PLACE NEXT CHAR IN OUTPUT ARRAY LITA, 0 LETTER, 0 LITF, HLT /LITERAL OUTPUT FIELD RTL RTL RTL AND (7700 TAD (40 /MAKE INTO A1 FORMAT DCAI LITA ISZ LITA NOP JMP I LETTER PAGE DT, 0 CIA DCA CHCH /STORE COUNT RETT, JMS LS /LEFT SHIFT 1 TAD ACL /SAVE THE FPAC DCA SACL TAD ACM DCA SACM TAD ACH AND (17 DCA SACH TAD SACH DCA ACH /TRIM AC TO 28 BITS JMS LS /LEFT SHIFT 2 JMS LS TAD ACL /ADD THE DSAVE TO THE ACC TAD SACL DCA ACL RAL /* TAD ACM TAD SACM DCA ACM RAL /* TAD ACH TAD SACH DCA ACH TAD ACH CLL RAR /ROTATE 3 RIGHT RTR AND (17 TAD (60 /MAKE DIGIT JMS LETTER /DUMP IT AND SEE IF ANY MORE ISZ CHCH /LOOP ON COUNT JMP RETT /* JMP I DT LS, 0 /LEFT SHIFT THE FPAC 1 TAD ACL CLL RAL DCA ACL TAD ACM RAL DCA ACM TAD ACH RAL DCA ACH JMP I LS /DONE DH, 0 DCA CX /DIVIDE FPAC BY TEN CX TIMES JMP DTA DTB, CALL 1,FDV ARG TN DTA, ISZ CX JMP DTB JMP I DH AS3, CLA /PRINT ASTERISKS FOR WHOLE FIELD SIZE TAD N3 /GET FIELD SIZE, E OR F CMA DCA CX /-COUNT JMP QQ QQA, TAD (52 /PRINT CX ASTERISKS JMS LETTER QQ, ISZ CX /INDEX COUNT JMP QQA STA /RETURN -1 IF *** ERROR FX, CALL 0,CLEAR RETRN NUMB / SA: OUTPUT LEADING BLANKS AND MINUS SIGN SA, 0 TAD SN SMA /THIS IS -(NUMB OF BLANKS) JMP AS3 /POSITIVE, NUMBER TOO BIG FOR FIELD DCA CRX SKP CLA RETC, JMS LETTER /HERE WE PUT OUT THAT MANY BLANKS TAD (40 ISZ CRX JMP RETC /YES CLA TAD SN SNA CLA /IS SIGN MINUS? JMP I SA /EVIDENTLY NOT TAD (55 JMS LETTER /PUT OUT A MINUS SIGN JMP I SA PAGE /INTEGER OUTPUT BUFPTR, IBUF 0;0;0 IBUF, 0;-1 INTOUT, TAD BUFPTR DCA SACL /SET POINTER TAD (-4 DCA WHI /SET WIDTH DCA SN TAD I ARGUMT /GET INTEGER VALUE SMA /NEGATIVE?? JMP DIVLP /NO CIA /POSITIZE INC SN /SET SIGN FLAG DIVLP, CALL 1,DIV ARG INTTEN /=10D DCA SACH /SAVE QUOTIENT CPAGE 4 CALL 0,IREM /USE DUMMY ARG INTTEN, 12 /DIVISION CONSTANT FOR BASE 10 WHI, 0 /WIDTH DCA I SACL /SAVE DIGIT STA TAD SACL DCA SACL /DECREMENT POINTER ISZ WHI /ALL DONE? TAD SACH /OR NUMB = 0? SZA JMP DIVLP /NO, DO IT AGAIN TAD N3 CMA TAD WHI TAD (4 /COMPUTE LEADING SPACE COUNT JMS SA /PRINT LEADING SPACES AND SIGN IDIG, INC SACL /POINT TO NEXT DIGIT TAD I SACL SPA /END OF ? JMP NUMBEX /YES, EXIT TAD (60 JMS LETTER /NO, OUTPUT DIGIT JMP IDIG /AND LOOP NUMBEX, CLA CLL RETRN NUMB /RETURN OKAY END