File: M3FPP.PA of Disk: Disks/MyPDP/m8-blue-rka1-rkb1
(Source file text)
/M3FPP.PA 19-JUN-80 XLIST -LFPP-1&XLISTX /FPP8A EMULATOR IFDEF FPP < / DEFINITIONS: CLSR=6140 / CLEAR SHIFT REGISTER SKFR=6141 / SKP IF FPP IC READY SKFE=6142 / SKIP IF FPP ERROR FLAG IS SET SKSR=6143 / SKIP IF SHIFT REGISTER NOT SHIFTING SEMO=6144 / SET MODE, CLEAR FPP READY FLAG MDINTE=4000 / AC0=1 =: INT. ENABLE ON FPP READY MDEXTD=2000 / AC1=1 =: 64/72 BIT MODE SCAC=6145 / SHIFT COUNTER TO AC6-11 (BIT 4,5 ALWAYS SET) SRAC=6146 / SHIFT REGISTER TO AC NRSR=6147 / NORMALIZE CONTENTS OF (POSITIVE) SHR / SHIFT LEFT UNTIL MSB IS AT LEFMOST POSITION / THE SHIFT COUNTER HOLDS THE PERFORMED SHIFT COUNT / EXCEPTION: SHR = 4000 =: SHIFT COUNT = 1 ACSR=6150 / AC TO SHIFT REGISTER, 0 =: AC ACSC=6151 / AC TO SHIFT COUNTER, 0 =: AC / AC6-11 TO SHIFT COUNTER (AC=0 =: 1 BIT SHIFT) DOWN=4000 / AC0=1 =: SHIFT DOWN IMPL=2000 / AC1=1 =: SET IMPLIED BIT LISH=1000 / AC2=1 =: LINEAR SHIFT (FILL WITH 0) SRFP=6152 / SHIFT REGISTER TO FPP (32 OR 64 BITS, SEE SEMO) FPSR=6153 / FPP TO SHIFT REGISTER (32 OR 64 BITS, SEE SEMO) STSR=6154 / STATUS OF FPP IC TO SHIFT REGISTER (8 LSB) LCGO=6155 / LOAD CMD BYTE INTO FPP IC & GO / THIS CMD WILL DESTROY THE LS 12 BITS / OF THE SHIFT REGISTER SRUP=6156 / SHIFT UP 12 BITS (IN RING-MODE) SRDN=6157 / SHIFT DOWN 12 BITS (IN RING-MODE) / / STATUS REGISTER : /BUSY/SIGN/ZERO/RSRV/DIVI/UNDR/OVER/RSRV/ / 200 100 40 20 10 4 2 1 / / NOTE: THE SHIFT REGISTER NEEDS SOME TIME FOR SHIFTING / ~ 150NS PER SINGLE BIT SHIFT /FPP8A HARDWARE INSTRUCTIONS EMULATION /EMULATOR DISPATCH FOR FPP8A INSTRUCTIONS EM55, TAD (EM55TB-50 /COMPENSATE FOR XX5X JMP I (EMLIST /GO TO DOT PROCESSOR IN M3.PA FPICL, JMS PUT /CLEAR STATUS UFPST /THAT WAS EASY JMP I (EMREDY /NO AC CLEAR FPCOM, JMS GET /SET APT HIGH AND DP MODE UAC /GET USER AC JMS PUT UAPTH /SET EMA BITS OF APT POINTER AC4000 AND I X /GET AC0 JMS PUT / UFPST /SET DP,FP/EP IN STATUS. DP=4000 JMP I (EMCLA /IGNORE ALL OTHER BITS FPRST, JMS GET UFPST /READ STATUS JMP I (EMCLA /EASY FPIST, JMS GET UFPST MQL DCA I X /CLEAR IT ALSO MQA JMS PUT / UAC /STORE STATUS IN AC JMP I (EMSKIP /CRAZY! IT SKIPS FPEP, JMS GET UAC /GET AC. ANOTHER CRAZY INSTRUCTION CLL RTL /IF AC=4000 (WHY THIS?) RTL /SET EP MODE JMS PUT / UFPST / JMP I (EMCLA FPST, JMS GET /SET APT LOW AND GO! UPC IAC /THIS INSTRUCTION SKIPS DCA I X /SO INCREMENT PC JMS GET / UAC TAD M1 /OPTIMIZATION JMS PUT / UAPTL /SET LOW ADDRESS-1 OF APT /FALL INTO NEXT PAGE IFNZRO .&4000 <FPERR, XERROR /M3 & CO ARE TOO BIG > FFACT, JMS FFSJOB /AM I INTERACTIVE ? TAD FFFREE /YES: IS SOMEBODY USING FPP ? SNA CLA /NON-ZERO IS FREE JMP FFSTAL /YES, WAIT DCA FFFREE /OK, HERE WE GO !! JMS GET /SHOW WE ARE BUSY UFPST / SPA CLA /WAS IT DP? IAC DCA DFLG /IF DP DFLG=1 TAD I X / SPA /NOT DP? JMP STSTEN AND C4 /NOT DP, CHECK EP SZA CLA /EP? ACM3 /YES, DFLG=-3 DCA DFLG /NO, DFLG=0 STSTEN, AC2000 AND DFLG /SET CORRECT SHR SIZE SEMO TAD BASE / TAD (UFLD0 /MAKE POINTER TO UFLD TABLE DCA I (FFPFLD /SETDF USES IT FOR FAST RESPONSE JMS I (APTGET /NOW LOAD INFO FROM USER BACKGROUND M8CHK, JMS I (CHKM8 /IS MULTI8 WAITING ? (RESET DF 10) JMS I (GETQ /GET CHAR FROM OUR UBUFIN /OUR INPUT BUFFER AND C177 / TAD M3 /WAS IT ^C? SNA CLA / JMP FFCTC /FAKE UNDERFLOW CONDITION ON ^C JMS FFSJOB /ARE WE STILL INTERACTIVE ? JMP I (FFNOP /YES, GO ON EMULATING JMS I (UNLOAD /NO, UNLOAD IC JMS I (APTDMP /AND DUMP CONTEXT IN USER FIELD ISZ FFFREE /FREE FPP EMULATOR FFSTAL, JMS MONITOR /STALL CONCURRENT BG STALL 1 /FOR 1 TICK JMS SETBASE /CLEAR AC, SET BASE,DF 10 JMP FFACT /TRY AGAIN FFSJOB, 0 /CHECK ON INTERACTIVE PRIORITY TAD BASE / CIA CDF 0 /SJOB IS IN F0 TAD I (SJOB /AM I THE INTERACTIVE JOB ? CDF 10 SNA CLA JMP I FFSJOB /YES, RETURN 1 ISZ FFSJOB JMP I FFSJOB /NO, RETURN 2 FFCTC, DCA I X /ONE ^C AT A TIME!! DEPENDS ON GETQ !!##!!##!! TAD (40 /SET UNDERFLOW BIT IN STATUS (NOT USED IN FRTS) JMP FFEXIT /GO BACK TO USER WITH CTRLC ERROR FFTRP3, FFTRP4, AC2000 /SET TRAPBIT IN STATUS FFPAUS, FFEXIT, MQL // CDF 10 / JMS GET / UFPST / MQA / DCA I X /BACK TO STATUS JMS I (UNLOAD /UNLOAD IC IF NOT YET DONE JMS I (APTDMP /DUMP ALL IN USER BG ISZ FFFREE /FREE FPP FOR OTHERS JMP I (EMREDY /BACK TO NORMAL EMULATOR FFFREE, 1 /FPP FREE FLAG PAGE SYNC, 0 //CALLED WITH FOREIGN FIELD TAD SYNIC //DO WE HAVE TO WAIT ? SNA CLA // JMP I SYNC //NO, WE ALREADY CAME THRU HERE RDF // TAD C6201 //MUST PRESERVE FIELD! DCA SYNEX // SYNWT, JMS I (CHKM8 /LOOK AT MULTI8 (SETS DF=10) SKFR /READY ? JMP SYNWT /NO, CHECK AGAIN STSR /STATUS TO SHR DCA SYNIC /DELAY AND SET NO SYNC SRAC /READ STATUS DCA ICSTAT /AND KEEP AC2000 AND DFLG /SET CORRECT SHR SIZE SEMO /CLEAR FLAG AND CLSR /CLEAR SHR IN CASE OF FAC=0 TAD ICSTAT AND C17 /DID WE GET AN ERROR ? SZA JMP FFERR /YES, BUT WHICH ONE ? TAD ICSTAT /GET STATUS FROM LAST OP AGAIN AND (140 /MASK OUT SIGN=100 AND ZERO=40 BITS BSW /NOW ZERO=4000 AND NEGATIVE=1 TAD (4000 /NOW NONZERO=4000 AND NEG=1 CLL RTR /NOW NONZERO=1000 AND NEG=4000 SYNCLR, DCA ACSGN /OUR SIGN IS SET SYNEX, HLT //BACK TO OLD FIELD JMP I SYNC // FFERR, /WE HAVE AN ERROR! DIV=10,UNDR=4,OVER=2 BSW /DIV=1000,UNDR=400,OVER=200 CLL RAR /DIV=400,UNDR=200,OVER=100 AND (500 /MASK OUT FATALS DIV AND OVER SNA /WAS IT UNDERFLOW? JMP SYNCLR /YES, CLEAR FAC AND GO ON /OVERFLOW=100,DIVERR=400 BITS OF FPP8A JMP I (FFEXIT /PUT IN STATUS AND EXIT UNLOAD, 0 //GETS CALLED WITH FOREIGN FIELD JMS SYNC //UNLOAD IS REALLY COMBINED SYNC-UNLOAD TAD INIC //DO WE HAVE TO UNLOAD ? SNA CLA JMP I UNLOAD //NO, ALREADY DONE DCA INIC //YES, CLEAR UNLOAD FLAG NOW CLSR //CLEAR SHR IN CASE NO SYNC TAD ACSGN //DID SYNC SHOW FAC=0 ? SNA CLA JMP I UNLOAD //YES, TAKE QUICK EXIT WITH ACSGN =0 FPSR //GET DATA FROM IC SKSR //WAIT FOR TRANSFER READY JMP .-1 // TAD DFLG SPA CLA //FP OR EP? JMP FFUNEP //EP FFUNFP, TAD (4+11 //POS EXP ACSC AND 0 //DELAY SRAC //GET EXP AND (377 //MASK TAD (-176 //DEOFFSET FFUNEN, DCA ACX TAD (DOWN+IMPL+LISH+2 ACSC //FINAL POSITION ACSR //CLEAR EXP (NO DELAY) TAD DFLG //WAS IT DP MODE? SPA SNA CLA // JMP I UNLOAD //NO, THAT'S ALL TAD (LISH //YES, FIDDLE MQL //FOR LINEAR SHIFT TAD (27 //IF D.P. INTEGER MODE JMS I (FIXSHF //GO TO UNNORMALIZE RESULT TAD (27 DCA ACX //AND SET EXPONENT TO STANDARD JMP I UNLOAD // FFUNEP, TAD (10+14 //POS EXP ACSC AND I 0 //DELAY SRAC //GET EXP AND (3777 //MASK TAD (-1776 //DEOFFSET JMP FFUNEN // FFCOMM, 0 /DOUBLE LOAD AND COMMAND TO IC DCA FFFUNC /SAVE IC OPCODE TAD INIC /ALREADY LOADED IN IC ? SNA CLA JMS I (FFLOAD /NO, LOAD FAC IN IC JMS I (FFGET //GET OPERAND JMS I (FFLOAD //AND LOAD OPERAND IN IC ISZ INIC //NOW IT IS LOADED AC2000 AND DFLG //BE SURE MODE IS SET SEMO //AND CLEAR FLAG TAD DFLG //WAS IT EP? SPA CLA TAD (50 //YES ADD EPIC MODE TAD FFFUNC //AND OPERATION LCGO ISZ SYNIC //A FLAG IS COMING UP JMP I FFCOMM //NOW OVERLAP EMULATION FFFUNC, 0 /IC FUNCTION ICSTAT, 0 /IC STATUS INIC, 0 /IC LOADED FLAG SYNIC, 0 /IC ACTIVE FLAG PAGE /MAIN INTERPRETER LOOP FFNOP, JMS I (FETPC /GET INST, RESET DF DCA ADRHI TAD ADRHI CLL RTL RTL SPA SZL /IS IT SPECIAL ? JMP BPAGE /BASE PAGE ACCELERATION AND C7 DCA OPCODE /0-2 = OPCODE JMS ADINAU /SET SOME REGISTERS TAD OPCODE TAD AUTO SNA CLA JMP I (XROPR /GO TO XR OR OPERATE CLASS JMS I (FETPC DCA ADRLOW /DOUBLE WORD SPECIAL TAD OPCODE TAD (SPCLST FFDISP, CDF 10 /BE SURE DCA DCDIDX TAD I DCDIDX /LOCAL DEFER DCA DCDIDX JMP I DCDIDX ADINAU, 0 TAD ADRHI CLL RTR RAR AND C7 DCA INDX /6-8 = USUALLY INDEX REGISTER TAD ADRHI AND C100 BSW DCA AUTO /5 = AUTO-INDEX JMP I ADINAU /RETURN - LNK=0 OPCODE, 0 BPAGE, SZL /IS IT REALLY BASE PAGE ? JMP LNGIND /NO, EITHER LONG OR INDIRECT AND C7 /CHOP OUT OPCODE TAD (JMS I FFLST DCA OPJMS /BUILD JMS TO OPERATION TAD ADRHI AND C177 DCA DCDIDX /PICK OUT ADDRESS PART TAD DFLG /CHECK IF DOUBLE INTEGER MODE SMA SZA CLA /IF NOT, LINK=0 STL /YES - ADD 1 TO ADDRESS TAD DCDIDX RAL TAD DCDIDX /MULTIPLY BASE OFFSET BY 3 TAD BASADR /ADD IN BASE PAGE ORIGIN DCA ADRLOW RAL TAD BASHI DCA ADRHI NOINDX, CDF 10 OPJMS, HLT JMP I (M8CHK //GO FOR MORE (RESET DF) LNGIND, AND C7 TAD (JMS I FFLST DCA OPJMS /BUILD JMS TO OP AGAIN JMS ADINAU /SETUP REGISTERS FOR THESE OPS TAD ADRHI /WHERE TO GO ? AND C200 /TEST LOW CLASS BIT SZA CLA /IS IT 'LONG' ? JMP BPAGEI /NO, 'INDIRECT' JMS I (FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS INDEX, DCA ADRLOW /HERE WE COME FROM BPAGEI JMS DCDIDX //SET XR VALUE (MAYBE INCREMENTED) TAD INDX // SNA CLA //IS XR NUMBER 0? JMP NOINDX //YES, NO INDEXING AC7775 //INDEX DF TAD DFLG //GET -3 IF F, -2 IF D, -6 IF E MODE DCA DCDIDX // TAD ADRLOW // XRADLP, CLL // TAD I XRPNT // SZL // ISZ ADRHI //IF LINK SET, INC FIELD ISZ DCDIDX //ADD THE XR IN THE PROPER NUMBER OF TIMES JMP XRADLP // DCA ADRLOW // JMP NOINDX // BPAGEI, TAD ADRHI AND C7 DCA ADRHI TAD ADRHI STL RAL TAD ADRHI /FORM 3*OFFSET+1 TAD BASADR DCA ADRLOW RAL TAD BASHI JMS I (SETDF //FORM PROPER CDF TAD I ADRLOW //GET FIELD BITS OF REAL ADDRESS DCA ADRHI //FROM 2D WORD OF BASE PAGE LOC ISZ ADRLOW // SKP // JMS I (DFBUMP //WATCH FOR FIELD OVERFLOW TAD I ADRLOW //GET LOW-ORDER ADDRESS FROM 3D WORD JMP INDEX //NOW GO DO INDEXING (IF ANY) FFLST, FFGET /FOR F,D AND E MODE FFADD FFSUB FFDIV FFMPY FFADM FFPUT FFMPM DCDIDX, 0 /PREINC XR TAD INDX / JMS I (SETXR //ADD IN BASE ADDRESS OF XR ARRAY TAD I XRPNT //XRPNT SET BY SETXR TAD AUTO //INCREMENT BIT ON? DCA I XRPNT //YES - BUMP XR JMP I DCDIDX // PAGE LDADX, TAD (LAXLST-XRLST+1 XROPR, TAD INDX SNA JMP OPRT /GO TO OPERATES TAD (XRLST-1 JMS DEFER DCA FETPC TAD ADRHI /HERE ADRHI IS INDEX JMS I (SETXR //SET 'XRPNT' AND FIELD JMP I FETPC // OPRT, TAD ADRHI /HERE ADRHI IS SUB OPCODE AND C7 TAD (OPRLST JMP I (FFDISP /JUMP DECODER JUMPS, TAD AUTO CLL RTL RAL TAD INDX TAD (JMPLST JMP I (FFDISP FFJXN, JMS I (DCDIDX //GET XR VALUE WITH INCREMENTING TAD I XRPNT // SNA CLA //ZERO? JMP I (FFNOP //YES. JMP FFJA //JUMP ON INDEX NON-ZERO, RIGHT? FFJAL, JMS I (UNLOAD TAD ACSGN /WAS AC=0 ? SZA CLA /AC=0 MEANS EXP=0 TAD ACX TAD (-27 SPA SNA CLA JMP I (FFNOP JMP FFJA FFJAC, JMS I (UNLOAD /AC=0 IMPOSSIBLE ? SRUP /MOVE TO 'ACH' NOP /DELAY SRAC /GET 'ACH' SRUP /MOVE TO 'ACL', LET'S HOPE IT IS POSITIVE DCA PCHI /WELL.. JA IS POSITIVE SRAC /GET 'ACL' FROM SHR SRDN /MOVE BACK 'ACH' DCA PC /STORE ACL SRDN /MOVE BACK 'ACX' JMP I (M8CHK /CHECK AFTER JUMPS /MISCELLANEOUS JUMP CLASS INSTRUCTIONS FFJSA, TAD ADRLOW DCA XRPNT /USE XRPNT REG HERE TAD ADRHI JMS I (SETDF //SET UP LOC TO SAVE PC IN AC0002 // TAD ADRLOW // DCA ADRLOW //BUMP ADDRESS BY 2 SZL // ISZ ADRHI //INC FOR 15 BIT JSAR, TAD PCHI //JSA/JSR COMMON CODE AND C7 // TAD (1030 //FORM "JA" INSTRUCTION DCA I XRPNT // ISZ XRPNT // SKP // JMS I (DFBUMP //BUMP TARGET ADDRESS TAD PC // DCA I XRPNT // JMP FFJA //NOW JUMP TO DESTINATION FFJSR, AC0001 TAD BASADR DCA XRPNT RAL TAD BASHI JMS I (SETDF //SET DF&T TO BASE PAGE LOC +1 JMP JSAR // VALGT=SPA SNA CLA VALLE=SMA SZA CLA VALGE=SPA CLA VALLT=SMA CLA VALNE=SNA CLA VALEQ=SZA CLA FFJGT, TAD (VALGT-VALLE FFJLE, TAD (VALLE-VALGE FFJGE, TAD (VALGE-VALLT FFJLT, TAD (VALLT-VALNE FFJNE, TAD (VALNE-VALEQ FFJEQ, TAD (VALEQ DCA CNDSKP JMS I (SYNC /WAIT FOR SIGN TO SET TAD ACSGN /EITHER -,0,+ CNDSKP, HLT /TEST AC JMP I (FFNOP /FAILED - DON'T JUMP. FFJA, TAD ADRLOW //DF MAY BE RANDOM DCA PC // TAD ADRHI // DCA PCHI // JMP I (M8CHK // FFSETX, TAD ADRHI /SET XR0 LOC DCA XRHI TAD ADRLOW DCA XRBASE JMP I (FFNOP FFSETB, TAD ADRHI /SET BASE ADDRESS DCA BASHI TAD ADRLOW DCA BASADR JMP I (FFNOP FETPC, 0 //GET NEW CODE ITEM TAD PCHI //DF MAY BE WRONG JMS I (SETDF //ANOTHER DF TAD I PC // CDF 10 /BE NICE TO ME ISZ PC JMP I FETPC ISZ PCHI /15 BIT INC JMP I FETPC FFADDX, TAD I XRPNT //FIELD SET AT 'XROPR' FFLDX, TAD ADRLOW //ADR SET AT 'SPECAL' DCA I XRPNT // JMP I (FFNOP // PAGE /ROUTINE TO NORMALIZE THE FAC FFNOR, 0 //FFNOR DOES NOT TOUCH DF! TAD ACSGN //IS FAC ZERO? SNA CLA JMP I FFNOR //NO USE NRSR //NORMALIZE SHR SKSR // JMP .-1 //DONE? SCAC //GET STEP-COUNT CIA // TAD (377 //WAS IT MAX? (IE FAC=0) SNA // (ALSO SUBTRACT 300 WHICH ARE ALWAYS SET) JMP NORZER //YES-INSURE ZERO EXPONENT TAD (-77+1 //COMPENSATE FOR SIGN DISTANCE TAD ACX //AND ADJUST EXPONENT DCA ACX // TAD (DOWN+1 //SHIFT DOWN 1 BIT ACSC //DOWN AGAIN TO MANTISSA POSITION JMP I FFNOR //RETURN NORZER, DCA ACSGN //SET FAC=0 CLSR //WHY NOT ? JMP I FFNOR // FIXSHF, 0 //USED FOR FIXING FAC IN SHR CIA //MQ HOLDS LISH OR NO LISH TAD ACX //ACX-VALUE IS SHIFT COUNT SNA // JMP I FIXSHF //ALREADY FIXED SMA //IS IT SHIFT UP? JMP FIXLIS //YES CIA // TAD (DOWN //NO : DOWN FIXLIS, DCA FFNOR //TEMP MQA //WAS IT CIRCULAR ? SNA CLA JMP FSHIFT //YES, DON'T DESTROY FAC TAD FFNOR // AND C3700 //IS SHIFT TOO BIG ? SNA CLA JMP FSHIFT //NO, GO ON CLSR //YES, NO HOPE DCA ACSGN //CLEAR FAC JMP I FIXSHF //AND EXIT FSHIFT, CLA MQA //MQA MAY HOLD LISH TAD FFNOR //GET SHIFT COUNT AND DIRECTION ACSC //SHIFT! SKSR // JMP .-1 //READY? JMP I FIXSHF //YES FFXTA, TAD (27 //XR TO AC - NORMALIZE IF FLOATING MODE DCA ACX //XR DF TAD I XRPNT // FFCLA, CDF 10 DCA FFNOR /TEMP SAVE JMS I (SYNC /WAIT FOR OP DCA I (INIC /OLD IC CONTENTS NOT INTERESTING CLSR /CLEAR ALL IN CASE NO SYNC TAD FFNOR / DCA ACSGN /SIGN IS SAME AS VALUE TAD ACSGN / SPA /IS VALUE NEGATIVE CIA /YES, MAKE POSITIVE ACSR /SET ACL POSITIVE WITH SIGN IN ACSGN TAD (14^2+DOWN ACSC /MOVE TO POSITION FFNORM, TAD DFLG / SMA SZA CLA /IS IT DP? JMP I (FFNOP /YES, NO NORMALIZE JMS I (UNLOAD /NOOP FOR XTA AND FCLA JMS FFNOR /NO, NORMALIZE JMP I (M8CHK / FFATX, JMS I (UNLOAD // TAD DFLG //ATX WORKS DIFFERENTLY IN D.P.I. MODE SPA SNA CLA //XR DF JMS FFNOR //DOES NOT TOUCH DF MQL //CIRCULAR SHIFT! ACM1 //CALL SHIFT ROUTINE WITH WANTED EXP JMS FIXSHF //-1 IS REALLY 27(EXP)-14^2 'ACL' POS TAD ACSGN //GET SIGN OF FAC CLL RAL // SRAC //READ ACL SZL //WAS FAC -? CIA //YES, USE -FIXED QUANTITY DCA I XRPNT //STORE IN XR REG AC0001 //ROTATE FAC BACK TAD ACX //MQ STILL=0 FOR CIRCULAR TAD ACX //COMPENSATE -ACX IN 'FIXSHF' JMS FIXSHF //ATX DOES NOT DESTROY FAC! JMP I (M8CHK // FFALN, JMS I (UNLOAD // TAD ACSGN //WAS FAC=0 ? SNA CLA // JMP I (FFNOP //YES, NOOP TAD DFLG // SMA SZA CLA // DCA ACX //ZERO EXP IF D.I. MODE TAD ADRHI // AND C7 // SZA CLA //IF IT'S AN 'ALN 0' JMP .+5 // TAD DFLG //AND IF WE'RE IN FLOATING POINT MODE, SPA SNA CLA // TAD (27 //ALIGN UNTIL EXPONENT = 23 SNA // TAD I XRPNT //OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE DCA ZTEM1 //KEEP VALUE OF EXPONENT TAD (LISH // MQL //INTO MQ FOR LINEAR SHIFT TAD ZTEM1 // JMS FIXSHF // TAD DFLG // SMA SZA CLA //IF DOUBLE INTEGER MODE, TAD (27 //ALIGNMENT LEAVES THE EXPONENT UNCHANGED SNA // TAD ZTEM1 //IF FP,EP SET NEW EXPONENT DCA ACX // ACSR //AND DELETE ANY RUBBISH IN EXP JMP I (M8CHK // PAGE FFGET, 0 /GET OPERAND FROM CORE INTO SHR CDF 10 /FOR 'DCA I (INIC' JMS I (SYNC /READ STATUS BEFORE NEW SHR FILL CLSR /CLEAR BEFORE GET DCA I (INIC /OLD IC CONTENTS NOT USED AC7775 / TAD DFLG / DCA ARCNT /SET SIZE OF FAC 6,3 OR 2 TAD ADRHI /SET DF OF TRANSFER JMS SETDF // FFGELP, TAD I ADRLOW //GET ACSR //GET PUTS IN SHR SRUP //NEXT IN SHR ISZ ADRLOW // SKP // JMS I (DFBUMP //CLEARS LINK ISZ ARCNT // JMP FFGELP // TAD DFLG // SMA SZA CLA //WAS IT DP? TAD (27 //YES EXP=23 SNA // SRAC //GET ACX FROM SHR IF NOT DP DCA ACX //IN CORE ACSR //CLEAR FAC ACX SRUP //POSITION ACH NOP //DELAY SRAC //GET ACH SRDN //POSITION ACX AGAIN SPA SNA //IF ACH POS, ALL POS JMS I (MAKPOS //MAKE POSITIVE IF NEGATIVE DCA ACSGN //AND SET SIGN JMP I FFGET // FFPUT, 0 /PUT RESULT FROM SHR INTO CORE JMS I (UNLOAD /FIRST UNLOAD IC TAD ACSGN /IF FAC WAS NEGATIVE MAKE NEGATIVE SPA /ONLY CALL FOR NEGATE JMS I (MAKPOS /CALLED WITH SIGN, RETURNS WITH SIGN CLA / TAD ACX /TRANSFER ACX TO SHR ACSR / AC7775 / TAD DFLG / DCA ARCNT /SET SIZE OF FAC 6,3 OR 2 TAD DFLG / SMA SZA CLA / SRUP /DON'T TRANSFER ACX FOR DP TAD ADRHI /SET DF OF TRANSFER JMS SETDF // FFPLP, SRAC //PUT GETS FROM SHR DCA I ADRLOW //PUT SRUP //NEXT IN SHR ISZ ADRLOW // SKP // JMS I (DFBUMP //CLEARS LINK ISZ ARCNT // JMP FFPLP // TAD ACSGN /IF FAC WAS NEGATIVE MAKE NEGATIVE SPA /ONLY CALL FOR NEGATE JMS I (MAKPOS /CALLED WITH SIGN, RETURNS WITH SIGN CLA ACSR //CLEAR FAC ACX JMP I FFPUT // FFDIV, 0 AC0004 /FPIC SDIV JMS I (FFCOMM JMP I FFDIV FFMPY, 0 AC0003 /FPIC SMUL JMS I (FFCOMM JMP I FFMPY FFSUB, 0 AC0002 /FPIC SSUB JMS I (FFCOMM JMP I FFSUB FFADD, 0 AC0001 /FPIC SADD JMS I (FFCOMM JMP I FFADD /RETURN SETXR, 0 /AC HAS XR NUMBER CLL /CLEAR FOR EVENTUAL OVERFLOW AND C7 / TAD XRBASE /SET ADDRESS OF X0-X7 DCA XRPNT /IN 'XRPNT' RAL /IF TO NEXT FIELD TAD XRHI /TO X0 FIELD JMS SETDF // JMP I SETXR // SETDF, 0 //GET NEW FIELD FROM EMULATOR CDF 10 /FOR EMULATOR FIELD AND C7 /32 K WRAP-AROUND DCA FFVFLD /VIRTUAL FIELD BITS IN USE TAD FFVFLD TAD FFPFLD /ADDRESS OF RESIDENT FIELDS DCA X TAD I X /IS FIELD ALLOCATED ? SZA JMP FFINFL /YES, TAKE QUICK EXIT TAD FFVFLD /NO, MAKE INCORE REQUEST CLL RTL RAL JMS I (EMGETF FFINFL, TAD C6201 DCA FFRFLD FFRFLD, HLT /REAL FIELD IN USE JMP I SETDF FFVFLD, 0 FFPFLD, 0 /POINTER TO UFLD TABLE DFBUMP, 0 /BUMP TO NEXT FIELD TAD FFVFLD IAC /INC FIELD JMS SETDF JMP I DFBUMP ARCNT, 0 PAGE /FPP AC-TO-MEMORY INTERPRETER / FFMPM, 0 /OP4 - FFMPY TAD FFMPM DCA FFADM /SET RETURN ADDRESS TAD (FFMPY-FFADD /USE FFMPY FOR FFMPM (NATCH!) SKP FFADM, 0 /OP1 - FFADD TAD (FFADD DCA ADMMPM / TAD ADRHI DCA ADSAVF TAD ADRLOW DCA ADSAV /SAVE FOR DOUBLE OP JMS I (UNLOAD /WAIT FOR END JMS APTDMP /DUMP APT TO USER TAD ADSAVF DCA ADRHI TAD ADSAV DCA ADRLOW JMS I ADMMPM /GO TO MUL OR ADD TAD ADSAV DCA ADRLOW /RESTORE ADR FOR PUT JMS I (FFPUT //PUT RESULT BACK IN LOC (WILL SET ADRHI FIELD) JMS APTGET /GET APT BACK (WITH OLD AC!) JMP I FFADM ADSAVF, 0 ADSAV, 0 /TEMPORARY ADRLOW ADMMPM, HLT /EITHER FFMPY OR FFADD FFNEG, JMS I (UNLOAD /WE NEED THE SIGN FIRST TAD ACSGN / CIA / DCA ACSGN /THAT WAS A QUICK ONE! JMP I (FFNOP / APTDMP, 0 JMS APTSET // JMS I (FFPUT //SETS APT FIELD TAD DTEM // DCA DFLG // TAD APTL //'APT-1' DCA AUTO10 TAD BASHI //IGNORE OPERAND FIELD AND C7 BSW MQL TAD XRHI AND C7 CLL RTL RAL MQA MQL TAD PCHI AND C7 MQA DCA I AUTO10 //APT TAD PC DCA I AUTO10 //PC LOW TAD XRBASE DCA I AUTO10 //XR LOW TAD BASADR DCA I AUTO10 //BASE LOW CDF 10 JMP I APTDMP APTGET, 0 JMS APTSET JMS I (FFGET //SETS APT FIELD TAD DTEM // DCA DFLG // TAD APTL //'APT-1' DCA AUTO10 TAD I AUTO10 //APT DCA PCHI TAD PCHI CLL RTR RAR DCA XRHI TAD PCHI BSW DCA BASHI TAD I AUTO10 //PC LOW DCA PC TAD I AUTO10 //XR LOW DCA XRBASE TAD I AUTO10 //BASE LOW DCA BASADR CDF 10 JMP I APTGET APTSET, 0 //SET PARAMETERS FOR APT XFER CDF 10 /BE SURE TAD DFLG /SAVE DFLG DCA DTEM TAD DFLG SMA CLA DCA DFLG /NO DP MODE, FFPUT WOULD LOSE ACX JMS GET UAPTH DCA ADRHI /SET FIELD BITS FOR FFPUT ISZ X /GO TO APTLOW TAD I X / DCA APTL /SAVE 'APT-1' A WHILE AC0006 TAD APTL DCA ADRLOW /SET 'ACX' FOR FFPUT JMP I APTSET / APTL, 0 DTEM, 0 CHKM8, 0 //CHECK ON MULTI-8 REQUESTS CDF 0 // TAD I (IHEAD //TASK IN INTQ ? SNA // TAD I (MHEAD //TASK IN MAINQ ? CDF 10 / SNA CLA / JMP I CHKM8 /NO, GO ON (DF=10) JMS MONITOR / PRECEDE /GIVE OTHERS A CHANCE JMS SETBASE /RESTORE BASE JMP I CHKM8 / PAGE O=JMP NPNONG MAKPOS, 0 //NEGATE SHR IF NECCESARY SMA CLA //IF CALLED WITH -SIGN TAD (O-7000 //IF POSITIVE ONLY CHECK FOR 0 FAC TAD C7000 //IF NEGATIVE DO ALL DCA NPSW //PLACE INSTRUCTION IN LOOP DCA ZTEM1 //SET FAC=0 SWITCH TO 0 SRDN //ACL OR EAC3 IN PLACE TAD DFLG // SMA //SKIP IF EP CLA //IGNORE DP NPFPDP, TAD M2 //-2 = -2 FOR FP,DP -5 FOR EP DCA ZTEM2 //FOR WORD COUNT STL //SET LINK FOR FIRST NEGATE NPLU, SRAC //GET LS ETC SZA //WAS THIS BYTE = 0 ? ISZ ZTEM1 //NO : FAC IS NON-ZERO NPSW, NOP //OR JMP NPNONG IF ONLY ZERO CHECK CMA SZL //BORROW OR START? CLL IAC //YES MAKE 'CIA' NPNONG, ACSR //BACK TO SHR SRDN //NEXT 12 BITS ISZ ZTEM2 //DONE? JMP NPLU ACSR //CLEAR EXP AGAIN TAD ZTEM1 //GET # FROM 0 TO 5 SZA CLA //IF ZERO, FAC IS ZERO TAD NPSW //IF NON-ZERO LOAD 7000 OR 5XXX CLL RAL //LEAVES 6000, 0, 2XXX IN AC JMP I MAKPOS //LEAVE WITH ACX IN POSITION //RETURN WITH SIGN IN AC FFLOAD, 0 JMS I (FFNOR //BE SURE FAC IS NORMALIZED TAD (2+LISH ACSC //POSITION MANTISSA LEFT TAD DFLG //EP OR FP? SPA CLA JMP FFLOEP //GO TO EP PART FFLOFP, TAD FF176 //GET EXP OFFSET TAD ACX // AND FF377 //MASK WITH MAX BITS FOR EXP MQL //NEW IC EXPONENT TAD ACSGN //OUR SIGN SNA //WAS IT ZERO? MQL //ZERO SIGN IS ZERO VALUE CLL RAL //PICK OUT SIGN BIT CLA RTR RTR //PUT SIGN AGAINST EXP MQA //GET EXP ACSR //LOAD IT IN HOLE TAD (DOWN+11+4 //GET FINAL SHIFT FFLOEN, ACSC FF377, 377 //DELAY SRFP //LOAD IC SKSR JMP .-1 JMP I FFLOAD //RETURN FFLOEP, TAD (1776 //GET EXP OFFSET TAD ACX // CLL RAL //MASK WITH MAX BITS FOR EXP MQL //NEW IC EXPONENT TAD ACSGN //OUR SIGN SNA //WAS IT ZERO? MQL //ZERO SIGN IS ZERO VALUE CLL RAL //PICK OUT SIGN BIT CLA MQA //GET EXP RAR //PUT BACK SIGN,EXP IN 4,3777 ACSR //LOAD IT IN HOLE TAD (DOWN+14+10 //GET FINAL SHIFT JMP FFLOEN // FFSTRE, TAD DFLG //WAS IT ALREADY EP? SPA CLA // JMP I (FFNOP //YES, IT'S A NOP. JMS I (UNLOAD //NO, SORRY AC2000 //XR DF SEMO //SET MODE FOR EAC CLEAR TAD (14^3+LISH //CLEAR EXTENDED FAC ACSC // ACM3 //SET DFLG=-3 FOR EP DCA DFLG // AC0004 JMP SESTAT // FFSTRD, TAD DFLG // SMA SZA CLA //WAS IT ALREADY DP ? JMP I (FFNOP //YES, NOOP JMS I (UNLOAD //NO, SORRY TAD (27 // DCA ACX //IT'S AN INTEGER! AC0001 // JMP SEDPFP // FFSTRF, TAD DFLG //WAS IT ALREADY FP ? SNA CLA // JMP I (FFNOP //YES, NOOP JMS I (UNLOAD //NO, SORRY SEDPFP, MQL //SAVE TAD DFLG // SMA CLA //WAS IT EP ? JMP NOEP //NO TAD (14^3+DOWN+LISH ACSC //MOVE ACH,ACL DOWN FF176, 176 //DELAY NOEP, MQA DCA DFLG // ACSR //CLEAR EXP SEMO //SET SHR SIZE TAD DFLG // CLL RTR //MAKE AC4000 IF DP SESTAT, MQL // CDF 10 /STATUS IN THIS FIELD JMS GET / UFPST AND (3773 /CLEAR OLD DP,EP BITS MQA / DCA I X /SET NEW DP OR EP BIT JMP I (M8CHK / PAGE /END IFDEF FPP >