.TITLE BCDIO / /COPYRIGHT (C) 1975 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY /ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH /THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS /SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO- /VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON /EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO /THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE /WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM- /MITMENT BY DIGITAL EQUIPMENT CORPORATION. / /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY /OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. .EJECT /EDIT #048 14 FEB 73 TAM(46,47) *REF*(28):WAD:(29)*REF*(33):WAD: /EDIT #049 05-MAY-75 R. K. BLACKETT REMOVE 'AND'S WHICH STRIP BITS 0-2 / FROM T.V. ADDRESS. THIS IS FOR XVM SYSTEMS. / THIS CHANGE DOES NOT PRECLUDE ITS USE ON NON-XVM / SYSTEMS. /EDIT #050 06-MAY-75 R. K. BLACKETT FIX THE 'LF' GLITCH (AS DOCUMENTED IN / SPRS 15-E951, 15-948, 15-960, ET. AL.) / ADD NEW CONDITIONAL PARMS MSCC, LFTOSP / MSCC (MASS STORAGE CARRIAGE CONTROL) IF DEFINED, / CONVERT 1ST CHAR TO INTERNAL CC CHAR CODE / LFTOSP (LINE FEED TO SPACE) IF DEFINED, CONVERT A LEADING / LINE FEED TO A SPACE. / REQUIRES USING FIOPS 036 OR LATER, AS FIOPS WAS / MODIFIED TO SET BIT 3 OF .STAB ENTRY TO INDICATE / A DIRECTORIED DEVICE. / ALSO NEED RBCDIO 008 OR LATER, AS IT WAS CHANGED / TO SET .MSDEV FOR ALL RANDOM ACCESS DEVICES, ON / OUTPUT. MODIFICATION WAS TO .RW SECTION OF RBCDIO. / /EDIT #051 23-JUL-75 R. K. BLACKETT INSERT A SPECIAL TRANSFER VECTOR CALLED / 'CC1' WHICH CONTAINS THE POINTER TO THE FIRST WORD / OF THE WORD PAIR WHICH CONTINS THE 'CURRENT CHARACTER'. / THE OLDER EDITS USED 'CC' FOR THIS PURPOSE, BUT 'CC' / ALSO CONTAINS THE CHARACTER WITHIN THE PAIR, / CODED IN BITS 0-2. THIS INTERFERES WITH XVM WIDE / ADDRESSING MODES. 'CC' IS STILL PRESENT AND USED FOR / ALL OF ITS PREVIOUS FUNCTIONS EXCEPT FOR FETCHING / AND STORING CHARACTERS THRU AS AN INDIRECT POINTER. / ALSO, REMOVE TWOS COMPLEMENT ROUTINE, SUBSITUTING / 'TCA' INTRUCTIONS. / ALSO, CHANGE THE GLOBAL ROUTINE '.READ' TO BE NAMED / 'READ.' SO AS NOT TO CONFLICT WITH I/O MACRO BY SAME / NAME. THIS WAS DONE WITH EDITORS 'CONVERT' COMMAND, / SO SOME COMMENTS MAY HAVE BEEN ALTERED. IN ADDITION, / THE MODIFIED LINES WERE NOT FLAGED WITH EDIT NUMBERS. / EDIT #052 20-AUG-75 M. HEBENSTREIT DISCLAIMER / / EDIT #053 12-DEC-75 R. K. BLACKETT FIX BUG INTEGER OUTPUT WHICH / CAUSED A NEXM WHEN OUTPUTING / THE LAST WORD OF PHYSICAL MEMORY / UNDER AN 'I' CONVERSION. / / / /ASSEMBLY PARAMETERS / DEFINE %FPP FOR FLOATING POINT PROCESSOR / DEFINE %V5A FOR ADSS SYSTEM, ELSE, DOS15 ASSUMED /DEFINE RSX FOR RSX SYSTEM. / DEFINE LFTOSP AND MSCC AS FOLLOWS: / NEITHER DEFINED = DOS XVM RSX XVM OR LATER SYSTEMS / LFTOSP=0 = **ILLOGICAL CASE** / LFTOSP=0,MSCC=0 = DOS V3A,V3B RSX PLUS III V1A, V1B / MSCC=0 = DOS V1A, V2A RSX PLUS ADSS V5B AND EARLIER .IFUND MSCC /(RKB-050) CHECK FOR ILLEGAL COMB .IFDEF LFTOSP /(RKB-050) .END *****ILLEGAL ASSEMBLY PARAMETER COMBINATION*** .ENDC /(RKB-050) .ENDC /(RKB-050) .IFDEF RSX %V5A=0 %V5A1=0 .ENDC .IFUND %V5A %V5A1=0 %DOS15=0 .ENDC .IFDEF %DOS15 %V5A1=0 .ENDC /BCD I/O OBJECT-TIME PACKAGE. / INTERNAL GLOBALS-- .GLOBL .FA3 /** TO ALLOW LDNG. OF .GD CALL .GLOBL .FA4 /** ALLOW JMP INTO .FA FR. .GE .GLOBL .FR /BCD READ .GLOBL .FW /BCD WRITE .GLOBL .FA /BCD ARRAY I/O .GLOBL .RA /* R.A. BCD ARRAY I/O .GLOBL .FE /BCD ELEMENT I/O .GLOBL .RE /* R.A. BCD ELEMENT I/O .GLOBL .FF /BCD I/O CLEANUP .GLOBL .STEOR /* STORE 'EOR' (S.A.) OR 'REOR' (R.A.) .GLOBL .BFLOC /* STORE '.FN' (S.A.) OR '.FNPTR' (R.A.) .GLOBL .INILB /* INIT. L.B. .GLOBL .INIFD /* INIT. FORMAT DECODER .GLOBL .HILIM /* HIGH LIMIT .GLOBL .RAENT /* R.A. ENTRY TO EOR .GLOBL .D /** DEC. FIELD WIDTH .GLOBL .W /** FIELD WIDTH .GLOBL .S /** FORMAT TYPE CODE .GLOBL .SF /** SCALE FACTOR .GLOBL .PACK /** PACK CHAR. IN L.B. .GLOBL READ. /** READ CHAR. .GLOBL .CHAR /** ASCII CHAR. READ FROM BUFFER .GLOBL .NMTST /** NUMBER TEST ROUTINE .GLOBL .MPYTN /** MULT. BY TEN .IFUND MSCC /(RKB-050) .GLOBL .MSDEV /(RKB-050) MASS STORAGE SWITCH (USED IN RBCDIO) .ENDC /(RKB-050) .IFUND %FPP .GLOBL .FAO /** DOUBLE LOAD .GLOBL .FAP .ENDC .GLOBL .HIFLG /** HIGH FLAG .GLOBL .SCC /** CHAR. CNTR. .GLOBL .PBLKS /** PACK BLANKS .GLOBL .LBADD /** L.B. ADDR. .GLOBL .FSTFL /** FIRST CHR. FLG.: =-1 IF ENCODE .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 .INISA /INIT. FOR SEQ. ACC. ROUT. .IFUND RSX .GLOBL .FC6 /**L.B. SIZE (FIOPS) .ENDC .IFDEF %V5A1 .GLOBL .RN /R.A. FLAG. =400000 IF RA. OR ELSE =0 .GLOBL .STADD /PTR. TO CURRENT ST. TAB. ENTRY (FIOPS) .ENDC .IFUND %FPP .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. .ENDC .GLOBL .ER4 /REINIT. LOCATION (OTSER) .IFDEF %DOS15 .GLOBL .DSK,.FLRA,.FLTB1,.FLZW0 .ENDC / / CONDITIONALLY DEFINED MACROS .IFUND %FPP .DEFIN FLD%,A JMS* A .ENDM .ENDC .IFDEF %FPP FLD=713050 .DEFIN FLD% FLD .ENDM .ENDC .IFUND %FPP .DEFIN URFST%,A JMS* A .ENDM .ENDC .IFDEF %FPP URFST=713650 .DEFIN URFST% URFST .ENDM .ENDC .IFDEF %FPP / DIRECT ASSIGNS. FOR FPP PROCESSOR DLD=713150 DST=713750 UNDST=713770 DRD=712540 FNG=713272 FAB=713271 FZR=711200 BZA=716601 BPA=716604 UNDMP=711560 URDDV=712050 BNA=716610 UNDLD=713170 URDRD=712550 DAD=716140 FNM=713250 DRD=712540 .ENDC / CONSTANTS AND WORKING STORAGE-- C00003 .DSA 3 / *** DDS FEB69 *** C00005 .DSA 5 / *** DDS FEB69 *** C00006 .DSA 6 C00035 .DSA 43 K00002 .DSA -2 / *** DDS FEB69 *** K00004 .DSA -4 K00006 .DSA -6 K00010 .DSA -12 / *** DDS FEB69 *** S00001 .DSA 1 S00004 .DSA 4 S00007 .DSA 7 S00010 10 S00012 .DSA 12 S00015 .DSA 15 S00017 .DSA 17 S00032 .DSA 32 S00040 .DSA 40 S00042 42 S00044 44 S00047 47 S00037 37 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 S00077 .DSA 77 S00101 .DSA 101 S00110 .DSA 110 S00111 .DSA 111 S00114 .DSA 114 S00117 117 S00120 .DSA 120 S00122 122 S00124 .DSA 124 S00130 .DSA 130 S00170 .DSA 170 S00175 .DSA 175 S00177 .DSA 177 S02000 .DSA 2000 S17777 .DSA 17777 / *** DDS FEB69 *** S20100 .DSA 020100 S77776 .DSA 077776 /S77777 .DSA 77777 /(RKB-049) THIS LITERAL REMOVED, NO LONGER USED T00000 .DSA 100000 T77777 .DSA 177777 U01004 .DSA 201004 V00002 .DSA 300002 V00000 300000 V40000 .DSA 340000 V77777 .DSA 377777 W00000 .DSA 400000 Z40000 .DSA 740000 Z77400 .DSA 777400 Z77600 .DSA 777600 Z77671 .DSA 777671 Z77706 .DSA 777706 Z77760 .DSA 777760 DBLONE .DSA 1 .DSA 200000 .DSA 0 CCNT .DSA 0 STCON 0 /STR. CONST. OCHR 0 /**OCTAL CHR. TBNM 0 /**TAB NUM. CCPTR 0 /** CHAR. PTR VRTYP 0 /** VAR. TYPE TEMP7 0 /** TEMP8 0 /** OCTL 0 /** OCTAL FLG.: =-1,OCTAL; =0, DEC. IGCNT 0 /** IGNORE CHAR. CNT. CNT2 .DSA 0 CNT .DSA 0 DADD .DSA 0 DELTA .DSA 0 .HIFLG .DSA 0 .HILIM .DSA 0 .LBADD .DSA 0 LIMIT .DSA 0 .IFDEF %FPP FP5 0 /TEMP FILLER FOR FPP --DON'T MOVE!!! / CLOBBERED BY LOADING MS AND LS .ENDC MS .DSA 0 LS .DSA 0 NUMFLG .DSA 0 .SCC .DSA 0 SIGN .DSA 0 SLOT .DSA 0 SMS .DSA 0 SLS .DSA 0 .FSTFL .DSA 0 CRAMFL 0 /CR-ALTMODE FLAG RDEXT .IFDEF %FPP FP1 0 /TEM. FP2 0 /WORKING REGISTERS FOR FPP FP3 0 /AC FP4 0 / FPH2 0 /HELD REGIS. FOR FPP FPH3 0 FPH4 0 .ENDC LDEOR .DSA EOR /* .STEOR XX /* .BFLOC XX /* .IFUND MSCC /(RKB-050) .MSDEV XX /(RKB-050) MASS STORAGE DEVICE SWITCH. /(RKB-050) SET FOR WRITING ONLY: /(RKB-050) SKP = NON-MASS STORAGE /(RKB-050) NOP = MASS STORAGE .ENDC /(RKB-050) BCNT=CCNT TEMP6=IGCNT /** 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 WD5=CCA PKBLK2=NUMTS2 CHCT=BCNT C00001=DBLONE / *** DDS FEB69 *** .TITLE .FR - - BCD READ /BCD READ /CALLING SEQUENCE -- JMS .FR / .DSA ADDRESS OF SLOT NUMBER. / .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY. .FR CAL 0 JMS .INISA /* INIT. FOR SEQ. ACC. DZM* .FH /SET READ/WRITE FLAG TO READ. LAC* .FR /INITIALIZE INPUT DEVICE. JMS* .FC DAC SLOT /SAVE SLOT NUMBER. .IFDEF %DOS15 DAC FR3 /SET UP .SEEK JMS* .DSK /A DISK? SNA JMP FR2 /NO LAC SLOT JMS* .FLRA /FILE OPEN FOR RAND. ACC.? JMP FR2 /YES. FR7A LAC SLOT /NO. .SEEK IF NO FILE ACTIVE JMS* .FLTB1 JMP FR6 /RETURNS HERE IF FILE ACTIVE-ADDR. OF DIR. BUFFER DAC FR4 /HERE IF NO FILE ACTIVE-ADDRESS OF DIR. BUFFER / (RKB-050) DELETE THE FOLLOWING 5 LINES / (RKB-050) LAC* .STADD /ZERO SO .INIT WILL GO THRO IN .FC / (RKB-050) DAC FW5 /FOR LEVEL OF INDIR. / (RKB-050) DZM* FW5 / (RKB-050) LAC* .FR /DAT SLOT / (RKB-050) JMS* .FC /INIT FOR INPUT FR3 0 /DIR. ENTRY BUFFER INTO FR4 3 /.SEEK FR4 0 /BUFF ADDRESS .ENDC FR2 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 .IFDEF %DOS15 FR6 SPA /IF AC POS., FILE ACTIVE FOR OUTPUT /CLOSE OUTPUT FILE AND REOPEN IT FOR INPUT THRU FR7A JMP FR2 /OK, FILE ACTIVE FOR INPUT (JUST CONT.) LAC SLOT /.DAT SLOT INTO AC DAC FR7 /SET .CLOSE CAL JMS* .FLZW0 /ZERO FILE ACTIVE WORD OF DIR. ENTRY FR7 0 /.CLOSE 6 JMP FR7A /GO REOPEN FILE FOR INPUT .ENDC .TITLE .FW - - BCD WRITE /BCD WRITE / CALLING SEQUENCE -- JMS .FW / .DSA ADDRESS OF SLOT NUMBER. / .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY .FW CAL 0 JMS .INISA /* INIT. FOR SEQ. ACC. LAC C00001 /SET READ/WRITE FLAG TO WRITE. DAC* .FH LAC* .FW /INITIALIZE OUTPUT DEVICE. JMS* .FC DAC SLOT /SAVE SLOT NUMBER. .IFUND MSCC /(RKB-050) LAC* .STADD /(RKB-050) TEST DEVICE FOR MASS STORAGE DAC .MSDEV /(RKB-050) RESOLVE ONE MORE LEVEL OF INDIRECTION LAC* .MSDEV /(RKB-050) TO GET TO CURRENT .STAB ENTRY AND (40000) /(RKB-050) BY CHECKING FOR 'DIRECTORIED' BIT SNA!CLA /(RKB-050) SET UP BY FIOPS LAC (1000) /(RKB-050) MAKE SWITCH A SKIP IF NON-MS TAD (740000) /(RKB-050) OR A NOP IF IT IS MASS STORAGE DAC .MSDEV /(RKB-050) LAC SLOT /(RKB-050) RESTORE AC .ENDC /(RKB-050) .IFDEF %DOS15 DAC FW3 /SET UP .ENTER JMS* .DSK /A DISK? SNA JMP FW2 /NO LAC SLOT /YES JMS* .FLRA /FILE OPEN FOR RAND. ACC.? JMP FW2 /YES LAC SLOT /NO-OPEN DEFAULT FILE IF NO FILE ACTIVE JMS* .FLTB1 JMP FW6 /FILE ACTIVE-CHECK I/O DIRECTION DAC FW4 /NO FILE ACTIVE-ADDRESS OF DIR. ENTRY BUFF / (RKB-050) DELETE THE FOLLOWING 5 LINES: / (RKB-050) LAC* .STADD /ZERO SO .INIT WILL GO THRO IN .FC / (RKB-050) DAC FW5 / (RKB-050) DZM* FW5 / (RKB-050) LAC* .FW /DAT SLOT / (RKB-050) JMS* .FC /INIT FOR OUTPUT FW3 0 /INTO FW4----.ENTER 4 FW4 0 /BUFFER ADDRESS .ENDC FW2 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 .IFDEF %DOS15 FW5 0 /TEMP FW6 SMA /IF AC NEG., FILE ACT. FOR INPUT - ERROR JMP FW2 /FILE ACTIVE FOR OUTPUT - OK JMS* .ER /OTS 51 51 .ENDC .TITLE .FA (.RA) - - ARRAY I/O (RANDOM ACCESS - .RA) /BCD ARRAY I/O / CALLING SEQUENCE -- JMS* .FA (.RA - FOR RAN. ACC.) / .DSA ADDRESS OF ADB WORD 5 .RA=. /* RAN. ACC. ENTRY .FA CAL 0 LAC (.FE /** SET TO JMP TO FORMATTED ELEMENT DAC .FA3 /** I/O .FA4 LAC* .FA DAC WD5 /ADDRESS OF WORD 5 OF ADB SPA /1 MORE LEVEL? LAC* WD5 /YES DAC WD5 /RESTORE TAD K00004 DAC WD1 /ADDRESS OF WORD 1 OF ADB ( NDIM-1, MODE) LAC* WD1 /GET ADDRESS INCREMENT - DELTA = NUMBER OF WORDS AND C00003 /PER DATA ITEM. MASK OUT THE MODE BITS CMA /CREATE A LAW 1'S COMPLEMENT OF MODE BITS DAC FA1 /WHICH IS EXECUTED JUST BEFORE CALLING ELEMENT I/O CMA /ROUTINE. RESTORE MODE BITS. SAD C00003 /ELEMENT SIZE IS MODE+1, EXCEPT IS 2 IF MODE LAC C00001 /IS 3 TAD C00001 /MODE 3 IS DOUBLE INTEGER DAC DELTA LAC* WD5 /PLACE ADDRESS OF BEGINNING OF ARRAY INTO DAC FA2 /BCD ELEMENT I/O CALL ISZ WD1 /BUMP TO POINT TO SIZE WORD TAD* WD1 /ADD ARRAY SIZE TO GET HIGH ADDRESS LIMIT DAC LIMIT FA1 LAW /(LAW -MODE, 1'S COMPLEMENT PUT HERE) JMS* .FA3 /** CALL BCD EL. 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 .FA3 XX /** HOLDS .FE (FORM.); .DSA .GD (DDIO) .TITLE .FE (.RE) - - ELEMENT I/O (.RE - RANDOM ACCESS) /BCD ELEMENT I/O CONTROL / CALLING SEQUENCE -- .GLOBL .FE, .RE / LAW -MODE 1'S COMPLEMENT / JMS* .FE (.RE - FOR RAN. ACC.) / CAL ELEMENT ADDRESS (T.V. IF BIT 0 = 1) / LAW -MODE, 1'S COMPLEMENT, RETURNED IN AC / .RE=. /* RANDOM ACCESS ENTRY .FE CAL 0 DAC ACSAVE /MODE BITS ARE SAVED CMA DAC VRTYP LAC* .FE /GET STARTING ADDRESS OF DATA ELEMENT DAC DADD SPA /IF T.V., ONE MORE LEVEL OF INDIRECT LAC* DADD / ADDRESSING. / AND S77777 /SQUASHES MODE BITS / /(RKB-049) ABOVE LINE REMOVED. DAC DADD LAC CC /** IF D-D I/O, SZA /** DON'T USE FORM. DECODER JMS .FD /GET FORMAT SPECIFICATION DZM OCTL /CLEAR OCTAL FLAG LAC .S /CONVERSION CODE TIMES TWO (PLUS ONE FOR RCL / WRITE)=INDEX VALUE FOR JUMP TABLE. TAD* .FH AND S00037 /** MASK 5 BITS 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 FE66AT JMP FE60 /A-READ JMP FE8 /A-WRITE JMP FE50O /O-READ JMP FE2O /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 JMP FE60R /** R-READ FE8RT JMP FE8R /** R-WRITE FE99 ISZ .FE ACSAVE LAW /LAW -MODE PUT HERE, RETURNED IN AC JMP* .FE .TITLE BCDIO /** O-CONVERSION -- WRITE PROCESSOR FE2O DZM MS LAC VRTYP SNA /SKIP IF DOUBLE INTEGER JMP .+4 /SINGLE INTEGER LAC* DADD DAC MS /GET HIGH ORDER ISZ DADD LAC* DADD DAC LS /GET LOW ORDER LAC .W TCA /(RKB-051) DAC POT /SAVE NEGATIVE OF FIELD WIDTH LAW -15 TAD .W SPA /SKP IF LDNG. BLANKS NECESSARY JMP FE2O9 TAD (1 JMS .PBLKS /PACK LDNG. BLANKS LAW -14 DAC POT /RESET FIELD CNT. CLC /SET AC=-1 FE2O9 DAC TEMP6 /CHAR. SKP CNT. JMP FE2O7 FE2O8 LAC OCHR /BIN. VAL. OF OCTAL CHAR. SZA JMP FOVFL2 /IF NOT=0, OVER-FLOW FE2O7 JMS GOCHR /GET OCTAL CHAR. ISZ TEMP6 JMP FE2O8 /CHK. FOR OVFLO FE2O6 JMS GETOD /GET OCTAL DIGIT JMS .PACK ISZ POT JMP FE2O6 /GET NXT DIGIT JMP FE99 /DONE - RTN. /** .EJECT /** I-CONVERSION -- WRITE PROCESSOR FE2 LAC* DADD DAC MS LAC VRTYP /(RKB-053) DON'T FETCH SECOND WORD FOR SNA /(RKB-053) SINGLE INTEGER OUTPUT JMP FE2A /(RKB-053) SINCE WE MIGHT RUN OFF THE END /(RKB-053) NOT A PROBLEM ON PDP-15, SINCE /(RKB-053) BOOTSTRAP, NOT DATA, WAS AT /(RKB-053) THE TOP OF PHYSICAL MEMORY. /(RKB-053) NOT TRUE OF XVM!! ISZ DADD LAC* DADD DAC LS /LD. MS+LS W/ DATA /(RKB-053) /(RKB-053) FOLLOWING TWO LINES DELETED: / LAC VRTYP / SZA /SKP IF S.P. INT. JMP FE3 /J FE2A LAC MS /(RKB-053) CONTINUE WITH SINGLE INTEGER DAC LS SPA!CLA CMA DAC MS FE3 DZM SIGN /SET TO POS. LAC MS SMA JMP FE4 JMS COMJ /COMPL. D.P. INT. ISZ SIGN /SET TO MINUS FE4 LAC (DIGTS DAC TEMP6 /HOLDS ADDR. OF 1ST DIG. DZM POT /DIGIT CNTR. /--DIVIDE BY 10(10) TO GET DEC. DIGITS FEIL LAC MS CLL IDIV 12 /INT. DIV. BY 12(8) DAC TEMP8 LACQ DAC MS LAC LS LMQ /INTO MQ LAC TEMP8 /PREVIOUS QUOTIENT CLL DIV 12 /FULL DIV. BY 12(8) DAC* TEMP6 /DEPOSIT IN PROPER DIGIT ISZ TEMP6 ISZ POT /INCR. DIGIT CNTR. LACQ DAC LS LAC MS OMQ /INCL. OR AC AND MQ TO CHK. IF BOTH 0 SZA /SKP IF DONE JMP FEIL /NOT DONE - GO AGAIN /--CHK. FOR FLD. OVFLO, PK. SIGN AND LEADING BLKS. AND DIGITS JMS PLBSN /PK. LDNG. BLKS. & SIGN IF NEC. FEDL CLC TAD TEMP6 DAC TEMP6 /PTS. TP PROPER DIGIT LAW 60 TAD* TEMP6 /ASCII FOR DIGIT JMS .PACK /PK. DIGIT LAC TEMP6 SAD (DIGTS JMP FE99 /ALL DIGITS DONE - EXIT JMP FEDL /NOT DONE - CONTIN. DIGTS .BLOCK 13 /** .EJECT /L-CONVERSION -- WRITE PROCESSOR FE7 CLC TAD .W SPA JMP FE99 /EXIT IF FIELD WIDTH ZERO OR NEGATIVE. JMS .PBLKS /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 /** R-CONVERSION--WRITE PROCESSOR FE8R LAW -5 TAD .W DAC IGCNT /NUM OF LDNG. CHRS. TO BE SKPD. SKP /** /A-CONVERSION -- WRITE PROCESSOR FE8 DZM IGCNT /** SET TO INDIC. A-CONV. CLA /CHECK FOR INTEGER TYPE. IF SO, SAD VRTYP /WILL HAVE TO FAKE BLANKS. JMP FE8I LAC* DADD /FIRST DATA TO MS DAC MS ISZ DADD LAC* DADD /SECOND DATA WORD TO LS FE8IX DAC LS LAC .W /IF W=0, EXIT SNA!SPA JMP FE99 TCA /(RKB-051) NEGATE W FOR A CHARACTER COUNT DAC POT LAW -5 TAD .W SPA!SNA JMP FE10R /** JMS .PBLKS /PACK (W-5) BLANKS IF W.GT.5 LAW -5 DAC POT FE10R LAC IGCNT /** IGCNT MINUS INDIC. R-CONV. W/ SMA /** W .LT. 5 JMP FE9 /** IF NO CHRS. TO BE SKPD., PACK FE9R JMS DSH7 /** SKP FIRST (5-W) CHRS. ISZ IGCNT /** JMP FE9R /** 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 FE8I LAC U01004 /FOR EITHER R OR A CONVERSION OF INTEGER, START DAC MS /WITH BLANKS,AS A CONV. IS A FAKE R CONV. LAC* TEMP1 /NOW CHECK FOR CONVERSION TYPE. SAD FE8RT JMP FE8IR /MATCH, WAS R CONVERSION FOR INTEGER LAW -5 /FOR A CONVERSION, RIGHT JUSTIFY ONE (IF A1) OR TAD .W /TWO CHARACTERS IN MS,LS, THEN TREAT AS IF R- DAC IGCNT /CONVERSION. LAW -1 /CHECK FOR A1 FORMAT TAD .W /ADD FIELD WIDTH, IS ZERO OF A1 SNA!CLA!CLL /DEFINE AN EAE LRS TO PUT ONE OR TWO CHARACTERS LAC S00007 /IN RIGHT OF LS TAD LRS3 /LRS 3+7 IF A1; LRS 3 OTHERWISE DAC .+2 LAC* DADD /GET CHARACTER(S) LRS /RIGHT ADJUST SKP FE8IR LAC* DADD /FOR R-CONVERSION, SIMPLY COMPLETE MS,LS PAIR AND S77776 /AND IMPOSE BLANK REMNANT AT BEGIN OF WORD JMP FE8IX LRS3 LRS 3 .EJECT /D- AND E-CONVERSION -- WRITE PROCESSOR. FE11 LAC .W /IF W.LT.7, DEFAULT. TAD K00006 SPA!SNA JMP FOVFL1 /** FLD. OVFLO LAW -1 /** TAD .SF /** CNT INCL. .SF-1 SPA /** IF POS. CLA /** ELSE, SET TO 0 TAD .D /** TAD C00002 /** DAC CNT /** NUM. OF DIGITS (& .) TO BE PRTED. TAD C00005 /** FOR SIGN AND 'E+00' TCA /(RKB-051) ** TAD .W /** SPA /** SKP IF DATA FITS JMP FOVFL1 /** ELSE, FLD. OVFLO JMS .PBLKS /IF (W-D).GE.7, PACK (W-D-7) BLANKS JMS GETPS JMS PKSGN LAC CNT /** TCA /(RKB-051) ** COMPLEMENT FOR COUNTER DAC CNT / LAC .D /CALCULATE FRACTION FLAG = -D -1 CMA DAC FRFLG LAC .SF /** SMA!SZA /** TAD C00001 /** SIGNIF. DIGS. =.D+.SF+1 (.SF .GT. 0) TAD .D /** =.D+.SF (.SF .LE. 0) DAC SDFLG /** SIG. DIG. FLG. 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 *** TCA /(RKB-051) TAD POT / *** DDS JAN69 *** DAC DIG2 SMA /IF EXPONENT IS NEGATIVE, COMPLEMENT IT JMP FE19 / AND SET EXPONENT SIGN TO MINUS. TCA /(RKB-051) 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 LAC .S SAD S00007 /SKP IF NOT G LAC C00005 /IF G, MAKE E TAD (100 /MAKE ASCII CHR. JMS .PACK /PACK E OR D CHR. 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. .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) TCA /(RKB-051) NEGATE FOR USE AS A LOOP COUNTER (DIG2) DAC DIG2 LAC SIGN /** SZA /** SKP IF PLUS LAW -1 /** TAD DIG2 TAD .W /IF LENGTH OF NUMERIC FIELD EXCEEDS THE SPA /** .W, GO TO FIELD OVFLO ROUTINE JMP FOVFL3 /** FIELD OVERFLO JMS .PBLKS LAC SIGN /** SZA /** IF PLUS, DON'T PACK JMS PKSGN /** LAC .D /SET FLG. (DPOS) TO INDIC. 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 *** TCA /(RKB-051) 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 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 .PBLKS / 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. .IFDEF %FPP FZR 0 .ENDC .IFUND %FPP DZM* .AA /CLEAR FLOATING ACCUMULATOR DZM* .AB DZM* .AC .ENDC LAW -6 /TEST CONVERSION-TYPE. SET NRZ=0 IF TAD .S /F, ELSE SET NRZ=1. .S IS 6 IF F TYPE SZA /REMAIN ZERO IF F TYPE LAC C00001 DAC NRZ LAC VRTYP /LOAD VARIABLE ON BASIS OF MODE TYPE SAD C00002 /NOT ON BASIS OF CONVERSION JMP GET03 /GO DO D.P. LOAD FLD% .AG /SINGLE PRECISION LOAD .DSA DADD+400000 JMP GET06 .IFDEF %FPP GET03 DLD /DOUBLE PRECISION LOAD .ENDC .IFUND %FPP GET03 JMS .FAO /D.P. LOAD INTO FLOATING ACCUMULATOR .ENDC .DSA DADD+400000 /COMMON ROUTINE .IFDEF %FPP GET06 BZA /BR IF FPP AC=0 GET17 /ZERO EXIT IMMED BPA /BR IF POS. GET07 ISZ SIGN /IF NEG. SET FLAG FAB /MAKE FPP POS. 0 GET07 DST /STORE FPP AC IN WORKING FP2 /REGISTERS FOR SCALING MANIPULATION LAC FP2 SPA!SNA JMP GET10 /DATA IN FPP AC MUST BE SCALED DAC TMPFAC /SO THAT 0.100000 .LE. DST /FPP AC .LE. 0.999999 FPH2 /(WHICH IS -3/31463146 .LE. DLD /FPP AC .LE. +0/3777777.... DBLONE /IN FLT. PT. NOTATION) SO THAT DST /MULT. BY TEN YIELDS FIRST FP2 /DIGIT. IN ORDER TO AVOID MANY GET08 LAC TMPFAC /DIVS. BY 10, THE FPP AC IS CMA /SAVED IN FPH2 AND FPP AC IS USED TAD FP2 /TO BUILD A SING. DIVISOR (POW. OF 10) SMA /AFTER SCALING, POT CONTAINS POWER OF JMP GET09 /TEN USED IN DIVISION ISZ POT JMS .MPYTN /MULT. FPP AC BY 10 DST /REST. TEMP FPP AC FOR EXP. TST FP2 JMP GET08 GET09 URDRD /DIV. SAVED FPP AC BY FPP AC (NOW FPH2 /APPROPRIATE POWER OF TEN) GET10 DST /RESULT IS NOT ROUNDED. LD. FPP AC FP2 /INTO TEMPS FOR MANIP. LAC C00003 /AFTER SCALING, IF EXPON. OF DATA TAD FP2 /IS NEG., FPP AC IS CHKD. FOR SPA /.LT. 0.1 (-3/31463146..) IF SO JMP GET11 /FPP AC IS MULT BY TEN AND POT SZA /IS DECREM. BY ONE. IF NOT, JMP GET12 /SCALING IS COMPLETE AND DATA CAN LAC FP3 /BE ROUNDED OFF. TAD TESTB SPA JMP GET11 SZA JMP GET12 LAC FP4 TAD TESTC SMA!SZA JMP GET12 .ENDC .IFUND %FPP 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 .MPYTN 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 .ENDC GET11 CLC TAD POT DAC POT JMS .MPYTN 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 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 *** .IFDEF %FPP DST /TEMP. STORE FO SCALED FPP AC GET31 DLD C00002 GET32 ISZ GET30 SKP JMP GET33 JMS .MPYTN JMP GET32 GET33 FNM /NORM. FPP AC BECAUSE MPYTEN DOESN'T 0 DRD /DIV. 1 BY (2*TEN**APPROP. POWER) DBLONE /WHICH IS IN FPP AC DAD /ADD SCALED DATA TO APPRO. POWER GET31 /OF TEN TIMES .5 FOR ROUNDING DST /TEST EXPON. FOR OVFLO ONLY FP2 /OVFLO THAT CAN OCCUR THAT MAKE FPP LAC FP2 /TOO SPA!SNA .ENDC .IFUND %FPP 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 .MPYTN / *** 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 .ENDC 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 *** .IFUND %FPP GET34 .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** .DSA 0 / *** DDS JAN69 *** .ENDC .EJECT /** PACK LEADING BLANKS AND SIGN /CALLING SEQUENCE-- / JMS PLBSN PLBSN 0 LAC .W /FLD. WIDTH CMA TAD POT TAD SIGN /=0, + (NOT OUTPUT); =1, - SMA /AC= -(.W+1)+POT+SIGN JMP FOVFL2 /FIELD OVFLO CMA JMS .PBLKS /PACK BLKS. LAC SIGN SZA /SKP IF PLUS JMS PKSGN /PK. SIGN JMP* PLBSN /** .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 .MPYTN /MULTIPLY FAC BY 10 TO EXTRACT THE NEXT DZM DIG / DECIMAL DIGIT. .IFDEF %FPP LAC FP5 .ENDC .IFUND %FPP LAC* .AA .ENDC SPA!SNA JMP GET22 /IF FAC EXPONENT.LE.ZERO, DIGIT IS A ZERO. TCA /(RKB-051) IF FAC EXPONENT .GT. 0, 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 .IFDEF %FPP UNDST /UNNORM. STORE FP2 DZM FP2 UNDLD FP2 .ENDC .IFUND %FPP DZM* .AA .ENDC LAW 60 /EXIT IS TAKEN WITH THE ASCII-7 CODE OF XOR DIG / THE DECIMAL DIGIT IN THE AC. JMP* GETDD .IFDEF %FPP GET23 UNDST FP2 LAC FP3 AND T77777 DAC MS LAC FP4 DAC LS .ENDC .IFUND %FPP GET23 LAC* .AB /MS/LS=FAC-1.0 AND T77777 DAC MS LAC* .AC DAC LS .ENDC JMS DSHL JMP GET22 .EJECT /** GET OCTAL CHAR. /CALLING SEQUENCE-- / JMS GOCHR GOCHR 0 LAW -3 DAC OCTL /CNTR. DZM OCHR GCH1 JMS DSHL /SHIFT MS+LS 1 LEFT LAC OCHR RAL /ROTATE BIT INTO AC DAC OCHR ISZ OCTL JMP GCH1 JMP* GOCHR /IN OCHR AND AC /** .EJECT /**GET OCTAL DIGIT /CALLING SEQUENCE-- / JMS GETOD GETOD 0 LAC OCHR XOR S00060 DAC TEMP6 JMS GOCHR LAC TEMP6 JMP* GETOD /** .EJECT /** O-CONVERSION -- READ PROCESSOR FE50O LAW -1 /** SET TO INDIC. OCTAL DAC OCTL JMS RDEXTO /RD. EXT. FLD. AS OCTAL JMP FE501 /** /I-CONVERSION -- READ PROCESSOR. FE50 JMS RDEXT /READ CONTENTS OF EXTERNAL FIELD. IF DZM OCTL /** CLR. OCTAL FLG. FE501 LAC SFFLG /SFFLG AND DPOS ARE NOT BOTH ZERO TAD DPOS /AN ILLEGAL CHARACTER IS IN THE INPUT SNA /** JMP FE502 /** EXT.FLD. OK BDTA DZM LS /** ILL. - SET TO 0 DZM MS /** FE502 LAC SIGN /** IF NUM. NEG., CMPL. RAR /** LAC VRTYP /** SAD C00003 /** SKP IF NOT J (ASSUME I) JMP FE503 /** LAC LS SZL TCA /(RKB-051) DAC* DADD /STORE INTEGER IN MEMORY. JMP FE99 /EXIT. FE503 SZL /** J MODE - SKP IF POS. NUM. JMS COMJ /** NEG. NUM., COMPLEMENT LAC MS /** DAC* DADD /** DEPOSIT NUM. ISZ DADD /** LAC LS /** DAC* DADD JMP FE99 /** .EJECT /** COMPLEMENT D.P. INT. (IN MS+LS) COMJ 0 LAC LS CMA!CLL TAD C00001 DAC LS LAC MS CMA!SZL /SKP IF NO LS OVFLO TAD C00001 DAC MS JMP* COMJ .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 .IFDEF %FPP FE515 UNDST FP1 LAC C00035 DAC FP1 DLD FP1 .ENDC .IFUND %FPP FE515 LAC C00035 /CONVERT RAW INTEGER MANTISSA TO FLOATING DAC* .AA / POINT. JMS* .CD .ENDC LAC FRFLG /CALCULATE MULTIPLIER POWER OF TEN = DECI- TCA /(RKB-051) 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. .IFDEF %FPP UNDST FPH2 DLD DBLONE .ENDC .IFUND %FPP 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. .ENDC LAC POT SKP FE52 TCA /(RKB-051) DAC CNT FE53 JMS .MPYTN .IFDEF %FPP FNM 0 /UNUSED .ENDC 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. .IFDEF %FPP DRD FPH2 .ENDC .IFUND %FPP JMS* .CI .DSA -44 .DSA 1 / *** WAD SEPT69 *** .ENDC FE54 LAC SIGN /SET ,CE = SIGN OF CONVERTED NUMBER. SZA / BIT 0 = 0 PLUS .IFDEF %FPP FNG /NEGATE NOP .ENDC .IFUND %FPP 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 *** .ENDC LAC VRTYP /STORING IS BASED ON MODE TYPE, NOT SAD C00002 /CONVERSION TYPE JMP FE545 /GO DO D.P. STORE URFST% .AH .DSA DADD+400000 JMP FE99 .IFDEF %FPP FE545 UNDST .ENDC .IFUND %FPP FE545 JMS .FAP /STORE DOUBLE .ENDC .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 /** R-CONVERSION -- READ PROCESSOR FE60R LAC .W TCA /(RKB-051) DAC IGCNT TAD C00005 SPA!SNA /** /A-CONVERSION -- READ PROCESSOR FE60 DZM IGCNT /** INDIC. A-CON. OR W .GE. 5 LAC JMP0 /** INIT. JMP INSTRUC. AND CHAR. DAC FE65 / COUNTER. DZM CHCT LAC .W /IF FIELD WIDTH.LE.0, EXIT IMMEDIATELY. SPA!SNA JMP FE99 TCA /(RKB-051) 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 FE66R /** CHK. IGCNT DAC CNT ISZ FE65 LAC S00040 DAC .CHAR JMP FE64 FE66R LAC IGCNT /** IGCNT = 0 IF A-CONV. OR IF SNA /** W .GE. 5 JMP FE66 /** NO SKPNG. - GET FIRST CHAR. IN PR. JMS DSHL /**SHIFT EXTRA BIT OFF FE67R JMS DSH7 /** SHIFT LEFT ONE CHAR. LAC LS AND S00177 RCL DAC TEMP8 LAC LS AND Z77400 XOR TEMP8 DAC LS ISZ IGCNT /** UNTIL BLKS. ON LEFT JMP FE67R /** SKP FE66 JMS DSHL /LEFT JUSTIFY TO 5/7 ASCII FORMAT LAC VRTYP /IF THE VARIABLE IS AN INTEGER, WILL SZA /TAKE SPECIAL TREATMENT JMP FE66T /NOT AN INTEGER LAC* TEMP1 /R CONVERSION? SAD FE66AT JMP FE66A /NO, A CONV. LAC LS /FOR R CONVERSION OF INTEGER,ONLY THE AND S77776 /LAST TWO CHARACTERS ARE TAKEN, RIGHT JMP FE66S /JUSTIFIED, WITH BLANK REMNANT IN BITS 0-3 FE66A LAW -3 /FOR A-CONVERSION, GET RIGHTMOST 1 OR 2 CHARCTERS TAD .W /AND SHIFT LEFT SPA /FIELD WIDTH: 1 2 3 4 5 6 7 . . . JMP FE66A1 /SHIFT LEFT: 0 0 1 2 3 3 3 . . . TAD K00003 /WHEN .W IS 3 OR GREATER, NUMBER OF SHIFTS SMA /IS LIMITED TO THREE. CLC TAD C00003 / RECOVER 0, 1, 0R 2, OR FORCE 2 CMA /EFFECTIVE 2'S COMPLEMENT OF NUMBER OF SHIFTS DAC CNT JMS DSH7 /SHIFT LEFT REQUIRED NUMBER OF TIMES ISZ CNT /THUS PUT RIGHTMOST OF FIELD OF WIDTH 3 OR JMP .-2 /LARGER INTO MS,LS LEFT JUSTIFIED. FE66A1 LAC MS /ONLY THE AND Z77760 /FIRST TWO CHARACTERS ARE TAKEN, WITH XOR S00004 /BLANK REMNANT IN LAST 4 BITS. JMP FE66S FE66T LAC MS /STORE BCD WORD PAIR IN OBJECT MEMORY. DAC* DADD ISZ DADD LAC LS FE66S DAC* DADD JMP FE99 /EXIT JMP0 JMP FE63 .EJECT /** READ EXTERNAL FIELD AS OCTAL /CALLING SEQUENCE-- / JMS RDEXTO RDEXTO 0 LAC RDEXTO /** LD. RDEXT SUB. FOR RTN. DAC RDEXT LAC (JMS OMPTN /** LD. JMP TO OCTAL MULT. DAC RDEX25 JMP RDXO /** JMP INTO RDEXT ROUTINE /** /READ EXTERNAL FIELD / CALLING SEQUENCE -- JMS RDEXT RDEXT CAL 0 /THIS SUBROUTINE INPUTS AN EXTERNAL LINE LAC (JMS IMPTEN /** LD. JMP TO DEC. MULT. DAC RDEX25 /** RDXO DZM SIGN /BUFF. FLD. OF LNGTH. 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 .NMTST /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. AND S00010 /** =0 IF LEGAL OCTAL NUM. AND OCTL /** =0, DEC.; =-1, OCTAL SZA /** SKP IF OK JMP BDTA /** O NM., NON-0 MD.:SET NM. TO 0 RDEX2 JMS BREAD JMS .NMTST /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 .NMTST /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 .NMTST /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 TCA /(RKB-051) 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 RDEX20 NOP /FALL THROUGH - (USED AS CONSTANT IN .FF) JMP RDEX2 /DON'T STORE TRAILING 0'S ANYWAY /SINCE CR OR ALT HIT RDEX17 LAC SFFLG SZA JMP RDEX18 LAC MS SZA /WAD ADD. JMP RDEX19 /WAD ADD. TAD LS JMP RDEX19 .IFDEF %FPP RDEX18 BNA RDEX19 CLA RDEX19 SNA /RDEX19 FROM RDEX17+5 & RDEX17+7 DAC SIGN /ZERO SIGN IN CASE 0.0 JMP* RDEXT .ENDC .IFUND %FPP RDEX18 LAC* .AB SZA / WAD ADD. TO 016 FOR DOS-15 TAF JMP RDEX19 / WAD ADD. TO 016 FOR DOS-15 TAF TAD* .AC RDEX19 SNA DAC SIGN JMP* RDEXT /EXIT .ENDC .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 .IFDEF %FPP UNDST FP6 LAC MS AND V77777 DAC FP7 LAC LS DAC FP8 UNDLD FP6 .ENDC .IFUND %FPP LAC MS AND V77777 DAC* .AB LAC LS DAC* .AC .ENDC JMP* TRMSLS .IFDEF %FPP FP6 0 FP7 0 FP8 0 .ENDC .EJECT /MULTIPLY FLOATING ACCUMULATOR BY TEN. 74 OR 89 USEC. / CALLING SEQUENCE -- JMS .MPYTN (77.0 USEC AVG) .IFDEF %FPP .MPYTN 0 UNDMP /UNNORM., MULT. MPY1 UNDST /LD. MS,LS FP5 JMP* .MPYTN MPY1 000004 /FLT. 10 240000 0 .ENDC .IFUND %FPP .MPYTN 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* .MPYTN .ENDC .EJECT /** OCTAL MULT. (BY 8) /CALLING SEQUENCE-- / JMS OMPTN OMPTN 0 DAC TAC /** SAVE NUM. TO BE ADDED AND S00010 SZA /** SKP IF LEGAL OCTAL NUM. JMP BDTA /** NOT OCTAL - RTN. LAC OMPTN /** SAVE RTN. ADDR. DAC IMPTEN DZM TLS /** ZERO TEMP. REGS. FOR MULT. BY 8 DZM TMS JMS DSHL /** MULT BY 2 JMP IMP2 /** JMP INTO IMPTEN ROUT. /** /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 IMP2 JMS DSHL /** MULT. MS+LS BY 8 (ENTRY FR. OMPTN) JMS DSHL 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) .IFUND %FPP .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 .ENDC .EJECT /DOUBLE STORE / CALLING SEQUENCE -- JMS .FAP / .DSA ADDRESS (+400000 IF TRANSFER VECTOR) .IFUND %FPP .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 .ENDC .EJECT /DOUBLE FLOATING ADD / CALLING SEQUENCE -- JMS FAQ (AUGEND IN FAC) / .DSA ADDEND ADDRESS .IFUND %FPP 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 .ENDC .EJECT /* /INIT. BCDIO FOR SEQ. ACC. / TO CHANGE LOCATIONS THAT MIGHT HAVE BEEN ALTERRED BY / PREVIOUS R.A. OPERATIONS /CALLING SEQUENCE -- / JMS .INISA .INISA 0 /* LAC LDEOR /* DAC .STEOR /* LAC .FN /* DAC .BFLOC /* .IFDEF %V5A1 DZM* .RN /* CLR. R.A. FLG. .ENDC JMP* .INISA /* .EJECT /INITIALIZE FORMAT DECODER / CALLING SEQUENCE -- LAC STARTING ADDRESS OF FORMAT STATEMENT. / JMS .INIFD .INIFD CAL 0 / AND S77777 /** AND OFF MODE BITS / /(RKB-049) ABOVE LINE DELETED FOR XVM 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 CC1 .DSA 0 /(RKB-051) POINTER TO FIRST WORD OF CURRENT WORD PAIR 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 / 10 R-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 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 S00044 /** JMP FDSC /** IF $ SAD S00047 /** JMP FDSC /** IF ' SAD S00042 /** JMP FDSC /** IF " 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 SAD S00122 /** JMP FD45 /** IF R SAD S00117 /** JMP FD46 /** IF O SAD S00124 /** IF T JMP FD60 /** 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* CC1 /(RKB-051) POINT TO FIRST WORD (USED TO BE '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* .STEOR /* 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* .STEOR /* 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 TCA /(RKB-051) 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. /**T-CONVERSION FD60 JMS FNBCHR JMS NUMCHK SKP /YES - NUM. IN LS; NXT. CHAR. IN .CHAR JMP FD86 /NOT NUM.: ERROR DAC TEMP8 LAC LS DAC TBNM /TAB NUM. LAW -4 DAC TEMP7 /CNT. FOR MULT. BY 5 LAW -2 .IFUND RSX TAD* .FC6 /L.B. SIZE - 2 FOR HDR. .ENDC .IFDEF RSX AAC 376 /L.B. SIZE -2 FOR HDR. .ENDC RCR DAC TEMP6 FD601 TAD TEMP6 ISZ TEMP7 JMP FD601 /ADD AGAIN DAC TEMP7 /(L.B.-2) * (5/2) - 1 TCA /(RKB-051) DAC TEMP6 /COMPL. LAC TBNM FD602 TAD TEMP6 /WRAP TBNM AROUND MAX. NM. OF CHRS. SZA!SMA JMP FD602 TAD TEMP7 DAC TBNM /FINAL TBNM /--PROCESS FOR READ OR WRITE LAC* .FH /=0, RD.; =1,WRT. SNA JMP FD603 /READ LAW -2 /WRITE TAD TBNM SPA /TBNM MUST BE .GE. 2 FOR WRITE JMP FD608 /ILLEGAL: EXIT LAC CCPTR TCA /(RKB-051) TAD TBNM /TBNM-CCPTR SPA /SKP IF OUTPT. ON SAME LINE JMP FD604 /START NEW LINE JMS .PBLKS /PACK TBNM-CCPTR BLANKS JMP FD608 /FINISHED /----WRITE NEW LINE FD604 JMS* .STEOR /NEW RCD. LAW 53 / '+' FOR NO ADVANCE JMS .PACK LAW -2 TAD TBNM JMS .PBLKS /PACK TBNM-2 BLANKS IN NEW LINE JMP FD608 /FINISHED /----READ FD603 LAC TBNM SNA JMP FD608 /ILLEGAL:TBNM MUST BE .GE. 1 FOR RD. LAC CCPTR TCA /(RKB-051) TAD TBNM /TBNM-CCPTR SNA JMP FD608 /DIFFER. = 0: DO NOTHING, RTN. SPA /SKP IF INPUT TO BE TAKEN FROM SAME LINE JMP FD605 /GET NEW LINE TCA /(RKB-051) DAC TEMP6 /CNTR. FD606 JMS READ. /DUMMY READ ISZ TEMP6 JMP FD606 /READ AGAIN JMP FD608 /FINISHED, RTN. /----READ NEXT LINE FD605 JMS* .STEOR /GET NEW RCD. LAW -1 TAD TBNM TCA /(RKB-051) DAC TEMP6 /READ TBNM-1 DUMMY CHRS. FD607 JMS READ. /DUMMY READ ISZ TEMP6 JMP FD607 /READ AGAIN /LD. NEXT CHR. AND GO BACK TO SKP CHAIN FD608 DZM NUMFLG LAC TEMP8 JMP FD02+1 /** /** $, ' (STRING CONSTANT)-CONVERSION FDSC DZM NUMFLG DAC STCON FDSC1 JMS FMTFCH /GET NEXT FORMAT CHR. SAD STCON JMP FDSC3 /SAME: CHK. IF STR. CHR. OR SEC. DELIM. FDSC4 LAC* .FH /RD./WR. FLG. SNA JMP FDSC2 /RD. LAC .CHAR /WR. - GET FRM. CHR. JMS .PACK /PACK JMP FDSC1 /RTN. TO GET AND CHK. NEXT CHR. FDSC3 JMS FMTFCH /LK. AT NXT CHR. SAD STCON JMP FDSC4 /DOUBLE CHR.: PACK AS STR. CHR. JMP FD01+1 /SINGLE CHR.: SEC. DELIM. FDSC2 JMS RDINFS /RD. INTO FORMT. STMNT. JMP FDSC1 /RTN. TO GET AND CHK. NEXT CHR. /** /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 TCA /(RKB-051) 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 RDINFS /**RD. INTO FRMT. STMNT. 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 TCA /(RKB-051) 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 .PBLKS 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 /R-CONVERSION FD45 LAW 10 /** EIGHT TO AC(14-17) JMP FD43 /** /**0-CONVERSION FD46 LAW 3 /** JMP FD43 /** /D- E- F- AND G-CONVERSIONS /FOUR(D), FIVE(E), SIX(F), OR SEVEN(G) FD42 LAC .CHAR / TO AC(15-17). AND S00007 /GET RID OF AC BITS 0-14 FD43 AND S00017 /** GET RID OF AC BITS 0-13 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 /** READ INTO FORMAT STATEMENT /CALLING SEQUENCE-- / JMS RDINFS RDINFS 0 JMS READ. /GET L.B. CHAR. LAC* CC1 /(RKB-051) MOVE FORMAT WORD PAIR INTO (WAS 'LAC* CC') DAC MS /MS+LS FOR SHIFTING LAC* CC2 DAC LS LAW -5 /INIT. LOOP CNTRS. CNT AND CNT2 TAD CCA DAC CNT2 LAC CCA CMA DAC CNT FD34 JMS DSH7 ISZ CNT JMP FD34 /UNTIL CUR. CHR. RT. JUST. IN LS LAC LS AND Z77600 XOR .CHAR /REPLACE OLD W/ NEW CHR. DAC LS SKP FD35 JMS DSH7 ISZ CNT2 JMP FD35 /COMPLETE 36 BIT CIRCUL. SHIFT JMS DSHL LAC MS DAC* CC1 /(RKB-051) (WAS 'DAC* CC') LAC LS DAC* CC2 /PUT WD. PR. IN FRMT. STMNT. JMP* RDINFS /** .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 .NMTST /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 .NMTST /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 .NMTST / JMP NO (TESTED CHARACTER IN AC) / JMP YES (BINARY VALUE OF CHARACTER IN AC) .NMTST 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 .NMTST /BUMP RETURN ADDRESS AND EXIT WITH BINARY JMP* .NMTST / VALUE OF CHARACTER IN AC. NUMTS1 LAC NUMTS2 /EXIT WITH ORIGINAL CHARACTER IN AC. JMP* .NMTST 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 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* CC2 /(RKB-051) 4 BITS IN WD1 + 3 BITS IN WD2. LMQ /(RKB-051) THIS SECTION RECODED TO BE SLIGHTLY FASTER LAC* CC1 /(RKB-051) COMBINE WITH WD1 LLS 3 /(RKB-051) JMP GETCC7 GETCC5 LAC* CC1 /(RKB-051) SHIFT WD1 4 RIGHT. RTR; RTR JMP GETCC7 GETCC6 LAC* CC1 /(RKB-051) SHIFT WD1 8 LEFT SWHA; RTR /(RKB-051) THIS LINE RECODED TO BE SLIGHTLY FASTER 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 AND (77777) /(RKB-051) STRIP CHARACTER COUNTER FROM [0:2] DAC CC1 /(RKB-051) CC1 IS NOW USED AS POINTER, NOT CC IAC /(RKB-051) POINT TO SECOND WORD OF PAIR DAC CC2 /(RKB-051) SIMILAR CODE EXISTED HERE LAC CC /(RKB-051) NOW EXTRACT THE CHARACTER COUNT 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 LAC CC /** =0 IF D-D SNA /** SKP IF NOT D-D JMP FF2 /** IF D-D, CALL TO .FD UNNEC. LAW -1 /SET NO-CONVERSION FLAG TO STOP AT END OF DAC NCF / FORMAT STATEMENT. JMS .FD /CLEANUP ALL H AND X CONVERSIONS. FF2=. .IFDEF %V5A1 LAC* .RN /* R.A. FLG. SZA /* SKP IF NOT R.A. JMP* .FF /* .ENDC LAC* .FH /IF A WRITE, OUTPUT LAST LINE. SZA JMS* .STEOR /** LAC RDEX20 /REINIT. .ER DAC* .ER4 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 .BFLOC /* RESET LINE BUFFER POINTER (LBADD) TO DAC .LBADD / BEGINNING OF LINE BUFFER. DZM .HIFLG /RESET FLAG TO 0 (POINTER OK). LAC C00001 /** DAC CCPTR /** INIT. CURR. CHR. PTR. 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. INILB2 DZM .FSTFL /SET FIRST CHARACTER FLAG. 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 S00077 /VALIDITY AND MODE BITS SAD C00002 JMP EOR3 /IF MODE OK, CONTINUE. JMS* .ER /IF MODE NOT IOPS-ALPHA, TAKE ERROR EXIT. .DSA 11 .RAENT 0 /* ENTRY FROM RBCDIO EOR1 LAC .HIFLG /IF LINE BUFFER IS NOT FULL, FILL CURRENT SZA / WORD PAIR WITH BLANKS. JMP EOR2 LAW 15 /SET UP .PBLKS TO PACK CR'S AT END DAC PKBLK1 /OF LINE, SO LP HANDLER WON'T OVERFLOW LAC .SCC TCA /(RKB-051) JMS .PBLKS LAW 40 /RESET .PBLKS TO PACK BLANKS DAC PKBLK1 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 .IFDEF %V5A1 LAC* .RN /* R.A. FLG. SZA /* SKP IF NOT R.A. JMP* .RAENT /* RTN. IF R.A. .ENDC 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 ISZ CCPTR /** INCREM. CURR. CHR. PTR. LAC .FSTFL /TEST FOR FIRST CHARACTER IN LINE. IF SO, SPA /** SKP IF NOT ENCODE JMP PACK3 /** ENCODE - CHK. IF D-D SZA / CHANGE IT TO A CARRIAGE CONTROL CHAR-, JMP PACK1 / ACTER. LAC .CHAR DAC .FSTFL /KILL FIRST-CHARACTER FLAG. .IFUND MSCC /(RKB-050) XCT .MSDEV /(RKB-050) SKP IF NOT MASS STORAGE JMP PACK2 /(RKB-050) NOP IF MASS STORAGE, DON'T CONVERT 1ST CHAR .ENDC /(RKB-050) 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 TCA /(RKB-051) IT 012 (LF) 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. PACK3 LAC .CHAR /** DAC .FSTFL /** SET TO INDIC. 1ST CHAR. REACHED LAC CC /** =0 IF D-D I/O SZA /** JMP PACK2 /** FRMTD.: NO FORMS CONTROL CHR. JMP* .PACK /** D-D: IGNORE 1ST CHAR. .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. ISZ CCPTR /** INCREM. CURR. CHR. PTR. JMS DSH7 /ROTATE MS+LS LEFT 7, AND EXTRACT OUT THE LAC LS / 7 LOW BITS = FETCHED CHARACTER. AND S00177 DAC .CHAR /** 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 JMS BUMP /BUMP CHR. CNT. JMS EXCH /RESTORE MS+LS AND SMS+SLS. LAC .CHAR /** TEST FOR CR SAD S00015 /** DON'T IGN. CR (FOR D-D I/O) JMP READ4 /** .IFDEF LFTOSP /(RKB-050) CONVERT LF'S TO SPACES LAC .FSTFL /IF THIS IS THE FIRST CHARACTER OF THE SNA /LINE, CHECK IF IT IS A LINE FEED. IF SO, LAC .CHAR /IT IS ASSUMED TO BE CARRIAGE CONTROL, AND DAC .FSTFL /IS CHANGED TO A SPACE. RESET FIRST CHAR LAC .CHAR SAD S00012 /FLAG LAC S00040 DAC .CHAR .ENDC /(RKB-050) LAW -40 /IGNORE ALL OTHER CHARACTERS LESS THAN 40(8) TAD .CHAR / EXCEPT CARRIAGE RETURN. SPA JMP READ1 LAC .CHAR /EXIT WITH FETCHED CHARACTER IN AC. READ4 JMP* READ. /** READ3 LAC CC /** =0 IF D-D SNA /** IF D-D OTPT., WANT CR, A.M. JMP READ2 /** LAC S00040 /BLANK DAC .HIFLG /NON-ZERO TO HIFLG. DAC .CHAR /** LAC BCNT /STORE BCNT AND SET CR-ALT FLAG DAC CRAMFL JMP READ2 .EJECT /EXCHANGE MS+LS WITH SMS+SLS 28 USEC. / CALLING SEQUENCE -- JMS EXCH EXCH CAL 0 LAC LS /LS TO TEMP DAC EXCH1 LAC SLS /SLS TO LS DAC LS LAC EXCH1 /TEMP TO SLS DAC SLS LAC MS /MS TO TEMP DAC EXCH1 LAC SMS /SMS TO MS DAC MS LAC EXCH1 /TEMP TO SMS DAC SMS JMP* EXCH /EXIT EXCH1 .DSA 0 .EJECT /BUMP CHARACTER COUNT AND WORD PAIR / CALLING SEQUENCE -- JMS BUMP BUMP CAL 0 ISZ .SCC /INCREMENT CHARACTER COUNT. IF LESS THAN JMP* BUMP / 5 CHARACTERS HAVE BEEN READ (PACKED), LAW -5 / EXIT IMMEDIATELY. IF NOT, RESET SCC DAC .SCC / AND UPDATE 2 WORDS OF LINE BUFFER. LAC* .FH /BRANCH PER READ OR WRITE. SZA JMP BUMP2 ISZ .LBADD /READ--LOAD NEXT 2 WORDS OF LINE BUFFER LAC* .LBADD / INTO MS+LS AND INCREMENT L.B. POINTER DAC MS / BY 2. ISZ .LBADD LAC* .LBADD DAC LS JMP* BUMP BUMP2 JMS DSHL /WRITE--LEFT-JUSTIFY MS+LS, STORE MS+LS IN ISZ .LBADD / NEXT TWO WORDS OF LINE BUFFER, AND LAC MS / INCREMENT L.B. POINTER BY 2. DAC* .LBADD ISZ .LBADD LAC LS DAC* .LBADD LAC .LBADD /IF L.B. POINTER HAS REACHED ITS HIGH SAD .HILIM / LIMIT, SET HIFLG=NON-ZERO TO SUPPRESS DAC .HIFLG / FURTHER L.B. ACCESS FOR THIS LINE. JMP* BUMP /EXIT. .EJECT /PACK BLANKS / CALLING SEQUENCE -- LAC NUMBER OF BLANKS (127 MAX) / JMS .PBLKS .PBLKS CAL 0 AND S00177 /COMPLEMENT NUMBER OF BLANKS TO GET LOOP SNA / INDEX. IF ZERO, EXIT. JMP* .PBLKS TCA /(RKB-051) DAC PKBLK2 PKBLK1 LAW 40 /PACK ONE BLANK. JMS .PACK ISZ PKBLK2 JMP PKBLK1 /LOOP UNTIL ALL BLANKS PACKED. JMP* .PBLKS .EJECT /** OVER FLOW ROUTINE - PACK *'S (AND D.P., IF POSS.) /E,D FOVFL1 LAC .D TAD C00005 TCA /(RKB-051) TAD .W /.W-(D+5) SPA JMP FOVFL2 /CAN'T DO D.P. JMS PKHSH /PACK .W-(.D+5) ASTERISKS LAW 56 /'.' JMS .PACK LAC .D TAD S00004 JMP PFIN /PACK .D+4 ASTERISKS FOVFL2 LAC .W JMP PFIN /--F FOVFL3 LAC .D CMA TAD .W /.W-(.D+1) SPA JMP FOVFL4 /CAN'T DO D.P. JMS PKHSH /PACK .W-(.D+1) ASTERISKS LAW 56 /D.P. JMS .PACK LAC .D SKP /CHK. FOR G-CONV. FOVFL4 LAC .W JMS PKHSH LAC S2 /CONV. CODE TAD K00006 SMA!SZA /SKP IF NOT G SKP JMP FE99 /G, SO, DONE LAC S00004 /PACK 4 MORE ASTERISKS PFIN JMS PKHSH JMP FE99 /** .EJECT /**PACK ASTERISKS /CALLING SEQUENCE-- / LAC (NUM. OF ASTERISKS TO BE PKED. / JMS PKHSH PKHSH 0 AND S00177 SNA JMP* PKHSH /0 ASTERISKS: RTN. IMMED. TCA /(RKB-051) DAC TEMP6 PKHSH1 LAW 52 /'*' JMS .PACK ISZ TEMP6 JMP PKHSH1 JMP* PKHSH /** .EJECT /PACK SIGN / CALLING SEQUENCE -- JMS PKSGN PKSGN CAL 0 LAC SIGN /IF SIGN IS PLUS (SIGN=0) PACK A BLANK. SZA!CLA /IF SIGN IS MINUS (SIGN.NE.0), PACK HYPHEN. LAW 15 TAD S00040 JMS .PACK JMP* PKSGN .END