/FLOATING POINT INPUT/OUTPUT ROUTINES: / 8NFIO.PA / FOR PDP8I OR PDP12 WITHOUT EAE / BASED ON 8XFIO.PA NEW NON-EAE EMULATION 2025-10 / BY BILL CATTEY AND CHATGPT /=============================================================== / NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E / TARGET RANGE: 13200-14177 /--------------------------------------------------------------- / THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO / CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES. / / THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE / WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978 / AS BEST WE COULD FIND IT. / / CURRENTLY IMPLEMENTED EMULATIONS: / MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT) / DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER) / SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE) /--------------------------------------------------------------- / NOTES: / MQL IS REDEFINED INLINE AS "DCA SAVMQ" / ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.) / WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO. /=============================================================== / THIS MODULE INCORPORATES TWO LEVELS SELF-TEST LOGIC / / DEFINE "EMTEST=1" IF YOU WANT A POST-HOC / REPEAT EVERY EMULATION WITH THE EAE AND HALT / ON ANY DISCREPENCY. / / THERE IS ALSO A STAND-ALONE TEST MODE. / WHEN 8NFIO IS ASSEMBLED WITHOUT U/W FOCAL, / THE VIRTUAL MQ SAVMQ STORED IN 10010 ISN'T DEFINED. / WE DETECT THAT AND DEFINE TESTME=1. / / TESTME IS A SHORT PROGRAM THAT PERFORMS / TESTS RECORDED IN THE TABLE APTLY NAMED / "TABLE". HERE AGAIN, THE EMULATION AND / THE EAE PERFORM BOTH TESTS AND HALTS / ON ANY DISCREPANCY. /--------------------------------------------------------------- / PAGE-ZERO “INSTRUCTION” VECTORS. APPENDING TO THOSE DEFINED / IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY" /EMTEST=1 / DEFINE IF WE WANT IN-LINE EMULATION TEST. / IF WE HAVE EMTEST, AND ARE INSIDE U/W FOCAL / SAVMQ IS DEFINED. WE NEED TO DEFINE / THE EAE OPS FOR TESTING THEY NORMALLY / DONT GET DEFINED IN NON-EAE U/W FOCAL IFDEF SAVMQ < MUY=7405 DVI=7407 > / TESTME CONTROLS STAND ALONE TESTING / 1 FOR ENABLE / 0 FOR NORMAL IFNDEF SAVMQ < *10 SAVMQ, 0 TESTME=1 IFNDEF EMTEST < EMTEST=1 / WE USE EMTEST STAND ALONE > > IFDEF TESTME < /================================================================ / PAL-8 TEST HARNESS — EAE vs EMULATION (MODE A) / 8 TEST CASES, HALT AFTER EACH SUBTEST / Inspect AC & MQ (hardware) vs AC & SAVMQ (emulation) at each HLT /================================================================ / Combined instructions L0001=CLL CLA IAC L0002=CLL CLA CML RTL L0003=CLL CLA CML IAC RAL L0006=CLL CLA CML IAC RTL L2000=CLL CLA CML RTR /EAE INSTRUCTIONS TO BE EMULATED MUY=7405 DVI=7407 MQL=7421 *0200 / origin for harness (pick a safe page / TABLE OF TESTS: / EMUOP, OPERAND, MQ, AC START, CLA CLL TAD TSTART DCA TABLEP DCA TNUM REP, TAD I TABLEP SNA HLT DCA EMUOP ISZ TABLEP TAD I TABLEP DCA EMUOP+1 ISZ TABLEP TAD I TABLEP DCA SAVMQ ISZ TABLEP TAD I TABLEP EMUOP, 0 0 ISZ TABLEP ISZ TNUM CLA CLL JMP REP TABLEP, 0 TNUM, 0 TSTART, TABLE / EM: OP; MQ; AC. SWP: AC and MQ swap PAGE TABLE, EMMUY; 5; 3; 0 / T0: 3 * 5; AC=0 MQ=17 EMMUY; 12; 0; 3 / T1: 0 * 12 + 3: AC=0 MQ=3 EMMUY; 2; 7777; 0 / T2: 7777 * 2: AC=1 MQ=7776 EMMUY; 7; 6; 0 / T3: 6 * 7: AC=0 MQ=52 EMDVI; 3; 2000; 1 / T4: 12000 / 3: AC=2 MQ=3252 EMDVI; 4; 14; 0 / T5: 14 / 4: AC=2 MQ=3 EMDVI; 400; 0; 2000 /T6: 20000000 / 400:AC=2000;MQ=1;L=1 EMDVI; 4; 12; 0 / T7: 12 / 4: AC=2 MQ=2 EMDVI; 6; 5; 0 / T10: 6 /5: AC=5 MQ=0 SWPMUY; 0; 0; 3146 / T11: 0 * 3146 + 0 = 0 NO ADD SWPMUY; 0; 1000; 3146 / T12: 0 * 3146 + 1000 AC=1147 MQ=1000 SWPMUY; 6316; 4000; 2400 / T13: 6316 * 2400 + 4000 AC=2000 MQ=7000 EMMUY; 0; 0; 3 / T14 0 * 0 + 3 AC=0 MQ=3 EMMUY; 3110; 2400; 0 / T 15 3110 * 2400 AC=766 MQ=0 EMMUY; 6650; 2400; 0 / T 16 6650 * 2400 AC=2104 MQ=4000 SWPMUY; 3000; 4000; 3147 /T 17: 3000 * 3147 + 4000: AC=1147 MQ=1000 SWPMUY; 3000; 1000; 3146 /T 20 3000 * 3146 + 1000 AC=1146 MQ=3000 SWPMUY; 6316; 7000; 2400 / T 21 6316 * 2400 + 7000 AC=2001 MQ=2000 EMDVI; 6000; 0; 2400 /T 22 24000000 / 6000 AC=4000 MQ=3252 EMDVI; 6000; 0; 2200 /T 23 22000000 / 6000 AC=0 MQ=3000 EMDVI; 5000; 0; 0 /T24 0 / 6000 AC=0 MQ=0 ZERO DIVIDEND IS NOT OVERFLOW. 0 / END OF HARNESS > /FLOATING POINT INPUT/OUTPUT ROUTINES: / 8NFIO.PA / FOR PDP8I OR PDP12 WITHOUT EAE / BASED ON 8XFIO.PA NEW NON-EAE EMULATION 2025-09 / BY BILL CATTEY AND CHATGPT /=============================================================== / NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E / TARGET RANGE: 13200-14177 /--------------------------------------------------------------- / THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO / CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES. / / THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE / WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978 / AS BEST WE COULD FIND IT. / / CURRENTLY IMPLEMENTED EMULATIONS: / MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT) / DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER) / SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE) /--------------------------------------------------------------- / NOTES: / MQL IS REDEFINED INLINE AS "DCA SAVMQ" / ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.) / WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO. /=============================================================== /--------------------------------------------------------------- / PAGE-ZERO “INSTRUCTION” VECTORS. APPENDING TO THOSE DEFINED / IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY" IFDEF EMTEST < IFNDEF TESTME < *PRODUCT-2 / EAT 2ND FROM LAST LOC FOR AUTO TEST > IFDEF TESTME < *100 > CMPEAE= JMS I . EAECMP > IFNDEF TESTME < *PRODUCT-1 / EAT LAST PATCH LOC > IFDEF TESTME < *101 > EMSWP= JMS I . / EMULATE EAE SWP SWPEM IFNDEF TESTME < *GINC+1 / CONSUME ALL USER CONSTANTS > EMMUY= JMS I . / EMULATE EAE MUY MUYEM MQLMUY= JMS I . / EMULATE EAE MQL MUY MUYMQL SWPMUY= JMS I . / EMULATE EAE SWP MUY MUYSWP EMDVI= JMS I . / EMULATE EAE DVI DVIEM MQLDVI= JMS I . / EMULATE EAE DVI DVIMQL /--------------------------------------------------------------- /========================================================== / EAE MODE A EMULATORS FOR U/W FOCAL 4E (PAL-8) / 5 ROUTINES: SWPEM, MUYEM, MUYMQL, DVIEM, DVIMQL / TEMP LOCS: EMOP..EMAC / SAVMQ USED AS SOFTWARE MQ /========================================================== IFNDEF TESTME < *14500 > IFDEF TESTME < *700 > / ONE COMBINED INSTRUCTION NOT DEFINED IN UWF L0002=CLL CLA CML RTL L4000=CLL CLA CML RAR L7777=CLL CLA CMA IFNDEF TESTME < *13200 > IFDEF TESTME < *1000 > /--------------------- SWPEM -------------------------------- / SWP EMULATOR (SINGLE WORD ENTRY) / SWP: SWAP AC and SAVMQ SWPEM, 0 DCA RMDPHI / SAVE AC to SWPET1 TAD SAVMQ DCA EMAC / SAVE OLD MQ to SWPET2 TAD RMDPHI DCA SAVMQ / NEW MQ := OLD AC TAD EMAC JMP I SWPEM / RETURN (AC := OLD MQ) MUYSWP, 0 / RELIES ON USE OF EMAC TO DO THE SWAP DCA EMAC / SAVE AC TAD MUYSWP / FIX RETURN ADDRESS DCA MUYEM TAD EMAC / RESTORE AC AND SWAP EMSWP / CALL OUT TO DISTANT EMSWP JMP MUYEM+1 / JUMP INTO MUYEM /============================================================ / MUY EMULATION FAMILY (MODE A) / MUYEM - MUY (PLAIN) : MULTIPLICAND IS SAVMQ (MQ EMULATED) / IF AC NON-ZERO ON ENTRY, ADD IT TO PRODUCT / MUYMQL - MQL + MUY : MULTIPLICAND IS AC (MQL STORES AC IN SAVMQ) / MULTIPLICAND IS IN NEXT WORD AFTER CALL / MUYCORE - COMMON KERNEL : 12-ITER SHIFT/ADD to 24-BIT PRODUCT / RESULTS: AC = HIGH 12 BITS, SAVMQ = LOW 12 BITS / TEMPS: MDCNT, EMOP, EMAC, AND RMDPHI, / ALGORITHM: REUSE SAVMQ AS BOTH MULTIPLIER AND LO RESULT / INITIALIZATION: LINK IS CLEAR; MULTIPLIER IN MQ; / MDCNT -14; MULTIPLICAND IN EMOP; HI PROD IN RMDPHI / IF LSB OF PRODUCT IS 1 ADD EMOP TO SAVMQ / CONSTANTS: NEG14 -14 OCTAL FOR 12 WAY SHIFT /============================================================ /---------------- MUYEM (PLAIN MUY) ------------------------- MUYEM, 0 DCA EMAC / SAVE ORIGINAL AC to EMAC DCA RMDPHI / IN CASE WE DO FAST EXIT TAD MUYEM DCA MUYMQL IFDEF EMTEST < TAD SAVMQ / PRESERVE MQ ACROSS QUICK EXIT MQL > TAD SAVMQ / TEST MULTIPLIER (MQ EMULATED IN SAVMQ) SZA CLA / MUYMQL WILL FETCH SAVMQ WHEN NEEDED. JMP MUYMQL+3 / IF NONZERO MULTIPLICAND, DO FETCH PATH JMP MPEXIT / IF ZERO, ADD TO MQ AND EXIT /---------------- MUYMQL (MQL + MUY) ----------------------- MUYMQL, 0 DCA SAVMQ / MOVE AC to SAVMQ (MQL EFFECT) DCA EMAC / MQL MUY CLEARS AC DCA RMDPHI / PRODUCT HIGH := 0 IFDEF EMTEST < / PRESERVE ORIGINAL SAVMQ TAD SAVMQ MQL > TAD I MUYMQL / FETCH MULTIPLIER (LITERAL) SNA JMP EXMQ0 / FAST EXIT IF MULTIPLIER = 0 DCA EMOP / EMOP := MULTIPLIER NEVER CHANGES TAD NEG14 DCA MDCNT / MDCNT := -14 (COUNT FOR 12 ITERATIONS) MPLOOP, CLL TAD SAVMQ RAR / SHIFT MULTIPLIER RIGHT, LSB to LINK DCA SAVMQ SZL / IF LINK = 1 (LSB WAS 1) DO ADD TAD EMOP CLL / ADD MAY HAVE SIGNIFICANT CARRY TAD RMDPHI RAR / AND ROTATE IT / PROD LO HAS MULTIPLIER RIGHT SHIFTED / PROD HI IS RIGHT SHIFTED / MAYBE WITH MULTIPLICAND ADDED DCA RMDPHI / IF HI SHIFTED A RIGHT BIT / ADD IT TO HI BIT OF SAVMQ SZL L4000 TAD SAVMQ DCA SAVMQ ISZ MDCNT JMP MPLOOP / --- ADD ORIGINAL AC (EMAC) INTO PRODUCT LOW, PROPAGATE CARRY --- MPEXIT, CLA CLL / LINK MIGHT HAVE BEEN SET ON ENTRY. IFDEF EMTEST < TAD I MUYMQL / FAST EXIT NEEDS TO INITIALIZE DCA EMOP / OP FOR TESTING. > TAD EMAC / GET SAVED AC TAD SAVMQ / ADD TO PRODUCT DCA SAVMQ / AND SAVE IT SZL IAC / IF ADDING TO SAVMQ OVERFLOWED TAD RMDPHI / PUT PRODUCT INTO AC ISZ MUYMQL CLL IFDEF EMTEST < CMPEAE > MPRET, JMP I MUYMQL / RETURN TO CALLER (MUYEM OR MUYMQL) EXMQ0, DCA SAVMQ JMP MPEXIT /---------------- TEMP & CONSTS ----------------------------- MDCNT, 0 / COUNTER EMOP, 0 / OPERAND -- MULTIPLIER OR DIVISOR RMDPHI, 0 / PROD HIGH OR DIVIDEND HI EMAC, 0 / SAVE OF AC AT ENTRY MINDIV, 0 / NEGATED DIVISOR NEG14, -14 /============================================================= / DVIEM - MODE A DVI NONRESTORING UNSIGNED DIVIDE / ENTRY: EMDVI, NEXT WORD = DIVISOR LITERAL / INPUT: AC = HIGH 12 BITS OF DIVIDEND / SAVMQ = LOW 12 BITS OF DIVIDEND / OUTPUT: NORMAL: AC = REMAINDER, SAVMQ = QUOTIENT, LINK = 0 / OVERFLOW: AC UNCHANGED, SAVMQ = (SAVMQ LEFT SHIFT 1)+1, LINK=1 /============================================================= / EMULATE COMBINATION OF MQL DVI / WHICH FILLS SAVMQ WITH AC AND CLEARS AC DVIMQL, 0 DCA SAVMQ TAD DVIMQL DCA DVIEM SKP / REGULAR DVI DVIEM, 0 / SAVE DIVIDEND DCA RMDPHI / RMDPHI := AC / FETCH DIVISOR TAD I DVIEM CIA DCA MINDIV IFDEF EMTEST < TAD SAVMQ / PRESERVE ORIGINAL SAVMQ MQL TAD RMDPHI / PRESERVE AC ORIGINALLY CALLED DCA EMAC TAD I DVIEM DCA EMOP > ISZ DVIEM / TEST FOR OVERFLOW: IF AC GREATER OR EQUAL TO EMOP CLL TAD MINDIV TAD RMDPHI / AC = EMOP - RMDPHI SNL CLA JMP DVNORM /---------------- OVERFLOW CASE ------------------------------ DVIOVF, TAD SAVMQ / MQ = (MQ LEFT SHIFT 1) + 1 RAL DCA SAVMQ TAD RMDPHI / RESTORE AC = ORIGINAL HIGH HALF STL / SET LINK IFDEF EMTEST < CMPEAE > JMP I DVIEM / DIVISION ALGORITHM FROM DECUS 8-436 / WITH A BIT MORE OPTIMIZATION /---------------- NORMAL DIVISION ---------------------------- DVNORM, L7777 TAD NEG14 DCA MDCNT / 13 ITERATIONS 15 OCTAL DVIS1, CLA CLL SKP DVIS2, DCA RMDPHI TAD SAVMQ RAL DCA SAVMQ TAD RMDPHI ISZ MDCNT SKP JMP DVDONE RAL DCA RMDPHI TAD RMDPHI TAD MINDIV SNL JMP DVIS1 JMP DVIS2 / COMMIT THE SUBTRACTION DVDONE, CLL IFDEF EMTEST < CMPEAE > JMP I DVIEM IFDEF EMTEST < PAGE / IN-LINE EMULATION TESTING / HALT IF THE EAE ACTION IS DIFFERENT / MQ SET TO PRE EMULATION SAVMQ BY CALLER / FROM THE EMULATED ACTION EAECMP, 0 DCA ACEM / SAVE AC EMULATION RETURN RAR DCA LINKEM / SAVE LINK EMULATION RETURN TAD I EMOPPT / FETCH EMOP (MULTIPLICAND/DIVISOR) DCA EMOPCP TAD I EMACPT / FETCH EMAC (ORIGINAL AC) DCA EMACP MQA / FETCH MQ FROM BEFORE ACTION DCA MQSAVE TAD MULPTR / CALLED FROM MULTIPLY? CIA TAD EAECMP SZA CLA / OR ONE OF THE DIV CALLS L0002 / DVI = MUL + 2 TAD KMUY DCA TESTOP DOTEST, TAD EMOPCP DCA EAEARG TAD MQSAVE MQL TAD EMACP TESTOP, 0 EAEARG, 0 / THE OPERATION TO TEST DCA ACREPL RAR / FIRST TEST THE LINK REPLY TAD LINKEM SZA CLA HLT / LINK DOESN'T MATCH. HALT TAD ACREPL CIA TAD ACEM SZA CLA HLT / AC DOESN'T MATCH HALT MQA / COMPARE EAE MQ WITH EMULATION CIA TAD SAVMQ SZA CLA HLT TAD LINKEM RAL / RESTORE LINK REPLY TAD ACEM / RESTORE AC REPLY JMP I EAECMP / TAKE IT ON HOME! / ARGS TO THE EMULATION / HERE IN ORDER OF PLACEMENT IN THE TEST TABLE / OP, MQ, AC EMOPCP, 0 / COPY OF EMOP FROM EMULATION MQSAVE, 0 / COPY OF PRESERVED MQ BEFORE EMULATION EMACP, 0 / COPY OF EMAC FROM EMULATION / RESULTS TO COMPARE: / AC FROM EMULATION THEN AC FROM EAE / LINK FROM EMULATION THEN LINKL FROM EAE / WE COMPARE SAVEMQ WITH MQ REGISTER. ACEM, 0 / COPY OF AC REPLY FROM EMULATION ACREPL, 0 / AC REPLY FROM EAE LINKEM, 0 / COPY OF LINK REPLY FROM EMULATION LREPL, 0 / LINK REPLY FROM EAE / POINTERS TO STUFF IN THE EMULATION EMOPPT, EMOP EMACPT, EMAC MULPTR, MPRET / WHERE WE WOULD REURN TO IF MPY KMUY, MUY > IFNDEF TESTME < / CODE IMPORTED FROM 8XFIO.PA *5400 /AFTER THE FUNCTIONS FLINTP, 0 /CONVERT ASCII TO BINARY - 'READN' JMS FIGO5 /CHECK LEADING CHARACTERS JMS FIGO4 /READ FIRST DIGIT GROUP SNL /ENDED BY A PERIOD? JMS FETCH /SKIP IT & READ 2ND GROUP JMS FIGO7 /AND SET NEW DIGIT COUNT JMS I RESOL /FIX UP THE SIGN TAD CHAR TAD (-"E /DID WE READ AN 'E'? SZA CLA JMP FIGO2 /NO FIGO1, JMS FETCH /YES, PASS THE 'E' FENT FPUT I FLARGP /SAVE THE MANTISSA & DEC. PT. FEXT JMS FIGO4 /READ THE DECIMAL EXPONENT TAD OVER ISZ SIGN /CHECK THE SIGN CIA DCA FIGO4 /SAVE THE RESULT FENT FGET I FLARGP /RESTORE WHAT WE HAD FEXT TAD FIGO4 /COMBINE THE SCALE FACTORS FIGO2, TAD EXP /SET UP THE LOOP COUNTER CLL SPA STL CIA /WITH -(ABS. VALUE+1) CMA DCA FIGO4 SZL /TEST DIRECTION TAD FL10 TAD (FMUL FLP1 /OR 'FMUL FL10' DCA FIGO3+1 TAD P43 /INSERT THE PROPER EXPONENT DCA EXP NORMALIZE JMP FIGO3+3 FIGO3, FENT /SCALE LEFT OR RIGHT FMUL FL10 FEXT ISZ FIGO4 JMP FIGO3 JMP I FLINTP /***RETURN*** FIGO4, 0 /READ A GROUP OF DIGITS JMS FIGO6 /START WITH ZERO SM1 DCA SIGN /INITIALIZE SIGN TAD CHAR TAD (-"- SZA ISZ SIGN /RESET IF POSITIVE CMA CLL RAL /SET CODE FOR "+" CMA CLL RAR /"+" to 0000(1) SNA CLA /NOT "+" OR "-" IAC /SKIP THE SIGN JMS FIGO5 /AND IGNORE SPACES JMS FIGO7 /DO ALL THE WORK JMP I FIGO4 ///// FIGO5, 0 /PROCESS LEADING CHARACTERS SMA SZA /-240, ONLY 'SZA' OCCURS JMS FETCH /GET FIRST OR NEXT TAD CHAR TAD .-3 /IS IT A SPACE? SNA CLA JMP .-4 /IGNORE LEADING SPACES JMP I FIGO5 ///// FIGO6, 0 /'FLOAT' DCA HORD DCA LORD DCA OVER TAD P13 DCA EXP JMP I FIGO6 ///// /READ A CHARACTER FROM TEXT OR THE INPUT DEVICE: FETCH, 0 TAD I FLINTP /CHECK THE NEXT INSTRUCTION SMA CLA JMP ACCEPT GETC /READ FROM THE TEXT BUFFER JMP I FETCH ///// PRINTC /IN CASE WE WANT TO ECHO FF ACCEPT, READC /READ FROM THE INPUT DEVICE SORTJ /TEST FOR SPECIAL ACTION SPECIAL-1 ACTION-SPECIAL JMP I FETCH ///// FIGO7, 0 /DECIMAL-TO-BINARY CONVERSION DCA EXP /CLEAR DIGIT COUNTER TESTN JMP I FIGO7 /PERIOD, L=0 JMP FIGO9 /OTHER, L=0 TAD SORTCN /GET THE NUMBER FIGO8, MULT10 /ADD IT IN SZA CLA JMP .+3 TAD HORD /CHECK FOR OVERFLOW SPA CLA ERROR2 /INPUT OVERFLOW ERROR ISZ EXP /COUNT THE DIGITS JMS FETCH /GET ANOTHER ONE JMP FIGO7+2 ///// FIGO9, TAD CHAR /ALLOW A-Z TAD (-"E SNA JMP I FIGO7 /'E' IS SPECIAL AND L=1 TAD ("E-"Z-1 STL IAC TAD ("Z-"A+1 SNL SZA JMP FIGO8 /TREAT A-Z LIKE NUMBERS STL CLA JMP I FIGO7 /L=1 ///// /THESE TWO CONSTANTS MUST NOT BE SEPARATED FLP1, -3;3146;3146;3147 FL10, +4;2400;0000;0000 ECHOGO=. /BRANCH LIST FOR 'READC' IECHO-2 /FF IECHO+1 /LF IECHO+1 /RO *PRODUCT SPECIAL,233 /ESCAPE 375 /ALTMODE "_ /RESTART ECHOLST,FF /IGNORE (KEYBOARD ONLY) LF /IGNORE RO /IGNORE /THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO /ALLOW THE NUMBER OF DIGITS PRINTED IN SCIENTIFIC NOTATION /TO BE CONTROLLED. A FORMAT OF '0' MEANS 'ALL SIGNIFICANT /DIGITS' WHILE '.05' MEANS 'JUST PRINT 5' WITH APPROPRIATE /ROUNDING. THIS FORMAT PRINTS A LEADING DIGIT FOLLOWED BY /A DECIMAL POINT, MORE DIGITS AND THEN THE EXPONENT. /ANOTHER IMPROVEMENT IS THAT THE MINUS SIGN IS ALWAYS OUT- /PUT JUST AHEAD OF THE FIRST SIGNIFICANT DIGIT. *5600 /A RATHER SPECIAL LOCATION! PD, DIGITS /DEFAULT TGO, 0 /CALLED BY 'PRINTN' DCA XRT2 /SAVE BUFFER ADDRESS TAD FISW /GET FORMAT SAVED BY % TRAP AND P7600 /ISOLATE THE FIELD LENGTH RTL6 STL CIA /NEGATE AND TEST FOR ZERO DCA FLAC /SAVE MINUS FIELD LENGTH TAD FISW /GET NO. OF DECIMAL PLACES SNA TAD PD /USE DEFAULT IF NONE SPEC. ESGN, AND P177 /A REASONABLE LIMIT! SNL /SCIENTIFIC? JMP SPM0+1 /YES, ROUND TO D PLACES TAD FLAC /COMPARE FIELD SIZE SNL / D-F LESS THAN 0 ? STA STL /NO, TAKE D = F-1 TAD T3 /COMPARE DECIMAL EXPONENT SNL SMA SZA / E GREATER THAN F-D ? SPM0, SNL SMA SZA CLA /ROUND OFF TO F PLACES CIA /ENTER HERE FOR SCI. NOT. DCA T2 /SAVE F-D-E (OR 0 OR -D) TAD T2 /THIS IS TRICKY BUSINESS! STL /EXTEND THE SIGN TAD FLAC / -(E+D), -F OR -D (-D-F) TAD PD /COMPARE WITH LIMIT SZL /SKIPS FOR 0 LESS THAN AC LESS THAN PD+1 CLA /LIMIT ROUNDOFF TO DIGITS+1 TAD EX1 /ADD -PD-1 (MDM1) TO RESTORE STL CIA /(E+D), F, D, DIGITS (+1) BUMP, TAD XRT2 /SET UP BUFFER ADDRESS DCA OUTA ISZ I OUTA /INCREMENT THIS DIGIT TAD I OUTA /NOW TEST IT SNL /LITTLE EXTRA THE FIRST TIME TAD M4 TAD M5 SPA SNA CLA /CARRY REQUIRED? JMP RNDC+4 /NO: GO TO OUTPUT DCA I OUTA /YES: MAKE CURRENT DIGIT ZERO STL IAC /SET UP LINK FOR NEXT CYCLE & DCA I START /ANTICIPATE CARRY FROM 999... TAD OUTA /DECR AND CHECK THE POINTER TAD RNDC /-(START OF BUFFER) SZA /BEGINNING OF BUFFER REACHED? JMP BUMP /NO: BUMP THE NEXT DIGIT ISZ T3 /YES: INCR. DECIMAL EXPONENT RNDC, -BUFFER-1 /'NOP' CMA /AND SET THE MANTISSA TO 0.1 TAD XRT2 /BY DECREMENTING THE POINTER JMP TGO+1 /RECOMPUTE THE DECIMAL POINT SM1 /SET SIGN COUNTER DCA T1 TAD C240 /'TAD ESGN' IF YOU WISH CLA /PRINTC TO PRINT A LEADING SPACE BEFORE # TAD FLAC /GET FIELD SIZE SNA /FLOATING OUTPUT ? JMP FLOUT /YES TAD T3 /COMPARE WITH EXPONENT SMA SZA CLA / E GREATER THAN F ? JMP FLOUT+2 /YES: USE FLOATING FORMAT TAD T2 / F-D-E (OR 0 IF E GREATER THAN F-D) TAD T3 / F-D OR E CIA /CALCULATE -NO. OF POSITIONS DCA T2 /TO PRINT BEFORE DECIMAL PT. BACK, TAD T2 /PRINT DD.DDD TAD T3 SNA CLA / P = E ? JMP DIG /YES: PRINT DIGIT IAC /NO ('376' TO SUPPRESS 1ST ZERO) TAD T2 SPA CLA / P LESS THAN 1 ? TAD SPM0 /YES: PRINT SPACE AGAIN, JMS OUTA /PRINT CHARACTER ISZ T2 /P CHARACTERS PRINTED? JMP BACK /NO SM2 /YES ('TAD 376') PRINTD /PRINT DECIMAL POINT JMP BACK FLOUT, TAD T2 /SET FIELD SIZE DCA FLAC / -D SM1 /SET FLAG DCA OUTA ISZ TGO /SET SECOND RETURN DIG, CLA SM1 /POINTS TO 'TERM' TAD T3 /REDUCE E BY 1 DCA T3 JMS GETD /GET NEXT DIGIT ISZ OUTA /TEST FLAG JMP AGAIN /NORMAL RETURN PRINTD /PRINT FIRST FLOATING DIGIT SM2 /CREATE A PERIOD (256-260) SKP /DON'T FETCH & DON'T COUNT JMS GETD /FETCH NEXT DIGIT JMS OUTA /PRINT IT JMP .-2 /AND REPEAT OUTA, 0 PRINTD /PRINT CHARACTER ISZ FLAC /F CHARACTERS PRINTED? JMP I OUTA /NO: RETURN JMP I TGO /YES: NUMBER FINISHED ///// GETD, 0 /ROUTINE TO UNLOAD BUFFER TAD I XRT2 /AUTO-INDEX REG. SETUP UPON ENTRY ISZ EX1 /TEST FOR END OF SIGNIFICANT FIG. JMP I GETD CLA CMA /FORCE -1 IN ORDER TO DCA EX1 /OUTPUT EXTRA ZEROS JMP I GETD /LEAVE C(AC)=0 ///// FTRM, TAD I DIG /GET THE INPUT TERMINATOR FLOATR ///// DBLSUB, 0 /CHECK FOR A SECOND SUBSCRIPT TSTCMA JMP I DBLSUB /ONLY ONE PUSHF FLAC /SAVE THE FIRST ONE PUSHJ EVAL /GET THE SECOND ONE POPF FLARG /TEMPORARY STORAGE TAD DIMEN DCA PT1 /SET THE VARIABLE POINTER FENT FSUB I FP1 /THE SECOND MINUS ONE FMULIPT1 /TIMES THE DIMENSION FADD I FLARGP /PLUS OFFSET OF FIRST FEXT JMP I DBLSUB /CALLED BY 'GETARG' DIMEN, STVAR+2+WORDS+2 /DATA POINTER FOR (!) PAGE LNFEED= (0&(1&(2 /RESERVE 3 LOCATIONS XLIST; NOPUNCH; PAGE 30; ENPUNCH; XLIST /FLOATING POINT OUTPUT CONVERSION: 'PRINTN' /REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING' /MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) A /MEANS FOR 'TDUMP' TO OUTPUT 3-DIGIT SUBSCRIPTS (+/-999); /(3) A PROVISION FOR NON-PRINTING CALLS WHICH JUST SET UP /THE OUTPUT BUFFER BUT DO NOT DO ANY PRINTING. /THANKS TO JIM CRAPUCHETTES FOR TWELVE LOCATIONS! MDM1, -DIGITS-1 /START FLOUTP AT PAGE+1 FLOUTP, 0 /CONVERT BINARY TO ASCII DCA T2 /SET THE NON-PRINT FLAG STL IAC DCA T3 /INITIALIZE THE EXPONENT JMS I ABSOL /TAKE THE ABSOLUTE VALUE CMA RAR /LINK WILL BE ZERO IF NEGATIVE DCA FGO6 /SET THE SIGN FLAG TAD SIGN SNA CLA /ZERO? JMP FGO3 FGO1, FENT /NUMBER TOO LARGE FMUL I (FLP1 /MULTIPLY BY .1 FEXT ISZ T3 /INCREASE DECIMAL EXPONENT TAD EXP SMA SZA CLA /CHECK THE BINARY EXPONENT JMP FGO1 FGO2, FENT /NUMBER TOO SMALL FMUL I (FL10 /MULTIPLY BY 10 FEXT CMA /DECREASE DECIMAL EXPONENT TAD T3 DCA T3 TAD EXP /CHECK THE BINARY EXPONENT SPA SNA JMP FGO2 FGO3, CMA /NEGATE THE BIT COUNT DCA EXP TAD MDM1 /INITIALIZE DIGIT COUNT DCA OUTDG TAD START /INITIALIZE BUFFER POINTER DCA XRT2 FGO4, DCA EX1 /SHIFT OUT THE FIRST DIGIT SHIFTL TAD EX1 RAL ISZ EXP JMP FGO4 SKP FGO5, MULT10 /IE. 0.672 X 10 = 6 + 0.72.. ETC. DCA I XRT2 ISZ OUTDG /ALL DIGITS OUTPUT? JMP FGO5 /NO: CONTINUE TAD MDM1 DCA EX1 /SAVE NO. OF DIGITS TAD START /GET BUFFER POINTER ISZ T2 /TEST PRINT FLAG JMS I .+1 /OUTPUT MANTISSA JMP I FLOUTP /FIXED POINT DONE TAD ("E /PRINT 'E' PRINTC JMS FGO6 /OUTPUT THE EXPONENT JMP I FLOUTP /FLOATING POINT DONE ///// OUTDG, 0 /MULTI-PURPOSE ROUTINE - 'PRINTD' SMA /IGNORE SPACES AND THE LIKE OR ISZ T1 /DIGITS OTHER THAN THE FIRST ! JMP DGOUT DCA T1 /SAVE THE FIRST DIGIT ISZ FGO6 /CHECK THE SIGN FLAG TAD C255 /MAKE A '-' TAD C240 /'SZA' TO OMIT THIS SPACE PRINTC TAD T1 /RESTORE AC DGOUT, TAD ("0 /FORM ASCII PRINTC JMP I OUTDG C255, 15 /'255' ///// FGO6, 0 /ALSO CALLED BY 'TDUMP' TAD T3 /GET EXPONENT SPA CLA /TEST SIGN SP2 /+2 to -3 TAD M5 JMS OUTDG /PRINT SIGN TAD T3 SPA CIA MQLDVI /DIVIDE BY ONE HUNDRED 144 DCA T2 EMSWP /PRINT QUOTIENT SZA /UNLESS IT'S ZERO JMS OUTDG TAD T2 /NOW PRINT REMAINDER JMS PRNT JMP I FGO6 PRNT, 0 /PRINT TWO DECIMAL DIGITS AND P177 MQLDVI /DIVIDE BY TEN 12 DCA T2 EMSWP /GET QUOTIENT JMS OUTDG TAD T2 /GET REMAINDER JMS OUTDG DCA T1 /RESET SWITCH JMP I PRNT /CALLED BY 'FGO6' & 'PRNTLN' ///// MPLY, 0 /CONTINUATION OF EAE MULTIPLY TAD LORD DCA .+3 TAD AC1L /B*E SWPMUY 0 TAD EX1 DCA SAVMQ /DISCARD FOUR RAL DCA EX1 /INITIALIZE TWO TAD HORD DCA .+3 TAD AC1L /A*E SWPMUY 0 TAD EX1 /ADD TO TWO DCA EX1 TAD LORD DCA .+3 TAD AC1H /B*D SWPMUY 0 TAD EX1 /BUILD UP TWO JMP I MPLY /FINISH ONE & TWO FIELD 1 /FORGET LITERALS *LNFEED TAD I TABCNT /WHERE ARE WE? SNA CLA JMP I CFF /IGNORE THE LF AFTER A CR TAD LASTC DCAIAXIN /SAVE THE LAST CHARACTER JMP I .+1 LFCONT-7 /RETYPE THE INPUT LINE /THIS IS A VERY HANDY ROUTINE FOR CONVERTING BCD DATA TO /BINARY FLOATING POINT FORM. JUST SET EXP=43 AT THE END. *6204 XTEN, 0 /MULTIPLY THE FLAC BY 10 (DECIMAL) EMSWP /AND ADD IN C(AC) DCA CPRNT /SAVE THE MQ TAD OVER SWPMUY /THANKS TO REV. GEOFFREY CHASE 12 /FOR SUGGESTING AN EAE VERSION EMSWP DCA OVER TAD LORD SWPMUY 12 EMSWP DCA LORD TAD HORD SWPMUY 12 EMSWP DCA HORD TAD CPRNT /RESTORE MQ EMSWP /AC=OVERFLOW JMP I XTEN /EXECUTION TIME = 60 MICROSECONDS ///// MULT2, 0 /MULTIPLY FLAC BY 2 - 'SHIFTL' TAD OVER CLL RAL DCA OVER TAD LORD RAL DCA LORD TAD HORD RAL DCA HORD JMP I MULT2 /DOES NOT CHANGE 'EXP' ///// DUBLAD, 0 /TRIPLE PRECISION ADDITION CLL TAD OVR1 TAD OVER DCA OVER RAL TAD AC1L TAD LORD DCA LORD RAL TAD AC1H TAD HORD DCA HORD JMP I DUBLAD /CHARACTER INPUT/OUTPUT ROUTINES: 'READC' AND 'PRINTC' /THE INPUT ROUTINE MAY ALSO BE USED TO ECHO A CHARACTER. CHIN, 0 /INPUT A CHARACTER CDF P SNA /'ECHOC' IF AC#0 JMS I INDEV /'READC' IF AC=0 DCA CHAR SORTJ /TAKE CARE OF SPECIAL CHARACTERS ECHOLST-1 ECHOGO-ECHOLST JMP IECHO TAD INDEV /ONLY ECHO FF TO A FILE SPA CLA IECHO, PRINTC /'ZERO' IF NOT ECHOING JMP I CHIN ///// CHOUT, 0 /OUTPUT A CHARACTER - 'PRINTC' SNA /USE AC IF NON-ZERO TAD CHAR /OTHERWISE USE CHAR TAD MCR CIF L JMP TAB /ADJUST TAB COUNTER CROUT, TAD CCR JMS I OUTDEV /CARRIAGE RETURNS TAD CLF JMS I OUTDEV /NORMAL RETURNS JMP I CHOUT ///// /CALLS TO AND FROM THE TAB ROUTINES IN FIELD 0: TABX, PUSHJ /EVALUATE THE COLUMN NO. EVAL-3 FIXIT CIF L JMP ZER+1 /SAME PAGE, FIELD 0 SKPX, JMS CHIN /NEGATIVE COL. NO. CIF L JMP NEG+2 /RETURN TO LOWER FIELD ///// FILIN, ICHAR0 /FILE INPUT ECODEV, XOUTL /DEFAULT OUTPUT /FILE INPUT/OUTPUT ROUTINES: ICHAR, 0 /FILE INPUT VIA (INDEV) CDI L JMP I FILIN /CALL LOWER FIELD JMP I ICHAR FLEN, CLA IAC /CHECK THE FILE LENGTH AND EXP /0=OUTPUT, 1=INPUT CLL RTL /*4 TAD (XLEN DCA CPRNT JMP CPRNT+2 /OFF TO THE LOWER FIELD OCHAR, 0 /FILE OUTPUT VIA (OUTDEV) CDI L JMS I (OCHAR0 JMS I ECODEV /ECHO RETURN JMP I OCHAR /NO-ECHO RETURN EOF, 0 /TRAPS ATTEMPT TO READ BEYOND TAD (XI33 /THE 'END-OF-FILE' CHARACTER DCA INDEV /RESETS POINTERS TO THE TTY: TAD ECODEV DCA OUTDEV TAD CPRNT+1 /AND TURNS ON THE ECHO, TOO DCA IECHO TAD P337 /RETURN A '_' TO CLEAR THE '^Z' JMP I EOF /'EOF' IS ALSO USED BY 'RECOVR' CPRNT, 0 /'PRINTC' FOR DOWN BELOW PRINTC CDI L JMP I CPRNT FBLK, CDF L /READ THE INPUT BLOCK NUMBER TAD I ATSW /SAME PLACE! FL0ATR FIND, FIXIT /CHARACTER SEARCH FUNCTION DCA I TESTC&177 /SAVE IN 'CTEST' JMS I INDEV /READ A CHARACTER DCA CHAR SORTJ /CHECK FOR EOF, MATCH C232-1 FINISH-CTEST TAD CHAR /AND ECHO AS DIRECTED ECHOC JMP FIND+2 /EOF to 0, MATCH to CHAR PAGE >