
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
