FORTRAN II PDP-9 COMPILER
EI=4000
EH=10000

FIODEC

CN=144
TN=120
PN=120
PARN=4
PUSHN=144
POLEN=60

START

FORTRAN II - CAL HANDLER III-A 9-5-63

RET=JMP I-JMS

20/	HELPR
	JMP . 2
	JMP HERE3
	DAC PAC
	JMS .+2
PAC,	0		/SAVED AC
PLK,	0		/SAVED LINK
	ISZ PUSH
	LAC 20
	AND (17777
PUSH,	DAC PSTORE-1	/SAVE EXIT ADDRESS
	ADD (-1
	DAC #PTEM
	LAC I PTEM	/GET SUBROUTINE ADDRESS
	DAC PTEM
	LAW HELPR
	DAC 20
	ISZ LIMIT
	JMP EXITP
	HELP EH 1112

/COPY SUBROUTINE

COPYLP,	0
	ISZ TM#CNT
	SKP
	JMP I COPYLP
TT1,	XX
TT2,	XX
	ISZ TT1
	ISZ TT2
	JMP COPYLP 1

/CAL HANDLER - PAGE 2
/SAVE 1 REGISTER (RESTORE AC  AND LINK)

SAVE1=JMS .
	0
	LAC I PUSH
	TAD (20000
	ISZ PUSH
	DAC I PUSH	/INDEX  NO. OF SAVED ARGS.
	JMS RL6
	AND (37
	ADD (LAC PST-1
	DAC SAVEA
	LAM -1
	ADD PUSH
	DAC PTEM
SAVEA,	XX
	DAC I PTEM
	ISZ LIMIT
	RET SAVE1
	HELP EH 1112

/PUSH N REGISTERS

SAVE=JMS .
	0
	LAC I SAVE-JMS
	DAC TT1
	SKP
	SAVE1
	ISZ TT1
	JMP .-2
	RET SAVE

/CAL HANDLER - PAGE 3
/EXIT ROUTINES

EXIT3=JMP .	ISZ I PUSH
EXIT2=JMP .	ISZ I PUSH
EXIT1=JMP .	ISZ I PUSH
EXIT =JMP .	DAC PAC 		/SAVE AC AND LINK
EXITL,	RAR		/SAVE LINK
	DAC PLK
	LAC I PUSH	/RESTORE OLD AC AND LINK
EXITB,	DAC PTEM
	AND (760000
	SZA
	JMP RESTORE
EXIT1A,	LAM -1
	ADD PUSH
	DAC PUSH
	LAM -1
	ADD LIMIT
	DAC LIMIT
	ADD (PUSHN
	SPA
	HELP EH 1110
EXITP,	LAC PLK
	RAL
	LAC PAC
	JMP I PTEM

EXIT3R=JMP .	ISZ I PUSH
EXIT2R=JMP .	ISZ I PUSH
EXIT1R=JMP .	ISZ I PUSH
EXITR =JMP .	JMP EXITB-1

DSPTCH,	AND (7
	ADD I PUSH
	JMP EXITB

/CAL HANDLER - PAGE 4
/MISC. SUBROUTINES

RESTOR,	JMS RL6
	AND (37
	CMA
	DAC TMCNT
	ADD PUSH
	DAC PUSH
	ADD (LAC-DAC
	DAC COPYLP 4
	LAC (DAC PST
	DAC COPYLP 5
	LAC TMCNT
	ADD LIMIT
	DAC LIMIT
	JMS COPYLP
	JMP EXIT1A

/DISPLAY PARAMETERS

DSPARA=JMS .
	0
	LAM -PARN
	DAC TMCNT
	LAC (DAC PARA 1
	DAC COPYLP 5
	LAC I PUSH
	AND (17777
	ADD (LAC
	DAC COPYLP 4
	JMS COPYLP
	RET DSPARA

RL6,	0
	RTL	RTL	RTL	JMP I RL6

VARIABLES

PST,	PST 10/
PARG,	PARG PARN 1/

PARA=PARG-1

START

FORTRAN II - TAPE 1 SERVICE ROUTINES

FIODEC

/SOME SMALL POOR SUBS - I.E. - SUB- ROUTINES

SPECHR,	SAD (CHAR R
				EXIT	/C.R.
	SAD (CHAR R		EXIT	/TAB
	SAD (CHAR R 		EXIT	/SPACE
	EXIT1

/RETURN WITH THE NEW CHARACTER IN THE AC

NEWCHR,	GCR
	SPECHR
	EXIT
	SAD (74
	JMP NEWCAS
	SAD (72
	JMP NEWCAS
	ADD CASE#M
	EXIT

NEWCAS,	DAC CA#SE
	RAL6
	AND (7700
	DAC CASEM
	JMP NEWCHR

/INITIALIZE ABOVE ROUTINES

SETCHR,	LAC (CHAR R
	DAC SCAN#CH
	LAC (7200
	DAC CASEM
	LAC (72
	DAC CASE			/SET TO LOWER CASE
	DZM UCASE
	EXIT

/PACK AND UNPACK STATEMENT ROUTINES

PACK,	DAC N#CHR
	LAC CASE
	SAD N#CASE
	JMP . 3
	DAC NCASE
	PACK0
	LAC NCHR
PACK0,	AND (77
PACKM,	XX
	JMP PACK1
	JMP PACK2

PACK3,	XOR I CPOINT
	AND (77
	XOR I CPOINT
	DAC I CPOINT
PACK3A,	ISZ CPOINT
	LAW CPOINT CN
	SAD CPOINT
	HELP EH 1606
	LAC (JMP PACKM 1
	DAC PACKM
PACK3B,	LAC NCHR
	EXIT

PACK1,	RAR7
	XOR I CPOINT
	AND (770000
PACK1A,	XOR I CPOINT
	DAC I CPOINT
	ISZ PACKM
	JMP PACK3B

PACK2,	RAL6
	XOR I CPOINT
	AND (7700
	JMP PACK1A

/SET UP THE PACK AND UNPACK ROUTINES

PACKST,	LAW CPOINT
PAKSET,	DAC CPOINT
	LAM -0
	DAC U#PACKT
	LAC (140000
	DAC U#PAKCH
	DZM UCASE
	LAW CPOINT
	DAC U#POINT
	JMP PACK3A

/UNPACK THE STATEMENT

NXTCHR,	IDXCHR
UNPACK,	LAC UPAKCH
	RAL7
	AND (77
	SAD (13
	EXIT			/ALL DONE
	SPECHR
	EXIT1
	SAD (74
	JMP UNPAK0 1
	SAD (72
	JMP UNPAK0
	SAD (14
	JMP NXTCHR
	ADD U#CASE
	EXIT1

UNPAK0,	CLA
	RAL6
	AND (7700
	DAC UCASE
	JMP NXTCHR

UPAK1,	LAC UPAKCH
	JMS RL6
UPAK2,	DAC UPAKCH
	AND (770000
	XCT SPACES
	SZA
	EXITR

IDXCHR,	ISZ UPACKT
	JMP UPAK1
	ISZ UPOINT
	LAM -2
	DAC UPACKT
	LAC I UPOINT
	JMP UPAK2


SPACES,	NOP

/PUNCH STRING

TEMX=17

PUNSTR,	DAC TEMX
	LAM -2
	DAC T#EMCNT
	LAC I TEMX
PUNST1,	DAC T#EMP
	AND (770000
	SAD (130000
	EXIT
	SAD (140000
	SKP
	PUNCH1
	LAC TEMP
	RAL6
	ISZ TEMCNT
	JMP PUNST1
	JMP PUNSTR+1

/PUNCH THE SYMBOL IN COMMON

PUNADR,	PUNSYM
PUNCOM,	LAW CHAR R,
PUNCHR,	JMP PUNCHW

PUNSTY,	PUNSTR
PUNSYM,	LAC COMMON
	PUNCH3
	LAC COMMON 1
	JMP PUNCH3

PUNPER,	LAW CHAR R.
	JMP PUNCHW

PUNSTD,	PUNSTR
	LAC COMMON
	JMP DECPUN

PUNDCC,	DECPUN
	JMP PUNCRR

PUNADG,	DAC TEMCNT
	PUNPER
	LAC TEMCNT
	PUNCH3
	JMP PUNCOM

PUNJMP,	DAC TEM#
	LAW DOGOM-1
	PUNSTR
	LAC TEM
	JMP DIMV4


/GET THE NEXT ARGUMENT


GETARG,	GETSYM
	JMP GETA0		/NO MORE CHARACTERS
	JMP GETA1		/A NUMBER OR VARIABLE
	EXIT			/A PUNCTUATION

GETA0,	CLA			/0 MEANS EMPTY
	EXIT

GETA1,	DSPTCH
	JMP GETA2
	JMP GETA3

GETA4,	PVSTAK
	FIXFLO
	JMP . 3
	LAC (2
	JMP GETA5
	LAC (3
	JMP GETA5

GETA2,	PCSTAK
	LAC (1)
	JMP GETA5

GETA3,	FLCONS
	DAC COMMON 1
	LAC (FLEX .   1414
	DAC COMMON
	PVSTAK
	CLA

GETA5,	DAC IND#CAT	/EXIT FROM HERE WITH AC
	UNPACK		/00 MEANS A FLOAT CONSTANT
	JMP . 3		/01 MEANS A FIXED CONSTANT
	SAD (CHAR R,	/10 MEANS A FLOAT VAR
	IDXCHR		/11 MEANS A FIXED VAR
	LAC INDCAT	/FIRST BIT IN THE LINK
	RTR		/SECOND IN ACO
	EXIT1

/SOME MORE MISC SMALL SUBS

CHKCOM,	LAW CHAR R,
CHKNXT,	AND (7777
	DAC TEMC
	UNPACK
	EXIT
	SAD TEMC
	SKP
	EXIT
	IDXCHR
	EXIT1

CHKLPR,	LAW CHAR R(
	CHKNXT
	HELP 702
	EXIT

CHKRPR,	LAW CHAR R)
	CHKNXT
	HELP 703
	EXIT

GETFIX,	GETARG
	HELP 1201
	SMA
	HELP 1202
	LAC VPOIN1
	EXIT

GETVAR,	GETSYM
	EXIT
	SKP
	EXIT
	SAD (2
	EXIT1
	EXIT

GETCON,	GETARG
	EXIT
	LAC INDCAT
	SAD (1
	EXIT1
	HELP 1203
	EXIT

GETFXV,	GETFIX
	AND (300000
	SZA
	HELP 1204
	JMP GETVAR-2


/SCAN ROUTINE - PACK STATEMENT, DISPATCH ON TYPE

SCAN,	SAVE	-AN
	DZM C#COMMA
	DZM C#EQUAL
	DZM STAT#NI
	CLEARI
	LAC (12
	DAC CTEN
	PACKST
	PUNCRR
	LAC SCANCH
SCANA,	SAD (CHAR R
	JMP SCANS
	SAD (7263
	JMP SCANC
	SAD (7222
	JMP SCANC 2
	SKP

SCANBG,	NEWCHR
	SAD (CHAR R		/TAB
	JMP SCANTB
	DAC PAC
	AND (7700
	SAD (7200
	SKP
	HELP 701
	LAC PAC
	AND (77
	DIGIT
	HELP 701
	LAC I2
	DAC ST#NUM
	LAW
	DAC FOFFF
	DAC STATNI
	JMP SCANBG

SCANTB,	NEWCHR
	SAD (CHAR R	
	JMP SCANTB
	JMP SCAN0 1

SCANS,	NEWCHR
	JMP SCANA

/MORE SCAN

	CAL SCAN1
SCAN0,	NEWCHR
	SAD (CHAR R
	JMP SCAN0A		/DONE
	PACK
	SAD (7257
	JMP SCAN0-1
	SAD (7255
	HELP 704
	SAD (7233
	ISZ CCOMMA
	SAD (FLEX  =
	ISZ CEQUAL
	JMP SCAN0

	CAL SCAN1
SCAN1,	NEWCHR
	SAD (CHAR R
	JMP SCAN1A
	PACK
	SAD (7257
	JMP SCAN1-1
	SAD (7255
	EXIT
	JMP SCAN1

SCAN0A,	SCAN2
	JMP SCAN0
	JMP SCAN3

SCAN1A,	SCAN2
	JMP SCAN1
	HELP 705

SCAN2,	NEWCHR
	DAC SCANCH
	SAD (7440
	SKP
	EXIT1
	NEWCHR
	SAD (CHAR R	
	EXIT
	JMP .-3

SCAN3,	LAW 13
	PACK
	LAC CEQUAL
	SNA
	JMP CONTROL
	LAC CCOMMA
	SZA
	JMP DOSTAT
	JMP ARITH

SCANC,	LAW CHAR R/
	PUNCHW
	COPY
	JMP SCANS

/GET SYMBOL

GETSYM,	UNPACK		/GET NEXT CHARACTER
	EXIT		/ALL DONE
	CHRTYP
	JMP GETSN	/DIGIT
	JMP GETSY	/LETTER
	SAD (CHAR R.	/OTHER
	JMP GETSN
	EXIT2R		/"PUNCT" - LEARN

GETSN,	GETNUM
	EXIT1

GETSY,	DAC NCHR
	LAC (141414	/ALPHANUMERIC SYMBOL IN
	DAC COMMON	/SET UP TO READ AND PACK
	DAC COMMON+1
	LAM -6
	DAC TEMCNT
	LAW COMMON-1
	DAC CPOINT
	PACK3A

GETSY1,	GETPAK
	NXTCHR
	JMP GETSY2
	CHRTYP
	JMP GETSY1
	JMP GETSY1

GETSY2,	LAW CHAR R.
	GETPAK
	LAC (2
	EXIT1

GETPAK,	ISZ TEMCNT
	PACK0
	LAC TEMCNT
	SNA!CLC
	DAC TEMCNT
	EXIT


/UN PEU SUB

GETOPN,	SAD (FLEX  ^	LAW EXPOP
	SAD (FLEX  *	LAW MULOP
	SAD (FLEX  +	LAW ADDOP
	SAD (FLEX  =	LAW EQUOP
	SAD (FLEX   /	LAW DIVOP
	SAD (FLEX   -	LAW SUBOP
	SAD (FLEX   (	LAW UNOPEN
	SAD (FLEX   )	LAW CLOSEO
		SAD (FLEX   ,	LAW COMOP
	AND (17777
	EXIT

START

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

FORTRAN II - TAPE 3 - DIAGNOSTIC

TELETYPE

HELPR,	0
	DAC S#VAC
	LAW
	JMS TYP1
	LAM -1
	ADD HELPR
	DAC TE#MH
	LAC I TEMH
	DAC TEMH
	RTR	RTR	RTR
	AND (17
	ADD (LAC ERRTAB
	DAC .+1
	XX
	JMS TYP1
	JMS TYP1
	JMS TYP1
	LAC (660000
	JMS TYP1
	LAC TEMH
	RTR
	RAR
	JMS TYPDIG
	LAC TEMH
	JMS TYPDIG
	LAC (101000
	JMS TYP1
	JMS TYP1
	LAC STNUM
	DECPNT
	LAC (200476	/PRINT STATEMENT NUMBER
	JMS TYP1
	JMS TYP1
	JMS TYP1
	LAW CPOINT
	CMA
	ADD UPOINT
	DAC TEMH1
	RCL
	ADD TEMH1#
	ADD UPACKT
	CMA
	ADD (1
	DAC MARK
	LAW CPOINT 1
	JMS TOC
	LAC TEMH
	AND (14000
	SNA
	JMP HELPX
	SAD (EI
	JMP GO
	HLT
	JMP .-1
HELPX,	LAC HELPR
	RAL
	LAC SVAC
	JMP I HELPR

TYP1,	0
	JMS RL6
	JMS TYPIT
	JMP I TYP1

DIGTAB,	CHAR L0	CHAR L1	CHAR L2	CHAR L3
	CHAR L4	CHAR L5	CHAR L6	CHAR L7

TYPDIG,	0
	AND (7
	ADD (LAC DIGTAB
	DAC .+1
	XX
	JMS TYP1
	JMP I TYPDIG
/LINE PRINT ROUTINE
TOC,	0
	DAC BUF#P
TOC0,	LAM -2
	DAC CHA#C
	LAC I BUFP
TOC1,	JMS RL6
	DAC COM#2
	RAL
	AND (77
	ADD (XCT TUPTAB
	DAC COTA
COTA,	XX
	STL
	JMS RL6
	SMA
	SKP
	JMS TYP1
	JMS TYP1
	JMS TYP1
COTB,	ISZ MAR#K
	JMP TOC2
	LAC (200000
	JMS TYP1
TOC2,	LAC COM2
	ISZ CHAC
	JMP TOC1
	ISZ BUFP
	JMP TOC0
TOC3,	LAC (42000
	JMS TYP1
	JMS TYP1
	JMP I TOC
TUPTAB,	LAW 10
	LAW 6672
	LAW 6662
	LAW 6640
	LAW 6624
	LAW 6602
	LAW 6652
	LAW 6670
	LAW 6630
	LAW 6606
	JMP COTB
	JMP TOC3
	JMP COTB
	JMP COTB
	JMP COTB
	JMP COTB
	LAW 6632
	LAW 6656
	LAW 50
	LAW 2
	LAW 70
	LAW 36
	LAW 62
	LAW 56
	LAW 52
	LAW 42
	JMP COTB
	LAW 6614
	JMP COTB
	JMP COTB
	LAW 6650
	JMP COTB
	JMP COTB
	LAW 64
	LAW 74
	LAW 22
	LAW 16
	LAW 14
	LAW 6
	LAW 32
	LAW 72
	LAW 24
	JMP COTB
	JMP COTB
	LAW 6660
	LAW 6622
	JMP COTB
	LAW 6674
	JMP COTB
	LAW 60
	LAW 46
	LAW 34
	LAW 44
	LAW 40
	LAW 54
	LAW 26
	LAW 12
	LAW 30
	JMP COTB
	LAW 6616
	JMP COTB
	JMP COTB
	JMP COTB
	JMP TOC3

/ERR CODE TABLE

ERRTAB,	FLEX WHA
	FLEX CON
	FLEX COM
	FLEX ASG
	FLEX SUB
	FLEX DIM
	FLEX DO 
	FLEX ILF
	FLEX ICH
	FLEX DIT
	FLEX UFX
	FLEX FOR
	FLEX WHO
	FLEX IFU
	FLEX SCE

HELP=CAL I

FIODEC

CHRTY1,	HELP 1001
	NXTCHR
	HELP 1004

CHRTYP,	SAD (FLEX  +	EXIT2
	SAD (FLEX  =	EXIT2
	SAD (FLEX  *	EXIT2
	SAD (FLEX  ^	EXIT2
	AND (7)
	ADD (LAC TYPTAB
	DAC CHRTYA
	LAC PAC
	AND (7700
	SZA
	HELP 1002
	LAC PAC
	RTR
	RAR
	AND (7
	ADD (-7
	DAC TT1
CHRTYA,	XX
	RTR
	ISZ TT1
	JMP .-2
	AND (3
	TAD (-0
	SPA
	JMP CHRTY1
	JMP DSPTCH

TYPTAB,	054210
	275250
	221040
	227054
	221340
	221340
	221040
	221340

START

FORTRAN II - TAPE 4 FORMAT ETC.

/PUNCH JUMPS AROUND NON-EXECUTABLE STATEMENTS

FIODEC

XSTAT,	LAC #XVAR
	SNA
	JMP XSTATN
	LAC XVAR
	PUNADG
	DZM XVAR
XSTATN,	XCT XSTATW
	SKP
	JMP XSTATQ
	XCT SWITCH
	SKP
	JMP XSTATO
	LAW XSTATM-1
	PUNSTR
	CLL!CLC
	660000		/SIGN TO LINK IF EAE
	LAW NARMES-1
	SZL
	LAW EARMES-1
	PUNSTR
	LAW XSTATP-1
	XCT WSIZE
	SKP
	PUNSTR
XSTATO,	LAC (SKP
	DAC XSTATW
	JMP XSTATQ

NXSTAT,	LAC XVAR
	SZA
	JMP XSTATQ
	GENSYM
	DAC XVAR
	PUNJMP

XSTATQ,	LAC STATNI
	SMA!CMA
	EXIT
	DAC STATNI
	PUNPER
	LAC STNUM
	DECPUN
	JMP PUNCOM

XSTATF,	XSTAT
	JMP SETFIX

XSTATM,	TEXT .	CALST
.
XSTATP,	TEXT .	SET2W
.
NARMES,	TEXT .	EXTERNAL NARITH
	JMS NARITH
.
EARMES,	TEXT .	EXTERNAL EARITH
	JMS EARITH
.

/CODING FOR FORMAT STATEMENT

FORMAT,	NXSTAT
	CHKLPR
	DZM FORMPC
FORMLP,	CLC
	TAD FORMPC
	DAC FOR#MPC
	LAC (200000
	DAC FOR#ML	/LEFT TERMINATOR COUNTER

FORM1,	DZM FOR#MD
	GETDEC
	CLA
	DAC F#ORMR
	UNPACK
	JMP FORNUL

FORM2,	SAD (CHAR RH	JMP FORMH
	SAD (CHAR RI	JMP FORMI
	SAD (CHAR RF	JMP FORMF
	SAD (CHAR RE	JMP FORME
	SAD (CHAR RX	JMP FORMX
	SAD (CHAR RA	JMP FORMA
	JMP FORNUL

FORMI,	IDXCHR
	GETDEC
	LAC (10
	DAC FO#RMW
	LAW 1
	JMP FORMF2 1

FORME,	LAW 3
	SKP
FORMF,	LAW 2
	DAC FORMF2
	IDXCHR

FORMF1,	GETDEC
	LAC (20
	DAC FORMW
	LAW CHAR R.
	CHKNXT
	JMP FORMF2
	GETDEC
	LAC (12
	DAC FORMD

FORMF2,	XX
	GATHER
	JMP GATHR2

FORMA,	IDXCHR
	GETDEC
	LAC (1
	DAC FORMW
	LAW 6
	JMP FORMF2 1

/FORMAT - PAGE 2


FORMH,	LAC (SKP
	DAC SPACES
	LAC FORMR
	CMA
	DAC TEM#C

	LAW 5
	GATHR1

	LAW FORMHM-1
	PUNSTR
	DZM SC#ASE
	JMP FORMH3

FORMH1,	UNPACK
	JMP FORMH4
	DAC TEM
	LAC UCASE
	SAD SCASE
	JMP FORMH2
	DAC SCASE
	SNA
	LAC (7200
	RAR6
	PUNCHW
FORMH2,	LAC TEM
	PUNCHW
FORMH3,	IDXCHR
	ISZ TEMC
	JMP FORMH1

FORMH4,	LAC SCASE
	SNA
	JMP . 3
	LAC (72
	PUNCHW
	PUNCRR
	LAC (NOP
	DAC SPACES
	LAC UPAKCH	/FLUSH SPACES
	CAL UPAK2
	UNPACK
	JMP GATHR2
	CHRTYP
	JMP FORMCM
	JMP FORMCM
	JMP GATHR2

FORMHM,	TEXT .	TEXT 
.

/FORMAT - PAGE 3

FORMSL,	LAC (400000
	JMP FORM1-1

FORMCM,	DZM FORML
	JMP FORM1

FORMRP,	ISZ FORMPC
	JMP FORMCM
	PUNTAB
	LAC (600000
	DAC COMMON
	JMP PUNDCC

/COMBINE THE FORMAT SPECS INTO ONE WORD AND OUTPUT

GATHER,	DAC TEM
	LAC FORMR
	CLL
	AND (17
	RAL4
	LAC FORMD
	AND (17
	ADD PAC
	RAL5
	LAC FORMW
	AND (37
	ADD PAC
	DAC FORMR
	LAC TEM

GATHR1,	RAR6
	AND (160000
	ADD FORML
	ADD FORMR
	DAC TEM
	PUNTAB
	LAC TEM
	JMP PUNDCC

FORNUL,	CLA
	GATHR1
	JMP GATHR2
FORMX,	LAW 4
	GATHR1
	IDXCHR
GATHR2,	UNPACK
	CLA
	IDXCHR
	SAD (CHAR R,	JMP FORMCM
	SAD (CHAR R/	JMP FORMSL
	SAD (CHAR R)	JMP FORMRP
	SAD (CHAR R(	JMP FORMLP
	HELP 1302
	JMP FORMRP 2

START

4-TRAN OUTPUT AND OVERHEAD ROUTINES

FIODEC
AUTOG0=10	AUTOG1=11

/SEARCH ROUTINE

SEARCH,	DAC #SEARCA
	AND (17777
	SNA
	EXIT
	LAC PAC
	DAC #SEARCC
	RAL5
	AND (17
	CMA
	DAC #SEARCT	/COUNT OF COMPARISONS
	LAC (SAD COMMON
	DAC SP#OINT
SELOOP,	LAC I SEARCA
	DAC #SEARCB
	LAC SEARCT
	DAC #SEARCN
	JMP SELOO1

SELOO2,	ISZ SEARCA
	LAC I SEARCA
	XCT SPOINT
	JMP SEARCS
	LAC SEARCB
	SNA
	EXIT
	DAC SEARCC
	DAC SEARCA
	JMP SELOOP-2

SEARCS,	ISZ SPOINT
SELOO1,	ISZ SEARCN
	JMP SELOO2
	LAC SEARCC
	EXIT1

NFREE,	0		/NEXT FREE REGISTER
TYPE0,	100000		/DUMMY SYMBOL TABLE
TYPE1,	100000		/DIMENSIONED VARIABLE
TYPE2,	140000		/FLOATING POINT CONSTANT
TYPE3,	100000		/USED FUNCTION
TYPE4,	100000		/COMMON
TYPE5,	100000		/DIMENSIONED DUMMY SYMBOL
TYPE6,	100000		/DECLARED TYPES

ADVSTK,	LAW POLEND-1
	SAD IT
	HELP SCE 1
	LAC #VPOIN1	/ADVANCE POINTER
	ISZ IT
	DAC I IT
	EXIT

PVSTAK,	LAM -3		/PUT VARIABLES IN STACK
	ADD VPOINT
	DAC VPOINT
	DAC VPOIN1
	CMA
	ADD NFREE
	SMA
	HELP SCE 2
	LAC COMMON
	DAC I VPOINT
	ISZ VPOINT
	LAC VPOINT
	SAD NFREE
	HELP SCE 2
	LAC COMMON+1
PCCOM,	DAC I VPOINT
	ISZ #VARS
	EXIT

INSERT,	DSPARA		/INSERT INTO LIST
	LAC PAC
	AND (17
	DAC #NUMINS
	XCT PARA+1
	AND (17777
	SNA
	JMP FINSERT
	XCT PARA+1
	SEARCH
	SKP
	EXIT1
CINSERT,	LAC NFREE
	DAC I SEARCC
	DAC SEARCB
	DZM I SEARCB
	ISZ SEARCB
	ADD NUMINS
	DAC NFREE
	ISZ NFREE
	CMA
	ADD VPOINT
	SPA
	HELP SCE 3
	LAC NUMINS
	CMA
	DAC NUMINS
	ISZ NUMINS
	LAW COMMON
	DAC #TEMP

INLOOP,	LAC I TEMP
	DAC I SEARCB
	ISZ TEMP
	ISZ SEARCB
	ISZ NUMINS
	JMP INLOOP
	LAC I SEARCC
	EXIT2

FINSERT,	XCT PARA+1
	XOR NFREE
	DAC I PARA+1
	LAC NFREE
	JMP CINSERT+2

/GENERATE SYMBOL ROUTINE

GENSYM,	ISZ RIGHT
	LAW GETEND+1
	SAD RIGHT
	JMP NRIGHT
GEN2,	CLL!CLA
	XOR (6100
	XOR I MIDDLE	RAL6
	XOR I RIGHT
	EXIT

NRIGHT,	ISZ MIDDLE
	SAD MIDDLE
	HELP SCE 4
NRI2,	LAW GETAB
	DAC RIGHT
	JMP GEN2

MIDDLE,	LAW GETAB
RIGHT,	LAW GETAB-1

/PUT CONSTANT IN STACK

PCSTAK,	LAM -2
	ADD VPOINT
	SAD NFREE
	HELP SCE 5
	DAC VPOINT
	XOR (300000
	DAC VPOIN1
	LAC COMMON
	JMP PCCOM

/RESTORE
RESET1=JMS .	0
	LAW GETAB-1
	DAC RIGHT
	DAC MIDDLE
	ISZ MIDDLE
	JMP I RESET1-JMS

RESET,	CLC
	DAC #EXPCOT
	DZM STNUM
	DZM EXTSWT
	LAW 1
	DAC #TYPSWT
	DZM #NORSWT
	DZM #XVAR
	DZM DO#NUM
	DZM #COMSWT
	LAC NOPER
	DAC #SPACES
	DAC #XSTATW
	DAC WSIZE
	DAC #SWITCH
	DAC #FUNSWT
	DZM #FOFFF
	LAC #END
	DAC NFREE
	LAC (100000
	DAC TYPE0
	DAC TYPE1
	DAC TYPE3
	DAC TYPE4
	DAC TYPE5
	DAC TYPE6
	LAC (140000
	DAC TYPE2
	LAC (LAC I POLISH
	DAC TOP
	DZM #NUMAX
	LAC (CMT CRTURN
	DAC POLISH
	LAC THEEND
	DAC VPOINT
STRESET,	LAW POLISH
	DAC IT
	DAC #VARS
	DZM #ACIND
	DZM TEM#IND
	DZM #OVSYM
	DZM NUM#TEM
	EXIT

GETAB,	CHAR RA	CHAR RB	CHAR RC	CHAR RD	CHAR RE
	CHAR R1	CHAR RG	CHAR RH	CHAR RI	CHAR RJ
	CHAR RK	CHAR RL	CHAR RM	CHAR RN	CHAR RO
	CHAR RP	CHAR RQ	CHAR RR	CHAR RS	CHAR RT
	CHAR RU	CHAR RV	CHAR RW	CHAR RX	CHAR RY
GETEND,	CHAR RZ

POPTOP,	LAC TOP
	ADD (LAW-LAC-I-1
	DAC IT
TOPPOP,	LAM -1
	ADD TOP
	DAC TOP
	LAC I TOP
	SMA
	JMP TOPPOP
	EXIT

PTYPE1,	LAC TYPE1
	AND (17777
	SNA
	JMP PTYPE2
	DAC AUTOG1
	DAC #PTEMP
	LAC I AUTOG1
	DAC COMMON
	LAC I AUTOG1
	DAC COMMON+1
	LAC TYPE4
	SEARCH
	SKP
	JMP P4COM
	LAC I AUTOG1
	PUNADG
	PUNTAB
	LAC I AUTOG1
	DAC COMMON+3
	LAC (LAC FPSC
	FIOFLP
P4COM,	LAC I PTEMP
	JMP PTYPE1+1

FPSC,	FLEX .  +77		/.,SPACE,CRT

RAR9,	RAR
RAR8,	RAR
RAR7,	RAR
RAR6,	RAR
RAR5,	RAR
RAR4,	RAR
RAR3,	RAR
RAR2,	RTR
	EXIT


PTYPE2,	LAC TYPE2
	AND (17777
	SNA
	JMP PTYPE4
	DAC AUTOG1
	DAC PTEMP
	ADD (3
	WSIZE
	DAC #PTEMP2
	LAC I PTEMP2
	PUNADG
	LAM -1
	XCT WSIZE
	LAM -2
	DAC PTEMP2
IPT2LO,	PUNTAB
	LAC I AUTOG1
	DECPUN
	ISZ PTEMP2
	JMP IPT2LO
	PUNCRR
	LAC I PTEMP
	JMP PTYPE2+1

PUNCH3,	PUNCH1
	SKP
PUNCH2,	RAL
	PUNCH1+1
	SKP
PUNCH1,	RAL
	RAL6

PUNCHW,	DAC #PUNCHS
	AND (77
	SAD (14
	JMP PUNCHX
	PARITY
	ADD (200
	IPB
PUNCHX,	LAC PUNCHS
	EXIT

RAL9,	RAL
RAL8,	RAL
RAL7,	RAL
RAL6,	RAL
RAL5,	RAL
RAL4,	RAL
RAL3,	RAL
RAL2,	RTL
	EXIT


PTYPE4,	LAW TEMMES-1
	PUNSTR
	LAC COMSWT
	SNA
	JMP PTYPE6
	LAC EXTSWT
	RAR
	LAW XNDMES-1
	SNL
	LAW ENDMES-1
	PUNSTR
	DZM EXTSWT
	LAC TYPE4
PTYPE5,	AND (17777
	SNA
	JMP PTYPE6
	DAC AUTOG1
	DAC #PTEMP
	LAC I AUTOG1
	DAC COMMON
	LAC I AUTOG1
	DAC COMMON+1
	LAC TYPE1
	SEARCH
	JMP NDIMV
	ADD (2
	DAC AUTOG1
	LAC I AUTOG1
	DAC COMMON+1
	LAC I AUTOG1
	DAC COMMON+3
	LAC (LAC FPMT
	FIOFLP
	LAC COMMON+1
	PUNADG
COMRET,	PUNCRR
	LAC I PTEMP
	JMP PTYPE5

NDIMV,	LAW 1
	DAC COMMON+3
	LAC (LAC FPMT
	FIOFLP
	PUNADR
	JMP COMRET

FPMT,	FLEX .- +36

SCE=EH 1600

COMMON,	COMMON+4/
IT,	LAW POLISH

TEMMES,	TEXT .TEM,
.
ENDMES,	TEXT .

END/
.
XNDMES,	TEXT .

XND/
.
TEMME2,	TEXT .TEM+.
TEMME3,	TEXT ./

START
.

PTYPE6,	PUNCRR
	LAC NUMAX
	SZA
	CMA
	AND (17777
	DAC COMMON
	LAW TEMME2-1
	PUNSTD
	LAW TEMME3-1
	JMP PUNSTR

/DETERMINE FLOATING POINT WORD SIZE

WSIZE,	XX		/SET TO NOP OR SKP
	ADD (1
	EXIT

/FIXED OR FLOATING AND PUNCH

FIOFLP,	DAC FFPUN
	FIXFLO
	JMP FFPUN
	LAC COMMON+3
	AND (17777
	RCL
	XCT WSIZE
	ADD COMMON+3
	DAC COMMON+3
FFPUN,	HLT
	PUNCH2
	LAC COMMON+3
	AND (17777
	DECPUN
	LAC (CHAR R/
	PUNCHW
	XCT FFPUN
	JMP PUNCHW


/DETERMINE MODE OF IDENTIFIER

FIXFLO,	LAC COMMON
	SNA!CMA		/ZERO DENOTES FIXED
	EXITR
	SNA!CMA		/ZERO DENOTES FLOATING
	EXIT1R
	AND (-7777	/MASK TO FIRST CHARACTER
	SAD (CHAR L.	/CHECK FOR FLOATING CONSTANT
	EXIT1R		/YES, SO FLOATING EXIT
	LAC TYPE6
	SEARCH		/SEE IF DECLARED VARIABLE
	JMP FUNNOR	/NO, SO PROCESS ACCORDING TO NORMAL MODE
	LAC I SPOINT	/GET MODE IDENTIFIER
FUNNY2,	AND (3
	DSPTCH		/DISPATCH ON MODE TYPE
	EXITR		/FIXED POINT VARIABLE
	JMP FUNREG	/FORTRAN TYPE
	HLT		/NOT ASSIGNED
	EXIT1R		/FLOATING POINT VARIABLE

FUNNOR,	LAC TYPSWT
	JMP FUNNY2

FUNREG,	LAC COMMON+1
	SAD (FLEX F. +14
	JMP FUNYES
	AND (7777
	SAD (FLEX  F.
	JMP FUNYES
	AND (77
	SAD (FLEX   F
SKPCON,	SKP
	JMP REGFOR
FUNYES,	LAC COMMON
	AND (770000
	SAD (CHAR LX
	EXITR
	EXIT1R

REGFOR,	LAC COMMON
	AND (770000
	SAD (710000
	EXITR
	SMA
	EXIT1R
	ADD (320000
	SPA
	EXITR
	EXIT1R

/PARITY GENERATION ROUTINE

PARITY,	DZM #PARITC
	JMP .+3
	SZL
	ISZ PARITC
	CLL!SZA!RAR
	JMP PARITY+2
	LAC PARITC
	RAR
	SZL
	EXIT1R
	EXITR

/FLOATING CONSTANT LOOKUP
/RETURNS WITH GEN. SYMBOL IN AC

FLCONS,	LAW COMMON+2
	WSIZE
	DAC FLCO1
	GENSYM	/VALUE OF CONSTANT IS IN COMMON-COMMON+1 OR 2
	DAC I FLCO1
	LAW 3
	WSIZE
	INSERT
	LAC TYPE2
	JMP .+3
	LAC I #FLCO1	/NEW DEFINITION
	EXIT
	ADD (3		/SET TO PICK UP SYMBOL ALREADY DEFINED
	WSIZE
	DAC SEARCC	/FREE AT THIS TIME
	LAC I SEARCC	/PICK UP GEN. SYMBOL
	EXIT

/DECIMAL INTEGER PUNCH SUBROUTINE

DECPNT,	LAC (DECPR2
	JMP DCPUN2
DECPUN,	DAC PAC
	LAC (PUNCHW
DCPUN2,	DAC DECIOS
	DAC DECIO2
	LAC PAC
	CLL!SMA
	CMA!CML
	DAC DCPN#UM
	LAW CHAR R-
	SNL
DECIOS,	XX
	LAC (ADD DCPTAB
	DAC DCPLOP 2
	LAM -4
	DAC DCPC#NT
	LAC (SZA
	DAC DCPMOD

DCPGDG,	DZM DCPD#IG
	LAC DCPNUM
	JMP . 3

DCPLOP,	DAC DCPNUM
	ISZ DCPDIG
	XX
	SPA
	JMP DCPLOP
	ISZ DCPLOP 2
	LAC DCPDIG
DCPMOD,	XX
	JMP DPPUN
	ISZ DCPCNT
	JMP DCPGDG
	LAC DCPNUM
	CMA
	SNA
	LAW 20
	JMP I DECIOS
DECPR2,	JMS TYPDIG
	EXIT

DPPUN,	SNA
	LAW 20
DECIO2,	XX
	LAC (OPR
	DAC DCPMOD
	JMP DCPMOD+2

DECIMAL

DCPTAB,	100000	10000	1000	100	10	1


OCTAL

START

/4TRAN INSTRUCTION GENERATOR ROUTINE

IGROU,	DZM #OVSYM
	XCT TOP
	SPA!RAL		/BIT 0 IS "COMMUTE" BIT
	COMMUTE
	SPA		/BIT 1 IS "LAC-1" BIT
	LC1

ALIG,	LAC #FOFFF
	RAR		/+0 IS FIXED, -0 FLOATING, OTHER NONDET
	XCT TOP
	AND (17
	RAL
	SAD (1
	LC1
	ADD (LAC OPTAB
	DAC . 1
	XX
	DAC ALWORD

ALLOOP,	LAM -2
	DAC #ALCOUT
	LAW DTABIG-2
	DAC AUTOG0
ALWORD,	XX
	ISZ .-1
	RAL6
	DAC #ALTEM4
	RAL
	AND (77
	DAC DTABT
	ISZ AUTOG0
	SAD I AUTOG0
	JMP I AUTOG0
	JMP .-3

/DISPATCH ON IG CODES

DTABIG,	34	JMP UNSETM
	12	JMP EQUAS
	35	JMP IFOO2
	75	JMP IFOO
	76	JMP IFOO
	13	JMP ALDONE
	32	JMP ALWOR0
	15	JMP ALARG2
	14	JMP ALARG1
	33	JMP ALARGM
	37	JMP IFTEMZ
	16	JMP OVRUND
	17	JMP ALARG3
DTABT,	0


ALRETR,	PUNCHW
ALRETU,	ISZ ALCOUT
	SKP
	JMP ALLOOP
	LAW DTABIG-2
	DAC AUTOG0
	LAC A#LTEM4
	JMP ALWORD+2

IFOO2,	LAC (74
IFOO,	ADD (-73
	ADD TOP
	DAC ALTEM3
	PUNPER
	XCT ALTEM3
	PUNDCC
	JMP ALRETU

UNSETM,	CLC
	DAC FOFFF
	LAW 36
	JMP ALRETR

NOTHER,	LAC I ALTEM3
	AND (DAC
	CLC!SNA
	CLA
	JMP MODEA1

OVRUND,	CAL .+2
	JMP ALRETU
	OVFOO
	JMP NOTHER
	LAC I ALTEM3
	FUNQUR
	MODEA1

OVRET,	LAC I ALTEM3
	DAC ALTEM3
	LAC I #ALTEM3
	DAC COMMON
	ISZ ALTEM3
	LAC I ALTEM3
	DAC COMMON+1
OVMID,	LAC TYPE4
	SEARCH
	SKP
	EXIT
	LAC TYPE1
	SEARCH
	SKP
	EXIT
	LAC COMMON
	AND (770000
	SAD (730000
	EXIT
	FIXFLO
	CLA!SKP
	LAC (602414		/(UC-UNDERBAR-LC)-(141456)
	ADD (141456
	DAC OVSYM
	EXIT

OVFIX,	CLA
	SAD FOFFF
	EXIT2
	PUNTAB
	LAC PARA+1
	PUNCH3
	CLA
	JMP PFC

PUNTAB,	LAW 36
	JMP PUNCHW

PFIXI,	PUNTAB
	LAC PARA+2
	PUNCH3
	CLC
PFC,	DAC FOFFF
	PUNCRR
	EXIT2

ALDONE,	LAM -1
	ADD TOP
	DAC IT
	DAC ACIND
	DZM I ACIND
	SAD (LAC I POLISH
	SKP
	DZM I IT
	EXIT

ALARGM,	LAM -1
	SKP

ALARG3,	LAC (3
	SKP

ALARG2,	LAC (1
	SKP

ALARG1,	LAC (2
	ADD TOP
	PVAR
	JMP ALRETU

COMMUTE,	LAC TOP
	DAC #ALTEM1
	ISZ ALTEM1
	LAC I ALTEM1
	SZA!CMA
	EXITR
	TAD TOP
	DAC ACIND
	LAC I ACIND
	DAC I ALTEM1
	DZM I ACIND
	EXITR

LC1,	DAC #LCTEMX
	LAM -1
	ADD TOP
	DAC ALTEM1
	LAC I ALTEM1
	SNA
	JMP LCXIT
	ACINUT
	LAC I ALTEM1
	AND (TAD
	SAD (LAC
	SKP!CLA
	SAD (XOR
	JMP STLC2
	SAD (JMS
	CLA!SKP
	SAD (DZM
	JMP STLC2
	LAC I ALTEM1
	AND (ADD
	SAD (ADD
	SKP!CLC
	SETLC1
LC4,	CMA
	MODES-1
	LAC (FLEX 	LA
	PUNCH3
	PULAC
	LAC ALTEM1
	PVAR
	LAC ALTEM1
	DAC ACIND
	DZM I ALTEM1
LCXIT,	LAC LCTEMX
	EXIT

STLC2,	SZA!CMA
	CLA
	JMP LC4

PULAC,	LAC (FLEX C  
	JMP PUNCH2

ACINUT,	LAC ACIND
	SNA
	EXIT

ACINU,	SETSAV
	DAC I ACIND
	LAC (FLEX 	DA
	PUNCH3
	PULAC
	LAC ACIND
	DZM ACIND
	JMP PVAR

SETSAV,	DSPARA
	LAC FOFFF
	AND (40000
	ADD (100000
	ADD #NUMTEM
	XCT PARA+1

SETSE2,	LAC FOFFF
	AND (1
	XCT WSIZE
	RCL

SETSET,	ADD (1
	ADD NUMTEM
	DAC NUMTEM
	ADD #NUMAX
	SPA!CLL
	STL
	LAC NUMTEM
	SNL!CMA
	DAC NUMAX
	EXIT1

PVAR,	DAC ALTEM3
	LAC I ALTEM3
	DAC #PVART
	DAC #INDIND
	RAL4
	AND (3
	DSPTCH

PDIST,	JMP PVAR0
	JMP PVAR1
	JMP PVAR2
PVAR3,	LAC I PVART
	DAC COMMON
	LAW PARMES-1
	JMP PUNDCR

PARMES,	TEXT .(.

EXTPUN,	LAW EXTMES-1
	PUNSYC
	JMP PUNCRR

PVAR0,	LAC I PVART
	DAC COMMON
	ISZ PVART
	ISZ ALTEM3
	LAC I PVART
	DAC COMMON+1
	LAC I ALTEM3
	SAD (CMT UNOP1
	SKP
	JMP PVARC
	DZM I ALTEM3
	LAC FOFFF
	DAC #OLDMOD
	DUMSYM
	JMP PVARR2
	LAC TYPE1
	SEARCH
	SKP
	JMP PVARR
	LAW 2
	INSERT
	LAC TYPE3
	JMP PVARR
	EXTPUN

PVARR,	FUNXF
	CMA
	DAC FOFFF#1
PVARR2,	DZM OVSYM
	LAW MESCAL-1
	PUNSTR
	PUNMUC
	LAM -1
	ADD ALTEM3
	DAC ALTEM4
	DAC #TEMIND
	LAC FOFFF1
	AND (40000
	ADD (LAC I FOFFF1
	DAC I TEMIND
	LAC TYPE3
	SEARCH
	CLA!SKP
	CLC
	AND (10000
	XOR I TEMIND
	DAC I TEMIND

PVARL,	LAC ALTEM3
	DAC AUTOG1
PVARL2,	LAC I AUTOG1
	SPA
	JMP PVARQ
	DAC #ALTEM4
	AND (ADD
	SAD (ADD
	JMP CONVAR
	LAC ALTEM4
	AND (700000
	SZA
	JMP MODTOT
	LAC ALTEM4
	SETLC1+1
	CMA
	AND (CHAR LF-CHAR LX
PRETF1,	ADD (CHAR LX
	DAC #FIXVAR
PRETF,	LAC (FLEX 	AR
	PUNCH3
	LAC FIXVAR
	PUNCH2
	LAC ALTEM4
	OVRET+1
	LAC ALTEM4
	PVAR+2
	JMP PVARL2

CONVAR,	CLA
	JMP PRETF1

MODTOT,	LAC ALTEM4
	AND (40000
	SZA!CLC
	JMP PRETF1-1
	JMP PRETF1

MESCAL,	TEXT .	CAL .

IFTEMZ,	DZM COMMON
	DZM COMMON+1
	DZM COMMON+2
	PUNPER
	FLCONS
	PUNCH3
	JMP ALRETU

SETLC1,	LAC I ALTEM1
	DAC #STEMP
	LAC I STEMP
	DAC COMMON
	ISZ STEMP
	LAC I STEMP
	DAC COMMON+1
FUNXF,	FIXFLO
	CLC!SKP
	CLA
	EXIT

PUNIND,	LAC #INDUM
	SZA
	JMP PUNCH2
	EXIT

DUMSYM,	DZM INDUM
	XCT SWITCH
	EXIT1
	LAC TYPE0
	SEARCH
	EXIT1
	DZM OVSYM
	LAC TYPE5
	SEARCH
	JMP DUMIND
DUMSY2,	ADD (3
	DAC SEARCC
	FIXFLO
	CLA!SKP
	CLC
	DAC FOFFF1
	LAC I SEARCC
	DAC COMMON+1
	LAC (141473
	DAC COMMON
	EXIT

DUMIND,	LAC (CHAR LI
	DAC INDUM
	EXIT

PVARC,	TESTFU
	DUMSYM
	NOP

PUNMUC,	PUNIND
	LAC OVSYM
	SZA
	PUNCH3
	PUNSYM
	JMP PUNCRR

PVAR1,	LAC INDIND
	AND (I
	SZA!CLL
	STL
	LAC (FLEX I  
	SZL
	PUNCH2
	LAC PVART
	AND (7777
	DAC COMMON
	LAW TEMME2-1
	JMP PUNDCR

PVAR2,	DZM TEMIND
	LAW TEMADM-1
	JMP PUNSTR

TEMADM,	TEXT .I TEMAD
.

SETMODE,	DSPARA
	FIXFLO
	JMP OVFIX
	CLC
	SAD FOFFF
	EXIT2
	JMP PFIXI

EXPON,	ISZ EXPCOT
	JMP IGROU3
	LAW EXPMES-1
	PUNSTR
IGROU3,	LAM -1
	ADD TOP
	DAC ALTEM1
	ADD (2
	DAC #ALTEM2
	MIXMODE
	DAC ALTEM4
	LAC ALTEM2
	DAC ALTEM1
	MIXMODE
	XOR ALTEM4
	SZA
	JMP MIXEXP
	LAC ALTEM4
	SAD FOFFF
	JMP IGROU2
	ACINUT
	LAC ALTEM4
	MODES-1
	JMP IGROU2

EXPMES,	TEXT .
	EXTERNAL XPN,EXP

.

MIXMODE,	LAC I ALTEM1
	SZA
	JMP .+3
	LAC FOFFF
	EXIT
	AND NOPER
	SNA
	JMP .+5
	AND (40000
	SZA
	CLC
	EXIT
	LAC I ALTEM1
FUNQUR,	DAC ALTEM1
	LAC I ALTEM1
	DAC COMMON
	ISZ ALTEM1
	LAC I ALTEM1
	DAC COMMON+1
	FUNXF
	CMA
	EXIT

ALGORI,	DAC #NEWOPI
	LAC VARS
	SZA!CLL
	STL
	DZM VARS
	LAC NEWOPI
	SAD (ADDOP
	JMP ALO1
	SAD (SUBOP
	JMP ALO2
	SAD (UNOPEN
	JMP ALO3
	SAD (CLOSEO
	JMP ALO4
	SAD (CRTURN
	JMP ALO4+1
	SNL
	HELP 707 EI
	JMP ALO4+1
ALO1,	CLA!SKP
ALO2,	LAC (UNSUB
	SKP
ALO3,	LAC (OPENOP
	SNL
	DAC NEWOPI
	SKP
ALO4,	ISZ VARS
	LAC NEWOPI
	SNA
	EXIT
	LAC I NEWOPI
	AND (1700
	CMA

NEWOPL,	DAC NEWOP

NEWOPT,	XCT TOP
	AND (1700
	ADD #NEWOP
	ADD (1
	SMA
	JMP PROD

NEWOPR,	LAC N#EWOPI
	SAD (COMOP
	EXIT
	ISZ IT
	XOR (XCT
	DAC I IT
	LAC (LAC I-LAW
	ADD IT
	DAC TOP
	EXIT

PROD,	LAC I TOP
	DAC ALTEM1
	ISZ ALTEM1
	LAC I ALTEM1
	DAC ALTEM1
	SMA
	JMP I ALTEM1
	DAC I TOP
	JMP NEWOPT

CERR,	HELP 717 EI

OVFOO,	LAM -1
	ADD TOP
	DAC ALTEM3
OVFOO2,	LAC I ALTEM3
	AND (ADD
	SZA
	EXIT
	EXIT1

TESTFU,	LAC COMMON
	SAD NAME
	SKP
	EXIT
	LAC COMMON+1
	SAD NAME+1
	SKP
	EXIT
	XCT FUNSWT
	HELP IFU 1
	LAC (FLEX RES
	DAC COMMON
	LAC (141414
	DAC COMMON+1
	EXIT

IFU=EI 1500

UNOP,	ACINUT
	LAC I TOP
	DAC ALTEM2
	ISZ TOP
	LAC TOP
	DAC ALTEM1
	LAC I TOP
	ISZ ALTEM1
	DAC I ALTEM1
	LAC ALTEM2
	DAC I TOP
	MIXMODE
	MODES-1
	IGROU
	POPTOP
	JMP NEWOPT

PAREN,	LAC TOP
	DAC #ALTEM7
	ADD (2
	DAC TOP
	LC1
	LAC ALTEM7
	ADD (1
	ADD (-1
	DAC TOP
	DAC ALTEM7
	LAC I ALTEM7
	SPA
	JMP BIFOP
	LAC ALTEM7
	JMP .-7
BIFOP,	LAC TOP
	DZM I TOP
	DAC ACIND
	ADD (1
	JMP POPTOP+1

IFROU,	LAC TOP
	DAC ALTEM1
	ISZ ALTEM1
	LAC I ALTEM1
	DAC ALTEM3
	LAC I TOP
	DAC I ALTEM1
	LAC ALTEM3
	DAC I TOP
	ISZ TOP
	LAC TOP
	DAC ALTEM3
	ADD (3
	DAC ALTEM1
	ISZ ALTEM3
	XCT ALTEM3
	DAC ALTEM3
	XCT ALTEM1
	SAD ALTEM3
	JMP SPIF

IGROU2,	IGROU
	POPTOP
	JMP NEWOPT

SAVARG,	LAC I IT
	SNA
	JMP ACINU
	EXIT

PVARQ,	LAC OLDMOD
	DAC FOFFF
	EXIT

SPIF,	LAC (XCT IFOPZ
	DAC I TOP
	JMP IGROU2

OPARG,	LAC NEWOPI
	SAD (COMOP
	JMP SAVARG
	SAD (CLOSEO
	SKP
	JMP NEWOPR
	SAVARG
	LAC TEMIND
	SZA
	SAVTEM
	ISZ IT
	CLC
	DAC I IT
	TAD TOP
	PVAR
	JMP POPTOP

MIXEXP,	ACINUT
	LAC TOP
	DAC #ALTEM5
	LAC ALTEM4
	SNA
	JMP EASY
	ISZ TOP
	ISZ TOP
EASY,	LC1
	LAC ALTEM5
	DAC TOP
	CLC
	MODEA1
	JMP IGROU2

SAVTEM,	ACINUT
	LAC I TEMIND
	AND (DAC 10000
	ADD (JMS
	ADD NUMTEM
	DAC I TEMIND
	LAC NUMTEM
	DAC #TEMNUM
	LAC I TEMIND
	AND (10000
	SNA
	JMP DSAV
	LAC I TEMIND
	AND (DAC
	SZA
	CLC
	MODES-1
	SETSE2
NOPER,	NOP
	LAW SETMES-1
	DAC #TTEM
	LAC TEMNUM
	DAC COMMON
	LAC TTEM
	DZM TEMIND
PUNDCR,	PUNSTD
	JMP PUNCRR

DSAV,	SETFIX
	SETSE2
	NOP
	LAC (I
	ADD I TEMIND
	DAC I TEMIND
	LAW SETME3-1
	JMP NOPER+2

SETME3,	TEXT /	LAC TEMAD
	DAC TEM+/


ALWOR0,	LAC (1
	LC1+2
	JMP ALRETU

EQUAS,	LAM -1
	ADD TOP
	DAC ALTEM1
	LAC I ALTEM1
	AND (700000
	SNA
	JMP EQUAS2
	LAC I ALTEM1
	AND (DAC
	SZA!CLC
	CLA
	JMP .+3
EQUAS2,	LAC I ALTEM1
	SETLC1+1
	CMA
	MODEA1
	JMP ALRETU

SETMES,	TEXT /	LAC I TEMAD
	DAC TEM+/

EXTMES,	TEXT /
	EXTERNAL /

MODEA1,	DAC COMMON
MODEA,	SETMOD
	FLEX FXA
	FLEX FLO
	EXIT

SETFIX,	CLA
	DAC COMMON
MODES,	SETMOD
	FLEX LFM
	FLEX EFM
	EXIT
ADDOP,	CMT LV5 OPADD	IGROU3
SUBOP,	NLC LV5 OPSUB	IGROU3
MULOP,	CMT LV6 OPMUL	IGROU3
DIVOP,	LV6 OPDIV	IGROU3
EQUOP,	LV5		XCT EQUOP1
EQUOP1,	NLC LV3 OPEQUX	IGROU2
EXPOP,	LV7 OPEXP	EXPON
OPENOP,	LV11		XCT OPENOX
OPENOX,	NLC LV2 OPOPEN	PAREN
CLOSEO,	LV1 OPCLOSE	CERR
IFOP,	LV1 OPIF		IFROU
COMOP,	LV2		0
DOOP,	LV1 OPDO		IGROU3
UNOPEN,	NLC LV11 OPOPP	XCT UNOP1
DOOP1,	LV1 OPDO1	IGROU3
UNOP1,	NLC LV4 OPOPP	OPARG
UNSUB,	NLC LV10 UNSUBOP	UNOP
ULOAD,	LV1 ULODOP	UNOP
IFOPZ,	LV1 OPIFZ	0

FOFFF1,	0
START


/INSTRUCTION GENERATORS

ULODX,	130000

USX,	FLEX 	LA
	FLEX C  +15
	FLEX 	CM
	FLEX A  +7713
SUBF,	FLEX 	FS
	FLEX B  +15
	130000
EQUALX,	321236
	FLEX DAC
	1633
	130000
ADDX,	FLEX 	AD
	FLEX D  +15
	130000
MULF,	FLEX 	FM
	FLEX P  +15
	130000
DIVF,	FLEX 	FD
	FLEX V  +15
	130000
SUBX,	FLEX  	C+320000
	FLEX MA +77
	FLEX 	AD
	FLEX D  +33
	130000
DIVX,	FLEX 	JM
	FLEX S D
	FLEX IV +77
	FLEX 	LA
	FLEX C  +15
	130000
MULX,	FLEX 	JM
	FLEX S M
	FLEX UL +77
	FLEX 	LA
	FLEX C  +15
	130000
IFX,	FLEX  SZ+340000
	FLEX A!
	726344
	FLEX A  +7736
	FLEX SNA
	CHAR RJ+773600
	FLEX MP 
	753600+CHAR RS
	FLEX MA +77
	FLEX 	JM
	FLEX P  +35
	FLEX 	JM
	FLEX P  +76
	130000

IFF,	FLEX 	CA
	FLEX S  +37
	773600+CHAR RJ
	FLEX MP 
	353600+CHAR RJ
	FLEX MP 
	753600+CHAR RJ
	FLEX MP 
	761300

USF,	FLEX 	FC
	FLEX S  +15
	130000

EXF,	FLEX 	JM
	FLEX S E
	FLEX XP +77
	FLEX 	LA
	FLEX C  +15
	130000

EXX,	FLEX 	JM
	FLEX S X
	FLEX PN +77
	FLEX 	LA
	FLEX C  +15
	130000

IFZER,	FLEX  SZ+340000
	FLEX A!
	726344
	FLEX A  +7736
	FLEX SNA
	CHAR RJ+773600
	FLEX MP 
	CHAR RJ+753600
	FLEX MP 
	351300

/FOURTRAN INFINITE INSTRUCTION GENERATOR GARBAGE

OPSUB=LAC 0
OPEQUX=LAC 1
OPADD=LAC 2
OPMUL=LAC 3
OPDIV=LAC 4
OPDO=LAC 5
OPIF=LAC 6
UNSUBOP=LAC 7
OPEXP=LAC 10
OPDO1=LAC 11
OPIF1=LAC 12
ULODOP=LAC 12
OPIFZ=LAC 13
OPEQU=LAC 16
OPCLOSE=LAC 17
OPOPEN=LAC 20
OPOPP=LAC 21

LVM=0
LV0=100
LV1=200
LV2=300
LV3=400
LV4=500
LV5=600
LV6=700
LV7=1000
LV10=1100
LV11=1200

CMT=XCT

NLC=-LAC

OPTAB,	LAC SUBX	LAC SUBF
	LAC EQUALX	LAC EQUALX
	LAC ADDX	LAC ADDX
	LAC MULX	LAC MULF
	LAC DIVX	LAC DIVF
	LAC DOLOP	LAC DOLOP
	LAC IFX	LAC IFF
	LAC USX	LAC USF
	LAC EXX	LAC EXF
	LAC DOLOP1	LAC DOLOP1
	LAC ULODX	LAC ULODX
	LAC IFZER		LAC IFF

/IG'S FOR DO

DOLOP,	FLEX 	AD
	CHAR LD+17
	FLEX 	DA
	CHAR LC+15
	FLEX 	AD
	CHAR LD+14
	FLEX 	SP
	FLEX A
 +13

DOLOP1,	FLEX 	AD
	CHAR LD+17
	FLEX 	DA
	CHAR LC+15
	FLEX 	CM
	FLEX A
	
	FLEX ADD
	1400+CHAR R	
	TEXT .ADD (1
	SMA
.	130000

START

FORTRAN II - TAPE 5 INPUT CONVERSION ROUTINES

EXP2=COMMON

GETNUM,	CLC
	DAC FLT#SWT

GET1,	GETDEC
	CLA
GET2,	UNPACK
	JMP GET3
	SAD (CHAR R.
	JMP DFPOIN
	SAD (CHAR RE
	JMP DFEX
GET3,	ISZ FLTSWT
	JMP GET4
	LAC I2
	DAC COMMON
	CLA
	EXIT

GET4,	LAC (DECIMAL 53 OCTAL
	NORMA+1
	LAC JCNT
	JMP TERM

DFPOIN,	ISZ FLTSWT
	JMP TERM
	DZM J#CNT
	GETDGM
	NOP
	JMP GET2

DFEX,	LAC (DECIMAL 53 OCTAL
	NORMA+1
	CLA
	ISZ FLTSWT
	LAC JCNT
	DAC EXP10
	IDXCHR
	LAC (FLEX  +
	CHKNXT
	JMP DFEXM

DFEXP,	GETDEC
	CLA
	CMA
	TAD (1
	JMP DFEX1

DFEXM,	LAW CHAR R-
	CHKNXT
	JMP DFEXP
	GETDEC
	CLA
DFEX1,	TAD #EXP10

/INPUT CONVERSION - PAGE 2

TERM,	CMA
	TAD (1
	DAC EXP10

TERMC,	SNA
	JMP DONF
	SMA
	JMP TERMP

TERMM,	MULTAD	R0	OTEN0	I1
	MULTAD	R0	OTEN1	I2
	MULTAD	R1	OTEN0	I2
	MULTAD	R1	OTEN1	I3
	MULTAD	R2	OTEN0	I3
	LAM -2
	NORMA
	ISZ EXP10
	JMP TERMM
	JMP DONF

TERMP,	CMA
	TAD (1
	DAC EXP10

TERMP1,	MULTAD	R0	TEN	I1
	MULTAD	R1	TEN	I2
	MULTAD	R2	TEN	I3
	LAC (4
	NORMA
	ISZ EXP10
	JMP TERMP1
	JMP DONF

MULTAD,	DSPARA
	LAC PARA 3
	DAC M#ULT1
	LAC PARA 2
	DAC M#ULT0
	LAC I PARA 1
	MPY
	LAC I MULT0
	CLL
	TAD I MULT1
	DAC I MULT1
	LAC MP5
	SZL!CLL
MULTD1,	TAD (1
	ISZ MULT1
	TAD I MULT1
	DAC I MULT1
	SZL!CLA!CLL
	JMP MULTD1
	EXIT3

/INPUT CONVERSION - PAGE 3


MOVER,	DSPARA
	LAC I2	DAC I PARA 1	ISZ PARA 1
	LAC I1	DAC I PARA 1	ISZ PARA 1
	LAC I0	DAC I PARA 1
	CLEARI
	EXIT1
CLEARI,	DZM I0
	DZM I1
	DZM I2
	DZM I3
	EXIT

NORMA,	TAD EXP2
	DAC EXP2
	LAC I2
	ADD I1
	ADD I0
	SNA
	JMP NORMZ

NORM1,	LAC I0
	RAL
	SPA!CLC
	JMP NORMZ+1
	TAD EXP2
	DAC EXP2
	LAC I2	RCL	DAC I2
	LAC I1	RAL	DAC I1
	LAC I0	RAL	DAC I0
	JMP NORM1

NORMZ,	DZM EXP2
	MOVER	R2
	EXIT

/INPUT CONVERSION - PAGE 4

DONF,	XCT WSIZE
	JMP DONF3
	LAC EXP2
	RAL9
	AND (777000
	DAC EXP2
	LAC R0
	RAR8
	AND (777
	XOR EXP2
	DAC EXP2
	LAC R0
	RAL9
	AND (377000
	DAC COMMON 1
	LAC R1
	RAR9
	AND (777
	XOR COMMON 1

DONF1,	DAC COMMON 1
	LAC (1
	EXIT

DONF3,	LAC R1
	DAC COMMON 2
	LAC R0
	JMP DONF1

/INPUT CONVERSION - PAGE 5

/18+18@36 MULTIPLY

MPY,	DAC MP#1
	DZM MP#5
	SNA
	EXIT1
	DSPARA
	XCT PARA 1
	DAC MP#2
	SNA
	EXIT1
	LAM -22
	DAC TEMCNT

MP4,	LAC MP1
	RAR
	ISZ TEMCNT
	SKP
	EXIT1
	DAC MP1
	LAC MP5
	SZL!CLL
	TAD MP2
	RAR
	DAC MP5
	JMP MP4

/INPUT CONVERSION - PAGE 5

/GET AN OCTAL OR DECIMAL INTEGER

GETOCT,	LAC (10)
	SKP

GETDEC,	LAC (12
	DAC C#TEN
	CLEARI
	DZM JCNT
	LAC (EXIT

GETDG1,	DAC GETDGX 1
	UNPACK
	JMP GETDGX
	DIGIT
	JMP GETDGX
GETDGM,	IDXCHR
	LAC (EXIT1
	JMP GETDG1

GETDGX,	LAC I2
	XX

DIGIT,	SAD (20
	CLA
	DAC MP5
	TAD (-11
	SMA
	EXIT
	LAC I0
	AND (760000
	SZA
	EXIT1
	ISZ JCNT
	MOVER	INT2
	LAC MP5
	DAC I2
	MULTAD	CTEN	INT2	I2
	MULTAD	CTEN	INT1	I1
	MULTAD	CTEN	INT0	I0
	EXIT1

/INPUT CONVERSION - PAGE 6

/DATA STORAGE

OTEN0,	631463
OTEN1,	146315
TEN,	500000
I3,	0
I2,	0
I1,	0
I0,	0
R2,	0
R1,	0
R0,	0

INT2,	0
INT1,	0
INT0,	0

START

PDP-9 FORTRAN II INTERRUPT I/O 7/7/66

/INTERRUPT SERVICE ENTRY ROUTINES


INTRP,	DAC Z#C
	RSF	SKP	JMP TAPINT	/PERFORATED TAPE READER
	PSF	SKP	JMP PUNINT	/PERFORATED TAPE PUNCH
	TSF	SKP	JMP TYPINT	/TELETYPE TELEPRINTER
	IORS		/INPUT/OUTPUT STATUS TO AC
	HLT
	KRB		/READ KEYBOARD BUFFER.

DISMIS=JMP .
	LAC 0	RAL	LAC ZC	ION	JMP I 0

/CLEAR ALL FLEA BAGS

CLFLAG,	CAF
	CLA
	LAC (JMP INTRP
	DAC 1
	ION
	EXIT

/TAPE INTERRUPT ROUTINE

GCR,	LAC TAPO		/INITIALIZED TO LAW TAPBUF
	SAD (LAW TAPBUF+TN
	JMP GCR2		/HALF BUFFER FILLED

GCR0,	ISZ TAPCNT
	JMP GCR1		/GET ANOTHER CHARACTER
	LAC R#ON		/NO MORE CHARACTERS IN BUFFER
	SPA		/IF FLAG SET, TURN READER ON AGAIN
	RSA
	DZM RON
	LAC TAPCNT		/WAIT FOR PTR INTERRUPT
	SMA
	JMP .-2
	JMP GCR0

GCR1,	LAC MEDIAT		/INITIALIZED TO 0
	SZA
	JMP GCR6
	LAC I TAPO		/GET A CHARACTER
	ISZ TAPO
GCR4,	SKP		/MODIFIED, DEPENDING IN WHICH HALF OF RING CHAR IS CONTAINED
	RAR9
GCR5,	XX		/SKP IF FIODEC, NOP IF ASCII
	JMS ATF
GCR7,	AND (77		/CHAR. IN RIGHT HALF OF AC
	EXIT
GCR6,	DZM MEDIAT
	LAC TAPCNT
	TAD (-0
	DAC TAPCNT
	LAC ITEMB
	JMP GCR7

/START AT BEGINNING OF BUFFER, OTHER HALF OF WORD

GCR2,	LAW TAPBUF
	DAC TAPO
	LAC GCR4
	XOR (SKP-NOP	/MODIFY SKP + NOP
	DAC GCR4		/NOP IF CHAR ALREADY IN RIGHT HALF OF WORD
	JMP GCR0
WAIT=JMS .
	0
	LAC PON
	SZA
	JMS OPB
	LAC PON
	SNA
	JMP .-2
	JMP I WAIT-JMS

/COME HERE ON A TAPE INTERRUPT

TAPINT,	RRB
	JMS ENDTAP		/CHECK END OF TAPE
	RSA
	SNA
	DISMIS		/BLANK TAPE
TAPX,	DAC TA#PTEM
TAPY,	AND (100		/MODIFIED, JMP TAPINY IF ASCII
	SZA
	DISMIS		/DELETED CHAR
TAPIN4,	LAC TAPTEM
	RTL	RTL	RTL	RTL	RAL
	ADD TAPTEM		/FORM BUFFER RING
	XOR I TAPI
	AND TAPMSK	/HALF OF BUFFER BEING FILLED DETERMINED
	XOR I TAPI	/BY TAPMSK
	DAC I TAPI
	ISZ TAPI
	LAC TAPI
	SAD (LAW TAPBUF+TN
	JMP TAPIN2	/HALF OF BUFFER FILLED

/COUNT AND CHECK FOR FULL BUFFER

TAPIN1,	LAM -1
	ADD TAPCNT
	DAC TAPCNT
	SAD (-TN-TN+1
	JMP TAPINW	/NO MORE ROOM IN BUFFER TO READ  IN CHARS
	DISMIS

/SWITCH WORD HALFS, AND SET POINTER TO BEGINNING OF BUFFER

TAPIN2,	LAC TAPMSK
	CMA		/MASK OUT OTHER HALF OF WORD
	DAC TAPMSK
	LAW TAPBUF	/RESET POINTER
	DAC TAPI
	JMP TAPIN1
ENDTAP,	0
	DAC RRRB#
	IORS
	AND (1000		/BIT 8, PTR EMPTY
	SZA
	JMP .+3		/NO MORE TAPE IN PTR
	LAC RRRB
	JMP I ENDTAP
	DZM RON		/DO NOT SELECT READER AGAIN
	DISMIS

/SET NEXT INTERRUPT TO TURN OFF READER

TAPINW,	LAC RON
	SPA
	DISMIS
	LAC (JMP .+3	/LET PROCESSING CATCH UP
	DAC TAPINT
	DISMIS
	LAC . 4		/COME HERE ON NEXT INTERRUPT
	DAC TAPINT
	CLC
	DAC RON		/SET FLAG TO TURN READER ON AGAIN
	RRB
	JMS ENDTAP
	JMP TAPINT 3

/INITIALIZE READER AND PUNCH SERVICE ROUTINES

STREAD,	LAW TAPBUF
	DAC TA#PI
	DAC TA#PO
	DZM R#ON
	LAC (SKP
	DAC GCR4
	DAC OPBM
	LAC (777
	DAC TAPM#SK
	DAC PUNM#SK
	LAW PUNBUF
	DAC PU#NO
	DAC PU#NI
	LAM -PN-PN+1
	DAC P#UNCNT
	CLC
	DAC P#ON
	DAC TAP#CNT
	DZM OPBF#LG
	RSA
	LAS
	AND (200
	SZA
	JMP TAPINX	/ASCII INPUT
	LAC (AND KONA
	DAC TAPY
	LAC (SKP
	DAC GCR5
TAPINZ,	DZM MEDIA#T
	LAC (200
	DAC AFC#ASE
	DZM FTACAS
	EXIT
KONA,	100

TAPINX,	LAC (JMP TAPINY
	DAC TAPY
	LAC (NOP
	DAC GCR5
	JMP TAPINZ
TAPINY,	SAD (377
	DISMIS
	JMP TAPIN4



/PUNCH FOR INTERRUPT

IPB,	AND (377
	DAC IPBTTM
	LAS
	AND (400
	SZA
	JMS FTA		/BIT 9, ASCII OUTPUT
	LAC IPBTTM
	RCL
	RTL
	RTL
	RTL
	RTL
	ADD IPBT#TM	/FORM BUFFER RING
	XOR I PUNI
	AND PUNMSK	/PUNMSK DETERMINES IN WHICH HALF OF WORD CHARACTERS ARE BEING PUT
	XOR I PUNI
	DAC I PUNI
	ISZ PUNI
	LAC PUNI
	SAD (LAW PUNBUF+PN	/CHECK END OF BUFFER HALF
	JMP IPB1

/CHECK COUNT FOR FULL BUFFER AND LEAVE

IPB0,	ISZ P#UNCNT
	EXITR
	LAC P#ON		/NO MORE ROOM IN BUFFER
	SPA
	JMS OPB		/TURN PUNCH ON AGAIN IF OFF
	LAC PUNCNT	/LET PUNCHING CATCH UP
	SMA
	JMP .-2
	EXITR

/CHANGE WORD HALFS, START AT BUFFER BEGINNING

IPB1,	LAC PUNMSK
	CMA		/MASK OTHER HALF OF WORD
	DAC PUNMSK
	LAW PUNBUF	/RESET BUFFER POINTER
	DAC PUNI
	JMP IPB0

/GET A CHARACTER FROM THE BUFFER AND PUNCH IT

/COME HERE ON PUNCH INTERRUPT

PUNINT,	JMS OPB
	DISMIS

/PUNCH ONE CHARACTER FROM THE PUNCH BUFFER

OPB,	0
	LAC OPBFLG	/CARRIAGE RETURN FLAG
	SZA
	JMP OPBLF		/IF LAST CHAR PUNCHED A CR, PUNCH A LINE FEET TOO
	LAC PUNO
	SAD (LAW PUNBUF+PN
	JMP OPB1		/SWITCH BUFFER HALFS
	LAC PUNCNT
	SAD (-PN-PN+1
	JMP OPBF		/NOTHING LEFT IN BUFFER TO PUNCH
	TAD (-0
	DAC PUNCNT
	LAC I PUNO
	ISZ PUNO
OPBM,	SKP		/IN NOP, DEPENDING ON WHICH HALF OF BUFFER
	JMP OPBM1		/CHARACTER IN LEFT HALF, SHIFT OVER
	AND (377
	SAD (215
	ISZ OPBFLG	/CARRIAGE RETURN, SET FLAG
OPBPUN,	JMS NOTAPE
	PLS
	DZM PON
	JMP I OPB
OPBLF,	DZM OPBFLG
	LAC (212		/LINE FEED
	JMP OPBPUN

OPB1,	LAW PUNBUF	/SET BUFFER PNTR
	DAC PUNO
	LAC OPBM
	XOR (SKP-NOP	/SKP IF IN RIGHT HALF OF BUFFER ALREADY
	DAC OPBM
	JMP OPB+4

OPBM1,	RAR
	RTR
	RTR
	RTR
	RTR
	JMP OPBM+2

OPBF,	PCF		/TURN OFF PUNCH INTERRUPT, LET BUFFER FILL UP
	CLC
	DAC PON		/SET FLAG TO RE-ENABLE IT
	JMP I OPB
NOTAPE,	0
	DAC PUNTEN#
	IORS
	AND (400		/BIT 9, PTP EMPTY
	SNA
	JMP .+4		/RETURN
	CLC		/IF NO MORE TAPE IN PTP
	HLT		/SET AC TO ALL ONES AND
	JMP .-6		/WAIT TIL PUNCH REFILLED
	LAC PUNTEN
	JMP I NOTAPE

/TYPE

TYPIT,	0
	DAC TYP#BTA
	703301
	SKP
	JMS BTA
	TLS
	JMS TYPTES
	JMP .
	JMP I TYPIT

TYPINT,	TCF
	ISZ
	DISMIS

TYPTES,	0
	LAC TYPIT
	RAL
	LAC TYPBTA
	JMP I TYPTES

/BAUDOT TO ASCII CONVERSION
BTA,	0
	AND (37
	SAD (37
	JMP BLETT
	SAD (33
	JMP BFIG
	ADD (LAC BTAT
	DAC BTAA
	LAC B#FLC
	RAL
BTAA,	XX
	SNL
	RAR9
	JMP I BTA
BLETT,	CLA!SKP
BFIG,	CLC
	DAC BFLC
	JMS TYPTES
	JMP I TYPIT

BTAT,	200200
	324265
	215215
	317271
	240240
	310243
	316254
	315256
	212212
	314251
	322264
	307246
	311270
	320260
	303272
	326273
	305263
	332242
	304244
	302277
	323211
	331266
	306241
	330257
	301255

	327262
	312247
	200200
	325267
	321261
	313250
	200200

/FIODEC TO ASCII
FTA,	0
	LAC PLK
	DAC FTAPL#K
	LAC IPBTTM
	AND (77
	SAD (72
	JMP FTAL
	SAD (74
	JMP FTAU
	SAD (77
	JMP FTACR
	ADD (LAC TFTA
	DAC FTAA
	LAC FT#ACAS
	RAR
FTAA,	XX
	SZL
	RAR9
FTAX,	AND (377
	DAC IPBTTM
	LAC FTAPLK
	DAC PLK
	JMP I FTA
FTAL,	CLA!SKP
FTAU,	LAW 1
	DAC FTACAS
	CLC
	JMP FTAX
FTACR,	LAC (215
	JMP FTAX
TFTA,	240240
	242261
	247262
	337263
	245264
	241265
	246266
	274267
	276270
	336271
	200200
	214214
	377377
	377377
	377377
	377377
	300260
	277257
	323323
	324324
	325325
	326326
	327327
	330330
	331331
	332332
	377377

	275254
	377377
	377377
	211211
	377377
	244377
	312312
	313313
	314314
	315315
	316316
	317317
	320320
	321321
	322322
	377377
	377377
	253255
	335251
	334243
	333250
	377377
	301301
	302302
	303303
	304304
	305305
	306306
	307307
	310310
	311311
	377377
	252256
	377377
	377377
	377377
	215215

/ASCII TO FIODEC
ATF,	0
	AND (377
	TAD (-237
	SPA
	JMP ATFL	/NOT IN TABLE - LOW
	TAD (-77
	SMA
	JMP GCR	/NOT IN TABLE - HIGH, EXIT
	TAD (400100
	RCR
	ADD (IASC
	DAC .+1
	XX
	SNL
	RAR9
	DAC IT#EMB
	AND (300
	XOR AFCASE	/INITIALLY 200
	SNA
	JMP ATFC
ATF1,	LAC ITEMB
	JMP I ATF
ATFL,	SAD (-26
	LAC (236	/TAB
	SAD (-23
	LAC (13	/STOP CODE
	SAD (-22
	LAC (277	/CARRIAGE RETURN
	SPA
ATF4,	JMP GCR	/ELIMINATE ANY OTHER "LOW" CHARS
	JMP I ATF
ATFC,	LAC AFCASE
	CMA
	AND (300
	DAC AFCASE
	SAD (100
	CLA!SKP
	LAM -1
	TAD (274
	ISZ MEDIAT
	JMP I ATF
/TABLE FOR ASCII TO FIODEC CONVERSION
/CODE TRANSLATION CONVENTIONS ARE THOSE OF CANUTE
/WITH THE TWO EMENDATIONS, VIZ,
/(1) ASCII NUMBER SIGN SERVES AS FIODEC OVERBAR
/(2) ASCII DOLLAR SIGN SERVES AS FIODEC UNDERBAR
/COLON AND SEMICOLON ARE TRANSLATED AS SPACES
/NINE BIT CODES FOR EVEN ASCII MOD(240) IN LEFT HALF, ODD ASCII RIGHT HALF
/CASE CARRIED AS 100 FOR LC, 200 FOR UC, ALL LETTERS LC
/INITIAL BIT IS PARITY BIT IN NINE BIT EQUIVALENCE SCHEME
IASC,	500605
	201556
	240204
	606202
	157555
	273254
	533154
	173521
	120101
	102503
	104505
	506107
	110511
	500500
	207633
	210621
	220161
	162563
	164565
	566167
	170571
	541542
	143544
	145146
	547550
	151522
	123524
	125126
	527530
	131257
	656655
	611603
START

FORTRAN II

EI=4000
EH=10000
FINISH=EXIT-JMP

CRTURN,	LV0	FINISH

ENDCR=CRTURN

CLHTMX,	HELP 1110 EH
CLHTMS,	HELP 1111 EH
CLHSCX,	HELP 1112 EH

VPOINT=PST
DN=10
AN=1
DOG=PST 1
DO2=PST 2
DO3=PST 3
DOVAR=PST 4
DONUM=PST 5
DOOPR=PST 6

POLISH,	XCT CRTURN
POLISH POLEN/
POLEND,	0

TOP,	LAC I POLISH

PSTORE,	PSTORE PUSHN/
CPOINT,	CPOINT CN/
TAPBUF,	TAPBUF TN 1/
PUNBUF,	PUNBUF PN 1/
VARIABLES

START HERE
?