.TITLE	.INTRP
/
/   7 MAY 76 (026: PDH) INHIBIT LINE PRINTER FORM FEEDS IN DOS
/  20 FEB 76 (PDH) '.ARG' NOW TAKES SPECIAL ACTION ON DATA MODES 4 & 5;
/		CHANGE 'ISZ' TO 'IDX' OR 'SET' WHERE APPROPRIATE
/  14 MAR 75 (MKH) FIX IMPLIED DECIMAL IN 'F' FORMAT
/  25 NOV 74 (PDH) REMOVE RESIDUAL REPEAT COUNT IN FREE-FORMAT I/O;
/		   CHANGE ERROR TAGS TO NUMERIC
/  13 SEP 74 (PDH) DETECT ZERO & TOO-NARROW FIELD WIDTH FORMATS
/  12 SEP 74 (PDH) ^P NOW GIVES ERROR 30
/   4 AUG 74 (JAS) CORRECT VARIABLE RETURN AND ERROR TRACEBACK
/   1 AUG 74 (PDH) REMOVE '.IODEV' STATEMENT FOR DOS COMPATIBILITY
/  25 JUL 74 (PDH) ATTEMPT TO IMPROVE INTERACTION BETWEEN .DAT'S -12 & +6
/   3 APR 74 (JAF) FIX UP FREE-FORMAT OUTPUT
/  27 MAR 74 (JAF,JAS) CHARACTER SUBSCRIPTS FIXED UP
/   9 MAR 74 (JAF,JAS) CORRECT CARRIAGE CONTROL FOR FREE FORMAT
/   2 MAR 74 (PDH) SMALL FIX TO CHARACTER CORE-TO-CORE I/O
/  27 FEB 74 (JAF) MAKE CORE-TO-CORE I/O COMPATIBLE WITH WATFIV
/  21 NOV 73 (JAF) TRANSFER SMALLER DIMENSION IN '.PULL.'
/  20 SEP 73 (PDH) CORRECTLY CLOSE DEVICES ON '^P'
/  19 SEP 73 (JAF) REMOVE PDP-15 MODE BITS IN 'MODERC'
/  14 SEP 73 (JAF,PDH) MAKE SUBSCRIPTING PDP-15 COMPATIBLE
/  12 SEP 73 (PDH) REMOVE .SNAFU
/   4 JUL 73 (PDH) MOVE '.WAIT' IN TRACE
/  29 JUN 73 (PDH) INSERT MANY '.TITLE' & STATEMENT NUMBER TRACE FEATURE
/  23 MAY 73 (PDH) MAKE FORMAT STATEMENT PICK UP CORRECT DIMENSION
/  25 APR 73 (PDH) FIX UP FREE FORMAT CHARACTER INPUT
/  23 APR 73 (PDH) INSERT ' .GLOBL AAAAA.'
/  13 APR 73 (PDH) CHANGE ERROR HANDLING ROUTINE
/
/  MACROS FOR CONDITIONAL PDP-15 ASSEMBLY
/
	.DEFIN	.LACI,A
	.IFDEF	PDP15
	LAC*	A
	.ENDC
	.ENDM
/
/
	.DEFIN	.AND,A
	.IFDEF	PDP15
	AND	A
	.ENDC
	.ENDM
/
ERDV=-12			/ ERROR MESSAGE DEVICE
TRDV=ERDV			/ $TRACEON DEVICE
TTO=-3
TTI=-2
IDX=ISZ			/ INCREMENT POINTER. SKIP NEVER EXPECTED
SET=ISZ			/ SET A FLAG TO NON-ZERO VALUE
/
/	.IODEV	TRDV,ERDV,TTO,TTI
/
	.TITLE	GLOBAL DEFINITIONS
/
/ EXTERNAL GLOBALS
/ THE ARITHMETIC ACCUMULATORS
	.GLOBL	.MODEA,.SIGNA,.EXPA,.MOSTA,.LESTA,.A3,.A4
	.GLOBL	.SIGNB,.EXPB,.MOSTB,.LESTB,.B3,.B4
	.GLOBL	.INT1,.INT2,.LOGAC
/ SUBROUTINES
	.GLOBL	.SPADD,.SPRLD,.DPADD,.DPRML,.DPRDV,.DBNRM
	.GLOBL	.LDPT5,.ZRVAL,.CHRGT,.PSHBA,.CMPIT
	.GLOBL	.STORE,.SWPIT,.SWPUS,.FIX
	.GLOBL	.IABS,.IFIX,.FLOAT,.ALG10
/ REFERENCED LOCATIONS
	.GLOBL	L.BOX,.BOX,.LOADS,.TABLE
/ ENTRY POINTS
	.GLOBL	.NEXT,.NEXT1,.NEXT2,.NEXT3,.STORP,.STORN
/
/
/ INTERNAL GLOBALS
/ SUBROUTINES
	.GLOBL	AAAAA.		/FUDGE FOR LOADER
	.GLOBL	.INTRP,.ARG,.PULL.,.FETCH,.GRAB,.ERROR,OPEN,CLOSE
	.GLOBL	ERRORP,.NERR,FET.X,.RTRN2,.RTRN4
/ REFERENCED LOCATIONS
	.GLOBL	.CS1,.CS13,.POINT,.OPST
	.GLOBL	.ELIST,.NLIST
/
/ EQUIVALENCES FOR ARITHMETIC ACCUMULATORS
MODEA=.MODEA;SIGNA=.SIGNA;EXPA=.EXPA;MOSTA=.MOSTA;LEASTA=.LESTA
A3=.A3;A4=.A4
SIGNB=.SIGNB;EXPB=.EXPB;MOSTB=.MOSTB;LEASTB=.LESTB;B3=.B3;B4=.B4
INT1=.INT1;INT2=.INT2;LOGACC=.LOGAC
/
	.TITLE	.PULL.
