
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
?