
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
