
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