/
/
/ THIS SUBROUTINE TRANSFERS OTABLE DATA DESCRIPTORS FROM CALLING
/ TO CALLED SUBPROGRAMS. IT TRANSFERS THE SHORTER OF THE TWO
/ ARGUMENT LIST AND FORMAL PARAMETER LIST AND IGNORES EXTRA
/ ENTRIES. IT CHECKS THAT ARGUMENT TYPE AND FORMAL PARAMETER TYPE
/ ARE A VALID COMBINATION.
/
.PULL.	XX
	DAC*	(AUTO3	/ POINTER TO ARGUMENT LIST
	LAC	MODEA	/ INITIALIZE STORAGE FOR VARIABLE DIMENSION DATA
	DAC*	(AUTO4
	DAC*	(AUTO5
LOOPS	LAC*	.PULL.	/ GET FORMAL PARAMETER POINTER
	IDX	.PULL.	/ STEP TO NEXT ONE
	DAC	BIN
	SPA!CMA
	JMP	WHAT	/ NOT A SIMPLE ARGUMENT
	LAC*	AUTO3	/ GET ARGUMENT POINTER
	DAC	BIN2
	SPA
	JMP	ENDQ	/ NOT SIMPLE VARIABLE OR CONSTANT
TIES	LAC*	BIN2	/ TRANSFER OTABLE DESCRIPTOR
TIES1	DAC*	BIN	/ TO CALLED PROGRAM
	JMP	LOOPS
/
WHAT	SNA!CMA!CLL	/ CHECK FOR END-OF-LIST
	JMP	FINIT	/ ALL FORMAL PARAMETERS DONE
	AND	(700000	/ KEEP ONLY TYPE BITS
	TAD*	AUTO3	/ GET ARGUMENT POINTER
	DAC	BIN2
	SMA!RTL		/ TYPE BITS HAVE VALID SUMS 1 & 6
	JMP	MAYBE1	/ IT IS NOT 6.
	CML
	SZA!SPA!RTR
	JMP	ENDQ	/ MAY BE END-OF-ARGUMENT
	SNL		/ WAS IT 06 OR 16
	JMP	ERR26	/ ERROR. CONSTANT ARGUMENT-RETURNED VARIABLE
/
/ PROCESS DIMENSIONED VARIABLE (IT WAS 16)
/
	LAC*	BIN2	/ TRANSFER BASE ADDRESS
	DAC*	BIN
/
	IDX	BIN2	/ GET POINTER TO DIMENSION
	LAC*	BIN2	/ TABLE IN CALLING PROGRAM
	TAD	(2	/ STEP TO TOTAL SIZE ENTRY
	DAC	BIN2
/
	IDX	BIN	/ GET POINTER TO DIMENSION TABLE IN CALLED PROGRAM
	LAC*	BIN
	SPA
	DAC*	AUTO4	/ SAVE FOR LATER IF VARIABLE DIMENSION
	DAC	BOXX	/ ALSO SAVE IF ISN'T
	TAD	(2	/ STEP TO TOTAL SIZE ENTITY
	DAC	BIN
/
	SPA		/ SKIP IF FIXED DIMENSION
	JMP	TIES	/ GO TRANSFER SIZE
	LAC*	BOXX	/ TRANSFER SMALLER OF DIMENSION SIZE
	CMA		/ AND CALLING SIZE
	ADD*	BIN2
	SPA
	JMP	TIES
	LAC*	BOXX
	JMP	TIES1
/
/
MAYBE1	CMA		/ VALID L, AC0 =01 BEFORE CMA
	SNL!SMA
	JMP	TIES
/
/ CHECK FOR END OF ARGUMENT LIST MARKER
/
ENDQ	LAC	(77777
	AND	BIN2
	SZA!CLA!CMA	/ 777777 TO AC
	JMP	ERR27	/ INVALID TYPE COMBINATION
/
/ MUST SKIP OVER UNUSED FORMAL PARAMETERS
/
SKIPS	SAD*	.PULL.	/ WHEN FIND 777777 MARKING
	JMP	FINIT	/ END OF LIST, IT CAN
	IDX	.PULL.	/ BE EXECUTED (LAW), THUS
	JMP	SKIPS	/ AVOIDING A JMP AND ISZ.
/
/ PROCESS ANY VARIABLE DIMENSIONS
/
FINIT	DZM*	AUTO4	/ MARK END OF LIST
FINIT2	LAC*	AUTO5	/ GET ITEM FROM LIST
	SNA
	JMP*	.PULL.	/ ALL DONE
	DAC	BIN	/ POINT TO (# OF SUBSCRIPTS + 1)
	TAD*	BIN
	DAC	BIN2	/ POINTER TO BOTTOM OF FIXED DIM. TABLE
	DAC*	(AUTO3	/ POINTER TO VARIABLE LIMITS
	LAW	-2
	TAD*	BIN
	CMA
	DAC	BOX	/ -# OF SUBSCRIPTS
	LAC	(1
	DAC	SIZER
	IDX	BIN
	DZM*	BIN	/ ZERO THE OFFSET
	JMP	SLOP
/
SLOP2	DAC	SIZER
	DAC*	BIN2	/ ENTER IN DIM. TABLE
	LAW	-1
	TAD	BIN2	/ ADJUST DIMENSION
	DAC	BIN2	/ TABLE POINTER
/
SLOP	JMS	GETLK	/ GET LOWER LIMIT
	CMA!CLL
	DAC	APOINT
	JMS	SIZMUL	/ MULTIPLY BY SIZE TO DATE
	ADD*	BIN
	DAC*	BIN	/ ADJUST OFFSET
/
	JMS	GETLK	/ GET UPPER LIMIT. 1'S COMP.
	ADD	APOINT	/ SUBSTRACT LOWER LIMIT
	ADD	(1	/ AND GET ROW LENGTH
	SPA!SNA!CLL
	JMP	ERR61	/ ERROR. NEG. OR ZERO ROW LENGTH
	JMS	SIZMUL	/ CALC. NEW SIZE TO DATE
	ISZ	BOX	/ CHECK NUMBER OF SUBSCRIPTS DONE
	JMP	SLOP2
/
/ CHECK THAT SPECIFIED SIZE NOT LARGER THAN CALLING
/ PROGRAM ARRAY & USE SMALLER OF TWO
	CMA
	TAD*	BIN2
	SPA
	JMP	FINIT3	/ USE CALLING PROGRAM SIZE
	LACQ
	DAC*	BIN2	/ USE CALCULATED ARRAY SIZE
FINIT3	LAC*	BIN	/ CONVERT TO 2'S COMPLIMENT
	SPA
	TAD	(1
	DAC*	BIN
	JMP	FINIT2
/
/ THIS SUBROUTINE PICKS UP AN ENTRY FROM THE VARIABLE
/ DIMENSION TABLE, AND OBTAINS THE CURRENT INTEGER VALUE IN 1'S COMP.
/
GETLK	XX
	LAC*	AUTO3	/ GET ENTRY FROM TABLE
	SMA		/ IS IT VARIABLE OR CONSTANT
	JMP	GETLK3	/ ITS CONSTANT
/
	DAC	BOXX	/ CHASE DOWN ADDRESS OF VARIABLE
	LAC*	BOXX
	.AND	(077777	/ FOR PDP-15 ONLY
	DAC*	(AUTO2
	.LACI	BOXX	/ AGAIN FOR PDP-15 ONLY
	RTL
	SPA
	LAC*	AUTO2	/ IGNORE 1ST WOTD OF I*4
	LAC*	AUTO2
GETLK2	SPA		/ CONVERT FROM 2'S COMP TO 1'S COMP
	TAD	(1
	JMP*	GETLK
GETLK3	RAL		/ DELETE LEADING ZERO
	LRSS	1
	JMP	GETLK2
/
SIZMUL	XX
	MULS
SIZER	XX
	LACQ
	JMP*	SIZMUL
/
/
ERR26	LAW	26		/ CONSTANT ARGUMENT; RETURNED VARIABLE
	JMP	.NERR
ERR27	LAW	27		/ INVALID ARGUMENT MATCH
	JMP	.NERR
ERR61	LAW	61		/ ERROR IN VARIABLE DIMENSIONING
	JMP	.NERR
/
	.TITLE	.ARG
/
/ SUBROUTINE TO PROVIDE FORTRAN TO MACRO-9 SUBPROGRAM LINKAGE
/ WHEN THERE ARE ARGUMENTS.  DATA MODES CHECKED ARE 0: CONSTANT;
/  3: SINGLE VARIABLE; 4: STATEMENT NUMBER; 5: SUBPROGRAM NAME;
/  6: END OF ARGUMENT LIST; 7: DIMENSIONED VARIABLE.
/
.ARG	XX
	LAC	.ARG
	DAC	BIN2	/ STORE MACRO LIST ADDRESS
	CMA
	TAD*	.ARG	/ # OF ARGUMENTS (12 BITS)
	AND	(07777
	CMA
	TAD	(1
	DAC	MOVCNT
/
LOOPIT	IDX	APOINT
	IDX	BIN2
	LAC*	APOINT
	DAC	BOX		/ MODE IS IN AC 0-2 AND ADDRESS IN 3-17
	SPA!RCL			/ CHECK FOR MODES 0 - 3
	JMP	.ARG3		/ MODE IS 4,5,6, OR 7
.ARG1	LAC*	BOX	/ GET OTABLE WORD
	TAD	(1	/ ADDRESS WAS ONE LOW
.ARG2	DAC*	BIN2
	ISZ	MOVCNT	/ IS IT END OF MACRO LIST
	JMP	LOOPIT
	JMP*	.ARG	/ YES, EXIT
/
/  AT THIS POINT, THE MODE HAS BEEN SHIFTED SO THAT THE MSB (1) IS
/  LOST AND THE LSB IS IN AC 0.  IF THE END-OF-LIST INDICATOR IS
/  FOUND, THE LINK WILL BE SET AND THE AC CLEAR.  FOR MODES 4 & 5
/  THE LINK WILL BE CLEAR.  FOR MODE 7 (DIMENSIONED VARIABLE),
/  THE LINK WILL BE SET AND THE AC NON-ZERO.
/
.ARG3	RCL			/ FINISH REQUIRED SHIFT
	SNL
	JMP	.ARG4		/ MODE 4 OR 5
	SZA
	JMP	.ARG1		/ DIMENSIONED VARIABLE
	JMP*	.ARG		/ END OF ARGUMENT LIST
/
.ARG4	LAC*	BOX		/ STATEMENT NUMBER OR SUBPROGRAM NAME.
	JMP	.ARG2		/ ADDRESS ADJUSTMENT NOT NEEDED.
/
	.TITLE	.GRAB, .FETCH
/
/ THIS SUBROUTINE DOES A FETCH OF ONE ARGUMENT INTO ACCUMULATOR A
/ AND MAKES SURE THERE IS ONLY ONE ARGUMENT
.GRAB	XX
	JMS	.FETCH
	JMS*	.PSHBA
	IDX	APOINT
	LAC*	APOINT
	SAD	(600000
	JMP	JSTONE
ERR27B	LAW	27	/ ERROR - MORE THAN ONE ARGUMENT
	JMS	.ERROR
JSTONE	LAC*	MODEA
	JMP*	.GRAB
/
/
/ THIS SUBROUTINE LOADS A SUBPROGRAM ARGUMENT INTO ACCUMULATOR B
/ IF THE END OF THE ARGUMENT STRING IS REACHED, IT SETS THE LINK.
/
.FETCH	XX
	LAC	(QLOAD*10000		/ (270000
	LMQ
	IDX	APOINT
	LAC*	APOINT	/ GET ADDRESS OF OTABLE ENTRY
	SAD	(600000
	JMP	ENDLST
	SMA!CLL
	JMP*	.NEXT1	/ RETURNS TO FET.X WITH ACC B LOADED AND MODE
/			BITS RIGHT JUSTIFIED IN AC
ERR30	LAW	30		/ ARGUMENT MUST BE CONSTANT, SIMPLE VARIABLE,
				/ OR ARRAY ELEMENT
	JMS	.ERROR
/
ENDLST	STL
FET.X	JMP*	.FETCH
/
/
	.TITLE	.INTRP
/
/
/ ENTER HERE TO ENTER INTERPRETER MODE
/
.INTRP	XX
AAAAA.=.INTRP
	LAC	TABLE	/ GET ADDRESS OF OLD OTABLE
	LMQ
	LAC*	.INTRP
	DAC	TABLE	/ NEW TABLE ADDRESS
	DAC*	.TABLE	/ STORE IN .ARITH SECTION
	DAC*	(AUTO2
	TAD	(2
	DAC	TABLE3	/ POINTS AT 3RD ENTRY FOR STATEMENT NUMBER CODES
	LACQ
	DAC*	TABLE	/ SAVE OLD TABLE ADDRESS IN NEW TABLE+0
	LAC*	(AUTO1
	DAC*	AUTO2	/ SAVE OLD INSTRUCTION ADDRESS IN TABLE+1
	IDX	.INTRP
	LAC*	.INTRP
	DAC*	(AUTO1	/ NEW INSTRUCTION ADDRESS
/
/ THE FOLLOWING SETUP IS DONE ONLY ONCE. ITS ENTRANCE IS DESTROYED
/
	LAC	PA3
	DAC	.-1
	.INIT	ERDV,1,ERR36	/ INITIALIZE FOR ERRORS AND TRACEON
	LAC	X65
	CMA
	DAC	X65		/ NEGATIVE RELATIVE ADDRESS FOR 'ERRORP'
PAUSES	.INIT	TTO,1,ERR36	/ 'STOPX' IS BRANCHED TO ON AN ERROR
PA3	JMP*	.NEXT	/ START CRUNCHING
/
/ TABLE ADDRESS - MUST BE INSERTED AT EXECUTION TIME
TABLE	0
TABLE3	0
/
	.EJECT
/
/  STORAGE LOCATIONS
/
INTMA;INTMB;INTM3;INTM4
BIN;BIN2;BOX;CNTRL;MOVCNT
SIZE;APOINT
.POINT=APOINT
/
/
	.TITLE	NON ARITHMETIC OPERATION TABLE
/
.OPST=.-40
	JMP*	.STORP		/ STORE			OPCODE 40
	JMP*	.STORN		/ STORE NEGATIVE	OPCODE 41
	JMP	MOVE1		/ MOVE OUT		OPCODE 42
	JMP	CALL		/ CALL			OPCODE 43
	JMP	ERR25		/ (UNUSED)		OPCODE 44
	JMP	SUBSRP		/ SUBSCRIPT		OPCODE 45
	JMP	DO		/ DO			OPCODE 46
	JMP	UNDO		/ END OF DO		OPCODE 47
	JMP	GOTO		/ GO TO			OPCODE 50
	JMP	GOTOB		/ GO TO ( ),I		OPCODE 51
	JMP	IFA		/ ARITHMETIC 'IF'	OPCODE 52
	JMP	IFL		/ LOGICAL 'IF'		OPCODE 53
	JMP	IFLN		/ NEGATIVE LOGICAL 'IF'	OPCODE 54
	JMP	.READ.		/ READ ENTRY		OPCODE 55
	JMP	.WRIT.		/ WRITE ENTRY		OPCODE 56
	JMP	.GROUP		/ READ,WRITE AN ARRAY	OPCODE 57
	JMP	.SINGL		/ SINGLE VARIABLE	OPCODE 60
	JMP	.FINIS		/ END OF LIST		OPCODE 61
	JMP	STCODE		/ STATEMENT NUMBER CODE	OPCODE 62
	JMP	TRACON		/ $TRACEON		OPCODE 63
	JMP	TRACOFF		/ $TRACEOFF		OPCODE 64
	JMP	ERR25		/ OPCODE 65
	JMP	ERR25		/ OPCODE 66
	JMP	ERR25		/ OPCODE 67
	JMP	ERR25		/ OPCODE 70
	JMP	ERR25		/ OPCODE 71
	JMP	ERR25		/ OPCODE 72
	JMP	ERR25		/ OPCODE 73
	JMP*	AUTO1		/ ENTER MACHINE CODE	OPCODE 74
	JMP	PAUSE		/ PAUSE			OPCODE 75
	JMP	RTRN0		/ RETURN		OPCODE 76
	JMP	STOP		/ STOP (LEAVE)		OPCODE 77
/
ERR25	LAW	25		/ ILLEGAL OP CODE
	JMP	.NERR
/
	.TITLE	MOVE
/
/ THE FOLLOWING IS THE "MOVE1" OPCODE. IT IS USED
/ IN THE CASE OF SIMPLE ASSIGNMENTS WHERE BOTH SIDES
/ OF THE EQUAL SIGN ARE OF THE SAME MODE.
/ CHARACTER VARIABLES ARE ALWAYS LOAD,STORE; NEVER MOVE
/
/
MOVE1	LAC*	AUTO1	/GET DESTINATION CODE
	TAD	TABLE
	DAC	BOX	/OTABLE ENTRY ADDRESS
	RAL		/MOVE=00
	CLA!RAL		/MOVEN=40
	DAC	BOXX	/=1 FOR MOVEN
	LAC*	BOX
	.AND	(077777	/ CLEAR OFF BITS FOR PDP-15
	DAC*	(AUTO3	/DESTINATION ADDRESS
	.LACI	BOX	/ REGAIN FULL WORD
/
/ DO MODE SPLIT UP
/
	SMA!RAL
	JMP	MOVE4	/REAL,INTEGER
	SPA!RTL
	JMP	MOVE8	/LOGICAL
	SNL
	JMP	MOVE2	/C*8
/
/ ENTER HERE FOR C*16 (L=1)
/
	LAC*	AUTO2
	XOR	BOXX	/CHANGE SIGN IF MOVEN
	DAC*	AUTO3
	LAC*	AUTO2
	DAC*	AUTO3
	LAC*	AUTO2
	DAC*	AUTO3
	LAC*	AUTO2
	DAC*	AUTO3
/
MOVE2A	SNL		/SKIP IF C*16 OR R*8
	JMP	MOVE3	/MUST BE R*4
/
/ ENTER HERE FOR C*8,(L=0),R*8(L=1)
/
MOVE2	LAC*	AUTO2
	XOR	BOXX	/CHANGE SIGN IF MOVEN
	DAC*	AUTO3
	LAC*	AUTO2
	DAC*	AUTO3
/
/ ENTER HERE FOR R*4 (L=0)
/
MOVE3	LAC*	AUTO2
	SNL
	XOR	BOXX	/CHANGE SIGN IF MOVEN AND R*4 OR C*8
	DAC*	AUTO3
MOVE7	LAC*	AUTO2
	DAC*	AUTO3
	JMP*	.NEXT
/
/ ENTER HERE TO SPLIT INTEGER FROM REAL
/
MOVE4	SPA!RTL
	JMP	MOVE2A	/R*8(L=1) OR R*4(L=0)
/
/
	LAC	BOXX
	SNL
	JMP	MOVE6	/SINGLE INTEGER
	SNA
	JMP	MOVE3	/I*4 AND MOVE
/
/ HAVE MOVEN OF I*4 - MESSY,ISN'T IT
/
	LAC*	AUTO2
	CMA
	DAC	BOX	/COMPLEMENT OF FIRST WORD
	CLL!CLA!CMA	/SET L=0,AC=-1
	TAD*	AUTO2
	LMQ!CMQ		/COMPLEMENT OF SECOND WORD
	CLA!RAL		/AC=1 IF CARRY
	TAD	BOX
	DAC*	AUTO3
	LACQ
	DAC*	AUTO3
	JMP*	.NEXT
/
MOVE6	SNA!CLA!CMA	/-1 TO AC
	JMP	MOVE7	/I*2 AND MOVE
MOVE10	TAD*	AUTO2
	CMA		/FORM COMPLEMENT
	DAC*	AUTO3
	JMP*	.NEXT
/
/ MOVE AND MOVEN LOGICAL
/
MOVE8	LAC	BOXX
	SZA!CLA
	JMP	MOVE10	/LOGICAL AND MOVEN
	JMP	MOVE7
/
	.TITLE	CALL SUBROUTINE OR FUNCTION
/
/ THE ROUTINES TO HANDLE SUBROUTINE AND FUNCTION CALLS
/
/
/
/
/ NORMAL CALL TO FUNCTION OR SUBROUTINE
CALL	XCT*	L.BOX
	DAC	BOX	/ SUBROUTINE ADDRESS
	LAC*	AUTO1	/ ARGUMENT STRING ADDRESS
	TAD	TABLE
	DAC	BIN
	LAC*	BIN	/ ABSOLUTE ADDRESS OF ARG. STRING
	DAC	APOINT	/ARGUMENT STRING POINTER FOR .ARG AND .FETCH
	JMS*	BOX		/ EXIT TO SUBROUTINE VIA 'BOX'
	JMP*	.NEXT		/ MACRO SUBROUTINES RETURN HERE.
				/ FORTRAN SUBROUTINES RETURN VIA
				/ '.RTRN4', '.RTRN2', 'RTRN0'
/
	.TITLE	SUBSCRIPT EVALUATION ROUTINE
/
SUBSRP=.
	.IFDEF	PDP15
	XCT*	L.BOX		/MODE BITS MUST BE OBTAINED AT THIS
	DAC	WRITES		/POINT FOR PDP-15, & SAVED TEMPORARILY
	.ENDC
	IDX*	.BOX	/ STEP TO DIMENSION
	XCT*	L.BOX
	.AND	(077777
	DAC*	(AUTO3	/ POINT TO DIMENSION TABLE
	LAC*	AUTO3
	DAC	BOXX	/ BASE ADDRESS OFFSET
/
	LAC*	AUTO3
	DAC	SIZE	/ ARRAY SIZE
/
LOOP	LAC*	AUTO1	/ SUBSCRIPT POINTER
	SPA
	JMP	NOTROW	/ SUBSCRIPT ACC. OR MISSING SUBSCRIPT
	TAD	TABLE
	DAC	BIN	/ POINTER TO SUBSCRIPT ADDRESS
	RTL		/ SET L=1 FOR ROW INDEX
/
	LAC*	BIN
	.AND	(077777
	DAC*	(AUTO4	/ ADDRESS OF SUBSCRIPT
	.LACI	BIN
	SPA!RTL
	JMP	TEMPIS	/ COMPLEX,D. COMPLEX,LOGIC,CHAR TEMP. ACC
	SZL!SPA!RTR
	JMP	DOUBIS	/ 2 WORD INTEGER,(REAL, DOUBLE)
/
/ SINGLE INTEGER SUBSCRIPT
/
TIE4	LAC*	AUTO4	/ SUBSCRIPT
	SZL
	JMP	ROWDEX	/ IT WAS THE ROW INDEX
	GSM		/ 1'S COMP IF NEG
	SZL
	TAD	(1	/ FORM 2'S COMPLEMENT
	DAC	MULTPY
/
	LAC*	AUTO3	/ ROW MULIPLIER
	MULS
MULTPY	XX
	GS!LACQ
	SZL!CLL		/ TEST IF NEGATIVE
	TAD	(1	/ MAKE INTO 2'S COMP
	TAD	BOXX
	DAC	BOXX
	JMP	LOOP
/
NOTROW	RAL		/ TEST IF SUB. ACC OR
	SPA!CLL!RAR	/ MISSING SUBSCRIPT
	JMP	SUBACR	/ ITS SUBSCRIPT ACC.
	.AND	(077777	/ TO KEEP PDP-15 HAPPY
	TAD*	(AUTO3	/ ADJUST POINTER FOR MISSING SUBSCRIPT
	DAC*	(AUTO3
	JMP	LOOP
/
ROWDEX	TAD	BOXX
	DAC	BOXX
	LAC*	AUTO1
SUBACR	TAD	TABLE
	DAC	BIN	/ GIVES POINTER TO SUBSCRIPT ADDRESS
/
	RTL		/ TEST IF CONSTANT SUBSCRIPT ADJUSTMENT FOLLOWS
	SPA!CLA		/ (IE. WAS FORM '70  SUB.ACC.' )
	TAD*	AUTO1	/ ADD CONSTANT SUBSCRIPT ADJUSTMENT
	TAD	BOXX
	DAC	BOXX
/
JOINS	SPA!CMA!CLL
	JMP	ERR13	/ NEG. SUBSCRIPT ILLEGAL(IE. REL. ARRAY ADDRESS)
	TAD	SIZE
	SPA!CLA
	JMP	ERR13	/ SUBSCRIPT > ARRAY SIZE, ERROR.
/
	.IFDEF	PDP15
	LAC	WRITES
	AND	(700000		/RECOVER MODE BITS FOR PDP-15
	.ENDC		/TOTAL OF 10 USEC PENALTY FOR PDP-15 OVER PDP-9
	TAD*	(AUTO2	/ BASE ADDRESS
	SPA!RTL
	JMP	A1	/ COMPLEX,LOGICAL,CHARACTER
	SPA!RAR
	JMP	A33	/ I*4,R*8
	SMA!RTR
	JMP	A2	/ I*2
A0	TAD	BOXX
A7	RAL
A6	DAC*	BIN
	JMP*	.NEXT
/
A1	SPA!RAR
	JMP	A5	/C*16, CHARACTER
	SMA!RTR
	JMP	A44	/ C*8
/
A2	RAL
	TAD	BOXX
	JMP	A6
/
A33	SPA!RTR		/ SKIP IF I*4
A44	TAD	BOXX	/ R*8,C*8
	JMP	A0
/
A5	SPA!RTR
	JMP	CHKCHR	/ CHARACTER
	RTR
	TAD	BOXX
	RTL
	JMP	A7
/
/ POSSIBLE DOUBLE INTEGER SUBSCRIPT. IGNORE MOST SIG WORD
DOUBIS	RTL
	SNL!RTR
	JMP	TIE2	/ DOUBLE INTEGER
ERR12	LAW	12		/ ILLEGAL SUBSCRIPT MODE
	JMP	.NERR
/
/ COMPLEX, DOUBLE COMPLEX, LOGICAL, CHARACTER OR TEMPORARY ACC.
/ ONLY DOUBLE INTEGER TEMPORARY ACCUMULATOR IS LEGAL
/
TEMPIS	CMA!CLL
	SZL!SPA!RTL
	JMP	ERR12	/ LOGICAL, COMPLEX
	LAC*	AUTO4	/ IT IS TEMP. ACC, GET CONTROL BITS
	SZA!CML		/ RECOVER ROW INDEX CONTROL BIT
	JMP	ERR12	/ REAL, COMPLEX, CHAR
TIE2	LAC*	AUTO4	/ BY-PASS FIRST WORD OF 2 WORD INTEGER
	JMP	TIE4	/ DOUBLE INTEGER
/
ERR13	LAW	13	/SUBSCRIPT OUT OF RANGE
	JMP	.NERR
/
/
CHKCHR	LAC*	BIN	/GET ADDRESS OF 2 WORD SUBSCRIPTING DOPE VECTOR
	.AND	(077777	/ MORE FOR THE PDP-15
	DAC*	(AUTO3
	LAC*	AUTO2	/GET CHAR SIZE FROM ARRAY DOPE VECTOR
	DAC*	AUTO3	/INSERT IN NEW DOPE VECTOR
	AND	(077777	/ GET CHARACTER/ELEMENT
	DAC*	SIGNA
	JMS	ELMLGH	/ GET WORDS/ELEMENT
	MUL		/ CACULATE TOTAL DISPLACEMENT IN WORDS
BOXX	XX
	LACQ
	TAD*	AUTO2	/ ADD BASE ADDRESS OF ARRAY
	AND	(077777		/REMOVE CHARACTER ARRAY MARKER (4)
	DAC*	AUTO3	/STORE IN SUBSCRIPTING DOPE VECTOR
	JMP*	.NEXT
/
	.TITLE	'DO'
/  INITIATE DO LOOP COUNTER  OPCODE 
/
DO	LAC*	AUTO1	/ SET UP POINTER
	TAD	TABLE	/ TO DO CONTROL FIELD
	DAC	BIN
	SPA		/ CHECK WHETHER REVERSE SIGN IS REQUIRED
	JMS*	.CMPIT	/ COMPLIMENT THE NUMBER
	JMS*	.STORE	/STORE INITIAL VALUE
	LAC*	MODEA
	SZA
	JMP	ERR14	/NON-INTEGER INDEX
	LAC*	BIN
	.AND	(077777
	DAC*	(AUTO3
	XCT*	L.BOX	/ MAKE MODE BITS 0 OR 7
	TAD	(700001	/AND POINT AT ACTUAL LOCATION OF I
	DAC	APOINT
	DAC*	AUTO3
	JMS	YANKIT	/PUT L IN CONTROL FIELD
	SAD*	INT2
	SZA
	SKP
	JMP	ERR15	/ INCREMENT IS L=0, ILLEGAL
	JMS	YANKIT	/PUT K IN CONTROL FIELD
	LAC*	(AUTO1	/SET UP RETURN ADDRESS
	DAC*	AUTO3
	JMP*	.NEXT
/
YANKIT	XX
	LAC	(YANKED	/SET RETURN ADDRESS
	DAC	.FETCH
	LAC	(QLOAD*10000
	LMQ
	LAC	(10	/ OFFSET TO LOAD NEGATIVE FROM LOAD
	DAC	BIN
	LAC*	AUTO1
	SMA!CLL
	DZM	BIN
	JMP*	.NEXT3
YANKED	TAD	BIN
	JMS*	.PSHBA
	JMS*	.IFIX
	LAC	APOINT	/GET MODE OF INDEX OF DO
	SMA
	JMP	YANKTO	/DOUBLE INTEGER
	LAC*	INT2	/ SINGLE INTEGER
	DAC*	AUTO3
	SPA!CLA
	CMA
	SAD*	INT1
	JMP*	YANKIT
/
ERR14	LAW	14		/ NON-INTEGER INDEX IN 'DO'
	JMP	.NERR
ERR15	LAW	15		/ZERO INCREMENT
	JMP	.NERR
/
YANKTO	LAC*	INT2	/STORE TWO WORD QUANTITY BACKWARDS
	DAC*	AUTO3
	LAC*	INT1
	DAC*	AUTO3
	JMP*	YANKIT
/
/
/ END OF DO LOOP OPCODE
/ FOR SIMPLE INTEGER I THE TERMINATION OF DO 1 I=J,K,L COMPILES AS
/	UNDO	@1
/ WHERE @1 CONTAINS THE FOLLOWING 4 WORDS
/	1) ADDRESS OF I
/	2) VALUE OF L
/	3) VALUE OF -K
/	4) RETURN ADDRESS
/ THIS INFORMATION IS SET UP BY THE DO OPCODE
/
UNDO	LAC*	AUTO2
	DAC	BOX	/INDEX ADDRESS
	SMA!CLL
	JMP	UNDO2	/DOUBLE INTEGER
	LAC*	AUTO2	/GET INCREMENT
	DAC	BIN
	TAD*	BOX	/UPDATE INDEX
	DAC*	BOX
	TAD*	AUTO2	/ADD -LIMIT
	SNA
	JMP	UNDO4
UNDO3	XOR	BIN
	SMA
	JMP*	.NEXT	/DO FINISHED
UNDO4	LAC*	AUTO2
CONT1	DAC*	(AUTO1
	JMP*	.NEXT	/REPEAT LOOP
/
UNDO2	DAC	BOXX	/ADDRESS OF SECOND WORD
	IDX	BOXX	/OF DOUBLE INTEGER
	LAC*	AUTO2	/INCREMENT SECOND WORD
	TAD*	BOXX
	DAC*	BOXX
	LAC*	AUTO2
	DAC	BIN
	SZL
	TAD	(1
	TAD*	BOX
	DAC*	BOX
	CLL
	LAC*	BOXX
	TAD*	AUTO2
	DAC	BOXX
	CLA!RAL
	TAD*	BOX
	TAD*	AUTO2
	SZA
	JMP	UNDO3
	LAC	BOXX
	SZA!CLL!RAR	/ MAKE SURE 1ST BIT NOT MISTAKEN FOR MINUS SIGN
	JMP	UNDO3
	JMP	UNDO4
/
	.TITLE	COMPUTED GOTO
/
/
/  COMPUTED GO TO ROUTINE
/
GOTOB	LAC*	MODEA
	SZA
	JMS*	.FIX
	LAC*	AUTO2	/GET NUMBER OF ADDRESSES
	DAC	BIN
	LAC*	INT1
	SZA!CMA!CLL
	JMP	GFALL	/NEGATIVE  OR >2**18-1
	XOR	BIN	/-M+1
	TAD*	INT2
	SZL!SNA
	JMP	GFALL
	LAC*	INT2
	SNA
	JMP	GFALL	/ZERO ARGUMENT
	TAD*	(AUTO1
	DAC	BIN
	LAC*	BIN
	JMP	GOTIE
/
/ THE COMPUTED GO TO INDEX IS NOT VALID, FALL THROUGH
/
GFALL	LAC	BIN
	TAD*	(AUTO1
	JMP	CONT1
/
	.TITLE	'IF' STATEMENT ROUTINES
/
/
/
/ ARITHMETIC 'IF'
IFA	LAC*	MODEA	/ GET MODE
	SNA
	JMP	IF2	/ INTEGER, SINGLE OR DOUBLE
/
/ ITS REAL
	LAC*	MOSTA	/ MOSTA= 000000 FOR ZERO
	SNA
	JMP	GOTO
	LAC*	SIGNA	/ SIGNA= 1 FOR NEGATIVE, = 0 FOR POSITIVE
	SZA
/
IFNEG	LAC*	AUTO1	/ NEGATIVE
IFPOS	LAC*	AUTO1	/ POSITIVE
GOTIE	TAD	TABLE
	DAC	BOX
	LAC*	BOX
	JMP	CONT1
/
/ ITS INTEGER
IF2	LAC*	INT1	/ GET MOST SIG. WORD
	SPA
	JMP	IFNEG	/ ITS NEGATIVE
	SZA
	JMP	IFPOS	/ NUMBER IS POSITIVE
	LAC*	INT2	/ GET LEAST SIG. WORD (MOST SIG. WORD=0)
	SZA
	JMP	IFPOS
/ ENTRY POINT FOR 'GOTO' OPERATION
GOTO	XCT*	L.BOX
	JMP	CONT1
/
/ LOGICAL 'IF'
IFL	ISZ*	LOGACC
	JMP	GOTO	/ FALSE
	JMP*	.NEXT	/ TRUE
/
IFLN	ISZ*	LOGACC
	JMP*	.NEXT
	JMP	GOTO
/
	.TITLE	STATEMENT NUMBERS & TRACE FEATURE
/
/ THIS SECTION PROCESSES THE STATEMENT NUMBER CODES WHEN THEY ARE
/ GENERATED
STCODE	LACQ		/ GET ADDRESS FROM THIS INSTRUCTION
	DAC*	TABLE3	/ STORE IN 3RD ENTRY OF TABLE
ENABLE	JMP*	.NEXT		/CHANGED TO 'NOP' TO ENABLE TRACE
	LAC	TABLE
	TAD	(2		/PREPARE TO GET PROGRAM NAME
	DAC*	(AUTO4
	.WAIT	TRDV		/WAIT FOR POSSIBLE PREVIOUS I/O
	LAC*	AUTO4
	DAC	TNAME		/GET NAME
	LAC*	AUTO4
	DAC	TNAME+1
	LAC*	AUTO4
	DAC	TNAME+2
	LAC	(TNUM
	JMS	SETPUT		/POINT 'PUT' AT TRACE NUMBER BUFFER
	CLLS	14		/GET STATEMENT NUMBER FROM MQ
	JMS	G.CVRT		/CONVERT TO DECIMAL & PACK AS ASCII
	LAC	(CARAGE
	JMS	PUT		/APPEND CARRIAGE RETURN
	.WRITE	TRDV,2,TRNUMB,0	/WRITE OUT LINE NUMBER
STCEND	JMP*	.NEXT	/ RETURN
/
TRNUMB	4002; 0
TNAME	0; 0
	.ASCII	<0><0><0>'  '
TNUM	0; 0
/
TRACON	LAC	(NOP		/ENABLE TRACE
	SKP
TRACOFF	LAC	STCEND		/DISABLE TRACE
	DAC	ENABLE
	JMP*	.NEXT
/
	.TITLE	'RETURN'
/
/ RETURN CODES
/ 'RETURN N' (VARIABLE) ENTRIES
/
.RTRN4	LAC*	AUTO2	/ FIRST WORD MUST BE ZERO
	SZA
	JMP	ERR16
.RTRN2	LAC*	AUTO2
	SPA!SNA
	JMP	ERR16	/ MUST BE GREATER THAN ZERO
	TAD	TABLE	/ CALCULATE ADDRESS OF
	TAD	(5
	DAC*	.BOX	/ OTABLE ENTRY FOR RETURN
/
/ CHECKS THAT N NOT TOO BIG
	CMA
	TAD	TABLE	/ AC_ -N-6
	TAD*	AUTO1	/ -N-6+(MAX N+6)
	SPA
	JMP	ERR16
/
/ 'RETURN I' (CONSTANT) ENTRIES HERE
RTRN0	LAC*	TABLE		/ GET PREVIOUS OTABLE ADDRESS
	DAC*	.TABLE	/ RESET OTABLE ADDRESS IN .ARITH
	DAC	TABLE	/ RESET OTABLE ADDRESS
	TAD	(2
	DAC	TABLE3	/ POINT TO STATEMENT COUNT
	XCT*	L.BOX
	DAC*	(AUTO1
	SZA		/ IF ADDRESS NOT SET UP ITS ZERO
	JMP*	.NEXT
ERR64	LAW	64		/ VARIABLE RETURN ADDRESS NOT SET UP
	JMP	.NERR
/
ERR16	LAW	16	/'N' OUT OF RANGE
	JMP	.NERR
/
	.TITLE	PAUSE, STOP
/
/ THE FOLLOWING CODE HANDLES THE PAUSE AND STOP STATEMENTS OF
/ FORTRAN WHICH ARE THE 'PAUSE' AND 'LEAVE' OPCODES
PAUS	.ASCII '     PAUSE '<175>
	.LOC	.-1
STP	.ASCII '     STOP '<175>
	.LOC	.-1
DEAD	.ASCII '*****'
/
/ BUFFER FOR STOP AND PAUSE MESSAGE
BUFFS	.ASCII '     '
BUFFS1
BUFFS2
	.ASCII <215>
/
/ PAUSE
PAUSE	LAC	(PAUS
	JMS	WRITES
	JMP	.
/
/ CHECK FOR ANY DAT SLOTS OPEN FOR OUTPUT AND CLOSE THEM
/
ERR36	LAW	36		/ CONTROL COMES HERE ON '^P'
.NERR	JMS	.ERROR		/ENTRY FOR FATAL ERRORS
STOPX	LAC	(DEAD-1
	DAC*	(AUTO2
STOP	DZM	DEVICE
NEXTD	IDX	DEVICE	/ STEP TO NEXT DEVICE
	CLL
	JMS	PTSLOT	/ SET POINTERS TO DAT SLOT ENTRY
	LAC*	SPOINT	/ GET STATUS INDICATOR
	SAD	(1
	JMS	CLOSER	/ ITS OPEN FOR OUTPUT, CLOSE IT.
	SAD	ENSLOT	/ ARE WE DONE TABLE
	JMP	DNCLOS
	JMP	NEXTD
/
DNCLOS	LAC	(STP
	JMS	WRITES
	LAW	-1
	DAC	IODONE		/IN CASE I/O WAS UNDERWAY
	LAC	(JMP CLSM12	/CLOBBER RETURN TO
	DAC	RTRN0		/TRAP EXIT FROM 'ERRORP'
	JMS	ERRORP		/GO PRINT ERROR LOG
CLSM12	.CLOSE	ERDV		/CLOSE .DAT -12
EXIT	.EXIT
/
WRITES	XX
	DAC	WRIT+2
	.WAIT	TTO
	.INIT	TTO,1,PAUSES
WRIT	.WRITE	TTO,2,WRIT,34
	LAC*	AUTO2
	DAC	BUFFS1
	LAC*	AUTO2
	DAC	BUFFS2
	.WRITE	TTO,2,BUFFS,34
	.WAIT	TTO
	JMP*	WRITES
	.TITLE	WATRAN INTERPRETER I/O PACKAGE
/
/ THIS SUBROUTINE SETS UP THE INTERNAL DAT. SLOT TABLE WITH
/ THE FILE NAME FOR LATER USE
/ CALLING SEQUENCE    CALL OPEN(N,'FILNAMSRC')
OPEN	XX
	JMS	CLOSE	/ CLOSE IF IT WAS OPEN
	IDX	APOINT	/ STEP TO NEXT ARGUMENT
	LAC*	APOINT	/ PICK POINTER UP FROM APOINT
	SAD	(600000
	JMP	ERR34	/ ERROR, END OF LIST
	DAC*	.BOX	/ SET UP FOR GETSIZ ALSO
	XCT*	L.BOX
	JMS	SETFOR	/ SET UP SORTER
	JMS	GETNAM	/ GET AND STORE FILE NAME IN TABLE
	JMP*	OPEN
/
ERR34	LAW	34		/ MISSING ARGUMENT IN 'CALL OPEN'
	JMP	.NERR
/
/ THIS SUBROUTINE CAUSES THE FILE TO BE CLOSED AND CLEARS THE INTERNAL
/ DAT SLOT TABLE
CLOSE	XX
	JMS	.FETCH	/ GET DEVICE NUMBER
	XCT*	L.BOX	/ GET MODE BITS
	JMS	CHECKN	/ CHECK UNIT NUMBER,SETS UP 'DEVICE' & 'SPOINT'
	JMS	CLOSER	/ CLOSE THE FILE
	LAW	-1
	DAC*	FLPT1	/ INITIALIZE THE FILE NAME TO AN IMPROBABLE NAME
	DAC*	FLPT2
	DAC*	FLPT3
	LAC	(777
	DAC*	SPOINT	/ INDICATE DEVICE NOT IN USE
	JMP*	CLOSE
/
/ THIS SUBROUTINE CLOSES THE FILE
CLOSER	XX
	LAC*	SPOINT
	SAD	(777
	JMP*	CLOSER	/ DAT SLOT NOT IN USE.
	LAC	DEVICE
	SAD	(11
	JMP*	CLOSER	/ CLOSE NOT NEEDED FOR CHAR UNIT
	SAD	WAITR+1	/ IF DEVICE WAS LAST ONE IN USE, REMOVE WAIT
	DZM	WAITR+1	/ SINCE A .WAIT ON A CLOSED .DAT SLOT RESERVES IT.
	DAC	CLOSES
CLOSES	0
	.DSA	6
	JMP*	CLOSER
/
ERR35	LAW	35	/ ERROR - ATTEMPT TO PERFORM I/O IN A FUNCTION
	JMP	.NERR	/ WHICH IS CALLED IN AN OUTPUT STATEMENT
/
/
/
/ ENTER HERE FOR READ AND WRITE STATEMENTS
/
.WRIT.	STL
	SKP!CLA!RAL	/ AC_1
.READ.	CLA		/ AC_0
	DAC	IO	/SET DIRECTION OF I/O SWITCH 
	ISZ	IODONE	/CHECK THAT I/O IS NOT UNDERWAY - ERROR IF IT IS
	JMP	ERR35
	XCT*	L.BOX
	JMS	CHECKN	/ CHECK THE UNIT NUMBER AND SET THE DEVICE NUMBER
/
L.SPOI	LAC*	SPOINT
	SAD	IO
	JMP	RW5	/SLOT SET FOR CURRENT DIRECTION
/
/DATA SLOT NOT SET UP.  MAY HAVE TO CLOSE OLD USE.  MUST OPEN 
/FOR NEW USE.
/
	JMS	CLOSER	/ CHECK THE FILE
/
/ CONSTRUCT .INIT AND .FSTAT
/
RW4	LAC	IO		/ UNDER DOS, WE DO NOT WANT THE
	SZA			/ LINE PRINTER HANDLER TO INSERT
	LAC	(5000		/ ITS OWN FORM FEEDS.  THIS ACTION
	XOR	DEVICE		/ SHOULD NOT AFFECT OTHER DEVICES.
	DAC	INIT	/.INIT IS SET UP
/
	LAC	DEVICE	/BUILD .FSTAT
	XOR	(3000
	DAC	FSTAT
REDO	LAC	FLPT1	/CLEAR FILE ORIENTATION BIT
	DAC	FSTAT+2
/
INIT	.INIT 0,0,ERR36	/EXPANDS TO 4 WORDS
/
/ GET THE SIZE OF THE LINE BUFFER
/ MAX=134(10) , INCLUDES CARRIAGE CONTROL, 132 CHARACTERS, CARRIAGE RETURN
	LAW	-2		/ACCOUNT FOR HEADERS
	TAD	INIT+3	/ SET BUFFER TO MIN(133,HANDLER LIMIT)
	RCR
	GS!MUL
		5
	LACQ
	TAD	(-205
	SMA
	CLA
	TAD	(BUFFER+204
	CMA
	DAC*	SZPTR	/GIVES 2'S COMPLEMENT
/
FSTAT	.FSTAT	0,FSTAT
/
/ CHECK IF DEVICE IS FILE ORIENTED, IF NOT CONTINUE
/ CHECK IF WE HAVE A FILE NAME
/
	SZA		/IS DEVICE FILE ORIENTED
	JMP	BLDSEN	/YES,FILE FOUND
	LAC	FSTAT+2	/MAYBE, MAYBE NOT
	AND	(700000
	SNA
	JMP	RW10	/NON-FILE ORIENTED
/
/ FILE ORIENTED, FILE NOT FOUND
/
	LAC*	FLPT1
	SAD	(777777	/ IS IT STILL INITIALIZED VALUE
	JMP	REQNAM	/NO FILE NAME, REQUEST ONE
/
/ HAVE FILE NAME, FILE NOT FOUND
/
	LAC	IO
	SZA
	JMP	BLDSEN	/OKAY, ITS A WRITE!
/
ERR33	LAW	33	/ERROR, ATTEMPT TO READ A NON-EXISTANT FILE
	JMS	.ERROR
/
/ ISSUE ERROR AND RETURN TO FALL THROUGH 
/ ALLOW USER TO RESPECIFY NAME
/
/
REQNAM	LAC	DEVICE
	TAD	(60	/ CONVERT TO ASCII
	RAL
	LMQ
	LAC	MESAGE+13
	AND	(777400	/ CLEAR OFF OLD BITS
	OMQ
	DAC	MESAGE+13
/ PRINT OUT THE MESSAGE
PRTMES	.WAIT	TTO
	.WRITE	TTO,2,MESAGE,10
	.READ	TTI,2,BUFFER,9
	.WAIT	TTI
	LAC	BUFFER+5
	AND	(377	/ LOOK AT LAST CHAR
	SAD	(32
	JMP	NMGOOD	/ OKAY, CARRIAGE RETURN MEANS 9 CHARS
	SAD	(372
	JMP	NMGOOD	/ OKAY, ALTMODE
	JMP	PRTMES
/ TYPED IN NAME CONTAINS 9 CHARACTERS
NMGOOD	LAC	(600011	/ MARK AS CHARACTER VARIABLE
	DAC	BUFFER+1
	LAC	(700000!BUFFER	/ FUDGE UP AS A FORMAT
	JMS	SETFOR	/ SET UP SORTER
	JMS	GETNAM	/ GET AND STORE FILE NAME
	JMP	REDO	/ GO PROCESS THIS NAME
/
MESAGE	.ASCII '     ENTER FILE NAME, DEVICE  '<215>
/
/ WE HAVE A FILE NAME NOW, INITIATE I/O
/
BLDSEN	LAC	DEVICE	/BUILD SEEK OR ENTER
	DAC	SEKENT
	LAC	IO
	TAD	(3
	DAC	SEKENT+1
	LAC	FLPT1	/ POINTS TO FILE NAME
	DAC	SEKENT+2
SEKENT	0		/ SEEK OR ENTER
	0
	0
/
/ NOW READY TO READ OR WRITE
RW10	LAC	IO
	DAC*	SPOINT	/RECORD DIRECTION OF DATA FLOW
/
/ DECIPHER WORDS AFTER WRITE OR READ TO SET UP BINARY, FREE FORMAT,
/ 'END=', AND REGULAR FORMAT. IF BINARY I/O WAS UNDERWAY WAIT FOR IT.
RW5	LAC	BINSW
	SZA
	JMS	OWAITR	/ DO THE WAIT
	DZM	BUNCH	/ MARK AS NO ARRAY
	DZM	DATEND	/ CLEAR END= ADDRESS
	DZM	FREESW	/ CLEAR FREE FORMAT SWITCH
	DZM	BINSW	/ CLEAR BINARY SWITCH
RW6.1	LAC*	AUTO1	/ GET 1ST WORD AFTER OPCODE
	SPA		/ IS IT BINARY, OR END=
	JMP	MAYBIN	/ YES.
	SNA		/ IS IT FREE FORMAT
	JMP	FFREE	/ YES.
	TAD	TABLE	/ ITS REGULAR FORMAT. SET UP TO OTABLE
	DAC	BOX
	DAC*	.BOX		/UPDATE POINTER IN .ARITH
	LAC*	BOX	/ GET OTABLE ENTRY
	JMS	SETFOR	/ SET UP TO FORMAT,SET CHARCT, WORDCT
/
/ BUILD UP .READ OR .WRITE
RW6.2	LAW	-70
	DAC	DOIO.3	/ SET UP FOR ASCII LINE SIZE (MAX 134 CHARS)
	LAC	(2000
RW7	XOR	DEVICE	/ INSERT DEVICE NUMBER
	DAC	DOIO.
	LAC	IO
	TAD	(10
	DAC	DOIO.1	/EITHER READ=10, OR WRITE=11
	LAC	BINSW
	SZA!CLL
	STL
	LAC	(BINBUF
	SNL
	LAC	(ABUFFR
	DAC	DOIO.2
/
	LAC	IO
	SZA		/ IS I/O READ OR WRITE
	JMP	RW9	/ ITS WRITE
/
/PERFORM INITIAL INPUT OPERATION FOR THIS READ OPERATION
	JMS	OWAITR	/ WAIT FOR LAST WRITE OPERATION
	JMS	INOUT	/ DO FIRST READ AND WAIT UNTIL COMPLETE
	LAC	BINSW	/ CHECK IF A BINARY READ
	SZA
	JMS	GETIT	/ YES IT IS. DO A SPECIAL SETUP
RW7.1	LAC	FREESW
	TAD	BINSW
	SZA
	JMP*	.NEXT	/ EXIT IF BINARY OR FREE FORMAT
/
/ FPOINT,CHARCT, AND WORDCT ARE NOW ALL SET
	DZM	XNUM	/NO DATA AVAILABLE
	DZM	NSAVE	/SET UP ROUTINE FOR
	LAW	-1	/HANDLING OPENING
	DAC	LEVCNT	/PARENTHESIS
	LAC	(RTABLE-1
	DAC	BRKLIT
/
	JMS	GLETR
	DZM	NCONT2	/MULTI-REPEATS ON FIRST(
	JMP	FSTART
/
/ HAVE EITHER BINARY OR END=
MAYBIN	SAD	(400000	/ IS IT BINARY
	JMP	ITSBIN	/ YES
	DAC	DATEND	/ NO. ITS 'END='. STORE THE OTABLE ADDRESS
	JMP	RW6.1	/ GO PROCESS THE NEXT WORD
/ HAVE FOUND BINARY
ITSBIN	SET	BINSW
	DZM	PHYCNT	/ SET RECORD COUNT
	LAW	-377
	DAC	DOIO.3	/ MAX SIZE FOR BINARY RECORD
	CLA
	JMP	RW7	/ GO BUILD UP READ OR WRITE
/
/ FREE FORMAT COMES HERE
FFREE	DZM	LEVCNT	/ FOOL SUBROUTINE 'CLOSIT'
	SET	FREESW	/ MARK AS FREE FORMAT
	JMP	RW6.2	/ GO BUILD ASCII READ OR WRITE
/
/ WE HAVE A WRITE OPERATION
RW9	LAC	BINSW
	SZA
	JMP	BWRIT	/ ITS A BINARY WRITE
	LAC	(BLANKR
	JMS	BUFSET
	JMS	WONDER		/WHAT SORT OF CARRIAGE CONTROL IS WANTED?
	JMP	RW7.1
/
WONDER	XX
	LAC	FREESW		/FREE FORMAT I/O?
	SNA
	JMP*	WONDER		/NO.  FOLLOW NORMAL PROCEDURE.
	LAC	DEVICE
	SAD	(11		/CORE-TO-CORE?
	JMP*	WONDER		/YES.  NO PROCESS
	IDX	LOCATN		/INSERT CARRIAGE CONTROL CHARACTER FOR
	JMP*	WONDER		/FREE FORMAT
/
/ HAVE A BINARY WRITE. NOW MUST WAIT FOR I/O WHICH WAS NON-BINARY
/ SINCE BINARY I/O USES THE WHOLE BUFFER
BWRIT	JMS	OWAITR
	LAC	INIT+3
	AND	(777776	/ MAKE EVEN
	DAC	INIT+3	/ SAVE IT
	TAD	(-3	/ ACCOUNT FOR THE 3 HEADER WORDS
	CMA		/ 1'S COMP OF # OF WORDS TO BE FILLED IN BUFFER
	DAC*	SZPTR
	DAC	BCOUNT
	LAC	(BINBUF+3
	DAC	BPOINT
	JMP*	.NEXT
/
/
/ THIS SUBROUTINE GETS THE FILE NAME AND STORES IT IN THE TABLE
GETNAM	XX
	JMS	SNATCH
	DAC*	FLPT1
	JMS	SNATCH
	DAC*	FLPT2
	JMS	SNATCH
	DAC*	FLPT3
	JMP*	GETNAM
/
/ THIS SUBROUTINE PICKS UP 3 CHARACTERS AT A TIME FROM ANY
/ CHARACTER CONSTANT OR ARRAY USING GLETR AND RETURNS THEM AS
/ PACKED 6 BIT NUMBERS
SNATCH	XX
	JMS	SNAP
	LLS!10000	14	/ CLEAR CLQ ALSO
	DAC	SPOT
	JMS	SNAP
	LLS!10000	6	/ CLEAR MQ ALSO
	TAD	SPOT
	DAC	SPOT
	JMS	SNAP
	TAD	SPOT
	JMP*	SNATCH
/
/ THIS SUBROUTINE REPLACES SPACES WITH NULLS IN THE FILE NAME
SNAP	XX
	JMS	GLETR
	AND	(000077
	SAD	(40
	CLA
	JMP*	SNAP
/
/ THIS SUBROUTINE CHECKS THE UNIT NUMBER TO SEE IF ITS VALID,
/ AND SETS UP THE POINTERS TO THE PROPER DAT SLOT PLACE.
CHECKN	XX
	AND	(700000	/ GET MODE BITS
	SNA!CLL		/ CLEAR LINK FOR PTSLOT VIA CHUNIT
	JMP	RW2	/ SINGLE INTEGER
	SAD	(100000
	JMP	RW1	/ DOUBLE INTEGER
	SAD	(700000
	JMP	CHUNIT	/ CHAR VARIABLE UNIT
ERR37	LAW	37		/ NON-INTEGER UNIT NUMBER
	JMP	.NERR
/
/ IF I/O DEVICE IS DOUBLE INTEGER IS DOUBLE INTEGER, FIRST WORD MUST BE 0
/ 
RW1	LAC*	AUTO2
	SNA!CMA		/ AC -1
	JMP	RW3
ERR40	LAW	40		/ UNIT NUMBER OUT OF RANGE
	JMP	.NERR
/
RW2	LAW	-1
RW3	TAD*	AUTO2	/ GET I/O DEVICE -1
	DAC	DEVICE
	AND	(777770	/ VALID NUMBERS 0 TO 7
	SZA!CLL
	JMP	ERR40
	IDX	DEVICE	/ NUMBER VALID, PUT BACK IN RANGE OF 1 TO 8
	JMS	PTSLOT	/ SET POINTERS TO DAT SLOT TABLE ENTRY
	JMP*	CHECKN
/ THE UNIT # IS A CHARACTER VARIABLE. SET UP FOR I/O. THE FORM IS:
/  WORD1:  ELEMENT LENGTH IN WORDS
/  WORD2:  BASE ADDRESS OF ARRAY-1 OR ADDRESS OF VARIABLE-1
/  WORD4:  -(NUMBER OF ELEMENTS IN ARRAY) - 1
/  (NOTE: WORD3 NO LONGER EXISTS SINCE CORE-TO-CORE I/O RE-WORKED
/
CHUNIT	LAC	(11
	DAC	DEVICE
	JMS	PTSLOT	/ ANY CHARACTER UNIT IS DEVICE 11
	LAC	IO
	DAC*	SPOINT	/ CHAR UNITS ARE ALWAYS READY TO GO
	LAW	-2
	DAC	WORD4		/ASSUME 1 ELEMENT
	LAC*	AUTO2
	DAC	WORD2
	AND	(077777		/GET RID OF MODE BITS!
	DAC*	SIGNA		/NUMBER OF CHARACTERS
	TAD	(BUFFER-1
	CMA
	DAC*	SZPTR	/ 2'S COMP
	JMS	ELMLGH
	DAC	WORD1
	LAC	WORD2
	AND	(700000
	SAD	(600000
	JMP	NODOPV
/ VARIABLE HAS A DOPE VECTOR
	LAC*	AUTO2	/ GET 2ND WORD OF DOPE VECTOR
	SMA
	JMP	NOTARY	/ DOPE VECTOR IS NOT FOR ARRAY
/ CHAR VARIABLE IS AN ARRAY.
	AND	(077777
	DAC	WORD2
	JMS	GETSIZ
	CMA
	DAC	WORD4
	JMP*	CHECKN
/
/ CHARACTER VARIABLE IS SINGLE
/
NODOPV	LAC*	(AUTO2	/ ADDRESS OF VARIABLE
	DAC	WORD2
	JMP*	CHECKN
/
/ DOPE VECTOR FOR SINGLE VARIABLE
/
NOTARY	DAC	WORD2
	LAC*	(AUTO2
	SAD*	(AUTO3		/CHECK IF SUBSCRIPT DOPE VECTOR
	SKP!CLC
	JMP*	CHECKN		/NO.  SINGLE VARIABLE
	TAD	SIZE
	CMA
	TAD	BOX
	DAC	WORD4
	JMP*	CHECKN
/
/ THIS SUBROUTINE SETS UP THE POINTERS TO THE INTERNAL DAT SLOT
/ TABLE DEPENDING UPON THE DEVICE NUMBER
PTSLOT	XX
	LAC	DEVICE
	MUL
		5
	LACQ
	TAD	(SLOTS-5
	DAC	SPOINT
	TAD	(1
	DAC	SZPTR
	TAD	(1
	DAC	FLPT1
	TAD	(1
	DAC	FLPT2
	TAD	(1
	DAC	FLPT3
	JMP*	PTSLOT
/
/ THIS SUBROUTINE SETS UP THE EXTRACTION ROUTINE 'GLETR' TO PICK
/ UP CHARACTERS FROM ANY VARIABLE OR ARRAY.
/FIGURE OUT TYPE OF VARIABLE THAT FORMAT CODE IS STORED IN.
/FORMAT STATEMENTS ARE CHARACTER CONSTANTS.
/  NOTE:  WATRAN COMPILER RESTRICTS FORMAT TO BE ORDINARY
/	FORMAT (CHARACTER CONSTANT), OR AN ARRAY.
/
SETFOR	XX
	DAC	FPOINT	/ SET FORMAT POINTER
	AND	(700000
	SAD	(700000
	JMP	CHRFMT	/ CHARACTER
	JMS*	.CHRGT		/NON-CHARACTER; THUS IS ARRAY
	CMA
	TAD	(1	/ 2'S COMP OF CHARACTERS PER ELEMENT
	DAC	CHARCT
	JMP	FJOIN5		/GO TO GET # OF ELEMENTS
/
/FORMAT IS CHARACTER CONSTANT OR CHARACTER ARRAY
CHRFMT	IDX	FPOINT	/ INCREMENT TO CHARACTER COUNT
	LAC*	FPOINT	/PICK UP CHARACTER COUNT
	AND	(77777	/CLEAR TOP BITS OFF (6 OR 7)
	CMA
	TAD	(1	/GET 2'S COMPLEMENT OF COUNT
	DAC	CHARCT
	LAC*	FPOINT		/FPOINT=SINGL VAR-600000, ARRAY-700000
	RTL		/LEAVES L=1
	SMA!CLA!RAL		/AC_1
	JMP	FJOIN2	/CHARACTER CONSTANT (FORMAT STATEMENT)
/
	IDX	FPOINT	/ CHARACTER ARRAY, 2ND WORD IS POINTER
	LAC*	FPOINT	/GET ACTUAL ADDRESS AND
	DAC	FPOINT	/RESET POINTER
/
FJOIN5	JMS	GETSIZ	/GET NUMBER (N) OF ELEMENTS IN ARRAY
FJOIN2	CMA		/-N-1 IN 2'S COMP.
	DAC	WORDCT
	LAC	(G4
	DAC	GET2	/ INITIALIZE GLETR
	JMP*	SETFOR
/
/THIS SUBROUTINE GETS THE TOTAL # OF ELEMENTS IN AN ARRAY
/ CAVE CANIS: MUST NOT CHANGE THE LINK
/
GETSIZ	XX
	IDX*	.BOX	/STEP TO OTABLE ADDRESS
	XCT*	L.BOX	/OF DIMENSION TABLE
	DAC*	(AUTO3
	LAC*	AUTO3	/STEP PAST OFF-SET
	LAC*	AUTO3	/GET TOTAL ARRAY SIZE
	JMP*	GETSIZ
/
/ THIS SUBROUTINE CALCULATES THE NUMBER OF WORDS/ELEMENT
/ BASED ON THE NUMBER OF CHARACTERS/ELEMENT
ELMLGH	XX
	LAC*	SIGNA	/ NUMBER OF CHARACTERS/ELEMENT
	TAD	(2
	CLL!RAL
	IDIV
		5	/ # OF WORDS = # OF CHARS *2/5
	LACQ
	DAC	ELMSIZ
	JMP*	ELMLGH
/
/ MACRO FOR INTERNAL DAT SLOT ENTRIES
	.DEFIN	DSLOT
	.DSA	777
	0	/ CONTAINS BUFFER SIZE, & FILE NAME + EXTENSION
	777777
	777777
	777777
	.ENDM
/
/ INTERNAL DAT SLOT TABLE
SLOTS	DSLOT
	DSLOT
	DSLOT
	DSLOT
	DSLOT
	DSLOT
	DSLOT
	DSLOT
	DSLOT	/ CHARACTER VARIABLE SLOT (INTERNAL ONLY)
ENSLOT	.DSA	111111	/END OF TABLE INDICATOR
/
/ENTER AT THIS POINT TO PICK UP A NEW NUMERIC FORMAT CODE.  (MAY
/NOT GET ONE).
/
LOOK	ISZ	NCONT2	/CHECK IF NUMERIC FORMAT IS
	JMP	F6A	/BEING REPEATED.  EXIT IF YES
	DZM	RNUM
	JMP	NEXTC2	/ WE STILL HAVE A CHARACTER IN LETTER TO PROCESS
/
/  SLASHES FORCE I/O AND RE-INITIALIZATION OF INPUT-OUTPUT BUFFER,
/  THEN SEARCH FOR NEXT SPECIFICATION.
/
SLA	JMS	INOUT		/DO I/O TAND INITIALIZATION
/
/SEARCH FORMAT FOR NUMERIC SPECIFICATION, PERFORMING ALL OTHERS
/FOUND IN COURSE OF SEARCH.
/
NEXTC	JMS	GLETR	/ADVANCE TO NEXT LETTER
NEXTC2	LAC	LETTER
	SAD	(SPACE		/MUST WATCH OUT FOR SPACES!!
	JMP	NEXTC
	SAD	(COMA
	JMP	COM	/SLUFF OFF COMMA
	SAD	(CLOSPR
	JMP	CLOSIT	/ FOUND CLOSING PARENTHESIS
F3A	SAD	(SLASH
	JMP	SLA	/PROCESS SLASH
/
/
	SAD	(TEE
	JMP	TTYPE	/T-FORMAT
	SAD	(APOSTE
	JMP	LITRAL	/'LITERAL'
	SAD	(MINUS
	JMP	NEGP	/MUST BE - NNP
/
/HAVE HANDLED ALL SPECIAL CASES.  CAN LOOK FOR REPEAT COUNT.
/
	JMS	PIKNUM	/GET COUNT IF PRESENT. IF NOT AC_1,L_1
	DAC	NCOUNT
	SNA!CMA
	JMP	ZEROP	/MUST BY 0P
	TAD	(1
	DAC	NCONT2	/2'S COMPLEMENT OF COUNT
	SZL
	JMP	F1	/REPEAT COUNT OF 1 ASSUMED
/
/START SEARCH OF POSSIBLE CODE TYPES.  FIRST THOSE THAT MUST
/HAVE A REPEAT COUNT.
/
	LAC	LETTER
	SAD	(AITCH
	JMP	HTYPE	/H-FORMAT
	SAD	(EX
	JMP	XTYPE	/X-FORMAT
	SAD	(PEE
	JMP	OKP	/P-FORMAT
/
/THE FOLLOWING TYPES CAN HAVE IMPLIED REPEAT OF 1
/
F1	LAC	LETTER
	SAD	(EFF
	JMP	DEF	/F-FORMAT
	SAD	(EEE
	JMP	DEF	/E-FORMAT
	SAD	(EYE
	JMP	AIGL	/I-FORMAT
	SAD	(DEE
	JMP	DEF	/D-FORMAT
	SAD	(GEE
	JMP	AIGL	/G-FORMAT
	SAD	(AYE
	JMP	AIGL	/A-FORMAT
	SAD	(ELL
	JMP	AIGL	/L-FORMAT
FSTART	SAD	(OPENPR
	JMP	OPENER	/OPENING PARENTHESIS
ERR41	LAW	41	/ERROR- INVALID CODE
	JMP	.NERR
/
/WHEN COMMA IS FOUND TOSS IT AWAY AND TRY FOR USEFUL SPECIFICATION
/
COM	JMS	GLETR	/ADVANCE TO NEXT LETTER
	JMP	F3A
/
/PROCESS SCALING FACTOR (P-FORMAT)
/
NEGP	JMS	GLETR
	JMS	PIKNUM
	SZL!CMA		/COMPLEMENT COUNT (1'S)
	JMP	ERR42	/STRAY-SIGN, NO NUMBER
	DAC	NCOUNT
ZEROP	LAC	LETTER
	SAD	(PEE
	JMP	OKP
	JMP	ERR41		/NEGATIVE OR ZERO NUMBER,NOT P
/	INSERT CODE 
/
OKP	LAC	NCOUNT	/SET SCALE FACTOR
	DAC	PSCALE	/GO GET NEXT SPECIFICATION
	JMP	NEXTC
/
/PROCESS X-FORMAT SPECIFICATION
/
XTYPE	LAC	NCOUNT	/STEP ACROSS
	JMS	BCHECK	/CHECK FOR BUFFER OVERFLOW
	JMP	NEXTC
/
/PROCESS T-FORMAT SPECIFICATION
/
TTYPE	JMS	GLETR
	JMS	PIKNUM
	SZL
	JMP	ERR42	/MISSING NUMBER
	SNA
	JMP	ERR42	/ZERO NUMBER
	TAD	(BUFFER-1	/ ADD START ADDRESS OF BUFFER
	DAC	LOCATN	/RESET LOCATION POINTER
	CLA
	JMS	BCHECK
	JMP	NEXTC2
/
ERR42	LAW	42		/ MISSING OR ZERO TAB SPECIFICATION
	JMP	.NERR
/
/  WE HAVE FOUND '-----------------'
/
LITRAL	LAC	IO
	SNA
	XX		/INPUT
NEXTLR	JMS	GLETR
	SAD	(APOSTE
	JMP	.+3
	JMS	PUSHIT
	JMP	NEXTLR
	JMS	GLETR
	SAD	(APOSTE
	JMP	.-4	/OUTPUT SINGLE '
	JMP	NEXTC2
/
/ HAVE FOUND XXH-----------
HTYPE	LAC	IO
	SNA
	XX		/ INPUT
NXTLTR	JMS	GLETR
	JMS	PUSHIT
	ISZ	NCONT2
	JMP	NXTLTR
	JMP	NEXTC
/
/ PROCESS NUMERIC SPECIFICATION BY RECORDING TYPE AND PICKING
/UP FOLLOWING NUMERIC FIELDS.
/
DEF	DAC	NDEC	/ENTRY POINT FOR D, E, F
	SKP
AIGL	DZM	NDEC	/ENTRY POINT FOR A, I, L, G
	DAC	NTYPE	/RECORD TYPE
/
	JMS	GLETR
	JMS	PIKNUM
	SZL!SNA			/ SZL&SNA - COMPLAIN ON ZERO FIELD WIDTH
	JMP	ERR44		/ AS WELL AS NO NUMERIC FIELD
	DAC	NWIDTH	/FIELD WIDTH
	LAC	LETTER
	SAD	(DECIML
	JMP	F4	/MUST BE DEFG
	LAC	NDEC	/CHECK IF AILG
	SNA
	JMP	F6	/HAVE FULL SPECIFICATION
ERR44	LAW	44	/DECIMAL POINT MISSING
	JMP	.NERR
F4	LAC	(GEE	/CHECK IF G-TYPE
	SAD	NTYPE
	JMP	.+4	/EXIT HERE IF G
	LAC	NDEC
	SNA		/SKIP IF D,E,F
	JMP	ERR44	/ERROR- DECIMAL FOUND, FORMAT IS A,I,L
	JMS	GLETR	/SLUFF OFF DECIMAL POINT
	JMS	PIKNUM	/GET NUMERIC FIELD
	DAC	NDEC	/# OF DECIMAL DIGITS TO BE READ OR PRINTED
	SZL
	JMP	ERR44	/NO NUMERIC FIELD AFTER DECIMAL
/
/HAVE FOUND (OR STILL HAVE) A NUMERIC FORMAT
/
F6	DZM	XR	/INDICATE FORMAT HAS
			/AT LEAST 1 NUMERIC TYPE
F6A	SET	RNUM	/INDICATE NUMERIC SPEC.
	LAC	XNUM	/CHECK IF NUMERIC ADDRESS EXISTS
	SNA
	JMP	GETNUM	/NO.  GO GET ONE
DONUM	DZM	XNUM	/INDICATE AS USED
/
/CHECK NUMERIC FORMAT TYPE AND VARIABLE MODE AND ENTER
/APPROPRIATE I/O CONVERSION
/
	LAC	NTYPE
	DAC	NTYPE2
	SAD	(AYE
	JMP	AINOUT	/A-FORMAT
/
	SAD	(ELL
	JMP	LFORM	/L-FORMAT
/
	SAD	(GEE
	JMP	GFORM
/
/ NONE OF ABOVE MUST BE F,D,I,E
/
	LAC*	MODEA
	SMA
	JMP	CONVRT	/REAL,INTEGER
ERR45	LAW	45	/LOGICAL OR CHARACTER-FORMAT F,D,I,E
	JMP	.NERR
GFORM	LAC*	MODEA
	SPA!RTL
	JMP	LORC	/LOGICAL OR CHARACTER
/
	SZL
	JMP	CONVRT	/REAL OR DOUBLE
	LAC	(EYE
	DAC	NTYPE2	/CONVERT G TO I IF INTEGER
/
/REAL OR INTEGER VARIABLE, I,D,E,F OR G (REAL ONLY) FORMAT
/ CONVERT A NUMBER THE WIDTH OF NWIDTH INTO BINARY
/ AND THEN LOOK AT WHAT WE HAVE
/
CONVRT	LAC	IO
	SZA
	JMP	CONOUT
/
/	ITS INPUT
/
CONIN	DZM	DIGCNT
	DZM	DIGITS
	DZM	DEXFSH	/SCALING FACTOR
	DZM*	MOSTA
	DZM*	LEASTA
	DZM*	A3
	DZM*	A4
	DZM	EXPSW	/NO EXPONENT YET
	DZM	SIGNFG	/SIGN OF NUMBER WE ARE GOING TO CONVERT
	SET	SIGNFG	/ ASSUME NUMBER IS NEGATIVE
	SET	DIGMAK	/ MARK THAT NO DIGITS HAVE OCCURRED YET
	LAW	-1
	TAD	NWIDTH
	CMA
	DAC	NWIDE	/2'S COMP
	JMP	ENTER
/
/ PROCESS THE 1ST CHARACTER IN THE FIELD, SLOUFFING OFF BLANKS
/ ALL SPACES ENCOUNTERED BEFORE A STARTING CHARACTER ARE ASSUMED
/ TO BE ZEROS IN CASE THE FIELD IS ALL BLANKS. THE STARTING CHARACTERS
/ ARE PLUS,MINUS,DECIMAL, A DIGIT OR 'E', 'D'.
/ THE ILLEGAL COMBINATIONS ARE: E00 ( NOT PRECEDED BY A SPACE), +E00, 
/ -E00, .E00 (NOT PRECEDED BY A BLANK), +.E00, -.E00.
GETAGN	DZM	DIGMAK	/ A SPACE IS CONSIDERED A DIGIT
	ISZ	NWIDE	/ COUNT THE LAST CHARACTER
	SKP
	JMP	ENFELD	/ END OF FIELD
/
ENTER	JMS	PICKIT	/ GET NEXT CHARACTER
	SAD	(SPACE
	JMP	GETAGN	/ IT IS ' '
	SAD	(MINUS	/ IS IT '-'
	JMP	ITSPM	/YES.
	DZM	SIGNFG	/ WASN'T MINUS SIGN, THUS NUMBER IS POSITIVE
	SAD	(PLUS	/ IS IT '+'
	SKP
	JMP	NOTSIN	/ THE CHARACTER IS NOT A SPACE OR SIGN
ITSPM	SET	DIGMAK	/ SIGN ENCOUNTERED, THUS NO DIGITS YET
/
/ WE NOW HAVE ENCOUNTERED A CHARACTER OTHER THAN +, -, SPACE.
GETNXT	ISZ	NWIDE	/ COUNT LAST CHARACTER
	SKP
	JMP	ENFELD	/ END OF FIELD
	JMS	PICKIT	/ GET NEXT CHARACTER
NOTSIN	LMQ		/ STORE CHARACTER IN MQ
	SNL
	JMP	NUMERC	/ ITS NUMERIC
	SAD	(SPACE
	JMP	ASZERO	/ SPACES ARE NOW ASSUMED TO BE ZEROS
	SAD	(DECIML
	JMP	CPOINT	/ ITS DECIMAL POINT
	SAD	(COMA
	JMP	COMMAS	/ ITS A COMMA
/
/ CHARACTER MUST BE EITHER E, D OR AN EXPONENT OF THE FORM +N
	LAC	DIGMAK	/ ARE THERE ANY DIGITS?
	SNA
	JMP	.+3
ERR46	LAW	46		/ NO DIGITS IN INPUT FIELD
	JMP	.NERR
/
/ A LEGAL FRACTION HAS BEEN PROCESSED, NOW LOOK FOR AN EXPONENT
	LAW	-1
	DAC	EXPSW	/ MARK EXPONENT PRESENT
	DZM	SPOT
	DZM	FLAG
	LAW	-3
	DAC	QQ	/ ALLOW ONLY TWO EXPONENT DIGITS
	LACQ		/ REGAIN CHARACTER
	SAD	(EEE
	JMP	EXPGET	/ ITS 'E'
	SAD	(DEE
	JMP	EXPGET	/ ITS 'D'
	JMP	EXSIGN	/ NEITHER OF ABOVE MIGHT BE SIGN, GO TEST
/
/ PROCESS EXPONENT
EXPGET	ISZ	NWIDE	/ COUNT THE LETTER
	JMP	EXP1
ERR47	LAW	47		/ END OF FIELD ENCOUNTERED
	JMP	.NERR
EXP1	JMS	PICKIT
	SNL
	JMP	ITSNUM	/ FORM 'E'N
	SAD	(SPACE	/ FORM 'E' N, 'E'   
	JMP	CHKS
EXSIGN	SAD	(PLUS
	JMP	GOAHD1	/ ITS '+'
	SET	FLAG	/ ASSUME ITS MINUS
	SAD	(MINUS
	JMP	GOAHD1	/ ITS MINUS
	SAD	(COMA
	JMP	ERR47
ERR50	LAW	50		/ ILLEGAL CHARACTER IN INPUT FIELD
	JMP	.NERR
/
/ PROCESS THE NUMBER
ASZERO	LAC	FREESW
	SZA		/ ARE WE IN FREE FORMAT
	JMP	ENFELD	/ YES, A SPACE THEN TERMINATES THE FIELD
/
	CLQ		/ NOT FREE FORMAT, SPACES ARE AS ZEROS.
/ WE HAD A DIGIT
NUMERC	DZM	DIGMAK	/ MARK THAT A DIGIT OCCURRED
	LAC	DIGITS
	SZA		/ HAVE WE ANY SIGNIFICANT DIGITS YET
	JMP	SIGDIG	/ YES
	LACQ		/ NO.
	SNA!CLC		/ IS NUMBER ZERO, SET AC .NE. 24
	JMP	CHKDOT	/ YES, IF WE HAD . , MUST COUNT IT
/
SIGDIG	SAD	(24	/ HAVE WE 20 DIGITS
	JMP	HAVE20	/ YES
	LACQ
	JMS	DBCVTR	/ CONVERT TO BINARY
	IDX	DIGITS	/ COUNT THE SIGNIFICANT DIGIT
/
CHKDOT	LAC	DIGCNT
	SMA		/ HAVE WE HAD A '.'
	JMP	GETNXT	/ NO
	TAD	DEXFSH	/ YES. COUNT DIGIT AFTER DECIMAL
	DAC	DEXFSH
	JMP	GETNXT
/
HAVE20	LAC	DIGCNT
	SZA		/ HAVE WE HAD A '.'
	JMP	GETNXT	/ YES, THROW DIGIT AWAY
	ISZ	DEXFSH	/ NO, DIGITS TO LEFT OF DECIMAL MUST BE COUNTED
	JMP	GETNXT
/
/
/
/ A DECIMAL POINT WAS FOUND, THUS NUMBER IS REAL. CHECK IF
/ WE ALREADY HAD A DECIMAL POINT
CPOINT	LAC	DIGCNT
	SZA!CLC
	JMP	ERR47	/ ERROR - TWO DECIMAL POINTS
	DAC	DIGCNT	/ INDICATE DECIMAL OCCURRED
	JMP	GETNXT
/
/ A COMMA WAS ENCOUNTERED, THEY ARE LEGAL ONLY IN FREE FORMAT
COMMAS	LAC	FREESW
	SNA		/ IS IT FREE FORMAT
	JMP	ERR50	/NO. COMMA ILLEGAL
	JMP	ENFELD	/ FREE FORMAT. COMMA TERMINATES FIELD
/
/
/ COUNT THE SIGN
GOAHD1	ISZ	NWIDE
	SKP
	JMP	ERR47
/
/ PROCESS NUMBER
ARND	JMS	PICKIT
	SNL
	JMP	ITSNUM
	SAD	(SPACE
	JMP	CHKIT	/ CHECK IF FREE FORMAT
	SAD	(COMA
	SKP
	JMP	ERR50	/ ILLEGAL CHARACTER IN EXPONENT
/ ITS COMMA, CHECK IF FREE FORMAT
	LAC	FREESW
	SZA
	JMP	ENDFLD	/OKAY. FREE FORMAT. COMMA TERMINATES FIELD
	JMP	ERR50	/ NOT FREE FORMAT. COMMA ILLEGAL
/ ITS SPACE CHECK IF FREE FORMAT
CHKIT	LAC	FREESW
	SZA
	JMP	ENDFLD	/ ITS FREE FORMAT. SPACE TERMINATES FIELD
/ CONVERT TO BINARY. IF CHARACTER WAS SPACE AC=0.
ITSNUM	DAC	SPOT2
	LAC	SPOT
	MUL
		12
	LACQ
	TAD	SPOT2
	DAC	SPOT
	ISZ	QQ	/ CHECK IF MORE THAN 2 DIGITS
	JMP	GOAHD	/ NO
ERR51	LAW	51	/ YES, MORE THAN TWO DIGITS
	JMP	.NERR
/
/ CHECK IF FREE FORMAT
/
CHKS	LAC	FREESW
	SZA
	JMP	ERR51	/ERROR-SPACE TERMINATES FIELD,NO EXPONENT
/
/ CHECK IF FIELD FINISHED
/ 
GOAHD	ISZ	NWIDE
	JMP	ARND	/NO
/FIELD IS FINISHED, CHECK IF WE HAVE ANY DIGITS
ENDFLD	LAC	FLAG
	SNA!CLC		/ IS EXPONENT POS OR NEG
	JMP	POSIT	/ ITS POSITIVE
	TAD	SPOT	/ ITS NEGATIVE
	SKP!CMA
POSIT	LAC	SPOT
	TAD	DEXFSH	/ ADD EXPONENT TO DECIMAL OFFSET
	DAC	DEXFSH
/
/
/ THE NUMBER IS FINISHED BEING PROCESSED, FIND OUT WHAT WE HAVE.
ENFELD	LAC	DIGCNT
	SZA		/ DID NUMBER HAVE A DECIMAL POINT
	JMP	ITREAL	/ ITS REAL
/
/ LOOKS LIKE AN INTEGER, MIGHT BE REAL WITHOUT DECIMAL POINT
/
	LAC	NTYPE2
	XOR	EXPSW
	SAD	(EYE
	JMP	INTOK
	LAW	-1	/INSERT DEFAULT DECIMAL POINT
	TAD	NDEC
	CMA
	TAD	DEXFSH
	DAC	DEXFSH
	JMP	ITREAL
/
/ IT WAS AN INTEGER NUMBER
/
INTOK	LAC	SIGNFG
	RAR		/ SIGN INTO LINK
	LAC*	MOSTA
	SAD*	LEASTA	/ FIRST 2 WORDS MUST BE ZERO, OR NUMBER TOO LARGE
	SZA
	JMP	ERR52
	LAC*	A3
	SMA		/ ALSO IF AC0 =1, THEN NUMBER STILL TOO LARGE
	JMP	GOODSZ
ERR52	LAW	52		/ NUMBER TOO LARGE AN INTEGER TO STORE
	JMP	.NERR
/ THE NUMBER IS SINGLE OR DOUBLE INTEGER, NEGATE IF NECESSARY AND
/ STOR IN INT1 AND INT2
GOODSZ	LAC*	A3
	SNL		/ IS IT NEGATIVE
	JMP	.+2	/ NO
	CMA
	DAC*	INT1
	LAC*	A4
	SNL!CLL
	JMP	.+5
	CMA
	TAD	(1
	SZL
	IDX*	INT1	/ THERE IS A CARRY INTO INT1
	NOP		/ SKIPS ON A BLANK INPUT FIELD
	DAC*	INT2	/ STORE LEAST SIG BITS
	CLA		/ MARK ACC AS INTEGER
	JMP	PLACIT	/ GO TO STORE IT
/
/
/
/
/
/ THE NUMBER WAS REAL, IT MUST BE NORMALIZED AND MULTIPLIED
/ BY THE SCALE FACTOR
ITREAL	LAC	DIGITS
	SNA
	JMP	ZRNUM	/ THE NUMBER IS ZERO
	LAC	(110	/ ACCOUNT FOR 4 WORD SHIFT
	DAC*	EXPA
	JMS*	.DBNRM	/ DO NORMALIZE
	LAC	DEXFSH	/ GET SCALE FACTOR
	JMS	TENTOX
	LAC	SIGNFG
	CLL
	RTR
	DAC*	SIGNA
/
/ WE NOW HAVE THE CORRECT FLOATING POINT NUMBER
/ CHECK FORMAT TYPE REQUIRED, IF I ISSUE ERROR.
	SKP
ZRNUM	JMS*	.ZRVAL	/ PUT THE NUMBER ZERO IN THE ACC. A
	LAC	NTYPE
	SAD	(EYE
	JMP	ERR53
	LAC	(300000	/ MARK ACC AS DOUBLE REAL
/
/ STORE THE NUMBER.
PLACIT	DAC*	MODEA
	LAC	(AMODE	/ POINT BOX AT CORRECT MODE,MAINLY FOR COMPLEX
	DAC*	.BOX
	JMS*	.STORE
	JMP	LOOK
/
ERR53	LAW	53	/ WANTED INTEGER, FOUND FLOATING
	JMP	.NERR
/
XSPLIT	XX
	GSM
	SZL
	TAD	(1
	DAC	DEXFSH
	CLA!RAL
	DAC	FLAG	/STORE THE SIGN OF EXPONENT
	LAC	DEXFSH
	IDIV
		12
	DAC	SPOT2	/UNITS PART
	LACQ
	DAC	SPOT	/TENS PART
	JMP*	XSPLIT
/
/
TENTOX	XX
	JMS	XSPLIT
	TAD	(-12
	SPA
	JMP	.+3
ERR54	LAW	54	/EXPONENT OUT OF RANGE
	JMP	.NERR
	LAC	SPOT
	SNA!CLL		/IF TENS PART IS ZERO,BYPASS
	JMP	DBCV6	/FIRST MULTIPLY,OTHERWISE
	MUL
		5	/COMPUTE ADDRESS OF EQUIVALENT,
	LACQ		/PLACE IT IN ACC B AND PERFORM MULTIPLY
	TAD	(FPVALU+47
	JMS	COPY	/COPY NUMBER INTO ACC B AND
			/EITHER MULTIPLY OR DIVIDE.
DBCV6	LAC	SPOT2	/DO SAME WITH UNITS.
	SNA!CLL
	JMP*	TENTOX
	MUL
		5
	LACQ
	TAD	(FPVALU-6
	JMS	COPY
	JMP*	TENTOX
/
/
/
/ SUBROUTINE TO COPY NUMBER INTO ACC B AND DO THE ARITHMETIC
COPY	XX
	DAC*	(AUTO3
	DZM*	SIGNB
	LAC*	AUTO3
	DAC*	EXPB
	LAC*	AUTO3
	DAC*	MOSTB
	LAC*	AUTO3
	DAC*	LEASTB
	LAC*	AUTO3
	DAC*	B3
	LAC*	AUTO3
	DAC*	B4
	LAC	FLAG	/ IF FLAG IS SET NUMBER IS NEGATIVE
	SZA
	JMP	.+3
	JMS*	.DPRML	/ DO DOUBLE PRECISION MULTILPY
	JMP*	COPY
	JMS*	.DPRDV	/ DO DOUBLE PRECISION DIVIDE
	JMP*	COPY
DIGMAK
FLAG
SPOT
SPOT2
DEXFSH          /DECIMAL SCALE FACTOR
DIGCNT          / COUNT FOR DIGITS AFTER DECIMAL POINT
DIGITS
/
/TABLE OF FLOAT POINT VALUES OF POWERS OF 10, IE. 12 OCTAL. ALL NUMBERS
/ ARE NORMALIZED FRACTIONS. THE 1ST COLUMN CONTAINS THE EXPONENT
FPVALU  000004; 500000; 000000; 000000; 000000  / 12 TO EXPONENT 1
        000007; 620000; 000000; 000000; 000000  / 12 TO EXPONENT 2
        000012; 764000; 000000; 000000; 000000
        000016; 470400; 000000; 000000; 000000
        000021; 606500; 000000; 000000; 000000
        000024; 750220; 000000; 000000; 000000
        000030; 461132; 000000; 000000; 000000
        000033; 575360; 400000; 000000; 000000
        000036; 734654; 500000; 000000; 000000
        000042; 452013; 710000; 000000; 000000  / 12 TO THE 10TH
        000103; 532743; 536132; 614200; 000000  / 12 TO THE 20TH
        000144; 623713; 116320; 214723; 557244  / 12 TO THE 30TH
        000205; 726145; 174341; 534511; 376532  / 12 TO THE 40TH
        000247; 421541; 661277; 144463; 207642
        000310; 476474; 471141; 363210; 442374
        000351; 562727; 265556; 707171; 033252
        000412; 657635; 724370; 373275; 775716
        000453; 766541; 702224; 531616; 457360
/
/
/
/
/ THIS SUBROUTINE PICKS UP A CHARACTER ONE AT A TIME FROM
/ THE BUFFER. CHARACTER IS LEFT IN THE AC AND IF NUMERIC, LINK=0
/ ELSE LINK=1.
/ IF LOCATN=END OF BUFFER AND NOT FREE FORMAT, ERROR!
/ IF LOCATN=END OF BUFFER AND FREE FORMAT, RETURN A SPACE TO END FIELD
/ IF IT RETURNS TO PICKIT AGAIN ON FREE FORMAT, LOCATN=END OF BUFFER+1
/ IE. LOCATN-END OF BUFFER=1, THEN A NEW LINE IS READ
/
PICKIT	XX
	LAC	LOCATN
	TAD*	SZPTR
	SPA
	JMP	NOEND	/NOT END OF BUFFER
	SZA		/LOCATN=>END OF BUFFER
	JMS	INOUT	/LOCATN> BUFFER GET NEW LINE, FREE FORMAT ONLY
	LAC	FREESW
	SNA		/ SKIP IF FREE FORMAT, ALWAYS A SPACE LEFT IN BUFFER
	JMP	ERR60	/NOT FREE FORMAT.  ERROR
/
NOEND	LAC*	LOCATN	/GET NEXT CHARACTER
	IDX	LOCATN
	LMQ
	TAD	(-72
	SMA		/ FOR NUMERIC AC<0
	JMP	NONNUM
	TAD	(72-60
	SMA!CLL		/ FOR NUMERIC AC=>0
	JMP*	PICKIT
NONNUM	LACQ
	STL
	JMP*	PICKIT
/
/
/ THE DECIMAL TO BINARY SUBROUTINE FOLLOWS, ENTER WITH NUMBER IN AC
DBCVTR  XX
	DAC	CCNT
	LAC*	MOSTA	/MULTIPLY FRACTION BY 10 FOR ALL
        SNA!CLL         /DIGITS AFTER THE FIRST
        JMP     DBCV10
        MUL
                12
        LACQ
        DAC*     MOSTA
DBCV10  LAC*     LEASTA
        SNA!CLL
        JMP     DBCV11
        MUL
                12
        TAD*     MOSTA
        DAC*     MOSTA
        LACQ
        DAC*     LEASTA
DBCV11  LAC*     A3
        SNA!CLL
        JMP     DBCV12
        MUL
                12
        TAD*     LEASTA
        DAC*     LEASTA
        SZL!CLL
        ISZ*     MOSTA
        LACQ
        DAC*     A3
DBCV12  LAC*     A4
        SNA!CLL
	JMP	DBCV1
        MUL
                12
        TAD*     A3
        DAC*     A3
        SNL!CLL
        JMP     DBCV13
        ISZ*     LEASTA
        SKP
        ISZ*     MOSTA
DBCV13  LACQ
        DAC*     A4
DBCV1	CLL
	LAC	CCNT
	TAD*	A4
	DAC*	A4
	SNL!CLL
	JMP*	DBCVTR
	ISZ*	A3
	JMP*	DBCVTR
	ISZ*	LEASTA
	JMP*	DBCVTR
	ISZ*	MOSTA
	JMP*	DBCVTR
/
/
/
/ THIS SECTION CONVERTS THE NUMBER INTO ASCII AND OUTPUTS
/ THE BUFFER
/
/
/
/ FIRST THE NUMBER MUST BE LOADED INTO ACC A. THIS
/ REQUIRES US TO CRAWL BACK INTO THE INTERPRETER
/ TO GET THE CORRECT LOADING ROUTINE.
/
CONOUT	LAC	(BLOADD
	DAC	.FETCH
	LAC	(QLOAD*10000
	LMQ		/OP CODE IN MQ
	LAC*	MODEA	/GET MODE BITS
	JMP*	.NEXT2	/ENTER LOAD ROUTINE
BLOADD	JMS*	.PSHBA	/DO APPROPRIATE LOAD
/
/ SET UP ADDRESS FOR NUMBER INSERTING ROUTINES
/
	LAC	NWIDTH
	JMS	BCHECK
	LAW	-1
	TAD	LOCATN
	DAC	BACKLC
/
/ RECORD SIGN OF NUMBER, TAKE ABSOLUTE VALUE,
/ AND ADJUST FIELD WIDTH COUNT IF NEGATIVE.
/
	LAC*	MODEA
	SNA
	JMP	OUT3	/INTEGER
	LAC*	SIGNA
	DZM*	SIGNA	/TAKE ABSOLUTE VALUE
	SZA
OUT2	LAC	(MINUS	/ASCII - SIGN
OUT1	DAC	SS	/STORE FINAL SIGN
	SZA
	LAW	-1
	TAD	NWIDTH	/NWIDE IS FIELD WIDTH AFTER
	DAC	NWIDE	/ALLOWING FOR SIGN.
/
/ ADJUST FIELD WIDTH FOR DECIMAL POINT (D,E,F, AND G)
/ AND EXPONENT FIELD (D,E, AND G).
/
	LAC	NDEC
	CMA
	DAC	QQ	/- NUMBER OF DIGITS AFTER DECIMAL -1.
/
	LAC	NTYPE2
	SAD	(EYE
	JMP	OUT4	/INTEGER FORMAT
	SAD	(EFF
	JMP	OUT4A
	LAW	-6	/-5 FOR .E+XX (E,D,G)
OUT5	TAD	NWIDE	/MAX. DECIMAL DIGITS -1.
	SPA!CMA
	JMP	STARS1	/NO SPACE FOR DIGITS
	DAC	NWIDE	/-(MAX. DECIMAL DIGITS)
/
/ FOR E,D, AND G FORMATS WE MUST NOW FIND THE POWER
/ OF THE EXPONENT.
/
	LAC	NTYPE2
	SAD	(EYE
	JMP	I1	/I FORMAT
	DZM	G	/ASSUME F FORMAT
	LAC*	MODEA
	JMS*	.FLOAT	/MAKE SURE ARGUMENT IS REAL
	LAC	NTYPE2
	SAD	(EFF
	JMP	F1F	/ F FORMAT
	JMS*	.SWPUS	/SAVE CONTENTS OF ACC A
/
/ THE REQUIRED EXPONENT IS FLOOR(LOG10(A)+1).
/
	LAC*	MOSTA	/CHECK FOR ZERO VALUE
	SNA!CLA		/IF SO SET G TO 0
	JMP	OUT7
	LAC*	MODEA
	JMS*	.ALG10	/TAKE LOG
/
/ SHOULD NOW ADD 1.0. HOWEVER WILL JUST ADD 0.777777 (OCTAL)
/ SO ROUNDING ERRORS NEVER CAUSE EXPONENT TO BE HIGH. WILL
/ CHECK FOR IT BEING ONE LOW LATER.
/
	LAC	(D7777
	JMS*	.SPRLD
	JMS*	.SPADD	/ADD 0.777777 (OCTAL)
/
/ TAKE FLOOR FUNCTION. FOR POSITIVE ARGUMENT SAME AS IFIX.
/ FOR NEGATIVE ARGUMENT TAKE IFIX(A+X)-X WHERE X IS ANY
/ INTEGER GREATER THAN ABSOLUTE VALUE OF A.
/
	LAC*	SIGNA
	SMA
	JMP	OUT6	/POSITIVE RESULT
	LAC	(EIGHTY
	JMS*	.SPRLD	/ADD 80.0 SINCE
	JMS*	.SPADD	/-78<A<0
	LAC*	MODEA
	JMS*	.IFIX
	LAW	-120	/-80 DECIMAL
	TAD*	INT2
OUT7	DAC	G	/POWER OF TEN EXPONENT
	JMS*	.SWPIT	/RESTORE ORIGINAL ARGUMENT TO ACC A
/
/ MUST REMOVE POWER OF TEN EXPONENT. DO THIS BY MULTIPLYING
/ BY 10**(-G). MUST ALSO MOVE DECIMAL POINT (NDEC) DIGITS
/ RIGHT AND ROUND TO NEAREST INTEGER. (CAN OBVIOUSLY COMBINE
/ MULTIPLIERS.)
/
F1F	LAW	-1
	TAD	G
	CMA		/-G
	TAD	NDEC	/D-G
	JMS	TENTOX
/
/ NOW THE ROUNDING
/
	CLA		/LOAD O.5 INTO ACC B AND ADD.
	JMS*	.LDPT5	
	JMS*	.DPADD
	LAC	NTYPE
	SAD	(EFF
	JMP	FOUT	/BRANCH IF F FORMAT
/
/ POSSIBLE PROBLEM. THE VALUE OF G MAY BE ONE LOW DUE
/ TO (1) FUDGE ON ORIGINAL CALCULATION OR (2) CARRY
/ ON ROUNDING OPERATION. TO FIND MUST MULTIPLY BY
/ 10**(-D) AND CHECK THAT NUMBER IS LESS THAN 1.0.
/
	JMS*	.SWPUS	/SAVE CONTENTS OF ACC A.
	LAW	-1
	TAD	NDEC
	CMA
	JMS	TENTOX	/MULTIPLY BY 10**(-D)
	LAC*	EXPA
	SPA!SNA
	JMP	TESTG	/NO PROBLEM
	JMS*	.SWPIT	/RESTORE OUTPUT ARGUMENT
	LAW	-1
	JMS	TENTOX	/MULTIPLY BY 0.1
	IDX	G	/CORRECT G
	NOP		/MAY SKIP
/
/ MUST NOW CHECK G FORMAT. IF 0<=G<=D THEN IT
/ CAN BE OUTPUT AS F FORMAT
/
GJOIN	LAC	NTYPE
	SAD	(GEE
	SKP
	JMP	DEEXP	/E OR D
	LAC	G
	SPA
	JMP	GTODE	/TREAT AS D,E
	TAD	QQ	/-(D-G)-1
	SMA
	JMP	GTODE	/TREAT AS D,E
	DAC	QQ	/ADJUST DIGITS AFTER DECIMAL
	LAW	-4
	DAC	FLAG
	LAC	(SPACE
	JMS	INSERT
	ISZ	FLAG
	JMP	.-3
/
/ CONVERT NUMBER TO INTEGER FOR OUTPUT. THIS IS DONE
/ BY ADDING 0.0 WITH A DUMMY EXPONENT TO CONTROL BINARY
/ POINT ALLIGNMENT.
/
FOUT	DZM*	MOSTB
	DZM*	LEASTB
	DZM*	B3
	DZM*	B4
	LAC	(110
	DAC*	EXPB
	JMS*	.DPADD
	LAC	(110
	SAD*	EXPA
	JMP	DEFGGO
/
/ THIS SECTION INSERTS ASTERISKS ****** IN AN OUTPUT FIELD IF
/ THE FIELD IS TOO SMALL TO CONTAIN THE NUMBER.
/ ENTER AT STARS IF THE FIELD HAS BEEN SEMI-FILLED WITH DIGITS,
/ ENTER AT STARS1 IF THE FIELD IS STILL EMPTY.
/
STARS	LAW	-1
	TAD	LOCATN
	DAC	BACKLC		/ RESET TO RIGHT OF FIELD
STARS1	LAW	-1
	TAD	NWIDTH
	CMA
	DAC	NWIDE	/ RESET TO -WIDTH OF FIELD
/
STARS2	LAC	(52	/ ASCII '*'
	JMS	INSERT
	ISZ	NWIDE
	JMP	STARS2
	JMP	LOOK	/ FIELD FULL, CONTINUE.
/
/
DEFGGO	LAW	-1
	TAD	MOSTA
	DAC	WI
	LAW	-4
ALLJON	DAC	N
/
/ OUTPUT AN I,E,D,F, OR G FORMAT NUMBER.
/ WI POINTS AT FIRST WORD OF INTEGER FORMAT -1.
/ N CONTAINS -(NUMBER OF WORDS IN INTEGER)
/ NWIDE CONTAINS -(MAX. DIGITS)
/ QQ CONTAINS (-D-1) WHERE D IS DIGITS AFTER DECIMAL.
/ SS CONTAINS EITHER 0 OR ASCII - FOR SIGN OUTPUT.
/
TIEF	DZM	R	/INITIAL REMAINDER IS ZERO
	LAC	WI
	DAC	WX	/DIVIDE LOOP TO DIVIDE N WORDS
	LAC	N
	DAC	M
LOOP1	IDX	WX	/STEP TO DIVIDEND DATA WORD
	LAC*	WX
	LMQ		/AND PUT IN MQ
	LAC	R	/LOAD PREVIOUS REMAINDER
	GS!DIV
		12	/DIVIDE BY 10
	DAC	R	/SAVE REMAINDER
	LACQ
	DAC*	WX	/RESTORE QUOTIENT AS FUTURE DIVIDEND
	SZA		/CHECK FOR ZERO
	JMP	TIEXF	/NO CONTINUE DIVIDE LOOP
/
/ WE HAVE A ZERO QUOTIENT WORD. IF IT IS THE FIRST WORD OF
/ INTEGER DIVIDE LOOP, THE LOOP CAN BE SHORTENED FOR NEXT TIME.
/
	LAC	N	/IF N AND M ARE THE SAME
	SAD	M	/IT IS THE FIRST WORD.
	JMP	SHORT	/GO SHORTEN DIVIDE LOOP
TIEXF	ISZ	M	/CHECK IF LOOP DONE
	JMP	LOOP1	/NO, CONTINUE DIVIDE
/
/ DIVIDE COMPLETE. CONTENTS OF R IS NEXT DIGIT TO BE OUTPUT.
/ MUST FIRST CHECK TO SEE IF DECIMAL POINT SHOULD BE INSERTED.
/
TIE2F	ISZ	QQ
	JMP	.+3
	LAC	(DECIML
	JMS	INSERT	/INSERT DECIMAL POINT
	LAC	R
TIESF	TAD	(ZERO	/ASCII 0
	JMS	INSERT	/OUTPUT DECIMAL DIGIT
/
/ CHECK IF ALL SIGNIFIGANT DIGITS ARE OUTPUT.
/
	LAC	N
	SZA
	JMP	NOTEND	/MORE TO COME
/
/ MAKE SURE DECIMAL IS OUT. IF NECESSARY FILL SPACE
/ BEHIND DECIMAL WITH ZEROS.
/
	ISZ	QQ
	JMP	.+3
	LAC	(DECIML
	JMS	INSERT
	LAC	QQ
	SPA!CLA
	JMP	TIESF
/
/ INSERT SIGN OF NEGATIVE NUMBER
/
	LAC	SS
	SZA
	JMS	INSERT
	JMP	LOOK	/ RETURN TO LOOK FOR MORE OUTPUT VARIABLES
/
/ CHECK TO MAKE SURE THAT NUMBER NOT TOO LARGE
/ FOR FIELD WIDTH.
/
NOTEND	ISZ	NWIDE
	JMP	TIEF
	JMP	STARS	/OUTPUT FIELD FULL
/
/
/ ENTER HERE TO SHORTEN DIVIDE LOOP. IF WORD COUNT GOES
/ TO ZERO, THEN QUOTIENT WAS ALL ZERO AND SIGNIFIGANT
/ DIGITS HAVE BEEN GENERATED.
/
SHORT	IDX	WI	/ADJUST ADDRESS
	ISZ	N
	JMP	TIEXF	/QUOTIENT NOT ZERO YET
	JMP	TIE2F	/GO OUTPUT FINAL DIGIT
/
/ CONSTANTS
EIGHTY	7; 200000; 0
D7777	0; 777776; 0
/
/ CONVERT G FORMAT TO EITHER D OR E DEPENDING ON
/ NUMBER OF SIGNIFIGANT DIGITS.
/
GTODE	LAC	(DEE
	DAC	NTYPE2	/ASSUME D
	LAW	-10
	TAD	NDEC	/IF LESS THAN 8 SIGNIFIGANT
	SPA		/DIGITS, CONVERT TO E
	IDX	NTYPE2
DEEXP	LAC	G
	JMS	XSPLIT
	LAC	SPOT2
	TAD	(ZERO
	JMS	INSERT
	LAC	SPOT
	TAD	(ZERO
	JMS	INSERT
	LAC	FLAG
	SZA!RAR
	LAC	(MINUS
	SNL
	LAC	(PLUS
	JMS	INSERT
	LAC	NTYPE2
	JMS	INSERT
	JMP	FOUT
/
OUT4	DZM	QQ
	SKP!CLA!CMA	/AC=-1
OUT4A	LAW	-2	/-1 FOR . (F)
	JMP	OUT5
/
/
I1	LAC*	MODEA
	SZA
	JMP	FOUT	/HAVE REAL NUMBER
	LAW	-1
	TAD	INT1	/ SET UP TO OUTPUT
	DAC	WI	/INTEGER NUMBER
	LAW	-2	/UNDER AN INTEGER
	JMP	ALLJON
/
/
OUT6	LAC*	MODEA
	JMS*	.IFIX
	LAC*	INT2
	JMP	OUT7
/
/ TAKE ABSOLUTE VALUE OF INTEGER NUMBER AND SET SIGN CHARACTER.
/
OUT3	LAC*	INT1
	SMA!CLA		/AC=0 FOR BOTH EXITS
	JMP	OUT1	/POSITIVE, RETURN
	JMS*	.IABS	/TAKE ABSOLUTE VALUE
	JMP	OUT2
/
TESTG	JMS*	.SWPIT	/RESTORE ACC A
	JMP	GJOIN
/
LFORM	LAC*	MODEA
	SAD	(600000
	JMP	LINOUT	/L-FORMAT AND LOGICAL VARIABLE
ERR66	LAW	66	/ LOGICAL FORMAT, OTHER VARIABLE
	JMP	.NERR
/
LORC	SPA		/SKIP IF LOGICAL VARIABLE
	JMP	AINOUT	/CHARACTER VARIABLE
/
LINOUT	LAC	IO	/CHECK IN INPUT OR OUTPUT
	SNA
	JMP	LIN
/
/OUTPUT LOGICAL VARIABLE
	LAW	-1
	TAD	NWIDTH	/POINT TO LOCATION
	JMS	BCHECK
	LAC*	AUTO2	/GET LOGICAL VARIABLE
	SZA
	LAC	(TEE	/'T'_777777
	SNA
	LAC	(EFF	/'F'_000000
	JMS	PUSHIT	/PUT IN OUTPUT STRING
	JMP	LOOK
/
/INPUT LOGICAL VARIABLE
LIN	LAC	NWIDTH	/GET CHARACTER FROM INPUT LIST
	DAC	NWIDE
	JMS	PICKIT
	SAD	(TEE
	JMP	LTRUE
	SAD	(EFF
	JMP	LFALSE
	LAW	-1
	TAD	NWIDE
	DAC	NWIDE
	SZA
	JMP	LIN+2
/
/IF FIELD EMPTY ASSUME FALSE
LFALSE	CLA!SKP
LTRUE	LAW	-1
	DAC*	AUTO2	/STORE RESULT IN VARIABLE
	TAD	NWIDE	/ LOCATN IS ONE PAST CHARACTER
	JMS	BCHECK
	JMP	LOOK
	.EJECT
/
/ THIS SECTION HANDLES THE INPUT AND OUTPUT UNDER 'A' FORMAT
/ ON INPUT : IF FIELD WIDTH W > SIZE N, USE N RIGHT CHARS
/            ELSE N > W, THEN LEFT JUSTIFY W CHARACTERS IN VARIABLE
/ ON OUTPUT: IF FIELD WIDTH W > SIZE N, PRINT N CHARS RIGHT JUSTIFIED
/            ELSE N > W, PRINT ONLY FIRST W CHARACTERS
/
/ SUBROUTINE TO CALCULATE NUMBER OR WORDS IN ITEM
LENWRD	XX
	LAC*	MODEA
	SAD	(700000	/ IS VARIABLE CHARACTER
	JMP	ATIE	/ YES.
	JMS*	.CHRGT	/ NO. GET # OF CHARACTERS
	DAC*	SIGNA
ATIE	JMS	ELMLGH	/ GET WORDS/ELEMENT
	JMP*	LENWRD
/
AINOUT	JMS	LENWRD
	LAC	FREESW
	SNA		/ ARE WE IN FREE FORMAT
	JMP	NOTFREE
	LAC	IO		/INPUT OR OUTPUT?
	SNA
	JMP	FREEIN
	LAC	(BUFFER+1	/INSERT SPACE IF FREE FORMAT &
	SAD	LOCATN		/LINE NOT EMPTY
	SKP
	IDX	LOCATN
FREEIN	LAC*	SIGNA	/PICK UP CHARACTER COUNT
	DAC	NWIDTH	/ USE AS FIELD WIDTH
/
NOTFREE	LAC	NWIDTH	/ W	, WIDTH OF I/O FIELD
	CMA		/ -W-1
	TAD*	SIGNA	/ -W+N-1
	DAC	QQ
	SMA!CMA		/ W-N
	CLA
	DAC	SS	/ MAX(0,W-N), # OF CHARS TO BE IGNORED IN FIELD
/
/ CHECK IF END OF FIELD OVERFLOWS THE BUFFER & RESET 'LOCATN'
	LAC	NWIDTH	/ SET TO LOCATION
	JMS	BCHECK	/ IF OVERFLOW ON FREE FORMAT, BUFFER PRINTED & RESET
/
/ CALCULATE THE MAXIMUM NUMBER OF CHARACTERS TO BE MOVED
/ IE MIN(W,N)
	LAW	-1
	TAD	NWIDTH
	CMA
	TAD	SS
	DAC	CCNT	/ GIVES NUMBER OF CHARS FOR MOVE
/
/  SET UP POINTER TO GET MAX(N,W) RIGHT JUSTIFIED CHARACTERS
/
	TAD	LOCATN
	TAD	(-1		/SET UP POINTER TO CORRECT POSITION IN
	DAC*	(AUTO3		/FIELD OF IMAGE BUFFER FOR OUTPUT
/
/ SET UP POINTERS FOR INPUT AND OUTPUT TO SOURCE & DESTINATION
	LAC*	(AUTO2
	DAC*	(AUTO4	/ FOR OUTPUT
	TAD	(1
	DAC	POINTS	/ FOR INPUT
	TAD	(-1
	TAD	ELMSIZ
	DAC*	(AUTO2	/ IN CASE ITS AN ARRAY
	LAC	IO
	SNA
	JMP	AINPUT	/ ITS INPUT
/
/ IT IS HOLLERITH OUTPUT, USE BUSTER TO BREAK CONSTANT UP AND
/ PLACE IN IMAGE BUFFER.
	LAC	(LOOK	/ ADDRESS TO CONTINUE FORMAT INSPECTION
	DAC	BUFSET
	JMP	UNFRT
/
/ IT IS HOLLERITH INPUT, CONSTANT IS TAKEN FROM IMAGE BUFFER
/ AND PACKED INTO THE VARIABLES STORAGE
AINPUT	LAC	POINTS
	JMS	SETPUT
GTNEXT	LAC*	AUTO3	/ GET NEXT CHARACTER
PAD	JMS	PUT	/ GO TO PACKING ROUTINE
	ISZ	CCNT
	JMP	GTNEXT	/ NOT FINISHED, GO GET NEXT CHARACTER
	LAC	QQ	/ CHECK IF MUST PAD
	SPA!CLA!CMA	/ WITH SPACES
	JMP	LOOK
	DAC	CCNT
	TAD	QQ
	DAC	QQ
	LAC	(SPACE
	JMP	PAD
/
	.EJECT
/
/RETURN TO INTERPRETER TO GET ANOTHER DATA ADDRESS.  FIRST CHECK
/IF HAVE BALANCE OF AN ARRAY (OR  IMAGINARY PART OF COMPLEX) TO DO
/
GETNUM	LAW	-1
	TAD	BUNCH
	SPA!SNA
	JMP*	.NEXT	/NO ARRAY - GET NEW OPERATION
	JMP	GRP5	/CONTINUE WITH ARRAY
/
/ENTER HERE WHEN ARRAY I/O OP-CODE IS FOUND BY INTERPRETER
/
.GROUP	JMS	MODER
	JMS	GETSIZ
	JMP	GRP4
/
/ENTER HERE TO INPUT/OUTPUT SINGLE ITEM
/
.SINGL	JMS	MODER
	LAC	(1
GRP4	SZL
	RCL		/ MULT BY 2 FOR COMPLEX
GRP5	DAC	BUNCH
	LAC	AMODE	/ RETRIEVE MODE
NOW	DAC*	MODEA	/RECORD MODE
	LAC	FREESW
	SZA
	JMP	FREEF	/ ITS FREE FORMAT
	LAC	BINSW
	SZA
	JMP	BINARY	/ ITS NO FORMAT (BINARY)
/
/ ITS REGULAR FORMAT. CHECK IF WE HAVE A NUMERIC FORMAT
/ SPECIFICATION AND IF SO GO USE IT.
        SET     XNUM    /INDICATE DATA ADDRESS AVAILABLE
        LAC     RNUM    /IS FORMAT AVAILABLE
        SZA
        JMP     DONUM   /YES. GO CONVERT NUMBER
/
/HAVE HIT END OF FORMAT.  GO BACK TO LAST ( PROVIDED THAT
/NUMERIC FORMATS WERE ENCOUNTERED IN FIRST SCAN.
        LAC     XR
        SNA
        JMP     .+3     / EVERYTHING OKAY
ERR55  LAW     55      / LIST NOT EXHAUSTED- NO NUMERIC FORMATS
        JMP     .NERR
/
        JMS     INOUT   /PERFORM I/O EXPECTED
/
/NOW CHECK TO SEE IF THIS IS START OF THE FORMAT OR OF A NN(...)
/GROUP.
        LAC     NSAVE
        DAC     RTABLE+4        /REPEAT COUNT
        SNA
        JMP     F9      /ZERO - START OF FORMAT
/
/THIS IS A NN(...) GROUP.  FIX UP LEVCNT, ETC.
        IDX     LEVCNT
        LAC     (RTABLE+4
        DAC     BRKLIT  /POINT TO REPEAT COUNT
/
F9      LAC     (RTABLE-1
/MUST REPEAT SECTION AGAIN.  RESET SWITCHS IN THE GLETR ROUTINE
/TO CORRECT REPEAT POINT
BACKUP  DAC*    (AUTO3
        LAC*    AUTO3
        DAC     FPOINT
        LAC*    AUTO3
        DAC     WORDCT
        LAC*    AUTO3
        DAC     CHARST
        LAC*    AUTO3
        DAC     GET2
        JMP     NEXTC
	.EJECT
/
/ ITS FREE FORMAT. HASH UP A FORMAT CODE
FREEF	DZM	NWIDTH	/ INFINITE FIELD WIDTH FOR INPUT
	DZM	NDEC	/ NO DEFAULT DECIMAL POSITION
	DZM	NCONT2		/ ENSURE THAT FREE-FORMAT IS NOT 'DONE IN' BY
				/ A RESIDUAL COUNT LEFT BY A PREVIOUSLY
				/ UNEXPIRED REPEAT COUNT.
	LAC	(GEE
	DAC	NTYPE	/ SET GO G FORMAT
	DAC	NTYPE2
	LAC	IO
	SNA!CLL
	JMP	GFORM	/ ITS FREE FORMAT INPUT. GO GET MODE SORTED OUT
	LAC*	MODEA
	SZA
	SAD	(100000
	LAC	(FINTGR-1	/ USE INTEGER FORMAT
	SAD	(200000
	LAC	(FREAL-1	/ USE SINGLE REAL FORMAT
	SAD	(300000
	LAC	(FDREAL-1	/ USE DOUBLE REAL FORMAT
	SAD	(600000
	LAC	(FLOGIC-1	/ USE LOGICAL FORMAT
	SPA		/ IF NOT CHARACTER, AC HAS AN ADDRESS, AC0 = 0
	LAC	(FCHAR-1	/ USE CHARACTER FORMAT
	DAC	FPOINT
	SET	XNUM	/ INDICATE DATA ADDRESS AVAILABLE
	LAC	(G4
	DAC	GET2	/ SET UP CHARACTER EXTRACTION ROUTINE
	DZM	WORDCT
	DZM	CHARCT
	JMP	NEXTC	/ GO PROCESS FORMAT
	.EJECT
/ ITS BINARY I/O.  GET THE NUMBER OF WORDS PER ITEM AND
/ WRITE THEM OUT.
BINARY	JMS	LENWRD
	GS!MUL
BUNCH	XX
	LACQ
	CMA
	TAD	(1
	DAC	ITEMNM	/ NUMBER OF WORDS IN ITEM
	LAC	IO
	SNA
	JMP	BR1	/ BINARY READ
	JMP	BW1	/ BINARY WRITE
/
/ THE PHYSICAL RECORD IS FULL, WRITE IT OUT
DOWRIT	JMS	SETBIN
	JMS	OWAITR
	LAC*	SZPTR	/ RESET TO 1'S COMP
	DAC	BCOUNT
	LAC	(BINBUF+3
	DAC	BPOINT	/ ADDRESS OF 1ST WORD
/
/ TRANSFER THE ITEM TO THE BUFFER
BW1	ISZ	BCOUNT	/ IS BUFFER FULL
	SKP!CLA
	JMP	DOWRIT	/ YES. WRITE IT OUT
	LAC*	AUTO2	/ GET WORD OF ITEM
	DAC*	BPOINT	/ STORE IN BUFFER
	IDX	BPOINT
	ISZ	ITEMNM	/ IS ITEM EMPTY
	JMP	BW1	/ NO.
	JMP*	.NEXT	/ YES.
/
/ READ A NEW RECORD
GETNEW	JMS	INOUT	/ READ A RECORD
	JMS	GETIT	/ SET UP POINTER TO IT
/
/ TRANSFER TO ITEM
BR1	ISZ	BCOUNT	/ IS BUFFER EMPTY
	SKP
	JMP	GETNEW
	LAC*	BPOINT	/ GET WORD FROM BUFFER
	DAC*	AUTO2	/ STORE IN ITEM
	IDX	BPOINT
	ISZ	ITEMNM	/ IS ITEM FULL
	JMP	BR1	/ NO.
	JMP*	.NEXT	/ YES.
/
/ THIS SUBROUTINE SETS UP THE HEADER WORDS OF A RECORD AND
/ WRITES IT OUT
SETBIN	XX
	XOR	PHYCNT
	IDX	PHYCNT
	DAC	BINBUF+2	/ SET UP RECORD COUNT
	LAC	BCOUNT
	SNA		/ IF BCOUNT IS ZERO SET TO -1
	LAW	-1	/ BECAUSE OF 1'S COMP COUNTING
	TAD	INIT+3
	TAD	(2
	AND	(777776	/ MAKE EVEN
	LLS!CLQ	10	/ SHIFT LEFT 11 & DIVIDE BY TWO
	DAC	BINBUF	/ SET UP WORD PAIR COUNT
	DZM	BINBUF+1	/ CLEAR CHECK SUM
	JMS	DOIO
	JMP*	SETBIN
/
/ THIS SUBROUTINE GETS THE NUMBER OF WORDS IN THE BUFFER
GETIT	XX
	LAC	BINBUF
	CLL
	LRS	10	/ # OF WORDS
	TAD	(-3
	CMA		/ 1'S COMP
	DAC	BCOUNT
	LAC	(BINBUF+3
	DAC	BPOINT
	JMP*	GETIT
/
ITEMNM
BCOUNT
BPOINT
PHYCNT
	.EJECT
/
/ENTER HERE WHEN CLOSING PARENTHESIS FOUND.  IT IS EITHER END
/OF NN(...) OR END OF FORMAT.  IF END OF FORMAT GO SEE IF I/O 
/LIST EXHAUSTED.  IF REPEATING SECTION CHECK REPEAT COUNT AND
/EITHER REPEAT IT OR CONTINUE SCAN.
/
CLOSIT	DZM	RNUM	/INDICATE NO NUMERIC FORMAT IN
			/CASE THIS IS END OF FORMAT
	LAC	LEVCNT	/ARE ANY NN(...) LEVELS ACTIVE
	SNA
	JMP	GETNUM	/NO. END OF FORMAT
/
	LAW	-5	/CALC. ADDRESS OF PREVIOUS
	TAD	BRKLIT	/REPEAT GROUP DATA
	ISZ*	BRKLIT	/IF COUNT NOT EXHAUSTED
	JMP	BACKUP	/REPEAT SECTION
/
/THIS SECTION HAS BEEN REPEATED SPECIFIED NUMBER OF TIMES.
/RESET BRKLIT AND LEVCNT TO PREVIOUS LEVEL.
/
	DAC	BRKLIT
	LAW	-1
	TAD	LEVCNT
	DAC	LEVCNT
	JMP	NEXTC
/
/ENTER HERE WHEN ( FOUND.  RECORD REPEAT INFORMATION IN TABLE
/RTABLE.  IN INITIALIZATION BRKLIT_(RTABLE-1).  LEVCNT HAS
/THE FOLLOWING VALUES:
/	-1	INITIALIZATION
/	O	NO NN(...) GROUPS OUTSTANDING
/	M	M LEVELS OF NN(...) OUTSTANDING
/WHEN FINAL ) IN FORMAT IS REACHED RTABLE WILL CONTAIN DATA ON
/EITHER FIRST ( LOCATION, OR LOCATION OF MOST RECENT OUTERMOST
/NN(...) GROUP.
/
OPENER	LAC	BRKLIT	/POINT TO START OF NEXT
	DAC*	(AUTO3	/ENTRY IN TABLE
/
	LAC	LEVCNT
	SAD	(LEVELS-1
	JMP	ERR62	/TOO MANY NN(...) LEVELS
/
	SPA!SNA!CLL	/SET LINK IF THIS
	STL		/OUTERMOST NN(...)
	SNL
	SET	XR	/REFLECTION PREVENTER IF
			/NO NUMERIC FORMAT
	LAC	FPOINT
	DAC*	AUTO3
	LAC	WORDCT	/SAVE THE 4 ITEMS
	DAC*	AUTO3	/REQUIRED TO RESTART
	LAC	CHARST	/FROM THIS POINT WHEN
	DAC*	AUTO3	/MATCHING ) FOUND
	LAC	GET2
	DAC*	AUTO3
	LAC	NCONT2
	DAC*	AUTO3
/
	SZL		/IF OUTERMOST NN(...)
	DAC	NSAVE	/SAVE NN FOR POSSIBLE REFLECTION
/
	LAC*	(AUTO3	/RESET BRKLIT TO LAST
	IDX	LEVCNT	/ENTRY IN NEW GROUP
	DAC	BRKLIT	/UNLESS THIS IS INITIAL (
	JMP	NEXTC
/
/ENTER HERE WHEN END OF LIST OP-CODE FOUND
/
.FINIS	LAW	-1	/MARK I/O AS FINISHED
	DAC	IODONE
	LAC	BINSW
	SZA
	JMP	BINRY
	LAC	IO
	SNA
	JMP*	.NEXT	/WAS A READ OPERATION
	JMS	OWAITR	/ WAIT TIL ASCII BUFFER IS FREE
	JMS	GLUER	/ CONVERT IMAGE TO 5/7 ASCII
	JMS	DOIO
	JMP*	.NEXT
/
/ HAVE REACHED THE FINISH OPCODE ON BINARY I/O.  IF READ MAKE SURE
/ THAT WE ADVANCE TO END OF LOGICAL RECORD.  IF WRITE MARK AS LAST 
/ RECORD AND WRITE RECORD OUT.
BINRY	LAC	IO
	SNA
	JMP	BINRD	/ BINARY READ
	LAC	(400000	/ INDICATE LAST RECORD
	JMS	SETBIN
	JMP*	.NEXT
/ CHAIN TO LAST RECORD
BINRD	LAC	BINBUF+2
	SPA
	JMP*	.NEXT	/ ARE THERE ALREADY
	JMS	DOIO
	JMS	OWAITR
	JMP	BINRD	/ GO TEST THIS RECORD
/
/
IODONE	.DSA	-1	/NO I/O UNDERWAY
	.EJECT
/
/ THIS ROUTINE DISTINGUISHES BETWEEN A CHARACTER AND A 
/ NUMBER
/ IF A NUMBER IS FOUND, IT COMPILES THE COMPLETE OCTAL 
/ REPRESENTATION OF IT AND LEAVES IT IN THE AC UPON EXIT, L_0
/ IF A CHARACTER, AC_1, L_1
/
PIKNUM	XX
	DZM	NUMB
	LAW	-2
	DAC	CCNT	/TEST FOR A DIGIT HAVING OCCURRED
	LAC	LETTER
	SKP
LOOPY	JMS	GLETR
	SAD	(SPACE
	JMP	LOOPY		/CHECK FOR SPACES
	TAD	(-72
	SMA!CLL		/IF NUMERIC AC< OR = 0
	JMP	NOTNUM
	TAD	(72-60	/MAYBE NUMERIC
	SPA!CLL		/IF NUMERIC AC> OR = 0
	JMP	NOTNUM	/NOT NUMERIC
	DAC	CCNT	/STORE OCTAL DIGIT
	LAC	NUMB
	MUL
		12
	LACQ
	TAD	CCNT
	DAC	NUMB
	JMP	LOOPY
/
NOTNUM	CLL
	LAC	CCNT
	SAD	(-2
	CMA!STL!SKP	/L_1, AC_1
	LAC	NUMB
	JMP*	PIKNUM
/
/
/THIS ROUTINE PICKS UP 2.5 CHARACTERS PER WORD FROM N WORDS
/(EXTRA 0.5 IGNORED IF N ODD)
/REQUIRES - (NUMBER OF CHARACTERS PER STRING) IN CHARCT AND - 
/(NUMBER OF STRINGS)-1 IN WORDCT
/
GLETR	XX
	LAC*	FPOINT	/PICK UP WORD OF TEXT
	JMP*	GET2
GET2	XX		/INITIALLY .DSA G4
	AND	(177
	DAC	LETTER
	ISZ	CHARST	/CHECK CHARACTER COUNT
	JMP*	GLETR	/NOT END OF STRING
	LAC	(G4	/SET UP FOR NEXT
	DAC	GET2	/STRING
	LAC	LETTER
	JMP*	GLETR
/
G4	ISZ	WORDCT	/ IS TEXT EXHAUSTED
	JMP	G4A	/ NO
ERR56	LAW	56		/ END OF ARRAY CONTAINING FORMAT ENCOUNTERED
	JMP	.NERR		/ BEFORE END OF FORMAT STATEMENT
G4A	LAC	CHARCT
	DAC	CHARST
G0	IDX	FPOINT
	LAC*	FPOINT
	LMQ!LLS	7	/GET FIRST CHARACTER
	JMS	GET2
/
	LRS	4	/GET 2ND CHARACTER
	JMS	GET2
/
	DAC	GET2
	IDX	FPOINT
	LAC*	FPOINT
	LMQ
	LAC	GET2
	LLS	3	/GET 3RD CHARACTER
	JMS	GET2
/
	LRS	10	/GET 4TH CHARACTER
	JMS	GET2
/
	RAR		/GET 5TH CHARACTER
	JMS	GET2
	JMP	G0
	.EJECT
/
/PERFORM REQUIRED INPUT/OUTPUT OPERATION
INOUT	XX
	LAC	IO	/WHAT DIRECTION
	SZA
	JMP	OUT	/PERFORM OUTPUT
/
/ READ IN A RECORD. IF THIS IS THE FIRST READ OPERATION A WAIT
/ HAS ALREADY BEEN DONE.
/
	JMS	DOIO	/DO READ
	LAC	DEVICE
	SAD	(11		/CHARACTER DEVICE?
	JMP*	INOUT	/ RETURN FOR CHAR VARIABLE UNITS
	JMS	WAITR	/ WAIT UNTIL RECORD IS IN BUFFER
/
/ CHECK IF END OF FILE
/
	LAC*	DOIO.2
	AND	(000017
	SAD	(000005
	JMP	EOMF
	SAD	(000006
	JMP	EOMF
	LAC*	DOIO.2
	AND	(000060
	SAD	(000060
	JMP	ERR63	/ ERROR - LINE TOO LONG FOR INPUT
	LAC	BINSW
	SZA
	JMP*	INOUT	/ YES. EXIT TO AVOID OVERWRITING BUFFER
	LAC	(BUSTER
	JMS	BUFSET
	JMP*	INOUT
/ THE 'EOM' OR 'EOMF' BITS ARE SET
EOMF	LAW	-1
	DAC	IODONE	/ RESET I/O UNDERWAY SWITCH
	LAC	DATEND	/ GET 'END=' ADDRESS
	SZA
	JMP	GOTIE	/ JUMP TO END= STATEMENT
ERR57	LAW	57		/ END OF FILE ON INPUT DEVICE
	JMP	.NERR
ERR63	LAW	63		/ INPUT LINE TOO LONG (>133 CHAR)
	JMP	.NERR
/
/WRITE OUT A RECORD AND RE-SET AREA TO BLANK
/
OUT	JMS	OWAITR	/WAIT FOR LAST WRITE
	JMS	GLUER	/BUILD ASCII BUFFER
	JMS	DOIO	/DO WRITE OPERATION
	LAC	(BLANKR
	JMS	BUFSET
	JMS	WONDER		/SPECIAL CARE MAY BE NEEDED
	JMP*	INOUT
	.EJECT
/
/ READ OR WRITE THE ACTUAL LINE
/
DOIO	XX
	LAC	DEVICE
	SAD	(11
	JMP	CHDEV	/ CHARACTER DEVICE
DOIO.	0		/ THIS SECTION IS BUILT UP TO A READ OR WRITE
DOIO.1	0		/ READ=10, OR WRITE=11
DOIO.2	0		/ ADDRESS OF BUFFER
DOIO.3	0		/ BUFFER SIZE
	JMP*	DOIO	/ WRITE WITH DEVICE AND SIZE SET UP
/ DO I/O FOR CHARACTER UNIT
CHDEV	ISZ	WORD4		/CHECK IF ALL ELEMENTS USED
	SKP
	JMP	EOMF	/ NO MORE ELEMENTS, CHECK FOR END=
	LAC	WORD2	/ START ADDRESS OF VARIABLE
	DAC	CHRADR	/ ADDRESS OF ELEMENT
	TAD	WORD1		/ELEMENT LENGTH
	DAC	WORD2		/NEXT ELEMENT
/ SEPARATE INPUT AND OUTPUT NOW
	LAC	IO
	SNA
	JMP	READC
/ DO WRITE OPERATION
WRITEC	LAC	CHRADR	/ ADDRESS OF CHAR VARIABLE -1
	TAD	(1
	JMS	SETPUT	/ SET UP POINTERS FOR 'PUT'
	LAC*	SZPTR
	TAD	(BUFFER	/ RECOVER -# OF CHARS
	DAC	CCNT
	LAC	(BUFFER-1
	DAC*	(AUTO3
LOOPW	LAC*	AUTO3
	JMS	PUT
	ISZ	CCNT
	JMP	LOOPW
	JMP*	DOIO
/ DO READ OPERATION
READC	JMS	BUFCHR
	JMP*	DOIO
/
/ THIS SUBROUTINE WAITS ON OUTPUT FOR THE 5/7 ASCII BUFFER TO BE CLEAR
/ IT MUST CHECK THE LAST DEVICE THAT WAS WRITING
OWAITR	XX
	LAC	WAITR+1
	SZA
	JMS	WAITR	/ THERE WAS I/O ALREADY, CHECK ON BUFFER
	LAC	DEVICE	/ RESET .WAITR FOR THIS DEVICE
	SAD	(11	/ IS DEVICE A CHARACTER UNIT
	CLA		/ MARK AS NO I/O
	DAC	WAITR+1
	JMP*	OWAITR
/
/ I/O WAIT ROUTINE
/
WAITR	XX
	.WAIT 0		/ BUILT UP DURING EXECTUION
	JMP*	WAITR
	.EJECT
/ ON ENTRY WITH AC SET TO BUSTER, THIS ROUTINE CONVERTS CHARACTERS
/ FROM 5/7 ASCII TO IMAGE ASCII. IF AC IS SET TO BLANKR, THE
/ BUFFER IS INITIALIZED TO BLANK CHARACTERS.
BUFCHR	XX
	LAC	BUFCHR
	DAC	BUFSET
	LAC	(BUSTER
	DAC	HINGE
	LAC	CHRADR
	DAC	SOURCE
	LAC*	SZPTR
	TAD	(BUFFER	/ RECOVER -# OF CHARS
	JMP	BUFF1
/
BUFSET	XX
	DAC	HINGE	/SET CONTROL SWITCH
	LAC	(ABUFFR+1
	DAC	SOURCE
	LAW	-206	/LENGTH OF IMAGE BUFFER
BUFF1	DAC	CCNT
	LAC	(BUFFER-1
	DAC*	(AUTO3	/ADDRESS OF IMAGE BUFFER
	TAD	(1
	DAC	LOCATN
	JMP*	HINGE	/SEE WHAT TO DO
/
HINGE	XX
	AND	(177	/IF ASCII CHARACTER IS
	SAD	(CARAGE	/CARRIAGE RETURN OR ALT MODE,
	JMP	BLANKR	/IT IS THE END OF A PHYSICAL LINE.
	SAD	(ALTMOD	/FILL BALANCE OF BUFFER WITH BLANKS.
	JMP	BLANKR
/
HING2	DAC*	AUTO3	/STORE IMAGE CHARACTER AND
	ISZ	CCNT	/REPEAT UNTIL BUFFER FULL.
	JMP*	HINGE
	JMP*	BUFSET
/
BLANKR	LAC	(HING2	/SET SWITCH FOR BLANK INSERTIONS
	DAC	HINGE
	LAC	(SPACE
	JMP	HING2
/
/ THIS ROUTINE CONVERTS THE CHARACTERS FROM 5/7 ASCII TO 
/ IMAGE ASCII.  IF 1ST CHARACTER ON INPUT IS A CARRIAGE
/ CONTROL CHARACTER, IGNORE IT.
BUSTER	LAC	SOURCE
	DAC*	(AUTO4	/ ADDRESS OF 5/7 ACSII
	LAC*	AUTO4
	DAC	SPOT
	LMQ!LLS	7
	AND	(177
	SAD	(CARAGE
	JMP	UJOIN1	/ DON'T IGNORE A CARRIAGE RETURN
	TAD	(-40	/ ALL CHARS < 40 ARE CARRIAGE CONTROL
	SPA
	JMP	UJOIN2	/ CHAR IS < 40 THROW IT AWAY AND GET NEXT
	TAD	(40	/ CHAR IS NOT CARRIAGE CONTROL, REGAIN IT
/
UJOIN1	JMS	HINGE
/
UJOIN2	LLS	7
	JMS	HINGE
/
	LAC*	AUTO4
	LMQ
	LAC	SPOT
	LLS	3
	JMS	HINGE
/
	LLS	7
	JMS	HINGE
/
	LLS	7
	JMS	HINGE
/
UNFRT	LAC*	AUTO4
	DAC	SPOT
	LMQ!LLS	7
	JMP	UJOIN1
/
/
/ THIS SUBROUTINE INSERTS CHARACTERS INTO THE IMAGE OUTPUT BUFFER
/ IN THE FORWARD DIRECTION
PUSHIT	XX
	DAC*	LOCATN
	LAC	LOCATN
	TAD*	SZPTR
	SMA!SZA
	JMP	ERR60	/ERROR END OF BUFFER EXCEEDED
	IDX	LOCATN
	JMP*	PUSHIT
/
/
/ THIS SUBROUTINE INSERTS CHARACTERS INTO THE IMAGE OUTPUT BUFFER
/ IN THE REVERSE DIRECTION TO FILL A FIELD.
INSERT	XX
	DAC*	BACKLC
	LAW	-1
	TAD	BACKLC
	DAC	BACKLC
	JMP*	INSERT
/
/ THIS SUBROUTINE CHECKS FOR BUFFER OVERFLOW
BCHECK	XX
	DAC	BOXX
	TAD	LOCATN
	DAC	LOCATN
	TAD*	SZPTR
	SPA!SNA
	JMP*	BCHECK	/ NO OVERFLOW
	LAC	FREESW	/CHECK FOR FREE FORMAT
	SNA
	JMP	ERR60
	JMS	INOUT	/DO I/O
	LAC	BOXX	/ GET FIELD INCREMENT
	TAD	LOCATN
	DAC	LOCATN
	TAD*	SZPTR
	SPA!SNA		/ WATCH OUT FOR LONG CHARACTER VARIABLES
	JMP*	BCHECK
ERR60	LAW	60	/ERROR-FORMAT STATEMENT TOO LONG
	JMP	.NERR
/
/ THIS ROUTINE GETS MODE AND LEAVES IT IN AC AND AMODE. IF MODE IS
/ COMPLEX IT SETS UP AS A REAL ARRAY. IF MODE IS CHARACTER IT STORES
/ LENGTH IN SIGNA AND SETS AUTO2 TO POINT TO ACTUAL DATA.
/ NOTE: LINK SHOULD BE CLEARED ON EXIT UNLESS ORIGINAL MODE WAS COMPLEX.
MODER	XX
	XCT*	L.BOX
	AND	(700000	/ GET MODE BITS
	SPA!CLL
	SAD	(600000
	JMP	MODERX	/ LOGICAL, REAL, INTEGER
	SAD	(700000
	JMP	MODERC	/ CHARACTER
	TAD	(600000	/ CONVERT COMPLEX TO REAL AND SET LINK
MODERX	DAC	AMODE	/ STORE FOR SAFETY'S SAKE
	JMP*	MODER
/
MODERC	LAC*	AUTO2	/ GET INFO WORD
	TAD	(100000	/ SET LINK IF POINTER
	AND	(77777
	DAC*	SIGNA	/ CHARACTER COUNT
	SNL!CLL
	JMP	NOPOINT
	LAC*	AUTO2	/  GET BASE ADDRESS
	.AND	(077777
	DAC*	(AUTO2	/ OF CHARACTER VARIABLE OR ARRAY
NOPOINT	LAC	(700000
	JMP	MODERX
/
/
/ BUFFERS FOR I/O
BUFFER	.BLOCK	206	/ 134 SPACES
/
ABUFFR	.BLOCK	70	/ ALLOW 134 CHARACTERS IN 5/7 ASCII
/
	.LOC	BUFFER
BINBUF	.BLOCK 400	/ ROOM FOR BINARY I/O AND CORE-TO-CORE
			/ READ/WRITE OF 256 CHARACTERS
/
/ THIS SUBROUTINE SCANS THE IMAGE BUFFER BACKWARDS AND INSERTS A
/ CARRIAGE RETURN AFTER THE LAST CHARACTER. IT THEN WILL CONVERT
/ THE IMAGE BUFFER INTO 5/7 ASCII.
GLUDEC	LAW	-1
	TAD	CCNT
	JMP	CRLOOP
/
GLUER	XX
	LAC	DEVICE
	SAD	(11		/IF THIS IS A CHARACTER DEVICE, WE
	JMP*	GLUER		/DON'T DO ANY GLUEING
	LAC	(BUFFER+206-1	/ END OF IMAGE BUFFER
CRLOOP	DAC	CCNT
	LAC*	CCNT
	SAD	(SPACE	/CHECK FOR NON SPACE
	JMP	GLUDEC
	IDX	CCNT	/ STEP TO NEXT EMPTY WORD
	LAC	CCNT
	SAD	(BUFFER
	JMP	NLINE	/ LINE IS EMPTY
GJOYN	LAC	(015	/INSERT CARRIAGE RETURN
	DAC*	CCNT
/ CHECK THE 1ST CHARACTER FOR CARRIAGE CONTROL
	LAC	BUFFER	/ GET CARRIAGE CONTROL
	SAD	(ZERO
	LAC	(21	/DOUBLE SPACE
	SAD	(ONE
	LAC	(14	/FORM FEED
	SAD	(PLUS
	LAC	(20	/OVERPRINT
	SAD	(MINUS
	LAC	(22	/TRIPLE SPACE
	TAD	(-40	/ALL CARRIAGE CONTROL CHARACTERS ARE < 40
	SMA		/ SKIP IF CARRIAGE CONTROL
	LAC	(-40+12	/ELSE INSERT LINE FEED TO BE GENERATED
	TAD	(40	/GET CHARACTER OR LINE FEED BACK
	DAC	BUFFER	/INSERT IN BUFFER
	LAC	(BUFFER-1	/ START AT 1ST CHARACTER
	DAC*	(AUTO3
	LAC	(ABUFFR+2
	JMS	SETPUT	/ SET UP POINTER TO CORRECT ADDRESS
NXTCHR	LAC*	AUTO3	/ GET CHARACTER FROM IMAGE BUFFER
	JMS	PUT	/INSERT FIRST CHARACTER
	LAC	CHAR	/CHECK FOR CARRIAGE RETURN
	SAD	(015
	SKP
	JMP	NXTCHR
	IDX	DIGITS	/ACCOUNT FOR HEADER WORD PAIR
	LAC	DIGITS	/GET WORD PAIR COUNT
	CLQ!LLS	11
	DAC	ABUFFR
	JMP*	GLUER
/
/ BUFFER IS EMPTY WANT LINE FEED, SPACE AND CARRIAGE RETURN
NLINE	IDX	CCNT
	IDX	CCNT
	JMP	GJOYN
/
/ THIS SUBROUTINE DOES A SETUP FOR THE PUT SUBROUTINE
SETPUT	XX
	DAC	POINTS	/ POINTS TO THE DESTINATION BUFFER
	DZM	DIGITS
	LAC	(LEFT
	DAC	SWING
	JMP*	SETPUT
/
/ THIS SUBROUTINE PACKS CHARACTER FROM THE AC INTO A 5/7 ASCII BUFFER
PUT	XX
	DAC	CHAR
	JMP*	SWING
SWING	.DSA	LEFT
	DAC*	POINTS
	JMP*	PUT
LEFT	IDX	DIGITS
	CLQ!LLS	13
	JMS	SWING
	CLQ!LLS	4
	TAD*	POINTS
	JMS	SWING
	CLQ!LRSS	3
	TAD*	POINTS
	DAC*	POINTS
	IDX	POINTS
	LACQ
	JMS	SWING
	CLQ!LLS	10
	TAD*	POINTS
	JMS	SWING
	RCL
	TAD*	POINTS
	JMS	SWING
	IDX	POINTS
	JMP	LEFT
/
ERR62	LAW	62		/ TOO MANY 'NN( . .)' LEVELS IN FORMAT
	JMP	.NERR
/
/ STORAGE OF DEFAULT FORMATS FOR FREE FORMAT OUTPUT
FINTGR	.ASCII	'I13)'
FREAL	.ASCII	'E16.7)'
FDREAL	.ASCII	'D28.16)'
FLOGIC	.ASCII	'L8)'
FCHAR	.ASCII	'A256)'
/
/
/STORAGE AREA FOR NUMERIC (A,D,E,F,G,L,I)
/SPECIFICATION
NCOUNT		/REPEAT COUNT
NTYPE		/SPECIFICATION TYPE
NWIDTH		/FIELD WIDTH
NWIDE		/ COUNTER FOR FIELD WIDTH
NDEC		/DIGITS IN D OR S PART
NSAVE
NCONT2		/2'S COMPLEMENT OF REPEAT COUNT
NTYPE2
/
/ DATA STORAGE TABLE FOR NN(...) TERMS
/
LEVCNT		/ NUMBER OF NESTED NN(...) TERMS
BRKLIT		/ CURRENT LOCATION IN TABLE
RTABLE	.BLOCK	5*LEVELS
/
/
/ THE FOLLOWING CONSTANTS ARE USED BY THE SIN, COS AND ATAN
/ ROUTINES
.CS13	2; 647550; 666504
	4; 705047; 140010
	6; 240732; 326767
	7; 145513; 440040
	7; 214656; 431467
	6; 225357; 471421
.CS1	3; 444176; 325042
/
/
/	MISCELLANEOUS STORAGE
/
AMODE		/ SAVE MODE FOR ARRAYS SINCE MODEA GETS BOMBED
XR
XNUM
RNUM
BINSW
CCNT
CHARCT
CHARST
CHRADR		/ ADDRESS STORAGE FOR CHARACTER VARIABLE UNIT NUMBER
DATEND
DEVICE	0	/DEVICE NUMBER
FPOINT	0	/POINTER TO FORMAT STRING
FREESW
IO	0	/DIRECTION OF I/O
LETTER
LOCATN	0	/COLUMN POINTER TO IMAGE ASCII FILE
NUMB
PSCALE	0	/P FORMAT SCALING FACTOR
SIGNFG	0	/SIGN OF CONSTANT
WORDCT
BACKLC
G
M
N
QQ
R
SS
WI
WX
CHAR
POINTS
FLPT1
FLPT2
FLPT3
SZPTR
SPOINT
SOURCE
WORD1
WORD2
WORD4
DWORD3
ELMSIZ
	.TITLE	INTERPRETER ERROR ROUTINE
/
/
/  ERROR ROUTINE FOR INTERPRETER  OBJECT TIME
/
/   CALLED BY;
/	LAW	N
/	JMS*	.ERROR
/
/   THE NUMBER  'N' DETERMINES THE ERROR CONDITION
/
/   TABLE OF ERROR CODES;
/
/	 0	ARITHMETIC EXPONENT OVERFLOW
/	 1	ARITHMETIC EXPONENT UNDERFLOW
/	 2	INTEGER OVERFLOW
/	 3	STORAGE EXPONENT OVERFLOW
/	 4	STORAGE EXPONENT UNDERFLOW
/	 5	DIVISION BY ZERO
/	 6	NEGATIVE SQUARE ROOT ARGUMENT
/	 7	ZERO OR NEGATIVE LOGARITHMIC ARGUMENT
/	 8	COMPLEX VARIABLE STORED IN REAL OR INTEGER VARIABLE
/	 9	ILLEGAL MODE MIXING IN STORE
/	10	ILLEGAL SUBSCRIPT MODE
/	11	SUBSCRIPT OUT OF RANGE
/	12	NON-INTEGER INDEX IN DO
/	13	INCREMENT OF DO EQUALS ZERO
/	14	VARIABLE 'N' IN 'RETURN N' OUT OF RANGE
/	15	COMPLEX VARIABLES USED WITH RELATIONAL OPERATOR
/	16	ILLEGAL  MODE IN '**' OPERATION
/	17	0**A WHERE A=0
/	18	0**A WHERE A<0
/	19	ONLY ONE ARGUMENT IN MAX OR MIN FUNCTION
/	20	INVALID ARGUMENT TYPE IN LIBRARY FUNCTION
/	21	ILLEGAL OPERATION COMPILED
/	22	CONSTANT ARGUMENT, RETURNED VARIABLE FROM FORTRAN
/			SUBPROGRAM
/	23	INVALID ARGUMENT MATCH BETWEEN CALLER AND CALLED
/			FORTRAN PROGRAMS
/	24	ARGUMENT OF SUBPROGRAM CALL MUST BE CONSTANT,
/			SIMPLE VARIABLE, OR ARRAY ELEMENT
/	25	ATAN2(0.0,0.0), ANSWER SET TO 0.0
/	26	ZERO ARGUMENT,COMPLEX LOG. ZERO RETURNED.
/	27	ATTEMPT TO READ A NON-EXISTANT FILE
/
/      THE REST SHOULD BE ADDED AS THEY ARE NEEDED
/
/     FOR EACH ERROR TYPE  THERE IS A MICRO-CODED WORD
/     WHICH TELLS THE ERROR ROUTINE WHAT TO DO ABOUT THE ERROR
/
/     THE FIRST 4 BITS ARE CODED THUS;
/
/     BIT 0 - IGNORE THE ERROR
/     BIT 1 - LOG THE ERROR AND RETURN
/     BIT 2 - TYPE ERROR BOMB
/     BIT 3 - TYPE ERROR NUMBER AND RETURN
/     BITS 4-17 ARE A LOG FOR CODE BIT 1
/
/
.ERROR	XX
	AND	(007777	/ REMOVE THE LAW BITS
	DAC	WHICH	/STORE
	TAD	.NLIST		/CALCULATE ADDRESS IN ERROR LOG TABLE
	SMA			/IF ERROR NUMBER LARGER THAN TABLE,
	CLA			/POINT AT LAST ENTRY (FATAL ERROR)
	TAD	(.ELIST
	DAC	WHERE	/KEEP IT
	LAC*	WHERE
	SPA!RAL		/CHECK FIRST 4 BITS
	JMP*	.ERROR	/IGNORE
	SMA!RAL
	JMP	PERROR
/
/    LOG ERROR AND RETURN
/
	IDX*	WHERE
	JMP*	.ERROR
/
/ THE ERROR PRINTING ROUTINES FOLLOW.
/ ERROR MESSAGE
EMESAG	004000	/ ROOM FOR HEADERS
	000000
	.ASCII	'**ERROR** '
ENUMB	.BLOCK	2	/ ROOM FOR NUMBER TO BE INSERTED
/
/ ERROR TRACEBACK MESSAGE
TMESAG	015000	/ ROOM FOR HEADERS
	000000
	.ASCII	'   PROGRAM WAS EXECUTING LINE '
LINECT	.BLOCK	2	/ ROOM FOR LINE COUNT TO BE INSERTED
	.ASCII	' IN ROUTINE '<0><0>
PNAME	.BLOCK	3	/ ROOM FOR PROGRAM NAMES TO BE INSERTED
/
/
/ CONVERT ERROR NUMBER
/
PERROR	LAC	(ENUMB	/ ADDRESS OF DESTINATION
	JMS	SETPUT
	.WAIT	ERDV	/ WAIT IN CASE OF MULTIPLE NON-TRACEBACK ERRORS
	LAC	WHICH	/ GET ERROR CODE
	JMS	G.CVRT	/ CONVERT AND PACK
	LAC	(CARAGE
	JMS	PUT
	.WRITE	ERDV,2,EMESAG,4
/
/ TRACEBACK REQUIRED.  CONVERT LINE COUNT AND INSERT PROGRAM NAME
	LAC	TABLE
NEWPRG	DAC	WHICH	/ ADDRESS OF 1ST WORD OF TABLE
	TAD	(2
	DAC	CNTADR
	LAC	(LINECT	/ ADDRESS OF DESTINATION
	JMS	SETPUT	/ CONVERT AND PACK
	.WAIT	ERDV	/ WAIT UNTIL BUFFER IS FREE
	LAC*	CNTADR
	CLL
	LRS	6	/ GET STATEMENT LINE COUNT
	JMS	G.CVRT	/ CONVERT AND PACK STATEMENT COUNT
/ NOW GET PROGRAM NAME
	LAC	CNTADR
	DAC*	(AUTO4
	LAC*	AUTO4
	DAC	PNAME	/ INSERT PROGRAM NAME
	LAC*	AUTO4
	DAC	PNAME+1
	LAC*	AUTO4
	XOR	(000320	/ INSERT CARRIAGE RETURN
	DAC	PNAME+2
	.WRITE	ERDV,2,TMESAG,15
	LAC*	WHICH
	SZA
	JMP	NEWPRG
/
/ CHECK WHICH EXIT TO TAKE
CHKRET	LAC*	WHERE
	AND	(TYPE
	SZA
	JMP*	.ERROR
	JMP	STOPX	/ GO TO STOP PROGRAM IN AN ORDERLY WAY
/
/
/  ERROR LOG DUMP/RESET SUBPROGRAM.  CALLED VIA
/
/	CALL ERRORP
/
/  TO PRINT ERROR LOG, AND RESET IT TO ALL ZEROS.
/  ALSO CALLED AT STOP & ERROR EXITS.
/
MM=100000
NN=10000
/
ERRORP	XX
	LAC	(1		/PERFORM EQUIVALENT OF INITIAL PART
	DAC	IO		/OF .WRITE FOR
	ISZ	IODONE		/OUTPUT IF DEVICE -12
	JMP	ERR35
	LAC	(ERDV&777
	DAC	DEVICE
	LAC	(X65
	DAC	SZPTR		/POINTER TO LINE LENGTH
/
	JMS	.INTRP		/CALL INTERPRETER
	T
	S-1
/
T	0			/ OTABLE
	0
COUNT.	0*MM+REMAIN-1
INDEX.	0*MM+WHICH-1
FORM.	7*MM+.FORM-1
CH1.	7*MM+.CH1-1
CH2.	7*MM+.CH2-1
/
.FORM	600036; .ASCII "(' ERROR'(T7,6(G4,'('G5,')')))"
.CH1	600004; .ASCII 'LOG '
.CH2	600004; .ASCII 'NONE'
X65	BUFFER+101-1			/BUFFER SIZE (65 CHARACTERS)
/
S	74*NN	0		/RETURN TO MACHINE CODE
	JMP	RW5		/AND CONTINUE .WRIT  FROM RW5
	FORM.-T			/FORMAT
	74*NN	0		/ENTER MACHINE CODE TO
	JMP	FUDGE		/SET UP ERROR LOG SCAN
	60*NN	CH1.-T		/ .SINGL        /PATH IF NO
	60*NN	CH2.-T		/ .SINGL        /ERRORS HAVE
	61*NN	0		/ .FINIS        /BEEN LOGGED
	76*NN	1		/ RETURN
/
LS	60*NN	INDEX.-T	/ .SINGL	/PATH IF
	60*NN	COUNT.-T	/ .SINGL	/LOGGED
	74*NN	0		/RETURN TO M/C  /ERRORS
	JMP	CONTN		/AT CONTN	/EXIST
	61*NN	0		/ .FINIS
	76*NN	1		/ RETURN
/
FUDGE	LAC	(LIST		/POINT AT ERROR LIST
	DAC	WHERE
	DZM	WHICH		/SET ERROR # TO 0
AGAIN	LAC*	WHERE
	SNA
	JMP*	.NEXT		/END-OF-LIST.  RETURN TO INTERP.
	AND	(37777
	SZA			/CHECK FOR ERROR COUNT
	JMP	FOND		/FOUND ONE
CONTN	IDX	WHERE		/INCREMENT TABLE POINTER
	IDX	WHICH		/INCREMENT ERROR NUMBER
	JMP	AGAIN
/
FOND	DAC	REMAIN		/ERROR COUNT
	XOR*	WHERE
	DAC*	WHERE		/RESET COUNT TO ZERO
	LAC	(LS-1
	DAC*	(AUTO1		/SIMULATE A 'GOTO'
	JMP*	.NEXT		/TO LOCATION 'LS'
/
	.EJECT
/
/ THIS SUBROUTINE CONVERTS A 4 DIGIT OCTAL NUMBER FROM THE AC, INTO
/ A DECIMAL 5/7 ASCII AND STORES THE RESULT IN THE BUFFER SET UP
/ FOR THE PUT SUBROUTINE.
/
G.CVRT	XX
	DAC	REMAIN	/ STORE NUMBER
	LAC	DIVEND
	DAC*	(AUTO4
NXTDIV	LAC*	AUTO4
	SAD	DIVEND
	JMP*	G.CVRT
/
	DAC	DIVIDE
	LAC	REMAIN
	GS!IDIV
DIVIDE	XX
	DAC	REMAIN
	LACQ
	TAD	(60
	JMS	PUT
	JMP	NXTDIV
/
DIVISR	1750	/ DECIMAL 1000
	144	/ DECIMAL 100
	12	/ DECIMAL 10
	1	/ DECIMAL 1
DIVEND	DIVISR-1
/
IGNORE=400000
LOG=200000
BOMBIT=100000
TYPE=040000
/
/
REMAIN
WHERE
WHICH
CNTADR
EXPSW
/
	.EJECT
/ THE FOLLOWING LIST DESCRIBES THE ACTION TO BE TAKEN FOR EACH ERROR.
.NLIST	LIST-.ELIST
LIST	TYPE	/   ERROR 0
	LOG		/ 1
	TYPE		/ 2
	TYPE		/ 3
	LOG		/ 4
	TYPE		/ 5
	TYPE		/ 6
	TYPE		/ 7
	TYPE		/ 8
	BOMBIT		/ 9
	BOMBIT		/10
	BOMBIT		/11
	BOMBIT		/12
	BOMBIT		/13
	BOMBIT		/14
	BOMBIT		/15
	BOMBIT		/16
	BOMBIT		/17
	TYPE		/18
	TYPE		/19
	BOMBIT		/20
	BOMBIT		/21
	BOMBIT		/22
	BOMBIT		/23
	BOMBIT		/24
	TYPE		/25
	TYPE		/26
	TYPE		/27
.ELIST	0	/END OF LIST MARKER - ALL FATAL ERRORS POINTED HERE
	.END