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