HED NUMERICAL INPUT CONVERSION ******************************************************************** * INPUT IS THE ROUTINE THAT DOES ALL OF THE INPUT CONVERSION. IT * * INCLUDES BOTH A FREE-FIELD SCANNER AND A FORMATTED SCANNER. * * FREE-FIELD IS INDICATED BY FCR=0. ALL CONVERSION IS DONE IN * * THE SAME WAY, REGARDLESS OF THE FORMAT TYPE. THIS ALLOWS REAL * * VARIABLES TO APPEAR AS INTEGERS, AND VICE VERSA. THE FORM OF A * * NUMBER IS AS FOLLOWS: * * * * * * * * ALL OF THESE ARE OPTIONAL, AND THE APPEARANCE OF THE FIRST * * SIGN, DIGIT, OR DECIMAL PT. DEFINES A NUMBER. ANY COMBINATION * * OF THE ABOVE IS LEGAL, WITH THE FOLLOWING EXEPTIONS: * * * * (1) AN INITIAL E IS IGNORED IN FREE-FIELD, AND IS ILLEGAL IN * * FIXED FIELD; * * (2) IF NO INTEGER PART OR FRACTION APPEARS (AND A SIGN OR * * DEC.PT. DOES), THE RESULT IS ZERO * * * * IN FIXED-FIELD INPUT, IF NO DECIMAL PT. APPEARS, THE RESULT IS * * MULTIPLIED BY 10**(-D). * * * * THE FOLLOWING SPECIAL FEATURES ARE INCLUDED FOR FREE-FIELD INPUT:* * * * (1) WHEN 2 CONSECUTIVE COMMAS APPEAR WITH NO DATA BETWEEN, * * THAT LIST ELEMENT IS SKIPPED. * * * * (2) WHEN A SLASH OCCURS IN AN INPUT RECORD, THE REMAINDER * * OF THE RECORD IS TREATED AS COMMENTS. * * * * (3) IF A LINE TERMINATES WITHOUT A SLASH, THE INPUT OPERATION * * TERMINATES AND THE REMAINDER OF THE LIST REMAINS * * UNCHANGED. * * * * (4) WHEN A QUOTE APPEARS, THE FOLLOWING * * CHARACTERS IN THAT LINE ARE TREATED AS COMMENTS * * UNTIL ANOTHER QUOTE APPEARS. * * * * (5) ALL UNRECOGNIZED CHARACTERS ARE TREATED AS BLANKS * * * * (6) WHEN AN INTEGER IS PRECEDED BY THE CHARACTER "B", THE IN- * * TEGER IS INTERPRETED AS OCTAL. * * CONTROL WITHIN INPUT IS GOVERNED BY THE VARIABLE POST, * * WHOSE VALUE INDICATES HOW FAR THE NUMBER HAS BEEN * * SCANNED, AS FOLLOWS: * * * * POST = 0 : NUMBER NOT STARTED YET * * 1 : NUMBER STARTED, BUT NO DECIMAL PT. REACHED YET * * 3 : LAST CHARACTER WAS THE 'E' * * 4 : EXPONENT BEING PROCESSED * * * ******************************************************************** FFCHK NOP TEST FOR FREE-FIELD. IF NOT, JUMPS TO LDA FCR AN ERROR ROUTINE SZA JMP ERR4 JMP FFCHK,I INPUT NOP CLA INITIALIZATION SECTION STA SIGN STA ESIGN STA MANT STA MANT+1 STA EXPON STA EXP STA SKIP STA POST CPA FCR FREE-FIELD? RSS JMP INLUP STA W STA D FLIP ISZ W CHECK FOR END OF FIELD WIDTH. JMP INLUP FINAL CLA FINL1 STA CFLAG LDA EXPON FINAL COMPUTATION OF NUMBER ISZ ESIGN COMPUTE EXTERNAL CMA,INA EXPONENT AS NEGATIVE LDB D COMPUTE D CONTRIBUTION. SSB POSITIVE MEANS A PT APPEARED, CMB NEGATIVE MEANS IT'S IMPLICIT ADA B FINAL VALUE OF EXP AS NEGATIVE SZA,RSS IF ZERO THEN WE CAN JMP INXIT SKIP THIS PART SSA IF POSITIVE WE HAVE TO MULTIPLY JMP BIGEX BY .1 , OTHERWISE BY 10 CMA,INA SET NEGATIVE TO COUNT STA EXPON JSB DBY10 ISZ EXPON JMP *-2 JMP INXIT BIGEX STA EXPON JSB MBY10 ISZ EXPON JMP *-2 INXIT JSB LODEM ISZ SIGN TEST THE SIGN JMP INBAK POSITIVE--NO SWEAT CMA TWO'S COMPLEMENT THE CMB,INB,SZB,RSS DOUBLE LENGTH INA NUMBER INBAK JSB .PACK NORMALIZE AND PACK THE RESULT. EXP BSS 1 JSB STORM JMP INPUT,I RETURN INLUP JSB INCHR *********** BRANCH TO THE ROUTINE THAT HANDLES THIS CHARACTER ***** LDB POST CPA SLASH JMP INSLS CPA COMMA JMP INCOM CPA PLUS JMP INPLS CPA MINUS JMP INMIN CPA POINT JMP INPNT CPA E JMP INE CPA QUOTE JMP INQUO CPA OCTAL JMP INOCT JSB DIGIT JMP INBLN ***** THE CHARACTER IS A DIGIT. WE FIRST SET POST AS FOLLOWS: ***** * POST=0 : POST_1 * * POST=2 : DF_DF+1 * * POST=3 : POST_6 * ******************************************************************** LDB POST SZB,RSS ISZ POST IF POST=0, SET IT TO 1 CPB ....2 ISZ D IF POST=2, BUMP D CPB ....3 JMP INEX3 PROCESSING EXPONENT CPB ....4 JMP INEX4 PROCESSING EXPONENT ALF,ALF ALF,RAR STA TEMP1 JSB MBY10 MULTIPLY INPUT SO FAR BY 10 LDB EXP ADD DIGIT TO RESULT SO FAR SZB IF EXPONENT IS ZERO JMP INADD LDA ....4 SET UP EXP=4 AND STA EXP LDA TEMP1 NORMALIZE CLB INORM JSB NORML JMP FLIP INADD ADB MIN4 CMB LDA TEMP1 SET UP NUMBER FOR STB TEMP1 SHIFTS & STORE COUNT CLB INADL ISZ TEMP1 JMP INSHF ADA MANT CLE ADB MANT+1 SEZ INA JMP INORM INSHF CLE,ERA ERB JMP INADL INEX3 ISZ POST INEX4 LDB EXPON MULTIPLY EXPON BY 10 BLS,BLS ADB EXPON BLS ADA B STA EXPON JMP FLIP INCOM JSB FFCHK TREAT A COMMA ON INPUT CCA SZB IS POST=0? JMP FINL1 CPA CFLAG JMP *+3 DOUBLE COMMA STA CFLAG JMP FLIP STA SKIP SET TO SKIP INPUT ITEM JMP INPUT,I INPL2 STA ESIGN INPLS CPB ....4 IF POST=4 THIS IS ILLEGAL JMP ERR5 LDA ....4 SZB IF POST>0 THEN SET IT TO 4 STORP STA POST JMP FLIP INMIN CCA SET MINUS IN EITHER SIGN OR SZB ESIGN JMP INPL2 STA SIGN IF POST=0 THEN SIG_-1 JMP FLIP INPNT BRS HANDLES DECIMAL POINT SZB JMP ERR5 MEANS POST WAS 2 OR MORE STB D SET D TO ZERO LDA ....2 JMP STORP INE SZB,RSS HANDLES 'E' JMP INBLN IF POST=0 THEN COMMENTS ADB MIN3 SSB,RSS JMP ERR5 POST WAS 3 OR 4 LDA ....3 SET IT TO 3 JMP STORP INSLS JSB FFCHK CLA SET CCNT=0 TO FORCE A NEW RECORD STA CCNT TO BE READ NEXT TIME. INBLN LDB POST LDA FCR IF FREE-FIELD AND POST NEQ 0, SZA,RSS GO TO FINAL ELSE GO TO FLIP. SZB,RSS IS POST=0? JMP FLIP IF SO, JUST GO ON. JMP FINAL INQUO JSB INCHR READ CHARACTERS UNTIL ANOTHER CPA QUOTE QUOTE IS READ. JMP INBLN INBLN JMP INQUO INOCT STA POST SZB IF POST WAS NON ZERO, TREAT AS A JMP INBLN+3 BLANK. STB CFLAG RESET CFLAG TO SAY NO COMMA. JSB FFCHK INOC2 JSB INCHR GET NEXT CHARACTER. JSB DIGIT CHECK FOR DIGIT. JMP INOC1 NO. LDB MANT GET PREVIOUS OCTAL RESULT. BLF,RBR SHIFT LEFT 3. IOR B MERGE WITH NEW DIGIT. STA MANT JMP INOC2 INOC1 LDB .36 SET EXPONENT TO SAY 15. STB MANT+1 CPA BLANK IF TERMINATING CHARACTER IS JMP INPUT,I OTHER THAN A BLANK, JSB BACKB BACK UP THE BUFFER POINTER CCB AND COUNTER. ADB CCNT STB CCNT JMP INPUT,I HED CONTROL SECTION ******************************************************************** * THIS FINAL SET OF ROUTINES ARE THE ROUTINES ACTUALLY CALLED BY * * THE FORTRAN PROGRAM. FOR EACH REAL VARIABLE, INTEGER VARIABLE, * * REAL ARRAY, OR INTEGER ARRAY, THERE IS A SINGLE CALL TO EITHER * .IO * .IOR.,.IOI.,.RAR.,OR .IAR.. THERE IS INITIALLY A SINGLE CALL TO * * EITHER .DIO. OR .BIO.. * ******************************************************************** .IOR. NOP USED TO INPUT/OUTPUT A REAL VAR- * IABLE. .IOR. IS CALLED FOR * OUTPUT WITH THE NUMBER TO * BE OUTPUT IN A & B. FOR IN- * PUT IT RETURNS WITH THE IN- * PUT VALUE IN A & B JSB BCHEK CHECK FOR BINARY JMP BINRL STA MANT JSB .FLUN STA EXP STB MANT+1 JSB LST2F JSB LODEM ISZ SKIP JMP .IOR.,I NO SKIP ISZ .IOR. SKIP AROUND THE ISZ .IOR. STORE JMP .IOR.,I BINRL JSB BNARY STA FCR STB A JSB BNARY STA B LDA FCR JMP .IOR.,I * .IOI. NOP USED TO INPUT/OUTPUT AN INTEGER * VARIABLE. .IOI. IS CALLED FOR * OUTPUT WITH THE INTEGER IN A. * FOR INPUT IT RETURNS WITH THE * INTEGER IN A. JSB BCHEK CHECK FOR BINARY JMP BININ JSB FLOAT JSB .IOR. JSB IFIX JMP .IOI.,I ISZ .IOI. JMP .IOI.,I BININ JSB BNARY JMP .IOI.,I .RAR. NOP CALLED FOR INPUT/OUTPUT OF A CMA,INA REAL ARRAY. STA ALNTH A=ARRAY LENGTH (>0) STB ARRAY B=ARRAY ADDRESS RARLP DLD ARRAY,I JSB .IOR. STB .IAR. JMP RAR1 RARL1 ISZ ARRAY SKIP RETUR ISZ ARRAY ISZ ALNTH JMP RARLP JMP .RAR.,I RETURN RAR1 JSB IOCHK JMP RARL1 OUTPUT LDB .IAR. DST ARRAY,I JMP RARL1 .IAR. NOP CALLED FOR INPUT/OUTPUT OF AN CMA,INA INTEGER ARRAY. STA ALNTH A=ARRAY LENGTH (>0) STB ARRAY B=ARRAY ADDRESS IARLP LDA ARRAY,I JSB .IOI. JMP IAR1 IAR2 ISZ ARRAY ISZ ALNTH JMP IARLP JMP .IAR.,I IAR1 JSB IOCHK JMP IAR2 STA ARRAY,I JMP IAR2 BCHEK NOP RETURNS TO P+1 IF BINARY, ELSE 2 STB TEMP2 LDB BFLAG SZB,RSS ISZ BCHEK LDB TEMP2 JMP BCHEK,I BNARY NOP HANDLES TRANSFER OF 1 WORD TO OR FROM THE STA TEMP1 BINARY BUFFER. STB .DIO. USED AS TEMPORARY ISZ CCNT TEST FOR END OF BUFFER. JMP *+3 NO. JSB DTA CALL FOR BUFFER IN/OUT. JMP *-3 AND TRY AGAIN. ISZ BCR BUMP BUFFER POINTER. LDA TEMP1 RESTORE WORD TO BE OUTPUT. JSB IOCHK STA BCR,I OUTPUT LDA BCR,I INPUT LDB .DIO. JMP BNARY,I *************************** .DIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR FORMATTED INPUT/ *************************** OUTPUT. STA UNIT STB IO SZA CHECK FOR UNIT=0. JMP DIO1 NO-IO TRANSFER. INA INTERNAL CONVERSION. STA CCNT SET CCNT=1. CCA GET BUFFER ADDRESS INTO BCR. ADA .DIO.,I ADA .DIO.,I STA BCR ISZ .DIO. DIO1 CLA STA BFLAG STA SKIPL LDA ASCRY STA CLEN BUFFER LENGTH = 134 CHARS SZB,RSS JSB WAITO LDA .DIO.,I GET FORMAT ADDRESS RAL,CLE,SLA,ERA TEST FOR INDIRECT (1 LEVEL) LDA A,I LOAD TRUE ADDRESS. RAL CONVERT TO A CHARACTER CMA,INA,SZA ADDRESS CMA STA FCR ISZ .DIO. GET THE END-OF LIST LDA .DIO.,I ADDRESS STA ENDLS LDA MIN3 STA NEST CCA STA CFLAG ISZ .DIO. SET UP LDA .DIO. THE RETURN STA LST2F ADDRESS JSB IOCHK JMP FORMT JSB DTA READ ALINE IF INPUT. LDA FCR SZA TEST FOR FREE-FIELD JMP FORMT FORMATTED I/O. JSB F2LST JSB INPUT JMP *-2 *************************** .BIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR NON-FORMATTED *************************** INPUT/OUTPUT STA UNIT STB IO CLA,INA STA BFLAG LDA BINRY STA CLEN BUFFER LENGTH = 120 CHARS SZB,RSS JSB WAITO LDB IO SZB JSB DTA JMP .BIO.,I OLDIO NOP ISZ OLDIO JMP OLDIO,I LST2F NOP CLA STA SKIP JMP F2LST,I F2LST NOP LDA BCR STA BCRS ISZ SKIPL JMP LST2F,I JMP F2LST,I * .DTA. NOP LDA UNIT SET UP STATUS CONTROL SZA,RSS IF UNIT=0, JMP .DTA.,I IGNORE CALL. JSB EXEC DEF *+4 DEF D13 DEF UNIT DEF STXXX LDA STXXX AND PAPER TEST FOR PAPER TAPE CPA .4000 IF TYPE = 1X CLA SIMULATE PAPER TAPE SZA CLA,RSS NOT PAPER TAPE. LDA PBIT ADA UNIT SET UP BASIC IOC CONTROL WORD TO IOR BASIC SAY ASCII INPUT. JSB BCHEK XOR ASC2B STA CNTRL JSB IOCHK NOW TEST FOR INPUT OR OUTPUT. JMP DTAO * INPUT SECTION * JSB IOCIN PERFORM IOC CALL. JMP .DTA.,I RETURN * OUTPUT SECTION * DTAO LDB CCNT GET NUMBER OF CHARACTERS/WORDS. SZB BINARY RECORD CONTINUATION? CMB JSB BCHEK IF BINARY, DOUBLE BLS COUNT. ADB CLEN PRODUCES CORRECT COUNT IF ASCII. STB OUTBL STORE AS # OF CHARS. OUTPUT. JSB BCHEK JMP *+3 DTAO1 JSB IOCOU PERFORM IOC CALL JMP .DTA.,I RETURN CMB,INB SET BINARY COUNT TO POSITIVE AND BLF,BLF POSITION AS HIGH CHARACTER RBR ALF,ALF ROTATE P-BIT TO SIGN SSA IF NOT ZERO, STORE AS STB BUFO FIRST CHARACTER IN BUFFER. JMP DTAO1 * DTA NOP PERFORMS A COMPLETE I/O OPERA- JSB .DTA. TION. JSB IOCHK JMP *+3 JSB WAITI INPUT WAIT JMP DTA,I JSB WAITO OUTPUT WAIT JMP DTA,I * WAITI NOP WAITS FOR INPUT LDB UNIT IGNORE SZB,RSS CALL IF JMP WAITI,I UNIT=0. JSB BCHEK BINARY OR ASCII? ARS BINARY--CONVERT TO WORD COUNT. CMA STORE AS NEGATIVE IN STA CCNT COUNTER. LDB .IBUF GET BUFFER ADDRESS JSB BCHEK BINARY ? JMP WTI3 YES RBL FOR ASCII SET BCR TO POINT TO WTI2 ADB MIN1 THE FIRST CHARACTER PRECEDING WTI4 STB BCR THE BUFFER. JMP WAITI,I WTI3 LDA CNTRL ALF,ALF SSA,RSS PAPER TAPE ? JMP WTI2 NO ISZ CCNT YES JMP WTI4 * INPUT ERROR * * WAITO NOP WAITS FOR OUTPUT TO BE COMPLETED LDA UNIT IGNORE CALL IF SZA,RSS UNIT=0. JMP WAITO,I WTO7 JSB EXEC DEF *+4 DEF D13 DEF UNIT DEF STXXX LDA STXXX AND PAPER CLB SZA CPA .4000 LDB PBIT STB CNTRL WTO1 LDA .OBUF SET UP BUFFER ADDRESS AND CCB LENGTH. ADB CLEN JSB BCHEK BINARY. JMP WTO6 RAL ADJUST BUFFER ADDRESS FOR ADA MIN1 CHARACTERS STA BCR STB CCNT JMP WAITO,I WTO6 BRS ADJUST LENGTH FOR WORDS. ADA MIN1 STA BCR STB CCNT LDA CNTRL ALF,ALF SSA,RSS TEST FOR PAPER TAPE. JMP WAITO,I NOT PAPER TAPE. ISZ CCNT IF PAPER TAPE, BUMP BUFFER ISZ BCR ADDRESS AND COUNTER. JMP WAITO,I RETURN IOCIN NOP INPUT CALL TO IOC JSB EXEC DEF *+5 DEF ....1 DEF CNTRL .IBUF DEF BUFI DEF CLEN RAL SSA JMP IOCIN+1 ALF,ALF EOF TO BIT 0 SLA,RSS EOF? JMP *+4 NO, JUMP LDB CLEN YES, DUMMY TLOG SSB SKIP IF + CMB,INB MAKE IT + LDA B JMP IOCIN,I CLEN NOP * IOCOU NOP OUTPUT CALL TO IOC LDA CNTRL CLEAR BIT 7 AND =B177577 FOR OUTPUT REQUESTS STA CNTRO JSB EXEC DEF *+5 DEF ....2 DEF CNTRO .OBUF DEF BUFO DEF OUTBL JMP IOCOU,I OUTBL BSS 1 CNTRO BSS 1 * ERROR SECTION * ERR1 JSB ERROR ....1 ABS 1 ERR2 JSB ERROR ....2 ABS 2 ERR3 JSB ERROR ....3 ABS 3 ERR4 JSB ERROR ....4 ABS 4 ERR5 JSB ERROR ....5 ABS 5 ERROR NOP LDA ERROR,I ALF,ALF ADA =A0 STA ER+4 LDB =B141 JSB .OPSY CHECK FOR DOS OR RTE SSA,RSS SKIP IF RTE JMP *+3 ELSE JMP IF DOS LDB 1717B ADB =D12 LDA 1,I STA ER+5 INB LDA 1,I STA ER+6 INB LDA 1,I STA ER+7 JSB EXEC DEF *+5 DEF ....2 DEF ....1 DEF ER DEF D15 JMP ENDLS,I ER ASC 8,FMT ERR END