/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. /EDIT 11 10-14-70 .TITLE BCDIO /BCD I/O OBJECT-TIME PACKAGE. / INTERNAL GLOBALS-- .GLOBL .FR /BCD READ .GLOBL .FW /BCD WRITE .GLOBL .FA /BCD ARRAY I/O .GLOBL .FE /BCD ELEMENT I/O .GLOBL .FF /BCD I/O CLEANUP .GLOBL BCDIO BCDIO=. / VIRTUAL GLOBALS-- .GLOBL .FH /READ/WRITE FLAG. .GLOBL .FC /I/O DEVICE INITIALIZER. .GLOBL .FQ /LINE BUFFER TRANSFER ROUTINE. .GLOBL .FM /LINE BUFFER SIZE. .GLOBL .FN /LINE BUFFER. .GLOBL .ER /ERROR ROUTINE. .GLOBL .AA /FLOATING AC--EXP .GLOBL .AB /FLOATING AC--M.S. .GLOBL .AC /FLOATING AC--L.S. .GLOBL .AG /REAL LOAD .GLOBL .AH /REAL STORE. .GLOBL .CC /GENERAL FLOATING ADD. .GLOBL .CD /NORMALIZE FLOATING AC. .GLOBL .CE /ANSWER SIGN. .GLOBL .CF /HOLD FLOATING AC. .GLOBL .CH /ROUND AND INSERT SIGN. .GLOBL .CI /GENERAL FLOATING DIVIDE. / CONSTANTS AND WORKING STORAGE-- C00003 .DSA 3 / *** DDS FEB69 *** C00005 .DSA 5 / *** DDS FEB69 *** C00006 .DSA 6 C00017 .DSA 21 C00035 .DSA 43 K00002 .DSA -2 / *** DDS FEB69 *** K00006 .DSA -6 K00010 .DSA -12 / *** DDS FEB69 *** S00007 .DSA 7 S00012 .DSA 12 S00015 .DSA 15 S00017 .DSA 17 S00032 .DSA 32 S00040 .DSA 40 S00050 .DSA 50 S00051 .DSA 51 S00053 .DSA 53 S00054 .DSA 54 S00055 .DSA 55 S00056 .DSA 56 S00057 .DSA 57 S00060 .DSA 60 S00061 .DSA 61 S00101 .DSA 101 S00110 .DSA 110 S00111 .DSA 111 S00114 .DSA 114 S00120 .DSA 120 S00124 .DSA 124 S00130 .DSA 130 S00170 .DSA 170 S00175 .DSA 175 S00177 .DSA 177 S02000 .DSA 2000 S17777 .DSA 17777 / *** DDS FEB69 *** S77777 .DSA 77777 T00000 .DSA 100000 T77777 .DSA 177777 V00002 .DSA 300002 V77777 .DSA 377777 W00000 .DSA 400000 Z77400 .DSA 777400 Z77600 .DSA 777600 Z77671 .DSA 777671 Z77706 .DSA 777706 DBLONE .DSA 1 .DSA 200000 .DSA 0 CCNT .DSA 0 CNT2 .DSA 0 CNT .DSA 0 DADD .DSA 0 DELTA .DSA 0 HIFLG .DSA 0 HILIM .DSA 0 LBADD .DSA 0 LIMIT .DSA 0 MS .DSA 0 LS .DSA 0 NUMFLG .DSA 0 SCC .DSA 0 SIGN .DSA 0 SLOT .DSA 0 SMS .DSA 0 SLS .DSA 0 FSTFLG .DSA 0 CRAMFL 0 /CR-ALTMODE FLAG RDEXT BCNT=CCNT DIG1=TVCC DIG2 .DSA 0 DIG=INIFD DPOS=TVCC FADDR=INCCC FRFLG=CCA NRZ=FNBCHR OVFFLG=FMTFCH POT=CCN SDFLG=CC2 SEXP=INIFD SFFLG=CC2 SHCT=DSHR TAC=INCP TEMP1=NUMCHK TEMP2=INCP TEMP3=DECP TMPFAC=SPLIT TLS=DECP TMS=GETCC WD1=CCN WD4=CCA PKBLK2=NUMTS2 CHCT=BCNT C00001=DBLONE / *** DDS FEB69 *** .EJECT /BCD READ /CALLING SEQUENCE -- JMS .FR / .DSA ADDRESS OF SLOT NUMBER. / .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY. .FR CAL 0 DZM* .FH /SET READ/WRITE FLAG TO READ. LAC* .FR /INITIALIZE INPUT DEVICE. JMS* .FC DAC SLOT /SAVE SLOT NUMBER. ISZ .FR LAC* .FR /GET FORMAT ADDRESS. IF A TRANSFER VECTOR, DAC CC / GO ONE MORE LEVEL OF INDIRECT. SPA LAC* CC JMS INIFD /INITIALIZE FORMAT DECODER. JMS EOR /READ FIRST RECORD. ISZ .FR /EXIT. JMP* .FR .EJECT /BCD WRITE / CALLING SEQUENCE -- JMS .FW / .DSA ADDRESS OF SLOT NUMBER. / .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY .FW CAL 0 LAC C00001 /SET READ/WRITE FLAG TO WRITE. DAC* .FH LAC* .FW /INITIALIZE OUTPUT DEVICE. JMS* .FC DAC SLOT /SAVE SLOT NUMBER. ISZ .FW LAC* .FW /GET FORMAT ADDRESS. IF A TRANSFER VECTOR, DAC CC / GO ONE MORE LEVEL OF INDIRECT. SPA LAC* CC JMS INIFD /INITIALIZE FORMAT DECODER. JMS INILB /INITIALIZE LINE BUFFER. LAW -1 /SET UPPER LIMIT FOR CHARACTER PACKER AS A TAD .FN / FUNCTION OF LINE BUFFER SIZE. TAD* .FM DAC HILIM ISZ .FW /EXIT. JMP* .FW .EJECT /BCD ARRAY I/O / CALLING SEQUENCE -- JMS* .FA / .DSA ADDRESS OF DIMENSION INFORMATION .FA CAL 0 LAC* .FA DAC WD4 /ADDR OF WORD 4 OF DIM. INFO. (ARRAY ADDR). SPA /1 MORE LEVEL? LAC* WD4 /YES DAC WD4 /RESTORE TAD K00003 DAC WD1 /ADDR OF WORD 1 OF DIM. INFO. (N,SIZE). LAC* WD1 /GET ADDRESS INCREMENT--DELTA=NO. OF WORDS RTL / PER DATA ITEM. RTL RTL TAD C00001 AND C00003 SNA LAC C00001 DAC DELTA LAC* WD4 /GET FIRST ADDRESS OF ARRAY AND INITIALIZE DAC FA2 / BCD ELEMENT I/O CALL. LAC* WD1 /ADD ARRAY SIZE TO GET HIGH ADDRESS LIMIT. AND S17777 / *** DDS FEB69 *** TAD FA2 DAC LIMIT FA1 JMS .FE /CALL BCD ELEMENT I/O ROUTINE. FA2 .DSA 0 / ARGUMENT=ADDRESS OF DATA ITEM. LAC FA2 /INCREMENT DATA ITEM ADDRESS. TAD DELTA DAC FA2 CMA /COMPARE DATA ADDRESS WITH HIGH LIMIT. TAD LIMIT / IF FA2.LT.LIMIT, GO AGAIN. SMA / IF FA2.GE.LIMIT, EXIT. JMP FA1 ISZ .FA JMP* .FA .EJECT /BCD ELEMENT I/O CONTROL / CALLING SEQUENCE -- .GLOBL .FE / JMS* .FE / CAL ELEMENT ADDRESS (T.V. IF BIT 0 = 1) .FE CAL 0 LAC* .FE /GET STARTING ADDRESS OF DATA ELEMENT. DAC DADD SPA /IF T.V., ONE MORE LEVEL OF INDIRECT LAC* DADD / ADDRESSING. DAC DADD JMS .FD /GET FORMAT SPECIFICATION LAC S /CONVERSION CODE TIMES TWO (PLUS ONE FOR RCL / WRITE)=INDEX VALUE FOR JUMP TABLE. TAD* .FH AND S00017 TAD JTABLE DAC TEMP1 JMP* TEMP1 JTABLE .DSA FE1 FE1 JMP FE50 /I-READ JMP FE2 /I-WRITE JMP FE55 /L-READ JMP FE7 /L-WRITE JMP FE60 /A-READ JMP FE8 /A-WRITE JMP FD86 /O-READ JMP FD86 /O-WRITE JMP FE51 /D-READ JMP FE11 /D-WRITE JMP FE51 /E-READ JMP FE11 /E-WRITE JMP FE51 /F-READ JMP FE23 /F-WRITE JMP FE51 /G-READ JMP FE32 /G-WRITE FE99 ISZ .FE JMP* .FE .EJECT /I-CONVERSION -- WRITE PROCESSOR. FE2 JMS GETPS /GET INTEGER POWER OF TEN (POT), SIGN, AND LAC POT / INITIALIZE THE GETDD ROUTINE. IF THE SZA / NUMBER TO BE PRINTED IS ZERO (POT=0), JMP FE3 DZM* .AB ISZ POT / SET POT = 1 SO THAT A SINGLE ZERO WILL LAC POT / BE PRINTED. NOW POT = NO. OF INTEGER FE3 SAD W / DIGITS TO BE PRINTED. IF POT=FIELD JMP FE5 / WIDTH(W), DO NOT PACK ANY LEADING CMA / BLANKS OR SIGN. IF POT.GT.W, TRUNCATE TAD W / (POT-W) MOST SIGNIFICANT DIGITS. IF SMA / POT.LT.W, PACK (W-POT-1) LEADING JMP FE4 / BLANKS AND THE SIGN. JMS GETDD CLC TAD POT DAC POT JMP FE3 FE4 JMS PKBLKS /PACK LEADING BLANKS. JMS PKSGN /PACK SIGN. FE5 CLC /PACK (POT) DECIMAL DIGITS. TAD POT CMA DAC POT FE6 JMS GETDD JMS PACK ISZ POT JMP FE6 JMP FE99 /EXIT .EJECT /L-CONVERSION -- WRITE PROCESSOR FE7 CLC TAD W SPA JMP FE99 /EXIT IF FIELD WIDTH ZERO OR NEGATIVE. JMS PKBLKS /PACK (WI1) BLANKS. LAC* DADD SNA!CLA LAW -16 /F CHARACTER TO AC. TAD S00124 /T CHARACTER TO AC. JMS PACK /PACK TO OR F CHARACTER IN BUFFER JMP FE99 /EXIT .EJECT /A-CONVERSION -- WRITE PROCESSOR FE8 LAC* DADD /FIRST DATA WORD TO MS DAC MS ISZ DADD LAC* DADD /SECOND DATA WORD TO LS DAC LS LAC W /IF W=0, EXIT SNA!SPA JMP FE99 JMS CMP /TWOS COMPLEMENT W FOR A CHARACTER COUNT. DAC POT LAW -5 TAD W SPA!SNA JMP FE9 JMS PKBLKS /PACK (W-5) BLANKS IF W.GT.5 K00005 LAW -5 DAC POT FE9 JMS DSH7 /ROTATE MS/LS 7 LEFT AND PACK LOW BITS OF LAC LS / LS. CONTINUE UNTIL CHARACTER COUNT JMS PACK / IS ZERO. ISZ POT JMP FE9 JMP FE99 /EXIT .EJECT /D- AND E-CONVERSION -- WRITE PROCESSOR. FE11 LAC W /IF W.LT.7, DEFAULT. TAD K00006 SPA!SNA JMP FE21 LAC D /IF (W-D).LT.7, DEFAULT. CMA TAD K00006 TAD W SPA JMP FE22 JMS PKBLKS /IF (W-D).GE.7, PACK (W-D-7) BLANKS FE12 JMS GETPS FE125 JMS PKSGN LAC D /SET CNT TO TWOS COMPLEMENT OF THE NUMBER TAD C00001 / OF DECIMAL CHARACTERS IN THE MANTISSA CMA / FIELD (INCLUDING DECIMAL POINT), VIZ., DAC CNT / -D-2. TAD SF /CHECK SCALE FACTOR VS. CNT TO SEE IF TOO TAD C00001 / MANY INTEGER DIGITS HAVE BEEN SPECI- JMS CMP / FIED. IF SO, TRUNCATE THE NECESSARY DAC DIG1 / DIGITS. SMA JMP FE14 FE13 JMS GETDD ISZ DIG1 JMP FE13 FE14 LAC D /CALCULATE FRACTION FLAG = -D -1 CMA DAC FRFLG LAC D /CALCULATE SIGNIFICANT DIGIT FLAG = D+SF TAD SF DAC SDFLG LAC SF /IF SF.GT.0, MODIFY FLAGS -- SPA!SNA / FRFLG=SF-D-2 (-1 MAXIMUM) JMP FE15 / SDFLG=+SF+D+1 CLC TAD SF TAD FRFLG SMA LAW -1 DAC FRFLG LAC C00001 TAD SDFLG DAC SDFLG FE15 LAC CNT /MANTISSA OUTPUT LOOP. IF CNT=FRFLAG, SAD FRFLG / PRINT DECIMAL POINT. JMP FE17 TAD SDFLG /IF /CNT/.GT.SDFLG, PRINT LEADING ZERO SMA JMP FE16 /IF /CNT/.LE.SDFLG, PRINT NEXT SIGNIFICANT LAW 60 / DIGIT. JMP FE18 FE16 JMS GETDD JMP FE18 FE17 LAW 56 FE18 JMS PACK ISZ CNT /BUMP DIGIT COUNT JMP FE15 LAW 53 /SET EXPONENT SIGN TO PLUS CHARACTER. DAC SIGN DZM DIG1 /ZERO EXPONENT DIGIT 1, AND PLACE ENTIRE LAC SF / *** DDS JAN69 *** JMS CMP / *** DDS JAN69 *** TAD POT / *** DDS JAN69 *** DAC DIG2 SMA /IF EXPONENT IS NEGATIVE, COMPLEMENT IT JMP FE19 / AND SET EXPONENT SIGN TO MINUS. JMS CMP DAC DIG2 ISZ SIGN ISZ SIGN FE19 TAD K00010 /INTEGER DIVIDE DIG2 BY 10.0 -- QUOTIENT SPA / TO DIG1, REMAINDER TO DIG2. JMP FE20 DAC DIG2 ISZ DIG1 JMP FE19 FE20 LAW 100 /PACK E OR D CHARACTER. TAD S JMS PACK LAC SIGN /PACK EXPONENT SIGN. JMS PACK LAW 60 /PACK DIG1 OF EXPONENT. TAD DIG1 JMS PACK LAW 60 /PACK DIG2 OF EXPONENT. TAD DIG2 JMS PACK JMP FE99 /EXIT. FE21 LAC W /FIELD WIDTH TOO SMALL -- PACK (W) BLANKS JMS PKBLKS / AND EXIT. JMP FE99 FE22 TAD D /D IS GREATER THAN (W-7) -- SET D=(W-7) DAC D / AND CONTINUE. JMP FE12 .EJECT /F-CONVERSION -- WRITE PROCESSOR FE23 JMS GETPS /SCALE AND ROUND DATA. LAC POT /SINCE SCALE FACTOR ACTS AS AN ADDITIONAL TAD SF /POWER OF TEN FOR F-CONVERSIONS, INCOR- DAC POT /PORATE SF INTO POT. SPA!SNA /DETERMINE THE LENGTH OF THE NUMERIC FIELD LAC C00001 /INCLUDING DECIMAL POINT -- TAD C00001 /POT+D+1 IF DATA.GE.(1.0) TAD D /D+2 IF DATA.LT.(1.0) JMS CMP /NEGATE FOR USE AS A LOOP COUNTER (DIG2) DAC DIG2 TAD W /IF LENGTH OF NUMERIC FIELD EXCEEDS THE DAC DIG1 /SPECIFIED FIELD WIDTH, DEFAULT. IF SMA /NOT, RIGHT-JUSTIFY IN FIELD WITH LEAD- JMP FE26 /ING BLANKS AND SIGN. LAC W /DEFAULT--FORCE NUMERIC FIELD WIDTH (-DIG2) JMS CMP /TO SPECIFIED FIELD WIDTH (W). THEN DAC DIG2 /DETERMINE WHICH DEFAULT CONDITION MOST LAC POT /BE EMPLOYED SPA!SNA JMP FE25 FE24 JMS GETDD /DEFAULT FOR DATA.GE.(1.0)--TRUNCATE MOST ISZ DIG1 /SIGNIFICANT DIGITS UNTIL NUMBER FITS JMP FE24 /INTO SPECIFIED FIELD WIDTH(W DIGITS). JMP FE27 FE25 TAD C00001 /DEFAULT FOR DATA.LT.(1.0)--ALTER POT SO DAC POT /ZERO NOT PRINTED BEFORE DECIMAL POINT JMP FE27 FE26 SNA /NORMAL PATH (NO DEFAULT)--OUTPUT NECES- JMP FE27 /SARY LEADING BLANKS AND SIGN REQUIRED TAD K00001 /TO RIGHT-JUSTIFY NUMERIC OUTPUT. SZA JMS PKBLKS JMS PKSGN FE27 LAC D /SET A FLAG (DPOS) TO INDICATE WHERE THE CMA /DECIMAL POINT SHOULD BE OUTPUT DAC DPOS FE28 LAC DIG2 /NUMERIC OUTPUT LOOP -- IF LOOP COUNTER IS SAD DPOS /SAME AS DECIMAL POINT FLAG (DIG2=DPOS), JMP FE29 /OUTPUT DECIMAL POINT. LAC POT /EXAMINE SCALE FACTOR. IF NEGATIVE OR ISZ POT /ZERO, DATA.LT.(1.0) AND A LEADING ZERO SPA!SNA /IS PRINTED. SCALE FACTOR IS INCREMENTED JMP FE30 /ONE FOR NEXT PASS THROUGH LOOP. JMS GETDD /GET NEXT DECIMAL DIGIT FROM FLOATING AC. JMP FE31 FE29 LAW 56 /ASCII-7 DECIMAL POINT. JMP FE31 FE30 LAW 60 /ASCII-7 ZERO FE31 JMS PACK /PACK CHARACTER IN OUTPUT BUFFER AND TEST ISZ DIG2 /FOR END OF LOOP. JMP FE28 LAC S2 /EXAMINE CONVERSION TYPE TO DETERMINE TAD K00006 /EXIT LOCATION. SMA!SZA JMP FE33 /REENTER G-CONVERSION JMP FE99 /EXIT TO CALLING PROGRAM. .EJECT /G CONVERSION -- WRITE PROCESSOR FE32 JMS GETPS /GET POWER OF TEN AND SIGN LAC POT /IF POT.LT.0, GO TO E-CONVERSION. SPA JMP FE11 / *** DDS JAN69 *** JMS CMP /IF POT.GT.D, GO TO E-CONVERSION TAD D DAC DIG1 SPA JMP FE11 / *** DDS JAN69 *** LAC SF /IF 0.LE.POT.LE.D, SAVE SF, W, AND D. GO DAC TEMP1 / TO F-CONVERSION WITH SF=0, W=(W-4), LAC W / AND D=(D-POT). DAC TEMP2 LAC D DAC TEMP3 DZM SF K00004 LAW -4 TAD W DAC W LAC DIG1 DAC D LAC C00006 DAC S JMP FE23 FE33 LAW 4 /ON RETURN FROM F-CONVERSION PROCESSOR, JMS PKBLKS / OUTPUT 4 BLANKS AND RESTORE SF, W, AND LAC TEMP1 / D TO THEIR ORIGINAL VALUES. DAC SF LAC TEMP2 DAC W LAC TEMP3 DAC D ISZ S JMP FE99 /EXIT .EJECT /ROUND AND SCALE DECIMAL DATA / CALLING SEQUENCE -- JMS GETPS GETPS CAL 0 DZM OVFFLG DZM SIGN /SET SIGN POSITIVE. DZM POT /SET POWER-OF-TEN TO ZERO. DZM* .AA /CLEAR FLOATING ACCUMULATOR DZM* .AB DZM* .AC LAW -4 /TEST CONVERSION-TYPE FOR ENTRY POINT TAD S SPA JMP GET04 /I-CONVERSION. SNA JMP GET03 /D-CONVERSION. TAD K00002 SZA JMP GET01 /E- OR G-CONVERSION /F-CONVERSION ENTRY. DZM NRZ /ZERO TO ROUNDING FLAG. JMP GET02 /E- AND G-CONVERSION ENTRY. GET01 LAC C00001 /PLUS-ONE TO ROUNDING FLAG. DAC NRZ GET02 JMS* .AG /REAL LOAD DATA INTO FLOATING ACCUMULATOR. .DSA DADD+400000 JMP GET06 /D-CONVERSION ENTRY. GET03 LAC C00001 /PLUS-ONE TO ROUNDING FLAG. DAC NRZ JMS FAO /DBL LOAD DATA INTO FLOATING ACCUMULATOR. .DSA DADD+400000 JMP GET06 /I-CONVERSION ENTRY. GET04 CLC /MINUS-ONE TO ROUNDING FLAG DAC NRZ LAC* DADD /GET ACTUAL DATA WORD FOR FIXED-TO-FLOAT SNA / CONVERSION JMP GET06 /IF DATA=0, FAC OK AS-IS. SMA JMP GET05 ISZ SIGN /IF DATA NEGATIVE, SET SIGN TO MINUS AND JMS CMP / COMPLEMENT DATA. GET05 DAC* .AB /STORE DATA IN FAC MANTISSA. LAC W00000 /SET ROUND-OFF BIT. DAC* .AC LAC C00017 /SET FAC EXPONENT TO +17. DAC* .AA JMS* .CD /NORMALIZE FAC--DATA IS NOW FLOATING POINT. /COMMON ROUTINE GET06 LAC* .AB /CHECK FOR NEGATIVE NUMBER. SNA JMP GET17 /Y ZERO, EXIT IMMEDIATELY SMA JMP GET07 AND V77777 /IF MANTISSA IS NEGATIVE, EXTRACT OFF THE DAC* .AB / SIGN BIT AND SET SIGN TO MINUS. SNA /EXIT WITH 0.0 IN CASE OF -0.0 JMP GET17 ISZ SIGN GET07 LAC* .AA /THE DATA NOW IN FAC MUST BE SCALED SO SPA!SNA / THAT 0.100000.3E.FAC.3E0.999999 (WHICH JMP GET10 / IN FLOATING POINT POTATION IS DAC TMPFAC / -3/31463146...LE.FAC.LE.+0/3777777...) JMS* .CF / SO THAT MULTIPLYING BY 10 YIELDS FIRST JMS FAO / DIGIT. IN ORDER TO AVOID INNUMERABLE .DSA DBLONE / DIVISIONS BY TEN IN THE CASE WHERE THE GET08 LAC TMPFAC / EXPONENT IS LARGER AND POSITIVE, THE CMA / FAC IS SAVED IN TMPFAC AND THE FAC IS TAD* .AA / USED TO BUILD A SINGLE DIVISOR WHICH SMA / IS A POWER OF TEN. AFTER SCALING POT JMP GET09 / CONTAINS THE POWER OF TEN THAT WAS ISZ POT / USED IN THE DIVISION. JMS MPYTEN JMP GET08 GET09 JMS* .CI /FAC=HAC/FAC .DSA -44 .DSA 1 / *** DDS FEB69 ******WAD MAY 69 *** JMS* .CH /ROUND AND SIGN .DSA 0 / *** DDS FEB69 *** .DSA -1 / *** DDS FEB69 *** GET10 LAC C00003 /AFTER SCALING POSITIVE EXPONENTS BY DIVI- TAD* .AA / SION OR IF THE EXPONENT OF THE DATA IS SPA / NEGATIVE, THE FAC IS CHECKED IF IT IS JMP GET11 / LESS THAN 0.1 (-3/31463146....). SZA / IF SO, FAC IS MULTIPLIED BY 10 AND POT JMP GET12 / DECREMENTED BY ONE. IF NOT, SCALING LAC* .AB / IS COMPLETE AND THE DATA IS READY TO TAD TESTB / BE ROUNDED OFF. SPA JMP GET11 SZA JMP GET12 LAC* .AC TAD TESTC SMA!SZA JMP GET12 GET11 CLC TAD POT DAC POT JMS MPYTEN JMP GET10 TESTB .DSA 463147 TESTC .DSA 314632 /ROUND-OFF ROUTINE GET12 LAC NRZ /AT THIS TIME NRZ IS A FLAG USED TO DETER- SPA / MINE WHICH FORMULA IS TO BE USED TO JMP GET17 / CALCULATE WHICH ROUNDING VALUE IS TO SNA / BE ADDED TO FAC. JMP GET14 LAC SF /D, E, OR G-CONVERSION. NRZ=D+1 IF SF.GT.0 SMA!SZA / NRZ=D+SF IF SF.LE.0 LAC C00001 GET13 TAD D JMP GET15 GET14 LAC SF /F-CONVERSION. NRZ=D+POT+SF TAD POT TAD D GET15 SPA!CMA / *** DDS FEB69 *** JMP GET17 / DECIMAL DIGITS (MINUS ONE) THAT ARE TO DAC GET30 / *** DDS JAN69 *** JMS FAP / *** DDS JAN69 *** .DSA GET31 / *** DDS JAN69 *** JMS FAO / *** DDS JAN69 *** .DSA C00002 / *** DDS JAN69 *** GET32 ISZ GET30 / *** DDS JAN69 *** SKP / *** DDS JAN69 *** JMP GET33 / *** DDS JAN69 *** JMS MPYTEN / *** DDS JAN69 *** JMP GET32 / *** DDS JAN69 *** GET33 JMS FAP / *** DDS JAN69 *** .DSA GET34 / *** DDS JAN69 *** JMS FAO / *** DDS JAN69 *** .DSA DBLONE / *** DDS JAN69 *** JMS* .CF / *** DDS JAN69 *** JMS FAO / *** DDS JAN69 *** .DSA GET34 / *** DDS JAN69 *** JMS* .CI / *** DDS JAN69 *** .DSA -44 / *** DDS JAN69 *** .DSA 1 / *** WAD SEPT69 *** JMS* .CH / *** DDS JAN69 *** .DSA 0 / *** DDS FEB69 *** .DSA -1 / *** DDS FEB69 *** JMS FAQ / *** DDS JAN69 *** .DSA GET31 / *** DDS JAN69 *** LAC* .AA /CHECK FAC FOR OVERFLOW. THE ONLY OVER- SPA!SNA / FLOW THAT CAN OCCUR THAT MAKE FAC TOO JMP GET17 / BIG (.GT. 0.9999...) IS BY ONE BIT. LAC C00001 / IN THIS CASE, A FLAG(OVFFLG) IS SET DAC OVFFLG / FOR THE GETDD ROUTINE INDICATING THAT ISZ POT / THE FIRST DECIMAL DIGIT IS A ONE. THE NOP GET17 JMP* GETPS / REFLECT THE EXTRA DIGIT. GET31 .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** GET30 .DSA 0 / *** DDS JAN69 *** C00002 .DSA 2 / *** DDS JAN69 *** .DSA 200000 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** GET34 .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** .EJECT /GET DECIMAL DIGIT / CALLING SEQUENCE -- JMS GETDD GETDD CAL 0 LAC OVFFLG /CHECK OVERFLOW FLAG SET IN GETPS ROUTINE. SNA / IF SET, FIRST DIGIT IS A ONE AND JMP GET20 / FLOATING ONE IS SUBTRACTED FROM FAC. DAC DIG DZM OVFFLG JMP GET23 GET20 JMS MPYTEN /MULTIPLY FAC BY 10 TO EXTRACT THE NEXT DZM DIG / DECIMAL DIGIT. LAC* .AA SPA!SNA JMP GET22 /IF FAC EXPONENT.LE.ZERO, DIGIT IS A ZERO. JMS CMP / IF FAC EXPONENT.GT.ZERO, THE EXPONENT DAC BCNT / IS COMPLEMENTED TO USE AS A SHIFT JMS DSHL / COUNTER TO SHIFT THE INTEGER BITS OF GET21 JMS DSHL / MS/LS INTO DIG LAC DIG RAL DAC DIG ISZ BCNT JMP GET21 JMS DSHR GET22 JMS TRMSLS DZM* .AA LAW 60 /EXIT IS TAKEN WITH THE ASCII-7 CODE OF XOR DIG / THE DECIMAL DIGIT IN THE AC. JMP* GETDD GET23 LAC* .AB /MS/LS=FAC-1.0 AND T77777 DAC MS LAC* .AC DAC LS JMS DSHL JMP GET22 .EJECT /I-CONVERSION -- READ PROCESSOR. FE50 JMS RDEXT /READ CONTENTS OF EXTERNAL FIELD. IF LAC SFFLG /SFFLG AND DPOS ARE NOT BOTH ZERO, TAD DPOS /AN ILLEGAL CHARACTER IS IN THE INPUT SZA /FIELD AND ZERO IS STORED IN MEMORY. DZM LS LAC SIGN /IF NUMBER IS NEGATIVE (SIGN=1), TWOS- RAR /COMPLEMENT BEFORE STORING. LAC LS SZL JMS CMP DAC* DADD /STORE INTEGER IN MEMORY. JMP FE99 /EXIT. .EJECT /D- E- F- AND G-CONVERSIONS -- READ PROCESSOR FE51 JMS RDEXT /READ EXTERNAL INPUT FIELD LAC SFFLG /IF THERE WAS NO DECIMAL SCALE FACTOR, SZA / TRANSFER MS+LS INTO FAC AND SET SCALE JMP FE515 / FACTOR (LS) TO ZERO. JMS TRMSLS DZM LS FE515 LAC C00035 /CONVERT RAW INTEGER MANTISSA TO FLOATING DAC* .AA / POINT. JMS* .CD LAC FRFLG /CALCULATE MULTIPLIER POWER OF TEN = DECI- JMS CMP / MAL SCALE FACTOR (LS) MINUS NUMBER OF TAD LS / DIGITS AFTER DECIMAL POINT (SFFLG)=POT. DAC POT SNA JMP FE54 /IF POT=0, FAC OK AS-IS. SMA JMP FE52 /IF POT.GT.0, MULT. FAC BY TEN (POT) TIMES. JMS* .CF /IF POT.LT.0, SAVE FAC IN HAC AND LOAD 1.0 JMS FAO / INTO FAC --THEN MULTIPLY FAC BY TEN .DSA DBLONE / (-POT) TIMES TO OBTAIN DIVISOR. LAC POT SKP FE52 JMS CMP DAC CNT FE53 JMS MPYTEN ISZ CNT JMP FE53 LAC POT /IF POT.GT.0, CONVERSION IS NOW COMPLETE. SMA /IF POT.LT.0, CONVERSION IS COMPLETED BY JMP FE54 / DIVIDING HAC BY FAC. JMS* .CI .DSA -44 .DSA 1 / *** WAD SEPT69 *** FE54 LAC SIGN /SET ,CE = SIGN OF CONVERTED NUMBER. SZA / BIT 0 = 0 PLUS LAC W00000 / BIT 0 = 1 MINUS DAC* .CE JMS* .CH /ROUND OFF FAC LOW BIT AND INSERT SIGN. .DSA 0 / *** DDS FEB69 *** .DSA -1 / *** DDS FEB69 *** LAW -4 /TEST CONVERSION TYPE. TAD S SNA JMP FE545 /D-CONVERSION JMS* .AH /E-, F-, OR G-CONVERSION -- STORE REAL .DSA DADD+400000 JMP FE99 FE545 JMS FAP /STORE DOUBLE. .DSA DADD+400000 JMP FE99 .EJECT /L-CONVERSION -- READ PROCESSOR FE55 LAC W /SET COUNTER TO (W+1) CMA DAC CNT DZM SIGN /SET INITIAL CONDITION TO FALSE. FE56 ISZ CNT SKP JMP FE58 JMS READ /READ EXTERNAL CHARACTERS UNTIL THE FIRST SAD S00040 / NON-BLANK CHARACTER. JMP FE56 SAD S00124 ISZ SIGN /IF FIRST NON-BLANK CHARACTER IS A (T), FE57 ISZ CNT / SET CONDITION TRUE. SKP JMP FE58 JMS READ /READ AND IGNORE ALL REMAINING CHARACTERS JMP FE57 / IN THE EXTERNAL FIELD. FE58 LAC SIGN /IF INPUT IS TRUE, STORE 777777 IN MEMORY. SZA /IF INPUT IS FALSE, STORE ZERO IN MEMORY. CLC DAC* DADD JMP FE99 /EXIT. .EJECT /A-CONVERSION -- READ PROCESSOR FE60 LAC JMP0 /INITIALIZE JUMP INSTRUCTION AND CHARACTER DAC FE65 / COUNTER. DZM CHCT LAC W /IF FIELD WIDTH.LE.0, EXIT IMMEDIATELY. SPA!SNA JMP FE99 JMS CMP DAC CNT FE63 JMS READ /FETCH EXTERNAL 7-BIT CHARACTER, ROTATE FE64 JMS DSH7 / MS+LS 7 LEFT, AND MERGE CHARACTER INTO AND Z77600 XOR CHAR / LS. DAC LS ISZ CHCT ISZ CNT /CONTINUE UNTIL ALL CHARACTERS HAVE BEEN FE65 JMP 0 / READ AND PACKED. LAW -5 /CHECK CHARACTER COUNT AND IF LESS THAN TAD CHCT / FIVE CHARACTERS HAVE BEEN PACKED, PACK SMA / BLANKS UNTIL MS+LS IS FULL. JMP FE66 DAC CNT ISZ FE65 LAC S00040 DAC CHAR JMP FE64 FE66 JMS DSHL /LEFT JUSTIFY TO 5/7 ASCII FORMAT. LAC MS /STORE BOD WORD PAIR IN OBJECT MEMORY. DAC* DADD ISZ DADD LAC LS DAC* DADD JMP FE99 /EXIT JMP0 JMP FE63 .EJECT /READ EXTERNAL FIELD / CALLING SEQUENCE -- JMS RDEXT RDEXT CAL 0 /THIS SUBROUTINE INPUTS AN EXTERNAL LINE DZM SIGN / BUFFER FIELD OF LENGTH W. AT EXIT, DZM SEXP / THE FOLLOWING ITEMS HAVE BEEN DETER- DZM MS / MINED-- DZM LS / (1) SFFLG=0 IF THE FIELD WAS A RIGHT- DZM POT / JUSTIFIED NUMBER WITH OR WITHOUT DZM DPOS / A DECIMAL POINT AND THE INTEGER DZM SFFLG / VALUE OF THE DIGITS IS IN MS+LS. DZM CRAMFL LAC W / (2) SFFLG.NE.0 FOR ALL OTHER CASES CMA / AND THE INTEGER VALUE IS IN THE DAC BCNT / FLOATING ACCUMULATOR (UNNORMAL- / / IZED) AND LS CONTAINS THE DECI- / / MAL SCALE FACTOR. / / (3) FRFLG = POWER OF TEN THAT MUST / / BE DIVIDED INTO THE INTEGER TO / / REDUCE THE INTEGER VALUE OF THE / / NUMBER TO THE CORRECT FLOATING / / VALUE. / / (4) DPOS = 0 WHEN NO DECIMAL POINT / / HAS BEEN ENCOUNTERED IN THE / / EXTERNAL FIELD. / / (5) SIGN = 0, NUMBER IS POSITIVE. / / SIGN.NE.0, NUMBER IS NEGATIVE. RDEX1 JMS BREAD /FETCH LINE BUFFER CHARACTER. SAD S00053 JMP RDEX1 /IF CHARACTER IS PLUS SIGN. SAD S00055 JMP RDEX4 /IF CHARACTER IS MINUS SIGN. SAD S00056 JMP RDEX35 /IF CHARACTER IS DECIMAL POINT. JMS NUMTST /TEST FOR FIRST NUMBER. JMP RDEX1 / NO, FETCH NEXT CHARACTER. SNA /IS IT A LEADING 0 JMP RDEX1 /YES. IGNORE DAC LS / YES, COMPLETE NUMERIC CONVERSION. RDEX2 JMS BREAD JMS NUMTST /IS CHARACTER A NUMBER. JMP RDEX3 / NO, TEST FOR DECIMAL POINT. RDEX25 JMS IMPTEN / YES, 10*LS+NUMBER TO LS. JMP RDEX2 RDEX14 LAC CRAMFL /CR OR ALTMODE? SZA JMP RDEX15 /YES. DON'T STORE TRAILING 0'S /BUMP DPOS ANYWAY JMP RDEX25 /NO. CONTINUE RDEX3 SAD S00056 JMP RDEX35 /BLANKS TREATED AS ZEROS SAD S00040 SKP!CLA JMP RDEX5 JMP RDEX14 /NOT DECIMAL POINT -- END OF CONVERSION. /MAY HAVE HIT A CR OR ALT. CHECK ABOVE IN RDEX14 RDEX35 LAC BCNT /IF DECIMAL POINT, SAVE ITS POSITION AND DAC DPOS / CONTINUE WITH NUMERIC CONVERSION. JMP RDEX2 RDEX4 ISZ SIGN JMP RDEX1 RDEX5 LAC BCNT /SAVE POSITION OF CHARACTER TERMINATING DAC SFFLG / MANTISSA FIELD AND TRANSFER INTEGER JMS TRMSLS / VALUE OF MANTISSA TO THE FLOATING AC. /EXPONENT FIELD DZM LS DZM SF /IGNORE P-FORMAT SPEC WHEN EXP. IN EXT. FIELD LAC CHAR RDEX6 SAD S00053 /IF CHAR=PLUS, IGNORE IT. JMP RDEX8 SAD S00055 /IF CHAR=MINUS, SET SIGN OF EXPONENT.NE.0. JMP RDEX7 JMS NUMTST /IS CHAR A NUMBER. JMP RDEX8 / NO, CONTINUE. JMP RDEX9 / YES, COMPLETE NUMERIC CONVERSION. RDEX7 ISZ SEXP RDEX8 JMS BREAD JMP RDEX6 RDEX9 DZM MS DAC LS RDEX10 JMS BREAD /GET NEXT CHARACTER JMS NUMTST /IS CHAR A NUMBER. JMP RDEX11 / NO, END OF CONVERSION. JMS IMPTEN / YES, LS=10*LS+NUMBER JMP RDEX10 RDEX11 JMS BREAD /READ CHARACTERS UNTIL BREAD EXITS. JMP RDEX11 RDEX12 LAC DPOS SNA!CMA /DECIMAL PT HIT? JMP RDEX13 /NO ADJUST FRFLG TAD SFFLG /YES OVERRIDE FMAT. SPEC JMP RDEX16 RDEX13 LAC D /NO. OF DECIMAL DIGITS SPEC. TAD CRAMFL /BCNT AT CR OR ALT. OCCURANCE RDEX16 TAD SF /ALLOW FOR EXPLICIT P-FORMAT SPEC DAC FRFLG /POWER OF 10 RAW MANTISSA IS TO BE DIVIDED BY LAC SEXP /COMPL. IF SIGN OF EXPONENT IS NEG. SNA JMP RDEX17 LAC LS JMS CMP DAC LS JMP RDEX17 /EXIT RDEX15 LAC DPOS /BUMP DPOS IN CASE CR OR ALT SZA /DPOS=0 IF NI DECIMAL PT IN EXTER. FIELD ISZ DPOS /DECIMAL PT FOUND NOP /FALL THROUGH JMP RDEX2 /DON'T STORE TRAILING 0'S ANYWAY /SINCE CR OR ALT HIT RDEX17 LAC SFFLG SZA JMP RDEX18 LAC MS TAD LS JMP RDEX19 RDEX18 LAC* .AB TAD* .AC RDEX19 SNA DAC SIGN JMP* RDEXT /EXIT .EJECT /BUMP BCNT, TEST FOR ZERO, AND FETCH CHARACTER. / CALLING SEQUENCE -- JMS BREAD BREAD CAL 0 ISZ BCNT SKP /FIELD WIDTH NOT EXHAUSTED JMP RDEX12 JMS READ /FETCH LINE BUFFER CHAR JMP* BREAD .EJECT /TRANSFER MS/LS TO .AB/.AC / CALLING SEQUENCE -- JMS TRMSLS TRMSLS CAL 0 LAC MS AND V77777 DAC* .AB LAC LS DAC* .AC JMP* TRMSLS .EJECT /MULTIPLY FLOATING ACCUMULATOR BY TEN. 74 OR 89 USEC. / CALLING SEQUENCE -- JMS MPYTEN (77.0 USEC AVG) MPYTEN CAL 0 LAC* .AB /GET MS AND LS DAC MS LAC* .AC DAC LS JMS DSHR /SHIFT MS/LS 2 RIGHT AND ADD ORIGINAL JMS DSHR / CONTENTS. GLK TAD* .AC TAD LS DAC LS GLK TAD* .AB TAD MS DAC MS SMA!CLA /IF OVERFLOW, SHIFT ANSWER 1 RIGHT. JMP MPY1 JMS DSHR LAC C00001 MPY1 TAD C00003 /ADD 3 OR 4 TO EXPONENT DEPENDING ON TAD* .AA / WHETHER OR NOT FAC OVERFLOWED. DAC* .AA JMS TRMSLS JMP* MPYTEN .EJECT /MULTIPLY MS+LS BY 10 AND ADD (AC) 71-73 USEC. / CALLING SEQUENCE -- LAC BINARY NUMBER / JMS IMPTEN IMPTEN CAL 0 DAC TAC /SAVE NUMBER TO BE ADDED. JMS DSHL /MULTIPLY MS+LS BY 2 AND SAVE IN TMS+TLS. LAC LS DAC TLS LAC MS DAC TMS JMS DSHL /MULTIPLY MS+LS BY 8. JMS DSHL IMP1 CLL /ADD LS, TLS, AND ENTRY VALUE OF (AC). LAC LS TAD TLS SZL!CLL ISZ TMS /BUMP TMS IF OVERFLOW FROM LS+TLS NOP TAD TAC DAC LS GLK /GET CARRY BIT AND ADD MS AND TMS TAD MS TAD TMS DAC MS JMP* IMPTEN /EXIT .EJECT /SHIFT MS+LS RIGHT ONE OPEN 14 USEC / CALLING SEQUENCE -- JMS DSHR DSHR CAL 0 LAC MS RCR DAC MS LAC LS RAR DAC LS JMP* DSHR .EJECT /SHIFT MS+LS LEFT ONE OPEN 14 USEC / CALLING SEQUENCE -- JMS DSHL DSHL CAL 0 LAC LS RCL DAC LS LAC MS RAL DAC MS JMP* DSHL .EJECT /ROTATE MS+LS LEFT SEVEN 160 USEC. / CALLING SEQUENCE -- JMS DSH7 DSH7 CAL 0 LAW -7 DAC SHCT DSH71 JMS DSHL GLK TAD LS DAC LS ISZ SHCT JMP DSH71 JMP* DSH7 .EJECT /DOUBLE LOAD / CALLING SEQUENCE -- JMS FAO / .DSA ADDRESS (+400000 IF TRANSFER VECTOR) FAO CAL 0 LAC* FAO /GET ARGUMENT AND SAVE. DAC FADDR SPA /IF T.V., GO ONE MORE LEVEL INDIRECT. LAC* FADDR DAC FADDR /FADDR NOW CONTAINS ADDRESS OF FIRST WORD. LAC* FADDR DAC* .AA /LOAD FIRST WORD. ISZ FADDR LAC* FADDR DAC* .AB /LOAD SECOND WORD. ISZ FADDR LAC* FADDR DAC* .AC /LOAD THIRD WORD. ISZ FAO JMP* FAO /EXIT .EJECT /DOUBLE STORE / CALLING SEQUENCE -- JMS FAP / .DSA ADDRESS (+400000 IF TRANSFER VECTOR) FAP CAL 0 LAC* FAP /GET ARGUMENT AND SAVE. DAC FADDR SPA /IF T.V., GO ONE MORE LEVEL INDIRECT. LAC* FADDR DAC FADDR /FADDR NOW CONTAINS ADDRESS OF FIRST WORD. LAC* .AA DAC* FADDR /STORE FIRST WORD. ISZ FADDR LAC* .AB DAC* FADDR /STORE SECOND WORD. ISZ FADDR LAC* .AC DAC* FADDR /STORE THIRD WORD. ISZ FAP JMP* FAP /EXIT .EJECT /DOUBLE FLOATING ADD / CALLING SEQUENCE -- JMS FAQ (AUGEND IN FAC) / .DSA ADDEND ADDRESS FAQ CAL 0 JMS* .CF /TRANSFER AUGEND TO HAC. LAC* FAQ /TRANSFER ARGUMENT TO DBL LOAD CALL. DAC FAQ1 JMS FAO /LOAD ADDEND INTO FAC. FAQ1 .DSA 0 JMS* .CC /ADD HAC TO FAC. .DSA 42 JMS* .CH /ROUND AND SIGN FAC. .DSA 0 / *** DDS FEB69 *** .DSA -1 / *** DDS FEB69 *** ISZ FAQ /BUMP RETURN ADDRESS AND EXIT. JMP* FAQ .EJECT /INITIALIZE FORMAT DECODER / CALLING SEQUENCE -- LAC STARTING ADDRESS OF FORMAT STATEMENT. / JMS INIFD INIFD CAL 0 DAC CC /CHARACTER POINTER DZM SF /ZERO TO SCALE FACTOR, SPECIFICATION DZM R / REPEAT COUNT, AND PAREN COUNT. DZM P LAC KZ /SET GROUP REPEAT COUNT AND REENTRY LOCA- DAC K / TION POINTERS TO THEIR INITIAL VALUES ISZ K / AND SET RE(1) AND K(1) TO ZERO. DZM* K DAC K LAC REZ DAC RE ISZ RE DZM* RE DAC RE DAC NCF /SET NO-CONVERSION FLAG. DZM CCN /CLEAR RE(P) INTERMEDIATE VALUE. JMP* INIFD /FORMAT DECODER DEDICATED PARAMETERS -- KZ .DSA K K .BLOCK 4 REZ .DSA RE RE .BLOCK 4 REEN .DSA 0 CC .DSA 0 CCN .DSA 0 CCA .DSA 0 CC2 .DSA 0 P .DSA 0 SF .DSA 0 R .DSA 0 S .DSA 0 S2 .DSA 0 W .DSA 0 D .DSA 0 NCF .DSA 0 .EJECT /FORMAT STATEMENT DECODER / CALLING SEQUENCE -- JMS .FD /THE FOLLOWING INFORMATION IS RETURNED-- / (1) S -- THE CONVERSION TYPE -- 0 I-CONVERSION / 1 L-CONVERSION / 2 A-CONVERSION / 3 O-CONVERSION / 4 D-CONVERSION / 5 E-CONVERSION / 6 F-CONVERSION / 7 G-CONVERSION / (2) W -- THE EXTERNAL FIELD WIDTH / (3) D -- THE FRACTION FIELD WIDTH / (4) SF-- THE DECIMAL SCALE FACTOR .FD CAL 0 DZM NUMFLG /INTIALIZE NUMERIC FLAG K00001 LAW -1 /DECREMENT REPEAT COUNT. IF GREATER THAN TAD R / ZERO, EXIT WITH ALL SPECIFICATIONS DAC R / UNCHANGED. SPA!SNA JMP FD01 DZM NCF JMP FD99 FD01 JMS GETCC /GET FIRST CHARACTER. IF A BLANK, FETCH SAD S00040 / NON-BLANK CHARACTER. FD02 JMS FNBCHR SAD S00054 JMP FD20 /IF COMMA. FD03 SAD S00057 JMP FD21 /IF SLASH SAD S00051 JMP FD22 /IF RIGHT PAREN FD04 SAD S00055 JMP FD25 /IF MINUS FD05 SAD S00050 JMP FD26 /IF LEFT PAREN JMS NUMCHK JMP FD05 /IF A NUMBER. SAD S00120 JMP FD31 /IF P SAD S00110 JMP FD32 /IF H SAD S00130 JMP FD37 /IF X SAD S00111 JMP FD39 /IF I SAD S00114 JMP FD40 /IF L SAD S00101 JMP FD41 /IF A FD06 JMS NUMCHK JMP FD07 /IF A NUMBER. FD07 TAD Z77671 /CHAR - (107)8 SMA!SZA JMP FD08 TAD C00003 /CHAR - (104)8 SMA JMP FD42 /IF D, E, F, OR G FD08 LAC CHAR FD09 JMS NUMCHK JMP FD10 /IF A NUMBER FD86 JMS* .ER /END OF SKIP CHAIN -- ILLEGAL CHARACTER. .DSA 12 LAC* CC LAC* CC2 FD10 LAC LS /NUMBER IS FIELD WIDTH DAC W DZM NUMFLG LAC CHAR /IF NEXT CHARACTER IS A PERIOD, FRACTION SAD S00056 / FIELD WIDTH FOLLOWS. IF NOT, EXIT JMP FD11 / WITH FRACTION FIELD WIDTH=0. DZM D JMP FD99 FD11 JMS FNBCHR JMS NUMCHK SKP JMP FD86 /IF PERIOD NOT FOLLOWED BY A NUMBER, BAD LAC LS / FORMAT. DAC D FD99 LAC S DAC S2 JMP* .FD /COMMA FD20 LAC P /CHECK PAREN COUNT FOR GREATER THAN ZERO. SPA!SNA / IF NOT, BAD FORMAT. JMP FD86 / IF SO, IGNORE COMMA. JMS FNBCHR JMP FD03 /SLASH FD21 JMS EOR /START NEW RECORD AND THEN PROCESS LIKE LAC P /CHECK PAREN CNT FOR >0 SPA!SNA /IF NOT BAD FORMAT JMP FD86 JMP FD02 /CONTINUE /RIGHT PAREN FD22 JMS DECP /REDUCE PAREN COUNT. IF P=0, ITS THE END LAC P / OF THE FORMAT STATEMENT. RESET CC TO SZA / ITS REENTRY POSITION. IF P.NE.0, ITS JMP FD24 / THE END OF A REPEATING GROUP. RESET LAC REEN / CHARACTER COUNTER TO BEGINNING OF DAC CC / GROUP. JMS INCP /REENTRY POSITION IS THE START OF THE FOR- LAC* RE / MAT STATEMENT IF NO GROUPING PARENS SNA / ARE PRESENT (RE(1)=0). IF RE(1).NE.0, JMS DECP / REENTER WITH P=1. LAC NCF /IF END OF FORMAT STATEMENT HAS BEEN SZA / REACHED WITHOUT NO-CONVERSION FLAG JMP FD99 / BEING RESET, EXIT IMMEDIATELY. JMS EOR /START NEW RECORD. FD23 JMS GETCC /GET CHARACTER FOR NEW CC, AND REENTER JMP FD03 / SKIP CHAIN. FD24 CLC /DECREMENT THE GROUP REPEAT COUNT FOR THIS TAD* K / GROUP. IF K(P).GT.ZERO, SET CC=RE(P), DAC* K / THE SAVED GROUP REENTRY POINT AND SNA!SPA / REPEAT THE GROUP AGAIN. IF K(P)=0, JMP FD243 / DO NOT REPEAT AND GO ON TO NEXT CHAR- LAC* RE / ACTER IN THE FORMAT STATEMENT. DAC CC JMP FD23 FD243 DZM* K JMP FD02 /MINUS SIGN FD25 JMS FNBCHR /FETCH FIRST CHAR AFTER MINUS SIGN. JMS NUMCHK /IS IT A NUMBER. SKP JMP FD86 / NO, BAD FORMAT. LAC LS /COMPLEMENT THE CONVERTED NUMBER AND STORE JMS CMP / IT IN SF. DAC SF LAC CHAR /FIRST CHARACTER FOLLOWING MUST BE THE SAD S00120 / LETTER P. IF NOT, BAD FORMAT. SKP JMP FD86 DZM NUMFLG /NO REPEAT COUNT FD255 JMS FNBCHR /FETCH NEXT CHAR AND REENTER SKIP CHAIN. JMP FD06 /LEFT PAREN FD26 LAC P /IF P=0, THIS IS THE FIRST LEFT PAREN IN SZA / THE FORMAT STATEMENT. SAVE CC IN REEN JMP FD28 / FOR REENTRY, BUMP P BY 1, AND REENTER LAC CC / SKIP CHAIN DAC REEN FD27 JMS INCP JMS FNBCHR JMP FD03 FD28 LAC* K /IF REPEAT COUNT NOT ZERO, THIS IS A CON- SZA / TINUATION OF A GROUP REPEAT CYCLE -- JMP FD27 / BUMP P AND EXIT. LAC NUMFLG /IF REPEAT COUNT = 0, THIS IS A NEW GROUP SNA JMP FD29 / NUMERIC FLAG. IF SET, RESET IT AND / / STORE CONVERTED NUMBER AS A REPEAT LAC LS / COUNT. IF NOT SET, ASSUME A GROUP RE- JMP FD30 / PEAT COUNT OF ONE. SAVE CC IN RE(P) FD29 LAC C00001 / AS A GROUP REENTRY LOCATION. FD30 DAC* K LAC CC DAC* RE LAC P /IF THIS GROUP IS IN THE FIRST LEVEL OF SAD C00001 / PAREN NESTING (P=1), CLOBBER REEN WITH SKP / CCN OR RE(1) DEPENDING ON WHETHER THIS JMP FD27 / GROUP HAD A REPEAT COUNT OR NOT. LAC NUMFLG SNA JMP FD301 DZM NUMFLG LAC CCN JMP FD302 FD301 LAC* RE FD302 DAC REEN JMP FD27 /LETTER P FD31 LAC NUMFLG /LETTER P MUST BE PRECEDED BY NUMBER. IF SNA / NOT, BAD FORMAT. IF SO, NUMBER IS A JMP FD86 / NEW SCALE FACTOR. LAC LS DAC SF DZM NUMFLG JMP FD255 /REENTER SKIP CHAIN. /H-CONVERSION FD32 LAC NUMFLG /H CHARACTER MUST BE PRECEDED BY A NUMBER. SNA / IF NOT, BAD FORMAT. IF SO, CONVERTED JMP FD86 / NUMBER IS THE CHARACTER COUNT FOR LAC LS / HOLLERITH I/O TRANSFERS. DZM NUMFLG JMS CMP DAC CCNT SNA /IF NUMBER IS ZERO, BAD FORMAT. JMP FD86 LAC* .FH /IS THIS A READ OR WRITE CALL. SZA / READ JMP FD36 / WRITE FD33 JMS INCCC /UPDATE CC, CC2, CCA AND CLOBBER CHAR WITH JMS SPLIT / INPUT FROM LINE BUFFER. JMS READ /TRANSFER FORMAT STATEMENT WORD PAIR INTO LAC* CC / MS/LS FOR SHIFTING. DAC MS LAC* CC2 DAC LS LAW -5 /INITIALIZE LOOP COUNTERS CNT AND CNT2 TAD CCA / CCA=CHARACTER POSITION IN WORD PAIR. DAC CNT2 LAC CCA CMA DAC CNT FD34 JMS DSH7 /LOOP ONE -- ROTATE MS/LS LEFT UNTIL THE ISZ CNT / CURRENT CHARACTER IS RIGHT-JUSTIFIED JMP FD34 / IN LS. LAC LS /GET RID OF OLD CHARACTER AND MERGE IN AND Z77600 / THE NEW ONE. XOR CHAR DAC LS SKP FD35 JMS DSH7 /CONTINUE ROTATING MS/LS UNTIL A COMPLETE ISZ CNT2 / 36 BIT CIRCULAR SHIFT HAS BEEN DONE. JMP FD35 JMS DSHL LAC MS /TRANSFER MS AND LS BACK INTO THE FORMAT DAC* CC / STATEMENT. LAC LS DAC* CC2 ISZ CCNT /HAVE ALL CHARACTERS BEEN TRANSFERRED. JMP FD33 / NO, PROCESS NEXT CHARACTER. JMP FD02 / YES, REENTER SKIP CHAIN. FD36 JMS FMTFCH /HOLLERITH OUTPUT -- READ AND PACK (CCNT) JMS PACK / CHARACTERS IN LINE BUFFER. ISZ CCNT JMP FD36 JMP FD02 /REENTER SKIP CHAIN. /X-CONVERSION FD37 LAC NUMFLG /X CHARACTER MUST BE PRECEDED BY A NUMBER. SNA / IF NOT, BAD FORMAT. IF SO, COMPLEMENT JMP FD86 / OF NUMBER IS THE CHARACTER COUNT FOR LAC LS / I/O TRANSFER. DZM NUMFLG JMS CMP DAC CCNT SNA /IF CHARACTER COUNT IS ZERO, BAD FORMAT. JMP FD86 LAC* .FH /TEST FOR READ OR WRITE. SZA / READ. JMP FD385 / WRITE. FD38 JMS READ /READ--SKIP (CCNT) LINE BUFFER CHARACTERS. ISZ CCNT JMP FD38 JMP FD02 /REENTER SKIP CHAIN. FD385 LAC LS /WRITE--PACK (LS) BLANKS IN LINE BUFFER. JMS PKBLKS JMP FD02 /REENTER SKIP CHAIN. /I-CONVERSION FD39 CLA /ZERO TO AC(15-17) JMP FD43 /L-CONVERSION FD40 LAW 1 /ONE TO AC(15-17) JMP FD43 /A-CONVERSION FD41 LAW 2 /TWO TO AC(15-17) JMP FD43 /D- E- F- AND G-CONVERSIONS /FOUR(D), FIVE(E), SIX(F), OR SEVEN(G) FD42 LAC CHAR / TO AC(15-17). FD43 AND S00007 /GET RID OF AC BITS 0-14. DAC S /STORE CONVERSION TYPE CODE. DZM NCF /RESET NO-CONVERSION FLAG. LAC NUMFLG /CHECK FOR REPEAT COUNT. IF THERE IS A SNA / NUMBER, STORE IT IN R. JMP FD44 DZM NUMFLG LAC LS DAC R FD44 JMS FNBCHR /FETCH NEXT CHARACTER (=FIELD WIDTH) AND JMP FD09 / REENTER SKIP CHAIN. .EJECT /CHECK CHARACTER FOR NUMERIC -- COMPLETE CONVERSION IF YES. / CALLING SEQUENCE -- LAC CHARACTER (ASCII-7) / JMS NUMCHK / JMP YES (NEXT CHARACTER IN AC) / JMP NO (TESTED CHARACTER IN AC) NUMCHK CAL 0 JMS NUMTST /IS CHARACTER A NUMBER. JMP NUMCH3 / NO, BUMP RETURN ADDRESS AND EXIT. DAC LS / YES, INITIALIZE MS AND LS. DZM MS LAC CC /SAVE LOCATION OF 1ST CHARACTER IN CASE DAC CCN / THIS IS A GROUP REPEAT COUNT. CLC /SET NUMBER FLAG. DAC NUMFLG JMP NUMCH2 /ENTER LOOP TO COMPLETE NUMERIC CONVERSION. NUMCH1 JMS IMPTEN /MULTIPLY MS+LS BY 10 AND ADD (AC). NUMCH2 JMS FNBCHR /FETCH NEXT CHARACTER AND TEST IT. JMS NUMTST /IS IT A NUMBER. JMP* NUMCHK / NO, EXIT WITH NEXT CHAR IN AC. JMP NUMCH1 / YES, UPDATE TOTAL. NUMCH3 ISZ NUMCHK /EXIT HERE IF 1ST CHAR NON-NUMERIC. JMP* NUMCHK .EJECT /TEST FOR NUMERIC CHARACTER / CALLING SEQUENCE -- LAC CHARACTER (ASCII-7) / JMS NUMTST / JMP NO (TESTED CHARACTER IN AC) / JMP YES (BINARY VALUE OF CHARACTER IN AC) NUMTST CAL 0 DAC NUMTS2 /SAVE CHARACTER. TAD Z77706 /IS IT LESS THAN OR EQUAL TO NINE. SMA / YES, TEST AGAIN. JMP NUMTS1 / NO, EXIT. TAD S00012 /IS IT GREATER THAN OR EQUAL TO ZERO. SPA / YES, VALID NUMBER. JMP NUMTS1 / NO, EXIT. ISZ NUMTST /BUMP RETURN ADDRESS AND EXIT WITH BINARY JMP* NUMTST / VALUE OF CHARACTER IN AC. NUMTS1 LAC NUMTS2 /EXIT WITH ORIGINAL CHARACTER IN AC. JMP* NUMTST NUMTS2 .DSA 0 /TEMP STORAGE FOR (AC) AT ENTRY. .EJECT /INCREMENT PAREN COUNT / CALLING SEQUENCE -- JMS INCP INCP CAL 0 K00003 LAW -3 /IF P.GE.3, BAD FORMAT TAD P SMA JMP FD86 ISZ P / (P+1) TO (P) NOP ISZ K / (K+1) TO (K) ISZ RE / (RE+1) TO (RE) JMP* INCP .EJECT /DECREMENT PAREN COUNT / CALLING SEQUENCE -- JMS DECP DECP CAL 0 CLC TAD P /IF (P-1) NEGATIVE, BAD FORMAT. SPA JMP FD86 DAC P / (P-1) TO (P) CLC TAD K DAC K / (K-1) TO (K) CLC TAD RE DAC RE / (RE-1) TO (RE) JMP* DECP .EJECT /GET CURRENT CHARACTER / CALLING SEQUENCE -- JMS GETCC / EXIT WITH CHARACTER IN AC AND IN CHAR. GETCC CAL 0 JMS SPLIT /SPLIT CC INTO CCA AND CC2 TAD GETCC0 /FORM TRANSFER VECTOR TO ONE OF FIVE LOCA- DAC TVCC / TIONS ACCORDING TO CHARACTER NUMBER. JMP* TVCC GETCC0 .DSA GETCC1 GETCC1 JMP GETCC6 /1ST CHARACTER JMP GETCC5 /2ND CHARACTER JMP GETCC4 /3RD CHARACTER JMP GETCC3 /4TH CHARACTER GETCC2 LAC* CC2 /5TH CHARACTER -- SHIFT WD 1 RIGHT RAR JMP GETCC7 GETCC3 LAC* CC2 /SHIFT WD2 8 RIGHT. RTR; RTR; RTR; RTR JMP GETCC7 GETCC4 LAC* CC /4 BITS IN WD1 + 3 BITS IN WD2. RAL; RTL AND S00170 DAC CHAR LAC* CC2 RTL; RTL AND S00007 XOR CHAR JMP GETCC7 GETCC5 LAC* CC /SHIFT WD1 4 RIGHT. RTR; RTR JMP GETCC7 GETCC6 LAC* CC /REVOLVE WD1 8 LEFT. RTL; RTL; RTL; RTL GETCC7 AND S00177 /EXTRACT OFF UPPER 11 BITS. DAC CHAR JMP* GETCC /EXIT. TVCC .DSA 0 CHAR .DSA 0 .EJECT /SPLIT CC INTO CCA AND CC2 / CALLING SEQUENCE -- JMS SPLIT SPLIT CAL 0 LAC CC TAD C00001 DAC CC2 /CC2= CC+1 RTL; RTL AND S00007 DAC CCA /CCA=3 HIGH BITS OF CC, RIGHT JUSTIFIED. JMP* SPLIT /EXIT WITH CCA IN AC. .EJECT /FETCH FORMAT CHARACTER / CALLING SEQUENCE -- JMS FMTFCH FMTFCH CAL 0 JMS INCCC /BUMP CHARACTRE COUNT +1. JMS GETCC /GET CHARACTER. JMP* FMTFCH .EJECT /INCREMENT CHARACTER COUNT / CALLING SEQUENCE -- JMS INCCC INCCC CAL 0 LAC CC SPA /IF LAST CHARACTER IN THE WORD PAIR, RESET TAD V00002 / CHARACTER NUMBER TO ZERO, AND BUMP TAD T00000 / WORD PAIR ADDRESS BY 2. IF NOT LAST DAC CC / CHARACTER, BUMP CHARACTER NUMBER BY 1. JMP* INCCC .EJECT /FETCH NON-BLANK FORMAT CHARACTER. / CALLING SEQUENCE -- JMS FNBCHR FNBCHR CAL 0 FNB1 JMS FMTFCH SAD S00040 JMP FNB1 /IF CHAR=BLANK, FETCH AGAIN. JMP* FNBCHR .EJECT /BCD I/O CLEANUP / CALLING SEQUENCE -- JMS* .FF .FF CAL 0 LAW -1 /SET NO-CONVERSION FLAG TO STOP AT END OF DAC NCF / FORMAT STATEMENT. JMS .FD /CLEANUP ALL H AND X CONVERSIONS. LAC* .FH /IF A WRITE, OUTPUT LAST LINE. SZA JMS EOR JMP* .FF /EXIT. .EJECT /INITIALIZE LINE BUFFER / CALLING SEQUENCE -- JMS INILB INILB CAL 0 JMS EXCH /EXCHANGE MS+LS WITH SMS+SLS. CLC /SET CHARACTER COUNT TO MINUS ONE FOR THE DAC SCC / BUMP ROUTINE TAD .FN /RESET LINE BUFFER POINTER (LBADD) TO DAC LBADD / BEGINNING OF LINE BUFFER. DZM HIFLG /RESET FLAG TO 0 (POINTER OK). LAC* .FH SZA JMP INILB1 ISZ LBADD / READ -- INCREMENT LINE BUFFER POINTER ISZ LBADD / PAST THE TWO HEADER WORDS. JMP INILB2 INILB1 DZM MS / WRITE -- STORE ZERO IN WORD BUFFER DZM LS / FOR HEADER WORDS. DZM FSTFLG /SET FIRST CHARACTER FLAG. INILB2 JMS BUMP /BUMP CHARACTER COUNTER (SCC). JMS EXCH /RESTORE MS+LS AND SMS+SLS. JMP* INILB /EXIT .EJECT /END OF RECORD PROCESSOR / CALLING SEQUENCE -- JMS EOR EOR CAL 0 LAC* .FH /CHECK FOR READ OR WRITE. SZA JMP EOR1 LAC SLOT /READ--INPUT NEXT RECORD. XOR S02000 JMS* .FQ LAC* .FN /CHECK L.B. HEADER FOR IOPS-ALPHA MODE. AND S00017 SAD C00002 JMP EOR3 /IF MODE OK, CONTINUE. JMS* .ER /IF MODE NOT IOPS-ALPHA, TAKE ERROR EXIT. .DSA 11 EOR1 LAC HIFLG /IF LINE BUFFER IS NOT FULL, FILL CURRENT SZA / WORD PAIR WITH BLANKS. JMP EOR2 LAC SCC JMS CMP JMS PKBLKS EOR2 LAC* LBADD /CLOBBER LAST CHARACTER WITH A C/R. AND Z77400 /REMOVE CURRENT CHARACTER. XOR S00032 /INSERT C/R IN BITS 10 TO 16 (17=0). DAC* LBADD LAC .FN /CALCULATE LINE BUFFER SIZE. CMA!STL / (.F4) = 3BADD-.FN+1 TAD C00002 TAD LBADD RTL; RTL; RTL; RTL /CONSTRUCT HEADER WORD. XOR C00002 DAC* .FN LAC SLOT /WRITE CURRENT RECORD. XOR S02000 JMS* .FQ EOR3 JMS INILB /INITIALIZE LINE BUFFER. JMP* EOR /EXIT. .EJECT /PACK CHARACTER IN LINE BUFFER / CALLING SEQUENCE -- LAC CHARACTER (ASCII-7) / JMS PACK PACK CAL 0 AND S00177 /SAVE 7-BIT CHARACTER. DAC CHAR LAC FSTFLG /TEST FOR FIRST CHARACTER IN LINE. IF SO, SZA / CHANGE IT TO A CARRIAGE CONTROL CHAR-, JMP PACK1 / ACTER. LAC CHAR DAC FSTFLG /KILL FIRST-CHARACTER FLAG. SAD S00061 /IF A BCD ONE, CHANGE TO 014. LAW -14 / (EJECT PAGE) SAD S00053 /IF A BCD PLUS, CHANGE TO 020. LAW -20 / (NO LINE FEED) SAD S00060 /IF A BCD ZERO, CHANGE TO 021. LAW -21 / (DOUBLE SPACE) SMA LAW -12 /IF ANYTHING ELSE, MAKE JMS CMP /012 DAC CHAR JMP PACK2 PACK1 LAC HIFLG /IF LINE SIZE HAS BEEN EXCEEDED, EXIT SZA / IMMEDIATELY. JMP* PACK PACK2 JMS EXCH /OK TO PACK--EXCHANGE MS+LS AND SMS+SLS. JMS DSH7 /ROTATE MS+LS LEFT 7, REMOVE CURRENT CON- LAC LS / TENTS OF 7 LOW BITS, AND INSERT AND Z77600 / CHARACTER. XOR CHAR DAC LS JMS BUMP /BUMP CHARACTER COUNT. JMS EXCH /RESTORE MS+LS AND SMS+SLS. JMP* PACK /EXIT. .EJECT /READ CHARACTER FROM LINE BUFFER / CALLING SEQUENCE -- JMS READ / EXITS WITH ASCII-7 CHARACTER IN CHAR AND AC. READ CAL 0 LAC HIFLG /IF LINE SIZE HAS BEEN EXCEEDED, SET CHAR- SNA / ACTER TO A BLANK AND EXIT JMP READ1 LAC S00040 DAC CHAR JMP* READ READ1 JMS EXCH /OK TO READ--EXCHANGE MS+LS AND SMS+SLS. JMS DSH7 /ROTATE MS+LS LEFT 7, AND EXTRACT OUT THE LAC LS / 7 LOW BITS = FETCHED CHARACTER. AND S00177 SAD S00015 /IF CHAR=C/R OR ALT MODE, MAKE IT A BLANK JMP READ3 / AND SET HIFLG TO INDICATE END OF LINE. SAD S00175 JMP READ3 READ2 DAC CHAR JMS BUMP /BUMP CHARACTER COUNT. JMS E 2c@