FORTRAN II - TAPE 2 9-24-63 FIODEC HERE, LAC 7 DAC END LAC (17761 DAC THE#END RESET1 HERE1, LAC END CMA TAD THEEND JMP HERE2 HERE3, RESET1 SKP HERE2, HLT LAM -PUSHN 1 DAC L#IMIT LAC (DAC PSTORE-1 DAC PUSH RESET CLFLAG STREAD SETCHR TITLE JMP GO /TITLE PUNCH ROUTINE FEED, LAM -140 FEED1, DAC T#EMP LAS AND (400 SNA CLA!SKP LAC (12 IPB ISZ TEMP JMP FEED1 1 EXIT TITLE, LAM -74 1 DAC CR#CNT FEED GCR PUNCHW AND (77 SAD (CHAR R JMP TITLE 3 COPY LAW TITLED-1 JMP PUNSTR COPY, GCR PUNCHW AND (77 SAD (CHAR R EXIT JMP COPY TITLED, TEXT / DECIMA FIODEC EXTERNAL .IO1,.IO2,.IO3,.IO4,.IO5,.IO6,.IO7,.IO8,.IO9 EXTERNAL .IO57A,.IODEC / /CONTROL STATEMENT RECOGNIZER CONTROL, DZM IO#MODE LAW CONTAB DAC W#ORDAD DAC W#ORDP CONT1, PAKSET ISZ WORDP LAC I WORDP SZA JMP . 3 HELP 101 EXIT DAC #WORD CONT2, LAM -2 DAC WOR#DC CONT3, LAC WORD RAL6 DAC WORD RAL AND (77 DAC C#CHR SAD (13 JMP CONTF UNPACK JMP CONTNO SAD CCHR JMP CONT4 CONTNO, LAC I WORDAD JMP CONTROL 2 CONT4, IDXCHR ISZ WORDC JMP CONT3 JMP CONT1+1 CONTF, LAC I WORDAD ADD (JMP I-1 DAC . 1 XX /DATA FOR CONTROL STATEMENT NAMES CONTAB, CT1 TEXT .DIMENSION. DIMEN CT1, CT2 TEXT .COMMON. COMMO CT2, CT3 TEXT .CONTINUE. CONTU CT3, CT4 TEXT .GOTO. DOGO CT4, CT5 TEXT .IF. DIF CT5, CT6 TEXT .END. ENDA CT6, CT7 TEXT .CALL. CALL CT7, CT8 TEXT .RETURN. RETURN CT8, CT9 TEXT .FUNCTION. FUNCT CT9, CT10 TEXT .SUBROUTINE. SUBRUT CT10, CT11 TEXT .STOP. STOP CT11, CT12 TEXT .PAUSE. PPAUSE CT12, CT24 TEXT .ASSIGN. ASSIGN CT24, CT25 TEXT .2WORD. WORD2 CT25, CT26 TEXT .3WORD. WORD3 CT26, CT27 TEXT .READ. ISTAT CT27, CT28 TEXT .WRITE. IOSTAT CT28, CT29 TEXT .FORMAT. FORMAT CT29, CT30 TEXT .NOPUNCH. NOPU CT30, CT31 TEXT .EXTERNAL. EXTU CT31, CT32 TEXT .NORMALMODEREAL. TYPREL CT32, CT33 TEXT .NORMALMODEINTEGER. TYPNTG CT33, CT34 TEXT .NORMALMODEFORTRAN. TYPFTN CT34, CT35 TEXT .REAL. MREAL CT35, CT36 TEXT .INTEGER. MINTEG CT36, CT37 TEXT .FORTRAN. MFORTR CT37, CT38 TEXT .EXTENDMODE. EXTEND CT38, CT38 0 /NO PUNCH STATEMENT NOPU, LAC (EXIT DAC IPB EXIT /EXTERNAL STATEMENT EXTU, GETARG JMP CHKEND SNL HELP 161 EXTPUN JMP EXTU /TYPE DECLARATION GARBAGE TYPNTG, CLA!SKP TYPREL, CLC DAC #TYPSWT LAC #NORSWT SZA HELP 164 ISZ NORSWT EXIT TYPFTN, LAW 1 JMP TYPREL+1 /NORMAL MODE CONTROL MINTEG, CLA!SKP MREAL, CLC MCOP1, DAC COMMON+2 MCOPM, GETARG JMP CHKEND SNL HELP 162 LAW 3 INSERT LAC TYPE6 HELP 163 JMP MCOPM MFORTR, LAW 1 JMP MCOP1 /STOP AND PAUSE STATEMENTS STOP, PPAUSE LAW STPM4-1 JMP PUNSTR PPAUSE, XSTATF GETOCT CLA DAC COMMON LAW STPM1-1 PUNSTD STP1, LAW STPM2-1 JMP PUNSTR STPM1, TEXT / LAC (/ STPM2, TEXT / HLT / STPM4, TEXT / JMP .-1 / /CODING FOR EXECUTING SOME CONTROL STATEMENTS /CALL CALL, XSTAT DZM TEMA ARITHS JMP .-1 LAC TEMA SAD (CHAR R) JMP ENDSTA CALL1, LAC (UNOPEN ALGORITHM ENDPAR, LAC (CLOSEO ALGORITHM JMP ENDSTA /COMMON EXTEND, CLC DAC EXTS#WT COMMO, GETARG JMP CHKEND SNL HELP 201 LAW 2 INSERT LAC TYPE4 HELP 202 ISZ COMSWT JMP COMMO CHKEND, UNPACK EXIT HELP 720 EXIT /CONTINUE CONTU, JMP XSTAT /END ENDA, XSTATF STP1 PTYPE1 LAM -20 FEED1 LAW 13 IPB FEED WAIT JMP HERE2 /IF DIF, LAC (IFOP ALGORITHM JMP ARITH /FLOATING POINT WORD SIZE CNTROL WORD2, LAC (JMS DAC TYPE2 LAC (SKP DAC W#SIZE LAW W2SM-1 XCT SWITCH LAW WORD2M-1 JMP PUNSTR WORD3, XCT WSIZE HELP 730 EXIT WORD2M, TEXT .BAR 2 . W2SM, TEXT /BAR 2 SET2W / /COMPLICATED GOTO COMDOG, LAW CHAR R( CHKNXT JMP ASGOTO LAW GOST1-1 PUNSTR GENSYM DAC GO#TOM PUNCH3 LAW DOGOM-1 GOTO CHKCOM HELP 706 GETFIX LAC GOTOM PUNADG LAW GOST2-1 JMP PUNSYC GOST1, TEXT / JMS GOTO ./ GOST2, TEXT . LAC . /GOTO DOGO, XSTATF LAC CCOMMA SZA JMP COMDOG GETFIX AND (300000 SNA JMP ASGO3 LAW DOGOM-1 PUNSTD JMP PUNCRR /ASSIGNED GOTO ASGOTO, GETFIX LAW ASGOM1-1 PUNSTY CHKLPR LAW ASGOM2-1 GOTO LAW ASGOM5-1 JMP PUNSTR GOTO, DAC GOTO 4 PUNCRR GETCON JMP CHKRPR XX PUNSTD JMP GOTO 1 ASGO3, LAW ASGOM4-1 PUNSYC, PUNSTY PUNCRR, LAW CHAR R JMP PUNCHW ASGOM1, TEXT / LAC / ASGOM4, TEXT / JMP I / ASGOM2, FLEX SA FLEX D . FLEX 1 DOGOM, TEXT / JMP ./ ASGOM5, TEXT / DAC TEM+0 HLT XCT TEM+0 / /ASSIGN ASSIGN, XSTATF GETCON HELP 301 LAW ASSM1-1 PUNSTD LAW CHAR RT CHKNXT HELP 302 LAW CHAR RO CHKNXT HELP 302 GETFXV LAW ASSM3-1 JMP PUNSYC ASSM1, TEXT / LAW ./ ASSM2, TEXT / DAC #/ ASSM3, TEXT / ADD (JMP-LAW DAC #/ /SUBROUTINE AND FUNCTION PSEUDO - OPS SUBRUT, LAC (NOP SKP FUNCT, LAC (SKP DAC FUN#SWT LAC (SKP DAC S#WITCH XCT XSTATW SKP HELP 404 SUB1, GETVAR HELP 401 LAW SUBM1-1 PUNSYC PUNADR LAC COMMON DAC NAME LAC COMMON 1 DAC NAME 1 DZM FOFFF UNPACK JMP XSTAT LAW SUBM2-1 PUNSTR NXSTAT CHKLPR SUB2, GETARG JMP SUB3 SNL HELP 402 PUNSYM LAW 2 INSERT LAC TYPE0 HELP 403 LAW SUBM3-1 PUNSTR JMP SUB2 SUB3, XSTAT JMP CHKRPR NAME, 0 0 SUBM1, TEXT / INTERNAL / SUBM2, TEXT / JMS GTARG / SUBM3, TEXT /, 0 / SUBM5, FLEX LA FLEX W R FLEX ES SUBM4, TEXT / RETUR / /DIMENSION HANDLER DIMEN, NXSTAT DIMVAR CHKCOM JMP CHKEND JMP .-3 DIMST2, TEXT / JMS CALSB/ DIMST3, TEXT / LAW / /DIMENSION SUBROUTINE DIMVAR, SAVE -AN GETVAR HELP 501 LAC (NOP DAC SUBS#WT GENSYM  /GENERATE STORAGE NAME DAC COMMON 2 XCT SWITCH JMP DIMVR0 LAC TYPE0 /HERE IF A SUBROUTINE OR FUNCTION SEARCH JMP DIMVR0 LAC COMMON 2 /VARIABLE IS A DUMMY SYMBOL PUNADG LAC (SKP DAC SUBSWT LAW 3  /INSERT IN DIMEN. DUMMY SYMBOL LIST INSERT LAC TYPE5 NOP UNPACK SKP SAD (CHAR R, SKP JMP DIMVR0+1 LAW ASGOM4-1 JMP PUNSYC DIMVR0, PUNADR LAW DIMST2-1 PUNSTR LAC (1 DAC COMMON 3 DAC S#IZE LAC COMMON DAC LCTEMX FIXFLO JMP DIMVR1 LAC (2 WSIZE DAC S#IZE /SAVE ARRAY NAME, CHECK FOR (N DIMVR1, CHKLPR GETCON HELP 503 /MULTIPLY DIMENSIONS OUT, PUNCH LAW N FOR EACH BUT FIRST DIMVR2, LAC I VPOIN1 MPY LAC COMMON 3 DAC COMMON 3 GETCON JMP DIMVR3 LAW DIMST3-1 PUNSTD JMP DIMVR2 /TO FINISH DIMENSION, PUNCH LAW F, AND ADDRESS OF ARRAY=G.S. DIMVR3, CHKRPR   /CHECK IF ENDED WITH LAW DIMST3-1 PUNSTR LAC SIZE DECPUN   /LAW N LAC LCTEMX DAC COMMON  /RESTORE NAME LAW DIMST1-1 XCT SUBSWT  /CHECK FOR DUMMY ARRAY SKP JMP PUNSYC LAW 4   /NOT A DUMMY ARRAY INSERT LAC TYPE1 HELP 502 DIMVR4, LAC (773673 PUNCH3 LAC COMMON 2 DIMV4, PUNCH3  JMP PUNCRR  /PUNCH C.R. AND EXIT DIMST1, TEXT . I . /DO DO DOSTAT, XSTATF SAVE -DN AN LAW CHAR RD CHKNXT HELP EI 601 LAW CHAR RO CHKNXT HELP EI 601 /GET STATEMENT NO. AND I=N, COMPILE IT DOST1, GETDEC HELP 602 DAC DONUM DOSTL UNPACK DOST3 GETFIX LAC VPOIN1 DAC DO3 GENSYM DAC DOG PUNADG JMP GO /GENERATE DO SETUP, AND SET UP M2, AND M3 DOSTL, GETFXV  /GET DO VARIABLE DAC DOVAR ADVSTK ARITHS SKP HELP 603 ENDSTA /STACK IS NOW SET TO COMPILE THE SETUP STATEMENT GETFIX  /M2 DAC DO2 LAC INDCAT RTR LAW DOOP1 SZL JMP DOST2 CLC XOR I VPOIN1 DAC I VPOIN1 LAW DOOP DOST2, AND (17777 DAC DOOPR EXIT /IF NULL LAST AGRUMENT, SIMULATE A 1 DOST3, LAC (1 DAC COMMON PCSTAK EXIT1 /SPECIAL ADVSTAK ADVSK, DAC VPOIN1 JMP ADVSTK /GENERATE CODING FOR END ON DO-LOOP DODO, XSTATF STRESE LAC DOVAR ADVSK LAC DOOPR ALGORITHM LAC DOVAR ADVSK LAC DO2  ADVSK LAC DO3  ADVSK ENDSTA LAC DOG JMP PUNJMP /MAIN LOOP GO, STRESE SCAN LAC STATNI SNA JMP GO LAC STNUM SAD DONUM JMP DODO JMP GO ARITH, XSTAT ARITHS JMP .-1 ENDSTA, LAC (ENDCR JMP ALGORITHM /DO AN ARITHMETIC STATEMENT ARITHS, DZM ARITH#P ARITH1, GETSYM EXIT1  /ALL DONE JMP ARITH2 /VARIABLE TYPE SYMBOL DAC TEM#A GETOPN  /GET OPERATOR NAME ALGORITHM IDXCHR LAC TEMA  /SPECIAL CHARACTER CHECK SAD (CHAR R( JMP ARITHL SAD (CHAR R) JMP ARITHR SAD (CHAR R, JMP ARITHC JMP ARITH1 /DISPATCH ON SYMBOL TYPE ARITH2, DSPTCH JMP ARITH4 /FX CON JMP ARITH5 /FL CON /VARIABLE ARITH3, PVSTAK ADVSTK JMP ARITH1 /FIXED POINT CONSTANT ARITH4, ARITHM LAC COMMON CMA DAC COMMON PCSTAK JMP ARITH3 1 /FLOATING POINT CONSTANT ARITH5, ARITHM LAC COMMON+1 XOR (400000 DAC COMMON+1  /COMPLEMENT IF PRECEDED BY - FLCONS DAC COMMON+1 LAC (CHAR L. 1414 DAC COMMON JMP ARITH3 /MORE ARITHMETIC STATEMENT PROCESSOR /COMMA ARITHC, LAC ARITHP SZA   /CHECK LEVEL JMP ARITH1 EXIT   /EXIT IF A COMMA ON LEVEL 0 /LEFT PARANTHESIS ARITHL, CLC TAD ARITHP DAC ARITHP JMP ARITH1 /RIGHT PARANTHESIS ARITHR, ISZ ARITHP JMP ARITH1 JMP ARITH1 /SEE IF CONSTANT WAS PRECEDED BY A MINUS SIGN ARITHM, LAC I IT SAD (XCT SUBOP JMP .+4  /ORDINARY MINUS SAD (XCT UNSUB JMP POPTOP /UNARY MINUS EXIT3  /NO MINUS LAC (XCT ADDOP DAC I IT EXIT /RETURN RETURN, XSTATF LAW SUBM5-1 XCT FUNSWT LAW SUBM4-1 JMP PUNSTR ISTAT, ISZ IOMODE IOSTAT, XSTAT LAC FOFFF DAC FO#TEM PUNTAB LAC WORDAD PUNSTR PUNCRR PUNTAB GETARG HELP 722 SMA HELP 723  /NOT FIXED POINT SZL JMP IOST1 /FIXED VARIABLE LAC COMMON TAD (-143 SPA JMP IONORM TAD (-1603 SPA CLA!SKP  /57A LAC (12  /DECTAPE SKP IONORM, LAC COMMON ADD (LAC IOJMAD DAC . 1 XX PUNSTR LAC COMMON DECPUN PUNCRR JMP IOST2 IOJMAD, LAW IOME0-1 LAW IOME1-1 LAW IOME2-1 LAW IOME3-1 LAW IOME4-1 LAW IOME5-1 LAW IOME6-1 LAW IOME7-1 LAW IOME8-1 LAW IOME9-1 LAW IOME10-1 IOME0, TEXT /JMS .IO57A / IOME1, TEXT /JMS .IO1 / IOME2, TEXT /JMS .IO2 / IOME3, TEXT /JMS .IO3 / IOME4, TEXT /JMS .IO4 / IOME5, TEXT /JMS .IO5 / IOME6, TEXT /JMS .IO6 / IOME7, TEXT /JMS .IO7 / IOME8, TEXT /JMS .IO8 / IOME9, TEXT /JMS .IO9 / IOME10, TEXT /JMS .IODEC / IOST1, PVARC IOST2, GETDEC JMP IOST3 DAC COMMON LAW IOM10-1 PUNSTD PUNCRR UNPACK JMP IODONE CHKCOM HELP 725 IOST3, UNPACK JMP IODONE JMP IOLIST IOM10, TEXT / FOR ./ /IOLIST LIST GENERATOR IOLIST, STRESE DZM P#COUNT JMP . 3 ISZ PCOUNT IDXCHR UNPACK JMP IODONE SAD (CHAR R( JMP .-5 GETVAR JMP IODNER DZM X#FIX FIXFLO ISZ XFIX LAC PCOUNT SZA JMP IORR CHKCOM JMP IOAR IOLS2, LAC XFIX RAR LAW IOM2-1 SZL LAW IOM1-1 PUNSTR LAC IOMODE SZA PUNSTR 1 PVARC JMP IOLIST IOAR, UNPACK JMP IOLS2 SAD (CHAR R( SKP JMP IOLS2 IOARRY IOADN, LAW IOM5-1 PUNSTR JMP IOLIST /MORE IOLIST GENERATOR IORR, LAW IOM4-1 PUNSTR GENSYM DAC IO#ENT PUNCH3 PUNCRR GENSYM DAC IO#CONT PUNADG IOARRY IORR1, GENSYM DAC IO#CNT PUNJMP LAC PCOUNT SAD (1 JMP IORR3 GENSYM DAC IO#XCNT IORR2, PUNADG SPDO CHKCOM NOP CLC TAD PCOUNT DAC PCOUNT SNA JMP IOADN LAC IOXCNT DAC IOCONT JMP IORR1 IORR3, LAC IOENT JMP IORR2 IODNER, HELP 724 IODONE, LAC FOTEM DAC FOFFF LAW IOM3-1 JMP PUNSTR /EVEN MORE IO LIST IOARRY, PVSTAK ADVSTK ARITHS NOP LAC XFIX RAR LAW IOM6-1 SZL LAW IOM7-1 JMP PUNSTR IOM1, TEXT . ARX . 561300 IOM2, TEXT . ARF . 744072 130000 IOM3, TEXT . ENDIO . IOM4, TEXT / RPA ./ IOM5, TEXT . JMS DONE . IOM6, TEXT . JMS FARAD . IOM7, TEXT . JMS XARAD . /EVEN EVEN MORE MORE IO LIST SPDO, STRESE SAVE -DN AN DOSTL UNPACK SKP SAD (CHAR R) DOST3 GETFIX CHKRPR LAC VPOIN1 DAC DO3 LAC IOCONT DAC DOG PUNJMP LAC IOCNT PUNADG JMP DODO 1 START