;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
SUBTTL ASSEMBLY SWITCHES, GLOBALS AND MACROS


	SEARCH ALGPRM,ALGSYS	; SEARCH PARAMETER FILES
	.GTLIM=40		; [243] INDEX FOR BATCH STATUS GETTAB
	JB.LBT=200		; [243] "I'M A BATCH JOB" BIT IN GETTAB 40

	SALL

	%TITLE(ALGOTS,ALGOL OBJECT TIME SYSTEM)
	INTERNAL .JBOPS


	ENTRY %ALGDR

	IFNDEF FTOVRL,<FTOVRL==-1>	; TURN ON OVERLAYS
	FTGETCHK==0
	IFNDEF FTGETCHK,<FTGETCHK==0>	; TURN OFF HEAP-CHECKER.
	IF2, <
	IFN FTGETCHK,<PRINTX HEAP INTEGRITY CHECKER LOADED>>
	FTADMP==1
	IFNDEF	FTADMP,<FTADMP==0>	; 1 to give DUMP ALL on error in batch.

	EXTERNAL .JBUUO,.JB41,.JBREL,.JBHRL,.JBSA,.JBDA,.JBSYM
	EXTERNAL .JBFF,.JBAPR,.JBCNI,.JBTPC,.JBOPC
	EXTERNAL .JBINT,.JBDDT
	EXTERNAL %ALGDD,BREAK%,DDTOU%,DDTIN%,DDERM%,DDTER%,DUMP%
	INTERNAL IPRNT%,DPRNT%,PRFPR%,STSPR%,CNCTR%,FLABL%
	INTERNAL DDCON%,DDFIN%,DDBEG%,RSTRT%,SPACE%,CRLF%

	MLON
	IFNDEF HPCHN,<HPCHN==10>
	IFNDEF OVLCHN,<OVLCHN==10>


	LOC	.JBVER		;[172]
	EXP	VERNO		;[172]

	RELOC

	DEFINE DPUSH(A)
<	SUBI	A,(DB)
	PUSH	SP,A
>

	DEFINE RPOP(A)
<	POP	SP,A
	ADDI	A,(DB)
>


	%ALGDR=.		; IF THIS LABEL IS NOT DEFINED
				; REFERENCES TO IT ARE GENERATED BY
				; MACRO EXPANSIONS ON PASS 1

	DEFINE DDDUMP,<DUMP%>	; AVOID INFINITE LOOP !
	SUBTTL ROUTINE DIRECTORY
	LALL
	ALGDIR			; CALL ALGDIR MACRO

	SALL
SUBTTL MASTER CONTROL ROUTINE

; ENTERED FROM ALGOBJ (IN ALGLIB) WITH
; LH(AX): BIT 0 = 0 FOR START
;	        = 1 FOR REENTER
; RH(AX) = ADDRESS OF PARAMETER BLOCK

INITIA:	RESET			; INITIALIZE IO
	;
	; Edit(1013)  Clear overflow flags (compatability package bug)
	;
	JOV	.+1		; [E1013] Clear arithmetic
	JFOV	.+1		; [E1013) ..and floating overflow flags.
	HLRZ	A3,.JBSA	; HEAP ORIGIN
	HRRZ	A4,3(AX)	; GET HEAP SIZE (%HEAP)
	CAIGE	A4,DELTA1	; ENSURE IT'S AT LEAST
	MOVEI	A4,DELTA1	;   THE MINIMUM
	MOVEI	DB,(A3)
	ADDI	DB,(A4)		; DATA BASE
	MOVEM	DB,.JBOPS	; SAVE COPY
	MOVEI	SP,%DBL-1(DB)	; STACK ORIGIN

INIT0:	HRRZ	A2,.JBSA	; GET CURRENT START ADDRESS
	CAIE	A2,INIT8	; AND IF WE HAVE NOT YET STARTED
	MOVEI	A2,INIT4	; TRAP START AFTER CONTROL-C FROM
	HRRM	A2,.JBSA	; ALGDDT ON INITIAL REENTER
	MOVEI	A2,2(SP)
	CAMG	A2,.JBREL	; WILL STACK FIT IN CORE?
	JRST	INIT1		; YES
	CORE	A2,		; NO - TRY TO EXPAND CORE
	JRST	[OUTSTR	M201		; [277] FAILED, PRINT ERROR MESSAGE
		EXIT	1,		; [277] EXIT QUIETLY
		PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
		JRST	INIT0]		; [277] TRY AGAIN IF "CONT"

INIT1:	HRLZI	A2,(A3)
	HRRI	A2,1(A3)
	SETZM	(A3)
	BLT	A2,@.JBREL	; CLEAR OUT DATA BASE AND STACK
	HRLZM	A4,(A3)		; FILL IN HEAP SIZE
	MOVEM	A3,%SYS21(DB)	; SAVE HEAP ORIGIN FOR HEAP-SIZE STATISTICS
	HRLZI	A1,HPCHN+1	; SET UP HEAP TABLE AS A
	MOVEM	A1,(A3)		; USED HEAP PORTION
	MOVSI	A1,1-HPCHN	; [277] SETUP A COUNTER-MODIFIER
	ADDI	A1,1(A3)	; TO TABLE
	MOVEM	A1,%SYS2(DB)
	ADDI	A3,HPCHN+1	; A3 POINTS TO 1ST FREE AREA
	SUBI	A4,HPCHN+1	; AND A4 HAS ITS LENGTH
	HRLI	A3,(A4)
	MOVEM	A3,(A1)		; MAKE THE TABLE ENTRY
	HLL	A1,A3		; AND THE
	MOVEM	A1,(A3)		; BACK POINTER
	SETOM	%CHAN(DB)	; SELECT CHANNEL -1
	MOVEM	AX,%SYS0(DB)	; SAVE PARAMETER BLOCK ADDRESS
	HRLI	A1,5(AX)	; MOVE LOAD-FILE INFO
	HRRI	A1,%IFDAT(DB)	;  TO PERMANENT HOME
	BLT	A1,%IFDAT+2(DB)	;   FOR OVERLAY-HANDLER
	SKIPN	A1,10(AX)	; GET TRACE BUFFER LENGTH
	MOVEI	A1,^D100	; DEFAULT IF ZERO (COMPILER VER < 6)
	HRL	A1,A1		;
	MOVEM	A1,%TRLNTH(DB)	; AND SAVE IT IN BOTH HALVES
	MOVN	A1,.JBREL
	MOVNM	A1,%SYS1(DB)	; SAVE INITIAL CORE SIZE
	ADDI	A1,(SP)
	HRLI	SP,(A1)		; SET UP COUNT FOR PUSH DOWN OVERFLOW
	HRLZI	A1,IOTTC
	HRRI	A1,%TTY(DB)
	MOVEM	A1,%IODR-1(DB)	; INITIALIZE CHANNEL -1
	HRRZ	A0,2(AX)	; GET %OWN

INIT2:	HRRZ	A1,A0		; NEXT OWN AREA
	HRRZ	A2,(A1)		; GET POINTER TO NEXT
	JUMPN	A2,INIT2A	; NOT LAST ONE
	HLRZ	A2,(A1)		; GET LENGTH
	CAILE	A2,^D10		; GREATER THAN LENGTH OF %SFILE AREA ?
	MOVEI	A2,^D10		; YES - SET TO THAT.
	ADDI	A2,%SFILE-1(DB)	; GET END OF TRANSFER
	HRLZI	A3,1(A1)	; MAKE
	HRRI	A3,%SFILE(DB)	;  POINTER
	BLT	A3,(A2)		; MOVE SYMBOL FILENAME TO DATA-BASE

INIT2A:	HLRZ	A2,(A1)		; GET ITS LENGTH
	SOJLE	A2,INIT3	; EMPTY?
	SETZM	1(A1)		; NO - ZERO FIRST FREE WORD
	SOJE	A2,INIT3	; ANY MORE
	HRLZI	A0,1(A1)	; YES
	HRRI	A0,2(A1)	; PREPARE FOR BLT
	ADDI	A2,1(A1)	; SET UP END ADDRESS
	BLT	A0,(A2)		; AND ZERO AREA

INIT3:	HRRZ	A0,(A1)
	JUMPN	A0,INIT2	; KEEP GOING IF MORE
	MOVE	A2,4(AX)	; GET COMPILER VERSION WORD
	MOVEM	A2,%SYS23(DB)	; AND SAVE IT
	DATE	A2,	
	MOVEM	A2,%SYS3(DB)	; SAVE DATE IN %SYS3
	MSTIME	A0,	
	MOVEM	A0,%SYS4(DB)	; SAVE TIME OF DAY IN %SYS4
	MOVEI	A1,0
	RUNTIM	A1,	
	MOVEM	A1,%SYS5(DB)	; SAVE RUNTIME IN %SYS5
	MUL	A0,A1
	ROT	A1,(A2)
	MOVEM	A1,%RAND(DB)	; INITIALIZE %RAND
	HRROS	%DDTER(DB)	; SET REDIRECT CHAN # = -1 (TTY:)
	SETOM	%TTYCH(DB)	; [E132] SET TTY CHAN.NO. WORD TO -1
	HRLZI	A0,%ES-%DBL
	HRRI	A0,%ES-1(DB)
	MOVEM	A0,%ESP(DB)	; SET UP EMERGENCY STACK POINTER
	MOVE	A0,[JRST UUO]
	MOVEM	A0,%UUO+1(DB)
	HRLZI	A0,<JSR>B53
	HRRI	A0,%UUO(DB)
	MOVEM	A0,.JB41	; SET UP UUO TRAP
	MOVEI	A0,APRERR
	MOVEM	A0,.JBAPR	; SET APR TRAP ADDRESS
	MOVEI	A0,APRFLG
	APRENB	A0,		; AND ENABLE TRAPS
	SETOM	%DDERD(DB)	; [E127] MARK NO ERROR DETECTED
	MOVEI	A0,FM6
	MOVEM	A0,.JBREN	; SET REENTER ADDRESS
EDIT(021); AX is clobbered by the debugger - make REE work.
	MOVEM	AX,%ACCS+AX(DB)	; [E021] SAVE THE ONLY AC THAT MATTERS !
	JUMPL	AX,FM0		; REENTER?
DDBEG%:		; LABEL DEFINED FOR ALGDDT 'START' COMMAND
INIT4:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	A1,CONCTR	; SET UP CONTROL-C TRAP
	MOVEI	A2,INIT8	; "NO SECOND START" MESSAGE.
	HRRM	A2,.JBSA	; PREVENT 2ND. START.
EDIT(122); RESERVE IMPURE BLOCK (IN CASE OF /OTS:NONSHARE)
	PUSHJ	SP,TRSTD	; TELL TRACE IT'S THE
	EXP	.MAIN.		; [E122] MAIN PROGRAM
	MOVEI	DL,(DB)		; SET UP FOR LOCAL STACK
	PUSHJ	SP,@(AX)	; AND ENTER PROGRAM
	XWD	$PRO!$N!$SIM,1

; *************************	; PROGRAM EXECUTES (HOPEFULLY!)

DDFIN%:	; LABEL DEFINED FOR ALGDDT 'FINISH' COMMAND
INIT5:	SETZM	.JBINT
	MOVE	A0,SP		;
	HRRI	A0,[		;[206] SET DRT TRAPS
	PUSHJ	SP,REL0		;[206]  FOR
	JRST	INIT7]		;[206]  TRAPS 46 AND 47
	MOVEM	A0,%TRAPS+46(DB)	;[206]
	MOVEM	A0,%TRAPS+47(DB)	;[206]
	MOVEI	A1,37

INIT6:	PUSHJ	SP,RELESE	; RELEASE IO CHANNELS
	JFCL	.+1

INIT7:	SOJGE	A1,INIT6
	SETOM	%CHAN(DB)	; MAKE SURE WE ARE ON CHANNEL -1!!!
	PUSHJ	SP,BRKBYT	; BREAK OUTPUT ON CHANNEL -1
	JFCL	.+1
	MOVEI	A1,END1
	PUSHJ	SP,MONIT
	PUSHJ	SP,BRKBYT
	JFCL
	MOVE	A1,[-1,,.GTLIM]	; [243] SET UP GETTAB TABLE # FOR OUR JOB
	GETTAB	A1,		; [243] GET TABLE INFORMATION
	LIBERR	5,		; [243] COMPLAIN IF GETTAB FAILS
	TLNN	A1,JB.LBT	; [243] IS THIS A BATCH JOB?
	EXIT	1,		; [243] NO, JUST EXIT
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,STSPRT	; [243] YES, PRINT ALL STATS
	EDIT(235)		; [235] FIX "REENTER" AFTER FATAL BOMB ON PTY
	SETOM	%DDERD(DB)	; [235] RESET ERROR COUNT TO 0
	EXIT			; [235] RETURN TO MONITOR, UNCONTINUABLE

.MAIN.:	EXP	0		; [E122] PROGRAM PMB
	XWD	3,12		; [E122] WORDS,,CHARS
	SIXBIT/MAIN.PROGRAM /	; [E122] ACTUAL TEXT

STSPR%:
STSPRT:	MOVE	A0,.JBREL	; CORE SIZE IN K
	LSH	A0,-12
	ADDI	A0,1
	PUSHJ	SP,IPRINT
	MOVEI	A1,END2
	PUSHJ	SP,MONIT
EDIT(041); DO STATISTICS, ETC. CORRECTLY
	MOVEI	A0,0		; [E041]
	RUNTIM	A0,		; [E041]	
	SUBM	A0,%SYS5(DB)	; [E041] EXECUTION TIME IN MS
	EXCH	A0,%SYS5(DB)	; [E041] GET DIFFERENCE, STORE NEW
	PUSHJ	SP,PRTIME	; [E041] PRINT IT
	MOVEI	A1,END3
	PUSHJ	SP,MONIT
	MSTIME	A0,		; [E041] GET TIME OF DAY	
	SUBM	A0,%SYS4(DB)	; [E041] ELAPSED TIME IN MS
	EXCH	A0,%SYS4(DB)	; [E041] GET DIFFERENCE, STORE NEW
	DATE	A1,		; [E041]	
	SUBM	A1,%SYS3(DB)	; [E041] ELAPSED DAYS
	EXCH	A1,%SYS3(DB)	; [E041] GET DIFFERENCE, STORE NEW
	JUMPE	A1,.+3		; NONE
	IMUL	A1,[
	EXP	^D24*^D60*^D60*^D1000]
	ADD	A0,A1		; ALLOW FOR DAYS
	PUSHJ	SP,PRTIME	; [E041] PRINT ELAPSED TIME
	MOVEI	A1,END4
	PUSHJ	SP,MONIT
	MOVEI	A0,(DB)
	SUB	A0,%SYS21(DB)	; WORK OUT CURRENT (LARGEST) HEAP-SIZE
	PUSHJ	SP,IPRINT
	MOVEI	A1,END5
	PUSHJ	SP,MONIT
	MOVE	A0,%SYS20(DB)	; NUMBER OF STACK-SHIFTS
	PUSHJ	SP,IPRINT
	IFN FTGETCHK,<
	MOVEI	A1,END6
	PUSHJ	SP,MONIT
	MOVE	A0,%SYS24(DB)
	PUSHJ	SP,IPRINT
	> ; END OF FTGETCHK
	PUSHJ	SP,DCRLF
	JRST	DCRLF		; EXIT VIA DCRLF
RSTRT%:
INIT8:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	OUTSTR	[ASCIZ/
?ALGNSS ALGOL programs cannot be STARTed twice.
/]
		EXIT
END1:	ASCIZ /

End of execution.
/

END2:	ASCIZ /K core

Execution time:/

END3:	ASCIZ /
elapsed time:  /
END4:	ASCIZ/
maximum heap size: /
END5:	ASCIZ/, stack-shifts: /
	IFN	FTGETCHK,<
END6:	ASCIZ/

maximum # of used words in heap-table: /
	>
SUBTTL PRTIME - PRINT TIME ROUTINE

PRTIME:	ADDI	A0,5
	IDIVI	A0,^D10		; TIME IN 1/100'THS SECS.
	IDIVI	A0,^D6000
	JUMPE	A0,PRTIM2	; ANY MINUTES?
	PUSH	SP,A1		; YES - SAVE SECONDS
	IDIVI	A0,^D60
	JUMPE	A0,PRTIM1	; ANY HOURS?
	PUSH	SP,A1		; YES - SAVE MINUTES
	PUSHJ	SP,IPRINT	; PRINT HOURS
	MOVEI	A1,PRTIM3
	PUSHJ	SP,MONIT
	POP	SP,A1		; RESTORE MINUTES

PRTIM1:	MOVE	A0,A1
	PUSHJ	SP,IPRINT	; PRINT MINUTES
	MOVEI	A1,PRTIM4
	PUSHJ	SP,MONIT
	POP	SP,A1		; RESTORE SECONDS

PRTIM2:	MOVE	A0,A1
	HRLI	A0,233000
	FDVRI	A0,207620
	MOVEI	A2,1
	MOVEI	A3,1
	MOVEI	A4,2
	PUSHJ	SP,PRINT.	; PRINT SECONDS AND 1/100'THS
	MOVEI	A1,PRTIM5
	JRST	MONIT0

PRTIM3:	ASCIZ / hrs./

PRTIM4:	ASCIZ / mins./

PRTIM5:	ASCIZ / secs.
/
SUBTTL MONIT - MONITOR ROUTINE

; ENTERED WITH A1 = ADDRESS OF MESSAGE AT
; MONIT IF BREAK NOT REQUIRED
; MONIT0 IF BREAK REQUIRED
; MONSIX IF I/P IS IN SIXBIT (NO BREAK)

DCRLF:	PUSHJ	SP,CRLF		; DOUBLE CRLF

CRLF%:
CRLF:	MOVEI	A1,MONIT4	; SPECIAL CR-LF ENTRY

MONIT0:	TDZA	A0,A0		; CLEAR NO-BREAK FLAG
MONIT:	MOVEI	A0,1		; SET NO-BREAK FLAG
	MOVNI	A2,1
	EXCH	A2,%CHAN(DB)	; FAKE CHANNEL -1
	HRLI	A1,440700	; PREPARE ASCII BYTE-POINTER
	SKIPGE	A0,		; SIXBIT ?
	TLZ	A1,000100	; YES - ADJUST BYTE-POINTER

MONIT1:	ILDB	A13,A1		; GET NEXT BYTE
	JUMPE	A13,MONIT2	; NULL?
	SKIPGE	A0,		; NO - SIXBIT ?
	ADDI	A13,40		; YES - MAKE ASCII
	PUSHJ	SP,OUBYTE	; OUTPUT IT
	JFCL	MONIT1
	JRST	MONIT1

MONIT2:	JUMPN	A0,MONIT3	; BREAK REQUIRED?
	PUSHJ	SP,BRKBYT	; YES - BREAK OUTPUT
	JFCL	MONIT3

MONIT3:	MOVEM	A2,%CHAN(DB)	; RESTORE IO CHANNELS
	POPJ	SP,0

MONIT4:	ASCIZ /
/

MONSIX:	MOVNI	A0,1
	JRST	MONIT+1
	SUBTTL FAULT MONITOR

FM0:	MOVEI	A1,FM3		; INITIAL ENTRY ON REENTER
	MOVEI	DL,(DB)		; GIVE DEBUGGER SOMETHING TO WORK WITH.
	PUSHJ	SP,MONIT0	;
	MOVEI	A0,FM15
	MOVEM	A0,.JBOPC	; SET UP SO DDT CONTIN WILL RETURN HERE
	PUSH	SP,AX		; ALGDDT TENDS TO CLOBBER THIS.
	JRST	%ALGDD

FM15:	POP	SP,AX
	JRST	INIT4		;


FM3:	ASCIZ /
!ALGOL diagnostic system
!(H for Help) /

TRACE1:	ASCIZ/
%ALGNTL No trace list entries
/
TRACE2:	ASCIZ/
!
!ALGOL postmortem trace (latest first)
/
PRFMES:	ASCIZ/
Profile Print.

Count	Name
-----	----

/

	SUBTTL	Control-C Logic

CNCTR%:
CONCTR:	MOVE	A0,[-1,,.GTLIM]	; [243] SET UP GETTAB TABLE # FOR OUR JOB
	GETTAB	A0,		; [243] GET TABLE INFORMATION
	LIBERR	5,		; [243] COMPLAIN IF GETTAB FAILS
	TLNE	A0,JB.LBT	; [243] IS THIS A BATCH JOB?
	JRST	(A1)		; [243] YES, JUMP TO WHERE A1 POINTS
	MOVE	A0,[XWD 4,CONC]	; [243] NO, KEEP GOING
	MOVEM	A0,%CONC(DB)
	MOVEI	A0,CONCF	; [E1014]
	MOVEM	A0,%CONC+1(DB)
	SETZM	%CONC+2(DB)	; MONITOR REQUIRES THIS TO BE ZEROED.
	MOVEI	A0,%CONC(DB)
	MOVEM	A0,.JBINT	; SET UP CONTROL-C TRAP
	PJOB	A0,		;[214] DO DUMMY UUO TO FOOL PA1050
	JRST	(A1)

CONC:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEM	A1,.JBBLT##	; SAVE A1 IN A FIXED LOCATION
	HRRZ	A1,.JBINT##	; GET ADDRESS OF INTERRUPT BLOCK
	CAIN	A1,%CONC(DB)	; ARE WE IN THE STACK-SHIFTER ?
	JRST	CONCOK		; NO  - NORMAL TRAP ACTION
	MOVEM	A2,.JBBLT##+1	; YES - SAVE A2 AS WELL
	MOVE	A2,2(A1)	; GET CONTROL-C PC
	SETZM	2(A1)		; AND CLEAR IT FOR MONITOR
	EXCH	A2,.JBBLT##+1	; RESTORE A2,SAVE PC
	MOVE	A1,.JBBLT##	; RESTORE A1 CONTENTS
	SKIPN	%DDTCC(DB)	; IF NO TRAP YET PENDING,
	HLLOS	%DDTPC(DB)	; [E114] SET UP AS SOON AS POSSIBLE
	JRST	@.JBBLT##+1	; AND CONTINUE EXECUTION
CONCOK:	MOVE	A1,.JBBLT##	; GET CORRECT A1 CONTENTS
	SETZM	.JBINT		; CONTROL-C - TURN IT OFF
	MOVEM	A0,%ACCS+A0(DB)
	HLRZ	A0,%CONC+3(DB)
	CAIE	A0,CONCF	; WAS IT CONTROL-C?
	EXIT	1,		; NO - STOP
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVE	A0,%CONC+2(DB)
	MOVEM	A0,.JBOPC	; SAVE PC
	HRLZI	A0,A1
	HRRI	A0,%ACCS+A1(DB)
	BLT	A0,%ACCS+SP(DB)	; SAVE AC'S
	SKIPE	%DDTCC(DB)	; ALREADY SEEN A CONTROL-C ?
	JRST	DO.CNC		; YES - TRAP ANYWAY
	HRRZ	A4,.JBOPC	; NO  - GET P.C.
	TRNE	A4,400000	; IN OTS ?
	JRST	OTSCNC		; YES - HANDLE DIFFERENTLY
	JRST	NXTCNC		; NO  - TRY TO DO A 'NEXT'
DO.CNC:	SETZM	%DDTCC(DB)	; SAY CONTROL-C NOTICED
	PUSHJ	SP,BRKBYT	; FINISH OUTPUT
	  JFCL
	MOVEI	A1,[ASCIZ/
Stopped
/]
	PUSHJ	SP,MONIT
	;[E127] 3 lines moved
	JRST	FM6A

CNC.AX::SKIPLE	%DDTCC(DB)	; [E114] IF NOT ^C PENDING,
	;
	; Edit(1007)  Ensure AX points below heap (avoids stack shifts)
	;
	CAML	AX,%SYS21(DB)	; [E1007] or AX not in program
	JRST	(AX)		; JUST BRANCH
	SETZM	.JBINT##	; O.K. - TURN OFF ^C TRAP
	HRRZM	AX,.JBOPC##	; SAVE USER PC
	MOVEM	A0,%ACCS+A0(DB)	; AND USER ACCS
	MOVSI	A0,A1		; ..
	HRRI	A0,%ACCS+A1(DB)	; ..
	BLT	A0,%ACCS+SP(DB)	; ..
NXTCNC:	PUSHJ	SP,DDT.CC##	; GO TRY TO SET UP AUTOMATIC NEXT
; ****	DOES NOT RETURN IF SUCCESSFUL !
; C[E127] NO CONTEXT - CARRY ON UNTIL WE CAN STOP PROPERLY
OTSCNC:	HLLOS	%DDTCC(DB)	; [E114] SET R.H. OF %DDTCC TO ALL ONES
	JRST	FM9B		; AND CONTINUE

FM6:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	TLNE	DB,INDDT	; [E127] LATER REENTER ENTER
	  JRST	%DDREE##	; [E127] IF IN DDT GO TO CMD LVL
	MOVEM	A0,%ACCS+A0(DB)
	HRLZI	A0,A1
	HRRI	A0,%ACCS+A1(DB)
	BLT	A0,%ACCS+SP(DB)	; YES - SAVE ACCUMULATORS
	PUSHJ	SP,BRKBYT	; CLEAR OUTPUT
	JFCL	.+1

FM6A:	TLO	DB,TMPFL3	; [E127]TELL HSTPRT NOT TO TYPE IF EXPERT.
EDIT (201); DELOCATE SP WHEN ABOUT TO ENTER ALGDDT ON CONTROL-C
	MOVE	A4,SP		;[201] GET SP
	SUBI	A4,0(DB)	;[201] DELOCATE IT
	MOVEM	A4,%ACCS+SP(DB)	;[201] AND SAVE IT
	HRRZ	A4,.JBOPC##	; [E127] GET PC OF ERROR
	PUSHJ	SP,PR.HST##	; [E127] HISTORY PRINT.
	TLZ	DB,INDDT
	SETZM	%SYS17(DB)	; INDICATE NO ERROR
	MOVEI	A1,FM3
	PUSHJ	SP,MONIT0
	JRST	%ALGDD		; JUMP TO DEBUGGER


DDCON%:	; LABEL DEFINED FOR ALGDDT 'CONTINUE' COMMAND
	SKIPE	%SYS17(DB)	; WAS IT AN ERROR
	JRST	FM9A		; YES
FM9B:	JSP	A1,CONCTR	; RESTORE CONTROL-C INTERCEPT

	HRLZI	A0,%ACCS+A1(DB)
	HRRI	A0,A1
	BLT	A0,A13
	MOVE	AX,%ACCS+AX(DB)	; DON'T RESTORE DB,DL,SP.
	MOVE	A0,%ACCS+A0(DB)	; RESTORE ACCUMULATORS
	JRSTF	@.JBOPC		; AND RETURN TO PROGRAM

EDIT(105); Force "Can't continue" error message out immediately
FM9A:	MOVEI	A1,FM13
	PUSHJ	SP,MONIT0	; [E105] CANNOT CONTINUE
	JRST	%ALGDD		; JUMP TO DEBUGGER.


FM13:	ASCIZ /
Can't continue after this error

/
SUBTTL PARAM - PROCEDURE CALL PARAMETER HANDLER

; MAGIC PARAMETER TYPE MATCH TABLE

; LH: FORMAL PARAMETER ENTRY
; RH: ACTUAL PARAMETER ENTRY

TYPTAB:	XWD	421030,000000	; "WILD" VARIABLE
	XWD	421020,000000	; ARITHMETIC/BOOLEAN
	XWD	421022,000000	; ARITHMETIC/BOOLEAN/NONTYPE
	XWD	400020,000000	; INTEGER/BOOLEAN
	XWD	021000,000000	; "WILD" FLOATING
	XWD	000000,000000
	XWD	000000,000000
	XWD	444000,700000	; INTEGER
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	222000,070000	; REAL
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	111000,007000	; LONG REAL
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000500,000600	; COMPLEX
	XWD	000240,000140	; LONG COMPLEX
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	421000,000000	; "WILD" ARITHMETIC
	XWD	000000,000000
	XWD	000000,000000
	XWD	000020,000020	; BOOLEAN
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000004,000004	; LABEL
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000002,000002	; NON-TYPE
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000010,000010	; STRING
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
	XWD	000000,000000
; PROCEDURE CALLS ARE FORMATTED AS FOLLOWS:


;		PUSHJ	SP,PROC
;		XWD	ATYPE,N+1
;		XWD	AT1,AA1
;		XWD	AT2,AA2
;
;		...............
;
;		XWD	ATN,AAN


; WHERE	N = NUMBER OF ACTUAL PARAMETERS

;	ATYPE = TYPE OF PROCEDURE REQUIRED

;	ATI = TYPE OF I'TH ACTUAL PARAMETER

;	AAI = ADDRESS OR VALUE OF I'TH ACTUAL PARAMETER



; THE PROCEDURE HEAD IS FORMATTED AS FOLLOWS:


;		XWD	DL,NA		; IF PAR0 ENTRY
;	PROC:	JSP	AX,PARAM	; OR PAR0
;		EXP	PM-BLOCK-ADDRESS
;		XWD	PL,L
;		XWD	FTYPE,M+1
;		XWD	FT1,FA1
;		XWD	FT2,FA2
;
;		...............
;
;		XWD	FTM,FAM


; WHERE	M = NUMBER OF FORMAL PARAMETERS

;	PL = PROCEDURE LEVEL

;	L = LENGTH OF FIXED STACK REQUIRED (NOT INCLUDING DISPLAY)

;	FTYPE = TYPE OF PROCEDURE

;	FTI = TYPE OF I'TH FORMAL PARAMETER

;	FAI = ADDRESS OF I'TH FORMAL PARAMETER (RELATIVE TO DL)

;	NA = ADDRESS FOR NUMBER OF ACTUAL PARAMETERS (PAR0 ONLY)
; TYPE ABBREVIATIONS:

;	I	INTEGER
;	R	REAL
;	LR	LONG REAL
;	C	COMPLEX (NOT IMPLEMENTED)
;	LC	LONG COMPLEX (NOT IMPLEMENTED)
;	B	BOOLEAN
;	S	STRING
;	L	LABEL
;	N	NON-TYPE (PROCEDURES ONLY)
SUBTTL PARAM - PROCEDURE TYPE HANDLING

PARAM:	TDZA	A1,A1		; NORMAL ENTRY
PAR0:	MOVEI	A1,1		; VARIABLE NUMBER OF PARAMETERS ENTRY
EDIT(100); Chain DL for debugger
	MOVE	A3,%DDTDL(DB)	; [E100] GET TOP-LEVEL DL
	EXCH	A3,(SP)		; [E100] STACK BEFORE PRGLNK
	MOVEI	A3,(A3)		; [E100] CLEAR PC FLAGS
	HRRZ	A0,(A3)		; NUMBER OF AP'S + 1
	CAILE	A3,(DB)
	CAILE	A3,(SP)		; IF THE LINK IS ABSOLUTE
	JRST	PAR5		; THEN LEAVE IT ALONE
	SUBI	A3,(DB)		; OTHERWISE DELOCATE IT
	HRLI	A3,DB		; AND PUT IN THE DB BITS

PAR5:	PUSH	SP,[0]		; [E127] SAVE SPACE FOR LINKPC
	PUSH	SP,A3		; [E100] PUT PRGLNK ON STACK
	ADDM	A0,(SP)		; ADVANCE LINK OVER AP'S
	AOS	%TRLV(DB)	; UPDATE DYNAMIC BLOCK COUNT
	PUSH	SP,0(AX)	; SAVE PMB POINTER
	HRRZ	A2,2(AX)	; NUMBER OF FP'S + 1
	XCT	[
	CAIE	A0,(A2)
	CAILE	A0,(A2)](A1)	; CHECK ON NUMBER OF PARAMETERS
	SYSER1	10,0		; WRONG
	MOVE	A4,DL		; GET CONDL INTO A4
	SUBI	A4,(DB)		; DELOCATE AND
	PUSH	SP,A4		; SAVE CONTEXT DL
	PUSH	SP,[0]		; INITIALIZE BLOCK POINTER
	HLLZ	A5,1(AX)	; SAVE PROCEDURE LEVEL
	PUSH	SP,A5		; AND INITIALIZE BLOCK LEVEL
	MOVEI	DL,1(SP)	; SET UP NEW DL
	HLRZ	A5,A5		; PROCEDURE LEVEL
	TLNE	A4,-1		; IS THIS PROCEDURE PARAMETRIC?
	HLRZ	A4,A4		; YES - USE ENVIRONMENT
	ADDI	A4,(DB)

PAR1:	SOJL	A5,PAR2		; LEVELS EXHAUSTED?
	PUSH	SP,(A4)		; NO - COPY DISPLAY ELEMENT
	AOJA	A4,PAR1		; AND ADVANCE OLD DL

PAR2:	MOVEI	A4,(DL)
	SUBI	A4,(DB)
	TLO	A4,DB
	PUSH	SP,A4		; ADD NEW DL
	AOS	%DDTPL(DB)	; UPDATE DYNAMIC PROCEDURE LEVEL
	MOVEM	A4,%DDTDL(DB)	; [E100] REMEMBER THIS DL
	HLRZ	A5,@A3
	ANDI	A5,$TYPE
	LSH	A5,-11		; TYPE OF PROCEDURE REQUIRED
	HRLZ	A5,TYPTAB(A5)	; GET TABLE ENTRY FOR IT
	HLRZ	A6,2(AX)
	ANDI	A6,$TYPE
	LSH	A6,-11		; TYPE OF PROCEDURE
	JUMPN	A5,.+2		; ANY ACTUAL TYPE BITS?
	HRLZ	A5,TYPTAB(A6)	; NO - FIX FOR SPRO5!!!
	AND	A5,TYPTAB(A6)	; GATE TABLE ENTRIES
	JFFO	A5,PAR4		; AND SORT IT OUT!!!!!!!

PAR3:	SYSER1	7,0		; MISMATCH
PAR4:	SKIPN	A5,PAR8(A6)	; GET MATCH ENTRY
	JRST	PAR3		; NO GOOD
	PUSH	SP,A5		; YES - PLANT IN EXIT FORMAL
	HRRZ	A5,1(AX)	; GET FIXED STACK LENGTH
	CAIE	A6,16		; [E054] IS THIS A STRING PROCEDURE ?
	JRST	.+4		; [254][E054] NO  - RESERVE ONE MORE WORD
	SUBI	A5,2		; [254] YES
	PUSH	SP,[0]		; [254] INITIALIZE TO NULL STRING
	PUSH	SP,[0]		; [254][E054] CLEAR SECOND WORD OF HEADER
	ADDI	SP,-1(A5)	; [254][E054] AND ADVANCE STACK
	MOVE	A5,.JBREL
	CAIG	A5,2(SP)	; STACK STILL IN CORE
	CCORE	1(A5)		; NO - TRY TO EXPAND
SUBTTL PARAM - MAIN CONTROL LOOP OF PARAMETER HANDLER

	MOVEI	A5,(SP)
	SUB	A5,.JBREL
	HRLI	SP,(A5)		; SET UP LH NEGATIVE COUNT
	MOVE	A13,SP
	SUBI	A13,(DB)
	PUSH	SP,A13		; MAKE FIRST BLOCK POINTER
	AOBJN	A13,.+1
	PUSH	SP,A13		; AND ANOTHER TO ENCLOSE VALUE ARRAYS
	AOBJN	A13,.+1
	MOVEM	A13,BLKPTR(DL)	; AND SET UP POINTER
	MOVN	A13,A0
	HRLZI	A13,(A13)
	HRRI	A13,2(AX)	; COUNTER/POINTER TO FP'S
	ADDI	A2,2(AX)
	ADDI	A3,1		; MOVE TO FIRST AP
	MOVEM	A2,LINKPC(DL)	; [E127] SAVE RETURN ADDRESS
	JUMPE	A1,PAR6		; PAR0 ENTRY?
	MOVEM	A0,@-2(AX)	; YES - FILL IN NUMBER OF AP'S

PAR6:	AOBJP	A13,PAR9	; EXIT IF NO MORE PARAMETERS
	HRRZ	A2,@A3		; GET AP ADDRESS
	MOVE	A4,(A13)	; GET FP WORD
	ADDI	A4,(DL)		; AND RELOCATE IT
	HLLZ	A5,@A3		; GET LEFT HALF OF AP WORD
	SETZB	A6,A10
	ROTC	A5,3		; SHIFT STATIC/DYNAMIC AND KIND TO A6
	EXCH	A6,A10		; AND THEN TO A10
	ROTC	A5,6		; SHIFT TYPE TO A6
	ROT	A5,3
	ANDI	A5,<$STAT>B41	; AND GET STATUS IN A5
	HLRZ	A7,A4
	HRRZ	A11,A7
	ANDI	A11,$KIND
	LSH	A11,-17		; GET KIND OF FP
	ANDI	A7,$TYPE
	LSH	A7,-11		; GET TYPE OF FP
	CAIN	A6,<$S>B44	; STRING?
	CAIE	A10,4		; YES - DYNAMIC VARIABLE?
	JRST	PAR10		; NO
	JUMPE	A5,PAR10	; SIMPLE AS WELL?
	MOVEI	A10,10		; NO - RECODE AS SPECIAL
	MOVEI	A6,<$I>B44	; - TYPE IS INTEGER
PAR10:	HRLZ	A6,TYPTAB(A6)	; GET ENTRY FOR AP TYPE
	AND	A6,TYPTAB(A7)	; GATE WITH ENTRY FOR FP TYPE
	JFFO	A6,@PAR7(A10)	; SORT IT OUT AND BRANCH!!!!!!!
EDIT (202);
	HRRZ	DL,CONDL(DL)	;[202] GET DL TO BE CONTEXT DL
	ADDI	DL,0(DB)	;[202] AND RELOCATE IT
	SYSER1	7,0		; MISMATCH

PAR7:	JRST	@SVAR(A11)	; STATIC, VARIABLE
	JRST	@SEXP(A11)	; STATIC, EXPRESSION
	JRST	@SARR(A11)	; STATIC, ARRAY
	JRST	@SPRO(A11)	; STATIC, PROCEDURE
	JRST	@DVAR(A11)	; DYNAMIC, VARIABLE
	JRST	@DEXP(A11)	; DYNAMIC, EXPRESSION
	JRST	PAR3		; DYNAMIC, ARRAY (IMPOSSIBLE)
	JRST	PAR3		; DYNAMIC, PROCEDURE (IMPOSSIBLE)
	JRST	@BVAR(A11)	; DYNAMIC SIMPLE VARIABLE STRING (BYTE)
SUBTTL PARAM - STATIC VARIABLE HANDLER

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

SVARD:	XWD	SVAR32,SVAR2	; I -> I
	XWD	SVAR33,SVAR3	; I -> R
	XWD	SVAR34,SVAR7	; I -> LR
	XWD	SVAR35,SVAR11	; R -> I
	XWD	SVAR32,SVAR2	; R -> R
	XWD	SVAR36,SVAR15	; R -> LR
	XWD	SVAR37,SVAR19	; LR -> I
	XWD	SVAR38,SVAR23	; LR -> R
	XWD	SVAR39,SVAR43	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	SVAR32,SVAR2	; B -> B
	XWD	SVAR40,SVAR28	; S -> S
	XWD	0,0		; L -> L [E053] LABELS HANDLED SPECIALLY
	XWD	0,0		; N -> N

SVAR:	XWD	0,SVAR0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,PAR3		; PROCEDURE

EDIT(053); HANDLE FORMAL LABELS CORRECTLY.
SVAR0:	CAIN	A5,<$FON>B41	; FORMAL VARIABLE?
	JRST	FSVR0		; YES - SPECIAL TREATMENT
	CAIN	A7,17		; [E053] LABEL ?
	JRST	SVAR24		; [E053] YES - SPECIAL TREATMENT
	CAIN	A5,<$OWN>B41	; FIXED VARIABLE?
	JRST	SVAR1		; YES
	HLRZ	A6,@A3
	ANDI	A6,$P		; GET VARIABLE LEVEL (P ADDRESS)
	ADD	A6,CONDL(DL)	; ADDRESS OF DISPLAY ENTRY
	ADDI	A6,(DB)		; AND RELOCATE
	ADD	A2,(A6)		; ADD TO Q ADDRESS

SVAR1:	SKIPN	A6,SVARD(A7)	; LOAD UP DISPATCH ENTRY
	JRST	PAR3		; ILLEGAL
	TLNE	A4,$VAL		; FORMAL BY VALUE?
	MOVS	A6,A6		; YES - SWAP HALVES
	JRST	(A6)		; AND DISPATCH
; I -> I, R -> R, B -> B, BY NAME

SVAR2:	TLO	A2,<MOVE	A0,0>B53
	MOVEM	A2,(A4)
	TLO	A2,<MOVEM	A0,0>B53
	MOVEM	A2,1(A4)	; PLANT DIRECT CODE IN F[0],F[1]
	AOJA	A3,PAR6

; I -> R, BY NAME

EDIT(002); SET UP A2 ON XCTA WHEN TYPE CONVERSION IS NEEDED
SVAR3:	DMOVE	A5,SVAR4
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR4:	PUSHJ	SP,SVAR5
	PUSHJ	SP,SVAR6

SVAR5:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	FLTR	A0,A0
	POPJ	SP,0

SVAR6:
DVAR5:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	FIXR	A3,A0		; F[1] CODE
	MOVEM	A3,@A2
	POPJ	SP,0

; I -> LR, BY NAME

SVAR7:	DMOVE	A5,SVAR8
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR8:	PUSHJ	SP,SVAR9
	PUSHJ	SP,SVAR10

SVAR9:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	JSP	AX,ILR
	POPJ	SP,0

SVAR10:
DVAR8:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	AX,SLRI		; F[1] CODE
	MOVEM	A3,@A2
	POPJ	SP,0
; R -> I, BY NAME

SVAR11:	DMOVE	A5,SVAR12
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR12:	PUSHJ	SP,SVAR13
	PUSHJ	SP,SVAR14

SVAR13:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	FIXR	A0,A0
	POPJ	SP,0

SVAR14:
DVAR11:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	FLTR	A3,A0		; F[1] CODE
	MOVEM	A3,@A2
	POPJ	SP,0
; R -> LR, BY NAME

SVAR15:	DMOVE	A5,SVAR16
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR16:	PUSHJ	SP,SVAR17
	PUSHJ	SP,SVAR18

SVAR17:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	MOVEI	A1,0
	POPJ	SP,0

SVAR18:
DVAR14:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	AX,SLRR		; F[1] CODE
	MOVEM	A3,@A2
	POPJ	SP,0

; LR -> I, BY NAME

SVAR19:	DMOVE	A5,SVAR20
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR20:	PUSHJ	SP,SVAR21
	PUSHJ	SP,SVAR22

SVAR21:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	ADDI	A2,1
	MOVE	A1,@A2
	SUBI	A2,1
	JSP	AX,LRI
	POPJ	SP,0
SVAR22:
DVAR17:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	AX,SILR		; F[1] CODE
	DMOVEM	A3,@A2
	POPJ	SP,0

; LR -> R, BY NAME

SVAR23:	DMOVE	A5,SVAR25
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR25:	PUSHJ	SP,SVAR26
	PUSHJ	SP,SVAR27

SVAR26:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	MOVE	A0,@A2
	ADDI	A2,1
	MOVE	A1,@A2
	SUBI	A2,1
	JSP	AX,LRR
	POPJ	SP,0

SVAR27:
DVAR20:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A2,@A2		; F[1] CODE
	MOVEM	A0,(A2)
	SETZM	1(A2)
	POPJ	SP,0
; LR -> LR, BY NAME

SVAR43:	TLO	A2,<DMOVE	A0,0>B53
	MOVEM	A2,(A4)
	TLO	A2,<DMOVEM	A0,0>B53
	MOVEM	A2,1(A4)
	AOJA	A3,PAR6

; S -> S, BY NAME

SVAR28:	DMOVE	A5,SVAR29	; LOAD UP CODE
	DMOVEM	A5,(A4)		; PLANT INDIRECT CODE IN F[0],F[1]
	MOVEM	A2,2(A4)	; AND ADDRESS IN F[2]
	AOJA	A3,PAR6

SVAR29:  PUSHJ	SP,SVAR30	; F[0] CODE
	PUSHJ	SP,SVAR44	; F[1] CODE

;
;	THIS SUBROUTINE RETURNS A STRING HEADER IN A0, A1.
;
SVAR30:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVEI	A2,@-1(A2)
	MOVE	A2,2(A2)
	DMOVE	A0,@A2
	POPJ	SP,0

DVAR23:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	DMOVEM	A0,@A2		; F[1] CODE
	POPJ	SP,0

EDIT(055); REVISE ASSIGNMENT TO FORMAL STRINGS
SVAR44:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; [E055] SAVE R.H. STRING ON STACK
	PUSH	SP,A1		; [E055] FOR CALL TO STRASS
	DMOVE	A0,@A2		; [E055] LOAD UP STRING HEADER
	JSP	AX,STRASX	; [E055] LET STRASS DO THE WORK
	DMOVEM	A0,@A2		; [E055] AND STORE NEW STRING
	POPJ	SP,		; [E055] RETURN
; I -> I, R -> R, B -> B, BY VALUE

SVAR32:
DVAR25:	MOVE	A0,@A2

DEXP18:	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; I -> R, BY VALUE

SVAR33:
DVAR26:	MOVE	A0,@A2

DEXP19:	FLTR	A0,A0
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; I -> LR, BY VALUE

SVAR34:
DVAR27:	MOVE	A0,@A2

DEXP20:	JSP	AX,ILR
	DMOVEM	A0,(A4)		; PLANT VALUE IN F[0],F[1]
	AOJA	A3,PAR6

; R -> I, BY VALUE

SVAR35:
DVAR29:	MOVE	A0,@A2

DEXP21:	FIXR	A0,A0
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; R -> LR, BY VALUE

SVAR36:
DVAR30:	MOVE	A0,@A2

DEXP22:	MOVEM	A0,(A4)
	SETZM	1(A4)		; PLANT VALUE IN F[0],F[1]
	AOJA	A3,PAR6
; LR -> I, BY VALUE

SVAR37:
SEXP26:
DVAR31:	DMOVE	A0,@A2

DEXP23:	JSP	AX,LRI
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; LR -> R, BY VALUE

SVAR38:
SEXP27:	DMOVE	A0,@A2
	JSP	AX,LRR
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; LR -> LR, BY VALUE

SVAR39:
DVAR28:
SEXP29:
SARR2:	DMOVE	A0,@A2

DEXP25:	DMOVEM	A0,(A4)		; PLANT VALUE IN F[0],F[1]
	AOJA	A3,PAR6
; S -> S, BY VALUE

SVAR40:
SEXP28:	DMOVE	A0,@A2

EDIT(045); Pass strings by value correctly
DEXP26:	MOVEI	A2,(A4)		; [E045] GET LOCAL STACK ADDRESS
	SUBI	A2,(DB)		; [E045] AND DELOCATE IT
	HRLI	A2,(<Z @(DB)>)	; [E045] SET POINTER THROUGH STRING HEADER
	EXCH	A2,(SP)		; [E045] ADD TO LIST ON THE STACK
	PUSH	SP,A2		; [E045] AND MAKE NEW BLOCK POINTER
	MOVE	A2,SP		; [E045] THEN GET DELOCATED TOP OF
	SUBI	A2,(DB)		; [E045] STACK FRAME AT THIS MOMENT
	MOVEM	A2,BLKPTR(DL)	; [E045] AND SAVE IT IN DISPLAY
	PUSH	SP,A0		; [E045] PUSH POINTER TO THE ACTUAL
	PUSH	SP,A1		; [E045] STRING ONTO THE STACK
	JSP	AX,STRAS0	; [E045] GET A COPY OF THE ACTUAL BYTES
	HRRZ	A2,-1(SP)	; [E045] GET STRING HEADER ADDRESS
	ADDI	A2,(DB)		; [E045] AND RELOCATE IT
	DMOVEM	A0,(A2)		; [E045] AND POINT TO THE NEW STRING
	AOJA	A3,PAR6
; L -> L, BY NAME, BY VALUE

EDIT(053); MAKE FORMAL SWITCHES WORK PROPERLY
SVAR24:	CAIN	A5,<$FOV>B41	; [E053] FORMAL LABEL BY VALUE ?
	JRST	FSVR0		; [E053] YES - LABELS BY VALUE ARE SPECIAL
SVAR41:
DEXP17:	MOVE	A5,[
	PUSHJ	SP,SVAR42]
	MOVEM	A5,(A4)		; PLANT CODE IN F[0]
	MOVEM	A2,1(A4)	; [E053] LABEL ADDRESS IN F[1]
	HRRZ	A5,CONDL(DL)	; AND CONTEXT DL
	HRLZM	A5,2(A4)	; IN LEFT HALF OF F[2]
	AOJA	A3,PAR6

SVAR42:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A1,(SP)		; [E053] DONT OVERWRITE A2 YET !
	SKIPA	A1,-1(A1)	; [E053] GET XCT INSTRUCTION
	MOVE	A1,@A1		; [E053] FOLLOW XCT CHAIN
	HLRZ	A0,@A1		; [E053] GET THE TARGET INSTRUCTION
	ANDI	A0,777000	; [E053] CLEAR AC AND INDEX FIELDS
	CAIN	A0,(XCT 0,0)	; [E053] WAS THIS AN XCT INSTRUCTION ?
	JRST	.-4		; [E053] YES - FIND OUT WHAT IT POINTS TO
	MOVEI	AX,@A1		; [E053] NO  - GET FORMAL ADDRESS
	MOVE	A2,1(AX)	; [E053] NOW GET F[1]
	TRNE	A2,-1		; [E053] IF SWITCH OUT OF RANGE
	TLNE	A2,-1		; [E053] OR ALREADY A FORMAL
	POPJ	SP,		; [E053] THEN RETURN
	SUBI	AX,(DB)		; DELOCATE FORMAL ADDRESS
	HRLZI	A2,(AX)
	HRRI	A2,FORLAB	; AND PREPARE FOR FORLAB
	POPJ	SP,0
; FORMAL STATIC VARIABLES

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

FSVARD:	XWD	DEXP18,FSVR2	; I -> I
	XWD	DEXP19,FSVR4	; I -> R
	XWD	DEXP20,FSVR7	; I -> LR
	XWD	DEXP21,FSVR10	; R -> I
	XWD	DEXP18,FSVR2	; R -> R
	XWD	DEXP22,FSVR13	; R -> LR
	XWD	DEXP23,FSVR16	; LR -> I
	XWD	DEXP24,FSVR19	; LR -> R
	XWD	DEXP25,FSVR2	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	DEXP18,FSVR2	; B -> B
	XWD	DEXP26,FSVR2	; S -> S
	XWD	DEXP17,FLAB01	; L -> L
	XWD	0,0		; N -> N
FSVR0:	HLRZ	A1,@A3
	ANDI	A1,$P		; VARIABLE LEVEL (P ADDRESS)
	ADD	A1,CONDL(DL)	; ADDRESS OF DISPLAY ENTRY
	ADDI	A1,(DB)
	ADD	A2,(A1)		; ADD TO Q ADDRESS
	SKIPN	A6,FSVARD(A7)	; LOAD UP DISPATCH TABLE ENTRY
	JRST	PAR3		; ILLEGAL
	TLNN	A4,$VAL		; FORMAL BY NAME?
	JRST	FSVR1		; YES
	SKIPA	A5,A2		; NO - GET ADDRESS IN A5

DEXP14:	MOVEI	A5,[
	PUSHJ	SP,(A2)]	; DYNAMIC EXPRESSION ENTRY
	MOVS	A6,A6		; TAKE LEFT HALF OF DISPATCH ENTRY
	PUSH	SP,A6		; AND SAVE IT
	PUSH	SP,A3
	DPUSH	A4
	PUSH	SP,A13		; SAVE VALUABLE ACCUMULATORS
	MOVEI	A1,(DL)
	DPUSH	DL		; SAVE CURRENT DL
	HRRZ	DL,CONDL(A1)
	ADDI	DL,(DB)
	XCT	@A5		; EVALUATE FORMAL OR THUNK
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE DL
	POP	SP,A13
	RPOP	A4
	POP	SP,A3		; RESTORE VALUABLE ACCUMULATORS
	POP	SP,A6		; AND DISPATCH ADDRESS
	JRST	(A6)		; DISPATCH

FSVR1:	HRL	A2,(A1)		; GET CORRECT DL

FSVR22:	MOVEM	A2,2(A4)	; AND PLANT IN F[2]
	DMOVE	A5,(A6)
	DMOVEM	A5,(A4)		; AND CODE IN F[0],F[1]
	AOJA	A3,PAR6
; ROUTINES FOR HANDLING ACTUALS THAT ARE ARE FORMALS

FSVRC0:	MOVE	A2,-1(SP)	; INDIRECT ENTRY ON F[0]
	MOVE	A0,-1(A2)	; GET XCT ORDER
	MOVEI	A2,@A0
	MOVE	AX,2(A2)	; GET CONTEXT DL AND ADDRESS
	DPUSH	DL		; SAVE CURRENT DL
	HLRZ	DL,AX		; AND ASSUME FORMAL'S DL
	ADDI	DL,(DB)
	ADDI	AX,(DB)
	TLNE	A0,$A		; XCTA?
	JRST	FSVRCA		; YES
	XCT	(AX)		; NO - GET VALUE OF FORMAL
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE CURRENT DL
	POPJ	SP,0

FSVRCA:	XCT	1,(AX)		; GET ADDRESS OF FORMAL
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE CURRENT DL
	POP	SP,AX		; LOSE F[0]'S LINK
	POPJ	SP,0

; N.B. A2 IS SET UP FROM FSVRCA

EDIT(101); Remember values are stored on the stack
FSVRD1:	MOVE	A3,(SP)		; [E101] DIRECT ENTRY ON F[1]
	JRST	FSVRDC		; [E101] JOIN COMMON CODE
FSVRC1:	SKIPA	A3,-2(SP)	; [E101] INDIRECT ENTRY ON F[1]
FSVRC2:	MOVE	A3,-3(SP)	; [E101] DITTO, TWO WORD VARIABLE
FSVRDC:	MOVEI	A3,@-1(A3)	; [E101] ADD LABEL FSVRDC
	MOVE	AX,1(A3)	; GET CONTEXT DL AND ADDRESS
	DPUSH	DL		; SAVE CURRENT DL
	HLRZ	DL,AX		; AND ASSUME FORMAL'S DL
	ADDI	DL,(DB)
	ADDI	AX,(DB)
	XCT	1(AX)		; STORE RESULT IN FORMAL
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE CURRENT DL
	POPJ	SP,0
; I -> I, R -> R, LR -> LR, B -> B, S -> S, L -> L, BY NAME

FSVR2:	PUSHJ	SP,FSVR3
	PUSHJ	SP,FSVRD1	; DIRECT F[1] CODE

FSVR3:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	POPJ	SP,0

; I -> R, BY NAME

FSVR4:	PUSHJ	SP,FSVR5
	PUSHJ	SP,FSVR6

FSVR5:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	FLTR	A0,A0
	POPJ	SP,0

FSVR6:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; INDIRECT F[1] CODE
	FIXR	A0,A0
	PUSHJ	SP,FSVRC1
	POP	SP,A0
	POPJ	SP,0

; I -> LR, BY NAME

FSVR7:	PUSHJ	SP,FSVR8
	PUSHJ	SP,FSVR9

FSVR8:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	PUSH	SP,AX		;[173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,ILR
	POP	SP,AX		;[173] RESTORE SAVED AX
	POPJ	SP,0

FSVR9:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; INDIRECT F[1] CODE
	PUSH	SP,A1
	PUSH	SP,AX		;[173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,LRI
	POP	SP,AX		;[173] RESTORE SAVED AX
	PUSHJ	SP,FSVRC2
	POP	SP,A1
	POP	SP,A0
	POPJ	SP,0
; R -> I, BY NAME

FSVR10:	PUSHJ	SP,FSVR11
	PUSHJ	SP,FSVR12

FSVR11:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	FIXR	A0,A0
	POPJ	SP,0

FSVR12:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; INDIRECT F[1] CODE
	FLTR	A0,A0
	PUSHJ	SP,FSVRC1
	POP	SP,A0
	POPJ	SP,0

; R -> LR, BY NAME

FSVR13:	PUSHJ	SP,FSVR14
	PUSHJ	SP,FSVR15

FSVR14:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	MOVEI	A1,0
	POPJ	SP,0

FSVR15:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; INDIRECT F[1] CODE
	PUSH	SP,A1
	PUSH	SP,AX		; [173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,LRR
	POP	SP,AX		; [173] RESTORE SAVED AX
	PUSHJ	SP,FSVRC2
	POP	SP,A1
	POP	SP,A0
	POPJ	SP,0

; LR -> I, BY NAME

FSVR16:	PUSHJ	SP,FSVR17
	PUSHJ	SP,FSVR18

FSVR17:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	PUSH	SP,AX		;[173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,LRI
	POP	SP,AX		;[173] RESTORE SAVED AX
	POPJ	SP,0

FSVR18:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,A0		; INDIRECT F[1] CODE
	PUSH	SP,AX		;[173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,ILR
	POP	SP,AX		;[173] RESTORE SAVED AX
	PUSHJ	SP,FSVRC1
	POP	SP,A0
	POPJ	SP,0
; LR -> R, BY NAME

FSVR19:	PUSHJ	SP,FSVR20
	PUSHJ	SP,FSVR21

FSVR20:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,FSVRC0	; INDIRECT F[0] CODE
	PUSH	SP,AX		;[173] SAVE AX IN CASE OF RECURSIVE CALL
	JSP	AX,LRR
	POP	SP,AX		;[173] RESTORE SAVED AX
	POPJ	SP,0

FSVR21:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSH	SP,0		; INDIRECT F[1] CODE
	MOVEI	A1,0
	PUSHJ	SP,FSVRC1
	POP	SP,A0
	POPJ	SP,0
SUBTTL PARAM - STATIC EXPRESSION HANDLER

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

SEXPD:	XWD	SEXP21,SEXP1	; I -> I
	XWD	SEXP22,SEXP5	; I -> R
	XWD	SEXP23,SEXP6	; I -> LR
	XWD	SEXP24,SEXP13	; R -> I
	XWD	SEXP30,SEXP14	; R -> R
	XWD	SEXP25,SEXP15	; R -> LR
	XWD	SEXP26,SEXP16	; LR -> I
	XWD	SEXP27,SEXP17	; LR -> R
	XWD	SEXP29,SEXP18	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	SEXP21,SEXP1	; B -> B
	XWD	SEXP28,SEXP18	; S -> S
	XWD	0,0		; L -> L
	XWD	0,0		; N -> N

SEXP:	XWD	0,SEXP0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,PAR3		; PROCEDURE

SEXP0:	SKIPN	A6,SEXPD(A7)	; LOAD UP DISPATCH ENTRY
	JRST	PAR3		; ILLEGAL
	TLNE	A4,$VAL		; FORMAL BY VALUE?
	MOVS	A6,A6		; YES - SWAP HALVES
	TRNE	A5,<$REG>B41	; REGULAR?
	JRST	(A6)		; YES - DISPATCH TO REGULAR ADDRESS
	JRST	1(A6)		; NO - DISPATCH TO SIMPLE ADDRESS
; I -> I, B -> B, BY NAME

SEXP1:	SKIPA	A1,(A2)		; REGULAR
	HRRZI	A1,(A2)		; SIMPLE
	MOVE	A0,A1

SEXP2:	MOVEM	A0,2(A4)	; PLANT VALUE IN F[2]
	DMOVE	A5,SEXP3	; PLANT INDIRECT CODE IN F[0]
	DMOVEM	A5,(A4)		; PLANT DIRECT CODE IN F[1]
	AOJA	A3,PAR6

SEXP3:	PUSHJ	SP,SEXP4
	SYSER1	11,0

SEXP4:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVE	A0,-1(A2)
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	MOVEI	A2,@A0
	MOVE	A0,2(A2)	; VALUE
	POPJ	SP,0

; I -> R, BY NAME

SEXP5:	SKIPA	A1,(A2)		; REGULAR
	HRRZI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	FLTR	A0,A0
	JRST	SEXP2
; I -> LR, BY NAME

SEXP6:	JRST	SEXP10		; REGULAR
	HRRZI	A0,(A2)		; SIMPLE
	FSC	A0,233

SEXP7:	MOVEM	A0,2(A4)	; PLANT VALUE IN F[2]
	DMOVE	A5,SEXP8	; PLANT INDIRECT CODE IN F[0]
	DMOVEM	A5,(A4)		; PLANT DIRECT CODE IN F[1]
	AOJA	A3,PAR6

SEXP8:	PUSHJ	SP,SEXP9
	SYSER1	11,0

SEXP9:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVE	A0,-1(A2)
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	MOVEI	A2,@A0
	MOVE	A0,2(A2)	; VALUE
	MOVEI	A1,0
	POPJ	SP,0

SEXP10:	MOVE	A0,(A2)		; REGULAR CASE
	JSP	AX,ILR
	JUMPE	A1,SEXP7	; EASY CASE IF NO LOW WORD
	MOVEM	A2,2(A4)	; PLANT ADDRESS IN F[2]
	DMOVE	A5,SEXP11	; PLANT INDIRECT CODE IN F[0]
	DMOVEM	A5,(A4)		; PLANT DIRECT CODE IN F[1]

SEXP11:	PUSHJ	SP,SEXP12
	SYSER1	11,0

SEXP12:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVE	A0,-1(SP)
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	MOVEI	A2,@A0
	MOVE	A0,@2(A2)	; VALUE
	JSP	AX,ILR
	POPJ	SP,0
; R -> I, BY NAME

SEXP13:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	FIXR	A0,A0
	JRST	SEXP2

; R -> R, BY NAME

SEXP14:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	JRST	SEXP2

; R -> LR, BY NAME

SEXP15:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	JRST	SEXP7

; LR -> I, BY NAME

SEXP16:	DMOVE	A0,(A2)
	JSP	AX,LRI
	JRST	SEXP2

; LR -> R, BY NAME

SEXP17:	DMOVE	A0,(A2)
	JSP	AX,LRR
	JRST	SEXP2
; LR -> LR, S -> S, BY NAME

SEXP18:	MOVEM	A2,2(A4)	; PLANT ADDRESS IN F[2]
	DMOVE	A5,SEXP19	; PLANT INDIRECT CODE IN F[0]
	DMOVEM	A5,(A4)		; PLANT DIRECT CODE IN F[1]
	AOJA	A3,PAR6

SEXP19:	PUSHJ	SP,SEXP20
	SYSER1	11,0

SEXP20:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE
	MOVE	A0,-1(A2)
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	MOVEI	A2,@A0
	HRRZ	A2,2(A2)
	DMOVE	A0,(A2)		; VALUE
	POPJ	SP,0
; I -> I, B -> B, BY VALUE

SEXP21:	SKIPA	A1,(A2)		; REGULAR
	HRRZI	A1,(A2)		; SIMPLE
	MOVEM	A1,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; I -> R, BY VALUE

SEXP22:	SKIPA	A1,(A2)		; REGULAR
	HRRZI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	FLTR	A0,A0
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; I -> LR, BY VALUE

SEXP23:	SKIPA	A1,(A2)		; REGULAR
	HRRZI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	JSP	AX,ILR
	DMOVEM	A0,(A4)		; PLANT VALUE IN F[0],F[1]
	AOJA	A3,PAR6

; R -> I, BY VALUE

SEXP24:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVE	A0,A1
	FIXR	A0,A0
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; R -> R, BY VALUE

SEXP30:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVEM	A1,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6

; R -> LR, BY VALUE

SEXP25:	SKIPA	A1,(A2)		; REGULAR
	MOVSI	A1,(A2)		; SIMPLE
	MOVEM	A1,(A4)
	SETZM	1(A4)		; PLANT VALUE IN F[0],F[1]
	AOJA	A3,PAR6
SUBTTL PARAM - STATIC ARRAY HANDLER

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

SARRD:	XWD	SARR3,SARR2	; I -> I
	XWD	SARR3,0		; I -> R
	XWD	SARR3,0		; I -> LR
	XWD	SARR3,0		; R -> I
	XWD	SARR3,SARR2	; R -> R
	XWD	SARR3,0		; R -> LR
	XWD	SARR3,0		; LR -> I
	XWD	SARR3,0		; LR -> R
	XWD	SARR3,SARR2	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	SARR3,SARR2	; B -> B
EDIT(045); String arrays by value don't work, so don't let users try
	XWD	SARR4,SARR2	; S -> S
	XWD	0,0		; L -> L
	XWD	0,0		; N -> N

SARR:	XWD	0,PAR3		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,SARR0		; ARRAY
	XWD	0,PAR3		; PROCEDURE

SARR0:	CAIN	A5,<$OWN>B41	; FIXED VARIABLE?
	JRST	SARR1		; YES
	HLRZ	A6,@A3
	ANDI	A6,$P		; GET VARIABLE LEVEL (P ADDRESS)
	ADD	A6,CONDL(DL)	; ADDRESS OF DISPLAY ENTRY
	ADDI	A6,(DB)
	ADD	A2,(A6)		; ADD TO Q ADDRESS

SARR1:	HRRZ	A6,SARRD(A7)	; LOAD UP NAME DISPATCH ENTRY
	TLNE	A4,$VAL		; FORMAL BY VALUE
	HLRZ	A6,SARRD(A7)	; YES - LOAD UP VALUE DISPATCH ENTRY
	JUMPN	A6,(A6)		; DISPATCH UNLESS
	JRST	PAR3		; ILLEGAL
; ALL VALID COMBINATIONS, BY VALUE

EDIT(057); MAKE STRINGS BY VALUE AS WELL IN STRING ARRAYS
SARR3:	TDZA	AX,AX		; [E057] EVERYTHING EXCEPT STRING ARRAYS
SARR4:	MOVEI	AX,1		; [E057] STRING ARRAYS - MORE DIFFICULT
	MOVEI	A1,@A2
	PUSH	SP,A3
	PUSH	SP,A13
	PUSH	SP,AX		; [E057] SAVE ARRAY TYPE FLAG
	PUSH	SP,A2		; SAVE VALUABLE ACCS. AND HEADER ADDRESS
	MOVE	A1,1(A1)	; GET SECOND WORD OF HEADER

SARR5:	PUSH	SP,(A1)		; AND COPY DOPE VECTOR TO THE STACK
	PUSH	SP,1(A1)
	ADDI	A1,1
	AOBJN	A1,SARR5
	HLRZ	A1,A4		; GET FP TYPE
	ANDCMI	A1,$STAT	; AND CLEAR STATUS BITS TO FOOL
				; $OWN TEST IN ARRAY
	MOVNI	A3,1		; ONE ARRAY
	EXCH	A2,A4		; ADDRESS OF NEW HEADER
	MOVEI	A4,@A4
	HLRE	A4,1(A4)	; -NUMBER OF DIMENSIONS
	JSP	AX,ARRAY	; LAY OUT NEW ARRAY
	POP	SP,A1		; RESTORE ADDRESS OF OLD HEADER
	MOVEI	A1,@A1		; AND MAKE IT ABSOLUTE
	SUBI	A2,2		; RETARD NEW ARRAY WORD POINTER
	PUSH	SP,A2		; [E057] KEEP HEADER ADDRESS
	PUSHJ	SP,CPYARR	; AND COPY OLD TO NEW
	POP	SP,A2		; [E057] GET HEADER ADDRESS AGAIN
	POP	SP,AX		; [E057] POP OFF POINTER LEFT BY ARRAY
	EXCH	AX,(SP)		; [E057] SWAP WITH ARRAY TYPE FLAG
	JUMPE	AX,SARR7	; [E057] CARRY ON IF NOT STRING ARRAY
	HRRZ	A1,1(A2)	; [E057] GET ADDRESS OF DOPE VECTOR
	HRRZ	A2,-2(A1)	; [E057] GET SIZE OF ILIFFE VECTOR(S)
	ADD	A2,-1(A1)	; [E057] PICK UP POINTER OVER DATA
SARR6:	PUSH	SP,STR1(A2)	; [E057] PUSH STRING HEADER
	PUSH	SP,STR2(A2)	; [E057] ONTO THE STACK
	JSP	AX,STRAS0	; [E057] FORM A COPY OF IT
	DMOVEM	A0,(A2)		; [E057] AND WRITE NEW HEADER
	ADDI	A2,1		; [E057] STEP ON TO NEXT STRING
	AOBJN	A2,SARR6	; [E057] AND REPEAT FOR ENTIRE ARRAY
SARR7:	POP	SP,A1		; SAVE THE POINTER THAT ARRAY CREATED
	POP	SP,A13
	POP	SP,A3		; RESTORE VALUABLE ACCS.
	JSP	AX,ARR16A	; [E057] ADJUST BLKPTR PROPERLY
	AOJA	A3,PAR6
SUBTTL PARAM - STATIC PROCEDURE HANDLER

SPRO:	XWD	0,SPRO0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,SPRO0		; PROCEDURE

EDIT(053); MAKE FORMAL SWITCHES WORK PROPERLY
SPRO0:	CAIN	A7,17		; [E053] IS THIS A SWITCH ?
	JRST	SLAB0		; [E053] YES - HANDLE IT
	CAIE	A5,<$FON>B41	; IS THE ACTUAL A FORMAL?
	JRST	SPRO1		; NO
	HLRZ	A6,@A3
	ANDI	A6,$P		; GET PROCEDURE LEVEL (P ADDRESS)
	HRRZ	A5,CONDL(DL)	; GET TRUE CONTEXT DL
	ADDI	A6,(A5)		; ADDRESS OF DISPLAY ENTRY
	ADDI	A6,(DB)
	ADD	A2,(A6)		; YES - ADD DISPLAY ELEMENT TO Q ADDRESS
	HRLI	A2,<XCT	(DB)>B53
				; AND PREPARE OPERATIONAL ORDER
	JRST	SPRO2

SPRO1:	HRLI	A2,<PUSHJ	SP,0>B53
				; IF NOT FORMAL, THIS IS THE ORDER

SPRO2:	JUMPE	A11,SPRO6	; FORMAL PARAMETER A VARIABLE?
	MOVEM	A2,1(A4)	; NO - PLANT OPERATION IN F[1]
	MOVE	A5,%PROF0
	MOVEM	A5,(A4)		; PLANT ENTRY IN F[0]
	MOVE	A5,CONDL(DL)
	MOVEM	A5,2(A4)	; AND CONDL IN F[2]
	AOJA	A3,PAR6
%PROF0::PUSHJ	SP,SPRO3		; Defined internal for ALGDDT
					; for breakpoint logic

SPRO3:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A1,(SP)		; F[0] CODE: GET LINK
	MOVEI	A2,@-1(A1)	; GET ADDRESS OF F[0]
%SPRO3::HRL	DL,2(A2)	; GET ENVIRONMENT DL
				; THE CONTENTS OF F[1] WILL BE
				; EITHER "PUSHJ SP,ROUTINE"
				; OR "XCT n(DB)", WHICH WILL
				; BE ANOTHER CALL TO SPRO3
	MOVEI	A2,@1(A2)	; GET EFFECTIVE ADDRESS
	MOVE	A3,(A2)		; GET ADDRESSED INSTRUCTION
	CAMN	A3,%PROF0	; ANOTHER CALL TO SPRO3 ?
	JRST	%SPRO3		; YES - TRY AGAIN
	JRST	(A2)		; NO  - GO TO ROUTINE
; CASE OF A PARAMETERLESS PROCEDURE ASSIGNED TO A VARIABLE

SPRO6:	TLNE	A4,$VAL		; FORMAL BY VALUE?
	JRST	SPRO9		; YES
	MOVEM	A2,1(A4)	; PLANT OPERATIONAL ORDER IN F[1]
	HLLZ	A6,A4
	TLZ	A6,$KIND!$STAT
	TLO	A6,$PRO!$SIM	; CONSTRUCT MATCHED TYPE DESCRIPTOR
	HRR	A6,CONDL(DL)	; AND CONDL
	MOVEM	A6,2(A4)	; PLANT IN F[2]
	MOVE	A5,[
	PUSHJ	SP,SPRO7]
	MOVEM	A5,(A4)		; PLANT ENTRY IN F[0]
	AOJA	A3,PAR6

SPRO7:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)		; F[0] CODE: GET LINK
	MOVE	A0,-1(A2)	; GET CALLING ORDER
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	CAILE	A2,(DB)
	CAILE	A2,(SP)		; IF THE LINK IS ABSOLUTE
	JRST	SPRO14		; THEN LEAVE IT ALONE
	SUBI	A2,(DB)		; OTHERWISE DELOCATE IT
	HRLI	A2,DB		; AND PUT THE DB BITS IN THE LH
	MOVEM	A2,(SP)

SPRO14:	MOVEI	A2,@A0		; GET ADDRESS OF F[0]
	MOVE	A3,DL
	DPUSH	A3		; SAVE CURRENT DL
	PUSH	SP,1(A2)	; STACK OPERATIONAL ORDER
	MOVE	A0,2(A2)	; GET F[2]
	HRL	DL,A0		; SET UP CORRECT DL
	HRRI	A0,1		; SET UP FOR NO ACTUALS
	PUSH	SP,A0		; AND STACK TYPE DESCRIPTOR
	PUSH	SP,[
	JRST	SPRO8]		; STACK RETURN JUMP
	JRST	-2(SP)		; AND ENTER CALL SEQUENCE INTERLUDE

SPRO8:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	SUB	SP,[3,,3]	; [303] GET RID OF UNWANTED STACK
	RPOP	DL		; RESTORE CURRENT DL
	POP	SP,AX
	JRST	@AX		; AND EXIT
SPRO9:	PUSH	SP,A3
	DPUSH	A4
	PUSH	SP,A13		; SAVE VALUABLE ACCUMULATORS
	MOVE	A0,DL
	DPUSH	A0		; SAVE CURRENT DL
	HRRZ	DL,CONDL(DL)
	ADDI	DL,(DB)		; AND ASSUME THAT OF CONTEXT
	PUSH	SP,A2		; STACK OPERATIONAL ORDER
	TLZ	A4,$KIND!$STAT
	TLO	A4,$PRO!$SIM
	HRRI	A4,1		; MAKE TYPE DESCRIPTOR
	PUSH	SP,A4		; FROM FORMAL - AND STACK IT
	PUSH	SP,[
	JRST	SPRO10]		; STACK RETURN JUMP
	JRST	-2(SP)		; AND ENTER CALL SEQUENCE INTERLUDE

SPRO10:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	SUB	SP,[3,,3]	; [303] GET RID OF UNWANTED STACK
	RPOP	DL		; RESTORE CURRENT DL
	POP	SP,A13
	RPOP	A4
	POP	SP,A3		; RESTORE VALUABLE ACCUMULATORS
	;
	Edit(151);  Don't assume result of formal procedure to be double length.
	;
	TLNN	A4,$VAR2	; [E151] Is the result double length ?
	MOVEM	A1,1(A4)	; [E151] Yes - plant the high order word
	MOVEM	A0,0(A4)	; [E151] Plant result in formal.
	AOJA	A3,PAR6
; CASE OF A SWITCH (LABEL PROCEDURE)

SLAB0:	JUMPE	A11,PAR3	; [E053] CAN'T ASSIGN SWITCH TO LABEL
	CAIE	A5,<$FON>B41	; [E053] IS THE ACTUAL A FORMAL ?
	JRST	SLAB1		; [E053] NO  - A2 CONTAINS ADDRESS OF CODE
	HLRZ	A1,@A3		; [E053] YES - GET L.H. OF LEXEME
	ANDI	A1,$P		; [E053] MASK TO P ADDRESS
	ADD	A1,CONDL(DL)	; [E053] GET ADRESS OF DISPLAY
	ADDI	A1,(DB)		; [E053] ENTRY FOR CONTEXT
	ADD	A2,(A1)		; [E053] GET Q ADDRESS
	SKIPA	A5,FLAB01	; [E053] LOAD A5 WITH "PUSHJ SP,FLABF0"
SLAB1:	MOVE	A5,[
	PUSHJ	SP,SWITCH]	; [E053] NON-FORMAL SWITCH - GET F[0] CODE
	MOVEM	A5,(A4)		; [E053] STORE INSTRUCTION IN F[0]
	HRL	A2,CONDL(DL)	; [E053] SET CONTEXT DL IN L.H. OF ADDRESS
	MOVEM	A2,2(A4)	; [E053] AND STORE IT INTO F[2]
	AOJA	A3,PAR6		; [E053] GO DEAL WITH NEXT PARAMETER

;	L -> L, SW -> SW WHEN ACTUALS ARE FORMALS

FLABL%:	; ENTRY POINT DEFINED FOR ALGDDT
FLAB01:	PUSHJ	SP,FLABF0	; [E053] F[0] CODE
	SYSER1	11,0		; [E053] F[1] CODE

FLABF0:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVE	A1,0(SP)	; [E053] DIRECT ENTRY ON F[0]
	SKIPA	A1,-1(A1)	; [E053] GET XCT ORDER
	MOVE	A1,@A1		; [E053] FOLLOW XCT CHAIN
	HLRZ	A0,@A1		; [E053] GET TARGET INSTRUCTION
	ANDI	A0,777000	; [E053] MASK TO OPCODE ONLY
	CAIN	A0,(XCT 0,0)	; [E053] IS THIS ANOTHER XCT ?
	JRST	.-4		; [E053] YES - REPEAT THIS STEP
	MOVEI	AX,@A1		; [E053] NO  - GET FORMAL ADDRESS
	MOVE	AX,2(AX)	; [E053] GET CONTEXT DL AND ADDRESS
	DPUSH	DL		; [E053] SAVE CURRENT DL
	HLRZ	DL,AX		; [E053] AND ASSUME FORMAL'S DL
	ADDI	DL,(DB)		; [E053] RELOCATE DL
	ADDI	AX,(DB)		; [E053] AND FORMAL ADDRESS
	XCT	(AX)		; [E053] GET VALUE OF FORMAL
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; [E053] RESTORE CURRENT DL
	POPJ	SP,0		; [E053] AND RETURN

;	ROUTINE TO EVALUATE A SWITCH PASSED AS A PARAMETER

SWITCH:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVE	A1,0(SP)	; [E053] DIRECT ENTRY ON F[0]
	MOVE	A1,-1(A1)	; [E053] GET XCT INSTRUCTION
	MOVEI	AX,@A1		; [E053] GET ADDRESS OF FORMAL
	MOVE	A1,AX		; [E053] AND SAVE THE ADDRESS
	DPUSH	A1		; [E053] TO SET UP F[1]
	DPUSH	DL		; [E053] SAVE CURRENT DL
	MOVE	AX,2(AX)	; [E053] GET CONTENTS OF F[2]
	HLRZ	DL,AX		; [E053] GET CONTEXT DL
	ADDI	DL,(DB)		; [E053] RELOCATE IT
	PUSHJ	SP,(AX)		; [E053] EVALUATE THE SWITCH
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; [E053] RESTORE CURRENT DL
	RPOP	AX		; [E053] AND ADDRESS OF FORMAL
	MOVEM	A2,1(AX)	; [E053] STORE VALUE IN F[1]
	TRNE	A2,-1		; [E053] IF OUT OF RANGE
	TLNE	A2,-1		; [E053] OR ALREADY A FORMAL
	POPJ	SP,		; [E053] JUST RETURN
	SUBI	AX,(DB)		; [E053] OTHERWISE GET F[0] ADDRESS
	HRLZI	A2,(AX)		; [E053] IN LEFT HALF OF A2
	HRRI	A2,FORLAB	; [E053] AND FORLAB IN RIGHT HALF
	POPJ	SP,		; [E053] AND RETURN
SUBTTL PARAM - DYNAMIC VARIABLE HANDLER

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

DVARD:	XWD	DVAR25,DVAR1	; I -> I
	XWD	DVAR26,DVAR3	; I -> R
	XWD	DVAR27,DVAR6	; I -> LR
	XWD	DVAR29,DVAR9	; R -> I
	XWD	DVAR25,DVAR1	; R -> R
	XWD	DVAR30,DVAR12	; R -> LR
	XWD	DVAR31,DVAR15	; LR -> I
	XWD	DVAR32,DVAR18	; LR -> R
	XWD	DVAR28,DVAR21	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	DVAR25,DVAR1	; B -> B
	XWD	SVAR40,DVAR44	; S -> S
	XWD	0,0		; L -> L
	XWD	0,0		; N -> N

DVAR:	XWD	0,DVAR0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,PAR3		; PROCEDURE

DVAR0:	SKIPN	A6,DVARD(A7)	; LOAD UP DISPATCH ENTRY
	JRST	PAR3		; ILLEGAL

DVAR33:	TLNE	A4,$VAL		; FORMAL BY VALUE?
	JRST	DVAR24		; YES
	HRL	A2,CONDL(DL)	; ADD CONTEXT DL TO THUNK ADDRESS
	JRST	FSVR22
; ROUTINE FOR EVALUATING DYNAMIC VARIABLE THUNKS

DVARC:	MOVE	A1,-1(SP)
	PUSH	SP,-1(A1)	; SAVE XCT(A) ORDER
	MOVEI	A1,@(SP)
	MOVE	A1,2(A1)	; GET THUNK'S DL AND ADDRESS
	DPUSH	DL		; SAVE CURRENT DL
	HLRZ	DL,A1		; AND ASSUME THUNK'S
	ADDI	DL,(DB)
	PUSHJ	SP,(A1)		; EVALUATE THUNK
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE CURRENT DL
	POP	SP,A1		; RESTORE XCT(A) ORDER
	TLNE	A1,$A		; XCTA?
	POP	SP,A1		; YES - LOSE F[0]'S LINK
	POPJ	SP,0
; I -> I, R -> R, B-> B, BY NAME

DVAR1:	PUSHJ	SP,DVAR2
	MOVEM	A0,(A2)		; DIRECT F[1] CODE

DVAR2:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; INDIRECT F[0] CODE
	MOVE	A0,(A2)
	POPJ	SP,0

; I -> R, BY NAME

DVAR3:	PUSHJ	SP,DVAR4
	PUSHJ	SP,DVAR5

DVAR4:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	MOVE	A0,(A2)
	FLTR	A0,A0
	POPJ	SP,0

; I -> LR, BY NAME

DVAR6:	PUSHJ	SP,DVAR7
	PUSHJ	SP,DVAR8

DVAR7:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	MOVE	A0,(A2)
	JSP	AX,ILR
	POPJ	SP,0

; R -> I, BY NAME

DVAR9:	PUSHJ	SP,DVAR10
	PUSHJ	SP,DVAR11

DVAR10:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	MOVE	A0,(A2)
	FIXR	A0,A0
	POPJ	SP,0

; R -> LR, BY NAME

DVAR12:	PUSHJ	SP,DVAR13
	PUSHJ	SP,DVAR14

DVAR13:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	MOVE	A0,(A2)
	MOVEI	A1,0
	POPJ	SP,0

; LR -> I, BY NAME

DVAR15:	PUSHJ	SP,DVAR16
	PUSHJ	SP,DVAR17

DVAR16:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	DMOVE	A0,(A2)
	JSP	AX,LRI
	POPJ	SP,0

; LR -> R, BY NAME

DVAR18:	PUSHJ	SP,DVAR19
	PUSHJ	SP,DVAR20

DVAR19:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	DMOVE	A0,(A2)
	JSP	AX,LRR
	POPJ	SP,0

; LR -> LR, BY NAME

DVAR21:	PUSHJ	SP,DVAR22
	PUSHJ	SP,DVAR23

DVAR22:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	DMOVE	A0,@A2
	POPJ	SP,0

; S-> S, BY NAME

DVAR44:	PUSHJ	SP,DVAR22
	PUSHJ	SP,SVAR44
; FORMAL BY VALUE

DVAR24:	HLRZ	A6,A6		; TAKE LEFT HALF DISPATCH ENTRY
	PUSH	SP,A6		; AND SAVE IT
	PUSH	SP,A3
	DPUSH	A4
	PUSH	SP,A13		; SAVE VALUABLE ACCUMULATORS
	MOVE	A5,DL
	DPUSH	A5		; SAVE CONTEXT DL
	HRRZ	DL,CONDL(DL)
	ADDI	DL,(DB)		; AND USE CONTEXT DL
	PUSHJ	SP,(A2)		; EVALUATE THUNK
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE DL
	POP	SP,A13
	RPOP	A4
	POP	SP,A3		; RESTORE VALUABLE ACCUMULATORS
	POP	SP,A6		; AND DISPATCH ADDRESS
	CAIGE	A6,BVAR10	; BUT IT MIGHT BE A BYTE POINTER
	TLZ	A2,-1		; CLEAR LEFT HALF OF POINTER.
	JRST	(A6)		; DISPATCH

; LR -> R, BY VALUE

DVAR32:	DMOVE	A0,(A2)

DEXP24:	JSP	AX,LRR
	MOVEM	A0,(A4)		; PLANT VALUE IN F[0]
	AOJA	A3,PAR6
SUBTTL PARAM - DYNAMIC EXPRESSION HANDLER

; LH ENTRY: BY VALUE
; RH ENTRY: BY NAME

DEXPD:	XWD	DEXP18,DEXP1	; I -> I
	XWD	DEXP19,DEXP2	; I -> R
	XWD	DEXP20,DEXP4	; I -> LR
	XWD	DEXP21,DEXP6	; R -> I
	XWD	DEXP18,DEXP1	; R -> R
	XWD	DEXP22,DEXP8	; R -> LR
	XWD	DEXP23,DEXP10	; LR -> I
	XWD	DEXP24,DEXP12	; LR -> R
	XWD	DEXP25,DEXP1	; LR -> LR
	XWD	0,0		; C -> C
	XWD	0,0		; C -> LC
	XWD	0,0		; LC -> C
	XWD	0,0		; LC -> LC
	XWD	DEXP18,DEXP1	; B -> B
	XWD	DEXP26,DEXP27	; S -> S
	XWD	DEXP17,DEXP15	; L -> L
	XWD	0,0		; N -> N

DEXP:	XWD	0,DEXP0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,PAR3		; PROCEDURE

DEXP0:	SKIPN	A6,DEXPD(A7)	; LOAD UP DISPATCH ENTRY
	JRST	PAR3		; ILLEGAL
	TLNE	A4,$VAL		; FORMAL BY VALUE?
	JRST	DEXP14		; YES
	HRL	A2,CONDL(DL)	; ADD CONTEXT DL TO THUNK ADDRESS
	MOVEM	A2,2(A4)	; AND PLANT IN F[2]
	MOVE	A5,[
	SYSER1	11,0]
	MOVEM	A5,1(A4)	; PLANT F[1] CODE
	MOVE	A5,(A6)
	MOVEM	A5,(A4)		; PLANT F[0] CODE
	AOJA	A3,PAR6
; ROUTINE FOR EVALUATING DYNAMIC EXPRESSION THUNKS

DEXPDR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	SKIPA	A2,(SP)		; DIRECT ENTRY
DEXPC:	MOVE	A2,-1(SP)	; INDIRECT ENTRY
	MOVE	A0,-1(A2)	; GET XCT ORDER
	TLNE	A0,$A		; ADDRESS REQUIRED?
	SYSER1	11,0		; YES - YOU LOSE
	MOVEI	A2,@A0
	MOVE	A2,2(A2)	; GET CONTEXT DL AND THUNK ADDRESS
	DPUSH	DL		; SAVE CURRENT DL
	HLRZ	DL,A2		; AND ASSUME THUNK'S DL
	ADDI	DL,(DB)
	PUSHJ	SP,(A2)		; EVALUATE THUNK
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE CURRENT DL
	POPJ	SP,0
; I -> I, R -> R, B -> B, LR -> LR, BY NAME

DEXP1:	PUSHJ	SP,DEXPDR	; DIRECT F[0] CODE

; I -> R, BY NAME

DEXP2:	PUSHJ	SP,DEXP3

DEXP3:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	FLTR	A0,A0
	POPJ	SP,0

; I -> LR, BY NAME

DEXP4:	PUSHJ	SP,DEXP5

DEXP5:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	JSP	AX,ILR
	POPJ	SP,0

; R -> I, BY NAME

DEXP6:	PUSHJ	SP,DEXP7

DEXP7:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	FIXR	A0,A0
	POPJ	SP,0

; R -> LR, BY NAME

DEXP8:	PUSHJ	SP,DEXP9

DEXP9:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	MOVEI	A1,0
	POPJ	SP,0

; LR -> I, BY NAME

DEXP10:	PUSHJ	SP,DEXP11

DEXP11:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	JSP	AX,LRI
	POPJ	SP,0
; LR -> R, BY NAME

DEXP12:	PUSHJ	SP,DEXP13

DEXP13:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	JSP	AX,LRR
	POPJ	SP,0

; S -> S, BY NAME

DEXP27:	PUSHJ	SP,DEXP28

DEXP28:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DEXPC	; F[0] CODE
	MOVEI	A2,0
	POPJ	SP,0

; L -> L, BY NAME

DEXP15:	PUSHJ	SP,DEXP16

DEXP16:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HRRZ	A2,(SP)
	MOVEI	AX,@-1(A2)	; GET ADDRESS OF FORMAL
EDIT(053); SAVE ADDRESS OF F[0] IN CASE IT WAS 'XCT'-ED  BY AN "XCT (AX)"
	MOVEI	A2,(AX)		; [E053] GET PHYSICAL ADDRESS
	DPUSH	A2		; [E053] AND SAVE IT (DELOCATED)
	MOVE	AX,2(AX)	; GET THUNK'S DL AND ADDRESS
	DPUSH	DL		; SAVE CURRENT DL
	HLRZ	DL,AX		; ASSSUME DL FOR LABEL
	ADDI	DL,(DB)
	PUSHJ	SP,(AX)		; EXECUTE THUNK
	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	RPOP	DL		; RESTORE DL
	RPOP	AX		; [E053] RESTORE ADDRESS OF FORMAL
	MOVEM	A2,1(AX)	; AND STORE LABEL ADDRESS IN F[1]
	TRNE	A2,-1		; SWITCH OUT OF RANGE?
	TLNE	A2,-1		; NO - FORMAL?
	POPJ	SP,0		; NO
	SUBI	AX,(DB)
	HRLZI	A2,(AX)		; YES - GET ADDRESS OF F[0]
	HRRI	A2,FORLAB	; AND LET FORLAB DO THE WORK
	POPJ	SP,0		; IF REQUIRED
; BYTE VARIABLE (DYNAMIC SIMPLE VARIABLE STRING)

BVARD:	XWD	BVAR10,BVAR1	; BYTE -> I
	XWD	BVAR11,BVAR4	; BYTE -> R
	XWD	BVAR12,BVAR7	; BYTE -> LR

BVAR:	XWD	0,BVAR0		; VARIABLE
	XWD	0,PAR3		; EXPRESSION
	XWD	0,PAR3		; ARRAY
	XWD	0,PAR3		; PROCEDURE

BVAR0:	MOVE	A6,BVARD(A7)	; LOAD UP DISPATCH ENTRY
	JRST	DVAR33

; BYTE -> I, BY NAME

BVAR1:	PUSHJ	SP,BVAR2
	PUSHJ	SP,BVAR3

BVAR2:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	LDB	A0,A2
	POPJ	SP,0

BVAR3:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	DPB	A0,A2		; F[1] CODE
	POPJ	SP,0
; BYTE -> R, BY NAME

BVAR4:	PUSHJ	SP,BVAR5
	PUSHJ	SP,BVAR6

BVAR5:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	LDB	A0,A2
	FLTR	A0,A0
	POPJ	SP,0

BVAR6:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	FIXR	A3,A0		; F[1] CODE
	DPB	A3,A2
	POPJ	SP,0

; BYTE -> LR, BY NAME

BVAR7:	PUSHJ	SP,BVAR8
	PUSHJ	SP,BVAR9

BVAR8:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	PUSHJ	SP,DVARC	; F[0] CODE
	LDB	A0,A2
	JSP	AX,ILR
	POPJ	SP,0

BVAR9:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	AX,SLRI		; F[1] CODE
	DPB	A3,A2
	POPJ	SP,0

; BYTE -> I, BY VALUE

BVAR10:	LDB	A0,A2
	JRST	DEXP18

; BYTE -> R, BY VALUE

BVAR11:	LDB	A0,A2
	JRST	DEXP19

; BYTE -> LR, BY VALUE

BVAR12:	LDB	A0,A2
	JRST	DEXP20
; EXIT DESTINATION TABLE

EDIT(047); Do type conversion on procedure exit correctly
PAR8:	JSP	AX,FII		; [E047] I  <- I
	JSP	AX,FRI		; [E047] I  <- R
	JSP	AX,FLRI		; [E047] I  <- LR
	JSP	AX,FIR		; [E047] R  <- I
	JSP	AX,FRR		; [E047] R  <- R
	JSP	AX,FLRR		; [E047] R  <- LR
	JSP	AX,FILR		; [E047] LR <- I
	JSP	AX,FRLR		; [E047] LR <- R
	JSP	AX,FLRLR	; [E047] LR <- LR
	0			; [E047] C  <- C
	0			; [E047] C  <- LC
	0			; [E047] LC <- C
	0			; [E047] LC <- LC
	JSP	AX,FBB		; [E047] B  <- B
	JSP	AX,FSS		; [E047] S  <- S
	0			; [E047] L  <- L
	JSP	AX,FNN		; [E047] N  <- N

PAR9:	PUSHJ	SP,TRLMAN	; MAKE TRACE ENTRY
	MOVE	AX,LINKPC(DL)	; [E127] GET LINK PC
	MOVEI	DL,(DL)		; CLEAR LH OF DL
	JRST	CNC.AX
; EXIT SEQUENCES

FIR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,IR
	JRST	FNN0

FILR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,ILR
	JRST	FNN0

FRI:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,RI
	JRST	FNN0

FRLR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	A13,FNN0
	MOVEI	A1,0
	JRST	CNC.AX

FLRI:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,LRI
	JRST	FNN0

FLRR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,LRR
	JRST	FNN0

EDIT(054); RETURN VALUE CORRECTLY FROM STRING PROCEDURES
EDIT(224); CORRECT EDIT 054 [JBS 4/1/80]
FSS:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	JSP	A13,FNN0	; [E054] TIDY UP THE STACK
	TLO	A1,STRPRC	; [E054] MARK AS PROCEDURE RESULT
	SETZ	A2,		; [307] [E054] [224] POINT A2 TO HEADER IN A0
	JRST	CNC.AX		; [E054] AND EXIT

FNN:	FII:	FRR:	FBB:
FLRLR:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	MOVEI	A13,FX3
	;
	Edit(152);  Save AX over possible stack shifts.
	;
FNN0:	SUBI	AX,(DB)		; [E152] Delocate AX over GETOWN
	TLO	AX,DB		; [E152]	"
	MOVEI	A0,0		; SET UP FOR GETOWN TO DELETE
	POP	SP,A1		; LOSE BLOCK POINTER
	SOS	%TRLV(DB)	; UPDATE TRACE DYNAMIC BLOCK-LEVEL
	SOS	%DDTPL(DB)	; AND PROCEDURE LEVEL

FX1:	POP	SP,A1		; UNSTACK
	JUMPL	A1,FX2		; BOTTOM BLOCK POINTER?
	TLZE	A1,(<Z 17,0>)	; [E057] IS THIS A STRING ARRAY ?
	PUSHJ	SP,DELSCN	; [E057] YES - DELETE SUB-STRINGS
	MOVEI	A1,@A1		; [E045] GET REAL ADDRESS, IF STRING
	JUMPE	A1,FX1		; [E045] DON'T DELETE NULL STRING
	PUSHJ	SP,GETOWN	; NO - DELETE ITEM
	JRST	FX1
FX2:	MOVEI	SP,PRGLNK(DL)	; RESET STACK POINTER
	HRRZ	DL,CONDL(DL)	; GET CONTEXT DL
	ADDI	DL,(DB)		; AND RELOCATE IT
	MOVEI	A1,(SP)
	SUB	A1,.JBREL
	HRLI	SP,(A1)		; SET UP LH OF STACK POINTER
	MOVEI	AX,@AX		; [E152] Relocate AX.
	DMOVE	A0,(AX)		; GET RESULT
	POP	SP,AX		; GET LINK
	SUB	SP,[1,,1]	; [E127] STEP OVER LINKPC
	POP	SP,%DDTDL(DB)	; [E100] RESET DL CHAIN
	MOVEI	AX,@AX		; STATICISE AX
	JRST	(A13)		; AND EXIT AS REQUIRED

FX3:	JRST	CNC.AX			; [E127]
SUBTTL GOLAB - GENERAL GOTO LABEL ROUTINE

; CALLED FROM LABEL WITH LINK IN AX
; WORD FOLLOWING CALL IS FORMATTED AS FOLLOWS:

;	BITS 0 - 12:	LEVEL OF BLOCK CONTAINING LABEL
;			RELATIVE TO ENCLOSING PROCEDURE

;	BITS 13 - 17:	BITS FOR MODIFYING ADDRESS BY DL

;	BITS 18 - 35:	STATIC PROCEDURE LEVEL OF PROCEDURE
;			ENCLOSING LABEL

GOLAB:	HRRZ	A13,@(AX)	; GET DESTINATION DL
	ADDI	A13,(DB)	; AND RELOCATE IT

EDIT(107); Make sure all local arrays, Etc. get deleted
GOLAB0:	MOVEI	DL,@%DDTDL(DB)	; [E107] SET DL TO TOP LEVEL
	MOVEI	A0,0		; SET A0 FOR GETOWN TO DELETE

GOLAB1:	CAIN	A13,(DL)	; ARRIVED AT THE PROCEDURE LEVEL?
	JRST	GOLAB5		; YES
	HRRZ	A12,PLBLKL(DL)	; GET BLOCK LEVEL
	POP	SP,A1		; LOSE BLOCK POINTER

GOLAB2:	SOS	%TRLV(DB)	; ADJUST DYNAMIC BLOCK POINTER
	SOJL	A12,GOLAB4(A12)	; ANY MORE BLOCKS?

GOLAB3:	POP	SP,A1		; UNSTACK
	JUMPL	A1,GOLAB2	; BLOCK POINTER?
	TLZE	A1,(<Z 17,0>)	; [E057] IS THIS A STRING ARRAY ?
	PUSHJ	SP,DELSCN	; [E057] YES - DELETE SUB-STRINGS
	MOVEI	A1,@A1		; [E045] GET REAL ADDRESS, IF A STRING
	JUMPE	A1,GOLAB3	; [E045] DON'T DELETE IF NULL
	SUBI	A13,(DB)	; [304] DELOCATE TARGET BEFORE GETOWN
	PUSHJ	SP,GETOWN	; NO - DELETE ITEM
	ADDI	A13,(DB)	; [304] RELOCATE AFTER POSSIBLE STACK SHIFT
	JRST	GOLAB3

	SKIPA	DL,LINKDL(DL)	; 2ND TIME: GET PREVIOUS DL [E107]
GOLAB4:	JRST	GOLAB3		; 1ST TIME: FUDGE FOR VALUE ARRAYS
	SOS	%DDTPL(DB)	; ADJUST PROCEDURE LEVEL
	HRRM	DL,%DDTDL(DB)	; [E100] RESET DL CHAIN
	AOS	%TRLV(DB)	; AND FUDGE 'COS 1 TOO MANY SOS'S
	MOVEI	DL,@DL		; RELOCATE DL
	MOVE	SP,BLKPTR(DL)
	ADDI	SP,(DB)		; GET BLOCK POINTER
	JRST	GOLAB1

GOLAB5:	HRRZM	AX,LINKPC(DL)	; [E127] STORE CONTEXT PC
	AOS	LINKPC(DL)	; [E127] POINT TO CORRECT PLACE
	HLRZ	A13,(AX)
	LSH	A13,-5		; DESTINATION BLOCK LEVEL
	HRRZ	A12,PLBLKL(DL)	; CURRENT BLOCK LEVEL
	HRRM	A13,PLBLKL(DL)	; REPLACE BY LABEL BLOCK LEVEL
	SUBI	A12,(A13)	; FORM DIFFERENCE
	JUMPE	A12,GO.NXT##	; EXIT IF THERE
	POP	SP,A1		; LOSE BLOCK POINTER
GOLAB8:	SOS	%TRLV(DB)	; DECREMENT FOR EACH BLOCK

GOLAB6:	POP	SP,A1		; UNSTACK
	JUMPL	A1,GOLAB7	; BLOCK POINTER?
	TLZE	A1,(<Z 17,0>)	; [E057] IS THIS A STRING ARRAY ?
	PUSHJ	SP,DELSCN	; [E057] YES - DELETE SUB-STRINGS
	MOVEI	A1,@A1		; [E045] GET REAL ADDRESS, IF A STRING
	JUMPE	A1,GOLAB6	; [E045] DON'T DELETE IF NULL
	PUSHJ	SP,GETOWN	; NO - DELETE ITEM
	JRST	GOLAB6

GOLAB7:	SOJG	A12,GOLAB8	; ANY MORE BLOCKS?
	PUSH	SP,A1		; AND ENTRY
	MOVE	A1,SP
	SUBI	A1,(DB)
	MOVEM	A1,BLKPTR(DL)	; RESET BLOCK POINTER
	JRST	GO.NXT##	; EXIT

; PRELUDE FOR GOING TO A FORMAL LABEL

%FRLAB::; Label for ALGDDT

FORLAB:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	HLRZ	A2,A2		; GET ADDRESS OF FORMAL LABEL
	ADDI	A2,(DB)
	MOVE	A0,DL		; SAVE CURRENT DL
	HLRZ	DL,2(A2)	; GET LABEL'S DL
	ADDI	DL,(DB)		; AND RELOCATE IT
	MOVE	AX,1(A2)	; GET ADDRESS OF LABEL
	HRRZ	A13,@1(AX)	; GET DL OF DESTINATION
	ADDI	A13,(DB)	; AND RELOCATE IT
	MOVE	DL,A0		; RESTORE CURRENT DL
	AOJA	AX,GOLAB0	; AND SIMULATE JSP

EDIT(057); RETURN INDIVIDUAL STRING SPACE FOR STRING ARRAYS

DELSCN:	PUSH	SP,A1		; [E057] SAVE TOTAL HEAP SPACE ADDRESS
	MOVE	A3,(A1)		; [E057] GET -# OF ARRAYS,,ILIFFE VECTOR SIZE
	MOVE	A2,1(A1)	; [E057] AND -DATA AREA SIZE,,FIRST ADDRESS
	PUSH	SP,A2		; [E057] SAVE THESE ON THE STACK
DELSC1:	PUSH	SP,A3		; [E057] FOR LOOP CONTROL
	ADDI	A2,(A3)		; [E057] STEP OVER ILIFFE VECTOR(S), IF ANY
DELSC2:	MOVE	A1,STR2(A2)	; [E057] GET NUMBER OF BYTES IN THE STRING
	TDNE	A1,[77,,777777]	; [E057] IF BYTE COUNT IS ZERO
	SKIPN	A1,STR1(A2)	; [E057] OR THIS IS A REAL NULL STRING
	JRST	DELSC3		; [E057] THEN TRY THE NEXT ONE
	MOVEI	A1,(A1)		; [E057] OTHERWISE JUST GET ADDRESS
	PUSH	SP,A2		; [E057] SAVE HEADER ADDRESS
	SUBI	A13,(DB)	; [304] DELOCATE TARGET BEFORE GETOWN
	PUSHJ	SP,GETOWN	; [E057] AND RETURN THE SPACE USED
	ADDI	A13,(DB)	; [304] RELOCATE AFTER POSSIBLE STACK SHIFT
	POP	SP,A2		; [E057] RESTORE HEADER ADDRESS
DELSC3:	ADDI	A2,1		; [E057] STEP TO NEXT HEADER, AND REPEAT
	AOBJN	A2,DELSC2	; [E057] FOR EACH STRING IN THE ARRAY
	POP	SP,A3		; [E057] THEN RESTORE COUNT OF ARRAYS
	AOBJP	A3,DELSC4	; [E057] WAS THAT THE LAST ARRAY ?
	HLL	A2,(SP)		; [E057] NO  - RESTORE COUNT OF STRINGS
	SOJA	A3,DELSC1	; [E057] AND REPEAT FOR THE NEXT ARRAY
DELSC4:	POP	SP,A2		; [E057] YES - LOSE SAVED POINTER
	POP	SP,A1		; [E057] RESTORE ADDRESS OF ARRAY SPACE
	POPJ	SP,		; [E057] AND RETURN TO DELETE THE ARRAY
SUBTTL BLKBEG/BLKEND - BLOCK ENTRY/EXIT

BLKBEG:	AOS	PLBLKL(DL)	; INCREMENT BLOCK LEVEL
	AOS	%TRLV(DB)	; AND DYNAMIC BLOCK POINTER
	PUSH	SP,BLKPTR(DL)	; MAKE NEW BLOCK POINTER
	MOVE	A0,SP
	SUBI	A0,(DB)
	MOVEM	A0,BLKPTR(DL)	; AND RESET BLOCK POINTER
	HRRZM	AX,LINKPC(DL)	; [E127] STORE UPDATED PC
	JRST	CNC.AX

BLKEND:	SOS	PLBLKL(DL)	; DECREMENT BLOCK LEVEL
	SOS	%TRLV(DB)	; AND DYNAMIC BLOCK LEVEL
	POP	SP,BLKPTR(DL)	; RESET BLOCK POINTER
	MOVEI	A0,0		; SET A0 FOR GETOWN

BLKE1:	POP	SP,A1		; UNSTACK
	JUMPL	A1,BLKE2	; BLOCK POINTER?
	TLZE	A1,(<Z 17,0>)	; [E057] IS THIS A STRING ARRAY ?
	PUSHJ	SP,DELSCN	; [E057] YES - DELETE SUB-STRINGS
	MOVEI	A1,@A1		; GETSTRING ITSELF, IF STRING VARIABLE.
	JUMPE	A1,BLKE1	; IF NO STRING ASSIGNED, DON'T DELETE.
	PUSHJ	SP,GETOWN	; NO - DELETE ITEM
	JRST	BLKE1

BLKE2:	PUSH	SP,A1		; PUT BACK LAST BLOCK POINTER
	HRRZM	AX,LINKPC(DL)	; [E127] STORE UPDATED PC
	JRST	CNC.AX		; AND EXIT
SUBTTL ARRAY - ARRAY LAYOUT ROUTINE

; AN ARRAY HEADER WORD PAIR IS FORMATTED AS FOLLOWS:

; FIRST WORD:	LH:	TYPE OF ARRAY
;		RH:	POINTER TO 0TH ELEMENT OF ARRAY IF VECTOR,
;			OTHERWISE 0TH ELEMENT OF PRIMARY ILIFFE VECTOR

; SECOND WORD:	LH:	- NUMBER OF DIMENSIONS
;		RH:	POINTER TO DOPE VECTOR

; THE I'TH ELEMENT OF THE J'TH LEVEL ILIFFE VECTOR (J = 1,2, ..... N-1)
; CONTAINS THE ADDRESS OF THE 0TH ELEMENT OF THE J+1'TH ILIFFE
; VECTOR (OR N'TH ROW IF J=N-1)

; THE DOPE VECTOR CONTAINS THE BOUND PAIRS

; ARRAY - NORMAL ENTRY
; OARRAY - OWN ARRAY ENTRY
; THE BOUND PAIRS ARE ON THE STACK (DOPE VECTOR)
; AND THE LINK IS IN AX
; A1 = ARRAY TYPE (T)
; A2 = ADDRESS OF FIRST HEADER WORD (A)
; A3 = - NO. OF ARRAYS (M)
; A4 = - NO. OF DIMENSIONS (N)
ARRAY:	TDZA	A11,A11		; NORMAL ENTRY
OARRAY:	MOVEI	A11,1		; OWN ARRAY ENTRY
	MOVN	A10,A3		; SAVE NO. OF ARRAYS
	HRLI	A2,(A3)		; -M,A
	HRLZI	A3,(A4)
	ASH	A4,1
	MOVN	A13,A4		; LENGTH OF DOPE VECTOR
	HRRI	A3,1(SP)
	SUBI	A3,(A13)	; -N,DV
	JUMPN	A11,ARR10	; OWN ARRAY?

ARR1:	HRLZ	A1,A1		; T,0
	MOVE	A4,A3		; DOPE VECTOR (DV) POINTER
	SETZB	A5,A6		; A5 = SPACE ACCUMULATOR
	MOVEI	A7,1		; A6,7 = MULTIPLIER ACCUMULATOR

ARR2:	MOVM	A0,(A4)		; ABS(LB(I))
	TLNE	A0,-1		; OK?
	SYSER1	4,(AX)		; NO
	MOVM	A0,1(A4)	; ABS(UB(I))
	TLNE	A0,-1		; OK?
	SYSER1	4,(AX)		; NO
	MOVE	A0,1(A4)
	SUB	A0,(A4)		; UB(I) - LB(I)
	AOJG	A0,.+2		; FORM D(I). OK?
	SYSER1	3,(AX)		; NO
	MOVE	A6,A7
	MUL	A6,A0		; ACCUMULATE PRODUCT
	JUMPN	A6,.+2
	TLNE	A7,-1
	SYSER1	4,(AX)		; TOO LARGE
	ADD	A5,A7		; ACCUMULATE SUM OF PRODUCTS
	ADDI	A4,1
	AOBJN	A4,ARR2		; RETURN IF MORE SUBSCRIPTS
	TLNN	A1,$VAR2	; ALLOW FOR LONG REAL, ETC.
	ADD	A5,A7
	TLNE	A5,-1		; TOO BIG FOR PDP-10?
	SYSER1	4,(AX)		; UNFORTUNATELY, YES
	JRST	ARR12
ARR3:	ADDI	A13,1

ARR4:	MOVE	A5,A3		; START OF DOPE VECTOR
	MOVE	A4,1(A5)
	SUB	A4,(A5)
	ADDI	A4,1		; DIMENSION OF FIRST BOUND
	MOVE	A7,A13
	SUB	A7,(A5)		; ADDRESS OF 0TH ELEMENT
	HRRI	A1,(A7)
	ADDI	A5,1		; MOVE UP DOPE VECTOR POINTER
	AOBJN	A5,ARR5		; AND JUMP UNLESS VECTOR
	TLNE	A1,$VAR2
	JRST	ARR8		; CHECK FOR LONG REAL, ETC.
	ASH	A4,1		; DOUBLE LAST SUBSCRIPT
	MOVE	A7,-2(A5)	; GET BACK LAST  LOWER BOUND
	SUB	A1,A7		; RECALCULATE ADDRESS OF 0TH ELEMENT
	JRST	ARR8

ARR5:	MOVE	A10,A13		; NOT A VECTOR

ARR6:	ADDI	A10,(A4)	; NEXT ILIFFE VECTOR OR ARRAY
	MOVE	A6,1(A5)
	SUB	A6,(A5)
	ADDI	A6,1		; DIMENSION OF I'TH BOUND
	MOVE	A7,A10
	SUB	A7,(A5)		; ADDRESS OF 0TH ELEMENT
	ADDI	A5,1		; MOVE UP DOPE VECTOR POINTER
	AOBJN	A5,ARR7		; AND JUMP UNLESS LAST SUBSCRIPT
	TLNE	A1,$VAR2	; CHECK FOR LONG REAL, ETC.
	JRST	ARR7		; NO
	SUB	A7,-2(A5)	; ALLOW FOR DOUBLING OF SUBSCRIPT
	ASH	A6,1

ARR7:	MOVEM	A7,(A13)	; FILL IN ILIFFE VECTOR ELEMENT
	ADDI	A7,(A6)		; ADVANCE ENTRY
	ADDI	A13,1		; INCREMENT ILIFFE VECTOR
	CAIE	A13,(A10)	; COMPLETE?
	JRST	ARR7		; NO - KEEP GOING
	IMULI	A4,(A6)		; NEW PRODUCT
	TLNE	A5,-1		; ANY MORE DIMENSIONS?
	JRST	ARR6		; YES

ARR8:	ADDI	A13,(A4)	; MOVE A13 OVER ARRAY
	MOVEM	A1,(A2)
	MOVEM	A3,1(A2)	; FILL IN HEADER WORDS
	ADDI	A2,1		; MORE ARRAYS?
	AOBJN	A2,ARR4		; YES
	JUMPN	A11,ARR14	; OWN ARRAY?
ARR9:	MOVE	SP,%SYS13(DB)	; RESTORE STACK POINTER
	ADDI	SP,-1(DB)

ARR16:	MOVEI	A1,(SP)
	SUB	A1,.JBREL
	HRLI	SP,(A1)		; AND SET UP LEFT HALF
	JUMPN	A11,CNC.AX	; EXIT IF OWN ARRAY
	HRRZ	A1,-1(A2)	; OTHERWISE GET ADDRESS OF ARRAY
EDIT(057) ; RETURN INDIVIDUAL SPACE FOR STRING ARRAYS
	MOVE	A6,%SYS11(DB)	; [E057] GET TYPE OF ARRAY AGAIN
	TLNN	A6,$TYPE-$S	; [E057] IS IT A STRING ARRAY ?
	ADD	A1,[<Z 1,0>-2]	; [E057] YES - SET TYPE CODE INTO DESCRIPTOR

ARR16A:	EXCH	A1,(SP)		; AND ADD TO ITEM LIST ON STACK
	PUSH	SP,A1		; AND MAKE NEW BLOCK POINTER
	MOVE	A1,SP		; MAKE NEW POINTER
	SUBI	A1,(DB)
	MOVEM	A1,BLKPTR(DL)
	JRST	CNC.AX		; AND EXIT

ARR10:	SKIPN	A4,1(A2)	; VIRGIN ARRAY?
	JRST	ARR1		; YES - RETURN TO MAIN SEQUENCE
	MOVE	A5,A3

ARR11:	MOVE	A0,(A5)		; COMPARE NEW DOPE VECTOR WITH OLD
	CAME	A0,(A4)		; LOWER BOUNDS THE SAME?
	JRST	ARR1		; NO
	MOVE	A0,1(A5)
	CAME	A0,1(A4)	; UPPER BOUNDS THE SAME?
	JRST	ARR1		; NO
	ADDI	A5,2
	ADDI	A4,1
	AOBJN	A4,ARR11	; MOVE TO NEXT SUBSCRIPT IF ANY
	SUBI	SP,(A13)	; SAME BOUNDS - LOSE NEW DOPE VECTOR
	JRST	ARR16		; AND EXIT

ARR12:	JUMPN	A11,.+2		; UNLESS OWN ARRAY
	IMULI	A5,(A10)	; ALLOW FOR THEM ALL
	ADDI	A5,(A13)	; ALLOW FOR DOPE VECTOR
	MOVEM	A5,%SYS7(DB)	; SAVE IT
	MOVEM	A13,%SYS10(DB)	; DOPE VECTOR LENGTH
	MOVEM	A1,%SYS11(DB)	; SAVE A1
	TLNN	A1,$OWN		; IF NOT FIXED ADDRESS
	SUBI	A2,(DB)		; THEN DELOCATE
	MOVEM	A2,%SYS12(DB)	; SAVE A2
	SUBI	A3,(DB)
	MOVEM	A3,%SYS13(DB)	; SAVE A3
ARR13:	MOVE	A0,%SYS7(DB)	; SPACE REQUIRED
EDIT(057); RETURN INDIVIDUAL STRING SPACE FOR STRING ARRAYS
	PUSH	SP,[0]		; [E057] PUT A ZERO WORD ON THE STACK
	JUMPN	A11,ARR13A	; [E057] NOTHING TO DO IF OWN ARRAY
	MOVSI	A1,$TYPE-$S	; [E057] WHAT TYPE OF ARRAY IS THIS ?
	TDNE	A1,%SYS11(DB)	; [E057] IS IT A STRING ARRAY ?
	JRST	ARR13A		; [E057] NO  - CARRY ON
	SETOM	(SP)		; [E057] YES - SET FLAG WORD
	ADDI	A0,2		; [E057] ACCOUNT FOR EXTRA WORDS NEEDED
ARR13A:	PUSHJ	SP,GETCLR	; [E057] TRY TO GET IT (ZEROED)
	POP	SP,A4		; [E057] RESTORE TYPE-CODED WORD
	JUMPE	A4,ARR13D	; [E057] CARRY ON IF NOT STRING ARRAY
	HLLZ	A4,%SYS12(DB)	; [E057] OTHERWISE GET NUMBER OF ARRAYS
	MOVEM	A4,(A1)		; [E057] STORE IT IN LEFT HALF OF WORD 1
	HRRZ	A4,%SYS10(DB)	; [E057] GET DOPE VECTOR SIZE
	ADDI	A4,2(A1)	; [E057] AND GET ADDRESS OF NEXT WORD
	MOVEM	A4,1(A1)	; [E057] STORE THIS IN SECOND WORD
	PUSH	SP,A1		; [E057] SAVE ADDRESS
	MOVE	A1,%SYS13(DB)	; [E057] GET DOPE VECTOR POINTER
	ADDI	A1,(DB)		; [E057] AND RELOCATE IT
	SETZ	A2,		; [E057] CLEAR TOTAL ILIFFE SIZE
	MOVEI	A3,1		; [E057] AND TOTAL DATA SIZE
ARR13B:	MOVN	A4,(A1)		; [E057] GET LOWER BOUND
	ADD	A4,1(A1)	; [E057] GET DIFFERENCE
	IMULI	A3,1(A4)	; [E057] ACCUMULATE PRODUCT
	AOBJP	A1,ARR13C	; [E057] EXIT IF LAST DIMENSION
	ADD	A2,A3		; [E057] OTHERWISE ACCUMULATE TOTAL
	AOJA	A1,ARR13B	; [E057] AND LOOP FOR NEXT DIMENSION
ARR13C:	POP	SP,A1		; [E057] RESTORE DATA AREA AGAIN
	HRRM	A2,(A1)		; [E057] STORE ILIFFE VECTOR SIZE
	MOVN	A3,A3		; [E057] GET -# OF ARRAY ELEMENTS
	HRLM	A3,1(A1)	; [E057] STORE THIS IN L.H. OF WORD 2
	ADDI	A1,2		; [E057] AND STEP OVER THESE WORDS
ARR13D:	MOVE	A4,A1		; [E057] ADDRESS OF SPACE
	MOVE	A3,%SYS13(DB)	; RESTORE TEMPORARY DOPE VECTOR POINTER
	ADDI	A3,(DB)
	HRLI	A4,(A3)		; BLT POINTER
	HRRI	A3,(A4)		; POINTER TO NEW DOPE VECTOR
	MOVE	A13,%SYS10(DB)
	ADDI	A13,-1(A4)	; END OF NEW DOPE VECTOR
	BLT	A4,(A13)	; COPY TEMPORARY TO NEW DOPE VECTOR
	MOVE	A1,%SYS11(DB)	; RESTORE A1
	MOVE	A2,%SYS12(DB)
	TLNN	A1,$OWN
	ADDI	A2,(DB)		; AND A2
	JUMPE	A11,ARR3	; IF OWN ARRAY
	PUSH	SP,[0]
	PUSH	SP,[0]
	HRROI	A2,-1(SP)	; SET UP FOR NEW HEADER
	JRST	ARR3

ARR14:	MOVE	A1,%SYS12(DB)	; GET ADDRESS OF OLD HEADER
	SKIPN	1(A1)		; VIRGIN ARRAY?
	JRST	ARR15		; YES
	MOVEI	A2,-1(SP)
	PUSHJ	SP,CPYARR	; NO - COPY RELEVANT PARTS OF OLD ARRAY
	MOVEI	A11,1		; RESET OWN FLAG
	MOVE	A1,%SYS12(DB)
	HRRZ	A1,1(A1)	; GET LOCATION OF OLD ARRAY
	MOVEI	A0,0
	PUSHJ	SP,GETOWN	; AND DELETE IT

ARR15:	MOVE	A2,%SYS12(DB)	; RESTORE ADDRESS OF HEADER
	POP	SP,1(A2)
	POP	SP,(A2)		; AND COPY NEW HEADER
	ADDI	A2,1
	AOBJP	A2,ARR9		; ANY MORE ARRAYS?
	MOVEM	A2,%SYS12(DB)	; YES - MOVE TO NEXT HEADER
	JRST	ARR13		; AND DEAL WITH THE NEXT ONE
SUBTTL STRDEC - DECLARE STRINGS

; CALL IS:
;	MOVEI	A1,<STRING-VARIABLE>
;	JSP	AX,STRDEC

STRDEC:	SETZM	(A1)		; MAKE IT A NULL STRING
	SETZM	1(A1)		; [254] CLEAR SECOND WORD OF HEADER
	CAIGE	A1,(DL)		; [E004] DYNAMIC ?
	  JRST	STRDC2		; [E004] NO.
	SUBI	A1,(DB)		; [E004] YES - 
	TLO	A1,DB		; [E004]  DELOCATE.
EDIT(004); MAKE STRING DELETE AT BLOCK-EXIT WORK IF STACK IS SHIFTED.

STRDC2:	TLO	A1,(@)		; SET INDIRECT BIT
	JRST	ARR16A		; LEAVE ADDRESS ON STACK FOR BLKEND

SUBTTL CHKARR - CHECK ARRAY SUBSCRIPTS ROUTINE

; ON ENTRY, THE SUBSCRIPTS ARE ON THE STACK
; A0 = NUMBER OF SUBSCRIPTS PRESENTED
; A2 = ADDRESS OF ARRAY HEADER
; THE LINK IS IN AX
; ON EXIT, THE ARRAY ELEMENT ADDRESS IS IN A2

CHKARR:	DMOVEM	A3,%SYS12(DB)	; SAVE A3,A4
	MOVE	A1,1(A2)	; GET DOPE VECTOR POINTER
	MOVE	A2,(A2)		; GET ARRAY TYPE AND ADDRESS OF 0TH WORD
	SUB	SP,A0
	MOVEI	A3,(SP)
	SUB	A3,.JBREL	; RESTORE STACK POINTER 
	HRLI	SP,(A3)		; TO POSITION BEFORE DUMPS
	MOVEI	A3,1(SP)	; POINTER TO SUBSCRIPTS

CHK1:	MOVE	A4,(A3)		; GET NEXT SUBSCRIPT
	CAML	A4,(A1)		; AND CHECK IF BETWEEN
	CAMLE	A4,1(A1)	; LOWER AND UPPER BOUNDS
	SYSER1	6,(AX)		; NO - COMPLAIN
	ADD	A2,A4		; OK - OFFSET ADDRESS BY SUBSCRIPT
	ADDI	A1,1		; ADVANCE DOPE VECTOR POINTER
	AOBJP	A1,CHK2		; ANY MORE ENTRIES IN DOPE VECTOR?
	SOJE	A0,CHK3		; YES - ANY SUBSCRIPTS LEFT?
	HRR	A2,(A2)		; YES - LOAD ILIFFE VECTOR ENTRY
	AOJA	A3,CHK1		; AND DEAL WITH NEXT SUBSCRIPT

CHK2:	SOJN	A0,CHK3		; END OF DOPE VECTOR - ANY MORE SUBSCRIPTS?
	TLNN	A2,$VAR2	; NO - TWO WORDS PER VARIABLE?
	ADD	A2,A4		; YES - DOUBLE LAST SUBSCRIPT
	DMOVE	A3,%SYS12(DB)	; RESTORE A3,A4
	JRST	CNC.AX		; AND RETURN WITH ADDRESS OF ELEMENT

CHK3:	SYSER1	5,(AX)		; WRONG NUMBER OF SUBSCRIPTS
SUBTTL COMPAR - COMPARE BYTE STRINGS ROUTINE

; STRING VARIABLES ARE FORMATTED AS FOLLOWS:

; FIRST WORD:	BYTE-POINTER TO STRING (POSITION FIELD = OCTAL 44)

; SECOND WORD:	BIT 0:	WRITE PROTECT BIT (SET IN STRING CONSTANT
;			HEADERS)
;		BIT 1:	 DYNAMIC BIT (SET IN STRINGS CREATED
;			IN THE HEAP)
;		BIT 2:		1 = RESULT OF STRING-TYPE PROCEDURE
;		BITS 3-11:	SPARE
;		BITS 12-35:	NUMBER OF BYTES IN BYTE STRING

; ON ENTRY:
; A0,A1 CONTAIN THE VALUE OF THE FIRST STRING VARIABLE
; A2,A3 CONTAIN THE VALUE OF THE SECOND STRING VARIABLE
; THE LINK IS IN AX
; ON EXIT:
; A0 CONTAINS -1,0 OR +1 ACCORDING AS THE FIRST STRING IS LESS THAN,
; EQUAL TO OR GREATER THAN THE SECOND STRING
EDIT(102); Rewrite COMPAR to deal with trailing ASCII spaces/nulls properly

COMPAR:	PUSH	SP,A0		; Save byte-pointer 1 on the stack
	TLZ	A1,STRBCC	; Mask out unwanted bits to get length 1
	SKIPN	A0		; If this is a null string,
	TDZA	A1,A1		; Ensure length is zero
	SKIPN	A1		; Also, if length is zero,
	SETZB	A0,(SP)		; Make sure this is a null string.
	PUSH	SP,A1		; Save length 1 on the stack
	PUSH	SP,A2		; Save byte-pointer 2 on the stack
	TLZ	A3,STRBCC	; Mask out unwanted bits to get length 2
	SKIPN	A2		; If this is a null string,
	TDZA	A3,A3		; Ensure length is zero
	SKIPN	A3		; Also, if length is zero,
	SETZB	A2,(SP)		; Make sure this is a null string.
	PUSH	SP,A3		; Save length 2 on the stack
	LDB	A1,[POINT 6,A0,11] ; Get byte-size 1 into A1
	LDB	A3,[POINT 6,A2,11] ; Get byte-size 2 into A3
	SETZ	A0,		; Initialize A0 (result) to 0
	CAMN	A1,A3		; Do byte sizes match ?
	JRST	CMPR2		; Yes - compare word-at-a-time
	CAIN	A1,7		; No. If first string is ASCII (byte size = 7)
	JUMPE	A3,CMPR5	; and the second is a null string,
	CAIN	A3,7		; or vice-versa, then check for string
	JUMPE	A1,CMPR5	; consisting entirely of nulls or spaces.

; Byte-at-a-time compare. (Different byte sizes).
CMPR0:	SETZB	A1,A3		; Initialize both values to nulls
	SOSL	-2(SP)		; If string 1 has not yet run out,
	ILDB	A1,-3(SP)	; Get next byte into A1.
	SOSL	0(SP)		; Similarly, if string 2 not yet exhausted
	ILDB	A3,-1(SP)	; Get next byte into A3.
	CAME	A1,A3		; Compare the two bytes
	JRST	CMPR9		; Unequal - strings are different
	SKIPG	-2(SP)		; Equal. Continue if either string
	SKIPLE	0(SP)		; not yet exhausted (padding with nulls)
	JRST	CMPR0		; to try to find a difference

CMPR1:	SUB	SP,[		; Both strings exhausted - compare equal.
	XWD	4,4]		; Retard stack to original level
	JRST	CNC.AX		; & return
; Word-at-a-time compare. (Same byte-size, in A3).
CMPR2:	JUMPE	A3,CMPR1	; If byte-size zero, both are (equal) null strings
	MOVNI	A2,^D36		; Otherwise must do a real compare.
	IDIVI	A2,(A3)		; Get -(#bytes/word) in A2

CMPR3:	SETZB	A1,A3		; Initialize both words to nulls
	SKIPLE	-2(SP)		; If still some of string 1 left,
	MOVE	A1,@-3(SP)	; get next word-full into A1
	SKIPLE	0(SP)		; Similarly get next word-full of string 2
	MOVE	A3,@-1(SP)	; into A3 (unless none left).
	CAME	A1,A3		; Are the words identical ?
	JRST	CMPR4		; No.
	ADDM	A2,0(SP)	; Yes - decrement both byte-counts
	ADDM	A2,-2(SP)	;  by number of bytes/word
	AOS	-3(SP)		; And increment both addresses to
	AOS	-1(SP)		;  point to the next full word.
	SKIPG	(SP)		; If either string has some bytes left
	SKIPLE	-2(SP)		; then continue with the comparison.
	JRST	CMPR3		; Otherwise strings are identical
	JRST	CMPR1		; except for possible trailing nulls

CMPR4:	MOVN	A2,A2		; Get +(bytes/word)
	CAIE	A2,5		; Is this an ASCII comparison ?
	JRST	CMPR0		; No - check for exact match

; Comparison of ASCII strings (trailing space = trailing null)
CMPR5:	SETZB	A1,A3		; Initialize both values to nulls
	SOSL	-2(SP)		; If string 1 has not yet run out,
	ILDB	A1,-3(SP)	; Get the next byte into A1
	SOSL	0(SP)		; And similarly get next byte of
	ILDB	A3,-1(SP)	; string 2, unless exhausted
	CAMN	A1,A3		; Are the bytes identical ?
	JRST	CMPR7		; Yes - try the next pair
	CAIN	A1," "		; Allow space from first string
	JUMPE	A3,CMPR6	; to match null from second string
	CAIN	A3," "		; And allow null from first string
	JUMPE	A1,CMPR6	; to match space from second string
	JUMPN	A0,CMPR1	; Some other character. If some difference
	JRST	CMPR9		; previously encountered, the string which
				; had the space will be greater than the string
				; which had the null. Otherwise, compare these
				; (different) characters to order the strings.
CMPR6:	JUMPN	A0,CMPR8	; Jump if already found a difference
	SKIPE	A1		; Otherwise set A0 to reflect which string
	AOJA	A0,CMPR8	; had the space, and which the null.
	SOJA	A0,CMPR8	; (-1 if string 1 null, +1 if string 2)
CMPR7:	JUMPE	A1,CMPR8	; Identical characters. If they are
	CAIE	A1," "		; both nulls or spaces, continue testing
	JUMPN	A0,CMPR1	; If not, embedded spaces do not match nulls
CMPR8:	SKIPG	-2(SP)		; If only spaces or nulls found so far,
	SKIPLE	0(SP)		; repeat while either string has characters
	JRST	CMPR5		; which have not yet been examined
	SETZ	A0,		; Otherwise set result 'equal'
	JRST	CMPR1		; and return (tidying up stack first)

CMPR9:	CAML	A1,A3		; Strings differ - see which is "greater"
	AOJA	A0,CMPR1	; A0:= +1;! string 1 > string 2;
	SOJA	A0,CMPR1	; A0:= -1;! string 1 < string 2;
SUBTTL PRBYTE/PWBYTE - BYTE POINTER ROUTINES

; ON ENTRY:
; A1 = BYTE NUMBER
; A2 = ADDRESS OF STRING VARIABLE
; THE LINK IS IN AX
; ON EXIT, THE BYTE POINTER IS IN A2

; E.G.
;
;	S.[I] := S.[J]
;
; COMPILES INTO
;
;	MOVE	A1,J
;	MOVEI	A2,S
;	JSP	AX,PBYTE
;	LDB	A13,A2		; A13 := S.[J]
;	MOVE	A1,I
;	MOVEI	A2,S
;	JSP	AX,PBYTE
;	DPB	A13,A2		;  S.[I] := A13

PBYTE:	MOVEI	A2,@A2
	DMOVEM	A4,%SYS11(DB)	; SAVE A4,A5
	SOJL	A1,PBYT2	; CHECK SENSIBLE BYTE NUMBER

EDIT(033); CHECK FOR NULL STRINGS
PBYT1:	SKIPN	STR1(A2)	; [E033] IS THIS A NULL STRING ?
	JRST	PBYT2		; [E033] YES - TELL OFF BAD USER
	MOVE	A4,STR2(A2)
	TLZ	A4,STRBCC	; NUMBER OF BYTES IN STRING
	CAMGE	A1,A4		; ENOUGH?
	JRST	PBYT3		; YES
PBYT2:	SYSER1	16,(AX)		; BYTE NUMBER OUT OF RANGE
PBYT3:	HLL	A2,STR1(A2)	; GET LEFT HALF OF FIRST STRING WORD
	HLRZ	A5,A2
	ANDI	A5,STRBS
	LSH	A5,-6		; AND EXTRACT BYTE SIZE
	MOVEI	A3,44
	IDIVI	A3,(A5)		; CALCULATE NUMBER OF BYTES PER WORD
	EXCH	A1,A2		; EXCHANGE BYTE NUMBER AND ADDRESS
	IDIVI	A2,(A3)		; CALCULATE WORD AND BYTE NUMBER
	HRR	A1,(A1)		; GET ADDRESS OF BYTE STRING
	ADDI	A2,(A1)		; AND GET ADDRESS OF WORD CONTAINING BYTE
	CAMG	A2,.JBREL	; GOOD ADDRESS IN LOW SEGMENT?
	JRST	PBYT4		; YES
	HRRZ	A4,.JBHRL
	CAILE	A2,(A4)		; NO - GOOD ADDRESS IN HIGH SEGMENT
	SYSER2	5,0		; NO - COMPLAIN

PBYT4:	DPB	A5,[
	POINT	6,A2,11]	; SET UP BYTE SIZE
	IMULI	A5,1(A3)
	MOVEI	A4,44
	SUBI	A4,(A5)		; POSITION OF LAST BIT IN BYTE
	DPB	A4,[
	POINT	6,A2,5]		; SET IT IN BYTE POINTER
PBYT5:	DMOVE	A4,%SYS11(DB)	; RESTORE A4,A5
	JRST	CNC.AX
SUBTTL CPYSTR - COPY STRING ROUTINE

; ON ENTRY:
; A0,A1 CONTAIN THE VALUE OF THE OLD STRING VARIABLE
; A2 CONTAINS THE ADDRESS OF THE NEW STRING VARIABLE
; A4 CONTAINS THE ADDRESS OF THE NEW BYTE STRING
; A7 CONTAINS THE LOWEST BYTE NUMBER TO BE COPIED
; A10 CONTAINS THE NUMBER OF BYTES TO BE COPIED
; THE LINK IS IN AX

; A3 AND A13 ARE SACRED, AS THIS ROUTINE IS CALLED FROM PARAM

CPYSTR:	TLO	A1,STRDYN	; SET DYNAMIC BIT
	MOVE	A5,A1		; TAKE COPY OF 2ND WORD
	TLO	A5,STRPRC	; MARK AS RESULT OF STRING PROC
	MOVEM	A5,STR2(A2)	; AND SET UP SECOND WORD OF STRING
	DPB	A10,[
	POINT	24,STR2(A2),35]	; AND PLANT BYTE COUNT
	JUMPE	A10,CPYS7	; SPECIAL TREATMENT IF NULL STRING
	HLL	A4,A0
	MOVEM	A4,STR1(A2)	; SET UP FIRST WORD OF STRING

	MOVE	A5,A0		; GET POINTER TO OLD STRING
	MOVE	A2,A1		; SAVE FLAGS
	TLZ	A1,STRBCC	; GET BYTE COUNT
	JRST	CPYS4

CPYS2:	ILDB	A6,A5
	SOJG	A7,CPYS2	; IDLE UNTIL FIRST BYTE REQUIRED

	IDPB	A6,A4		; YES COPY BYTE
	SOJE	A10,CNC.AX	; COUNT DOWN COPY

CPYS4:	SOJGE	A1,CPYS2	; COUNT DOWN BYTES
	HLRZ	A1,A0		; EXHAUSTED

CPYS7:	SETZM	STR1(A2)	; CLEAR FIRST WORD OF NULL STRING
	JRST	CNC.AX
SUBTTL STRASS - STRING ASSIGNMENT ROUTINE

; S:=T
; ENTERED WITH:	0(SP),-1(SP)	LEFT-HAND STRING VARIABLE
;		-2(SP),-3(SP)	RIGHT-HAND STRING VARIABLE
; ON EXIT:	A0,A1		NEW LEFT-HAND STRING VARIABLE
;				STACK CLEARED.
;
STRAS0:	PUSH	SP,A2		; [E045] SPECIAL ENTRY POINT FOR PARAM
	JRST	STRAS1		; [E045] TO INITIALIZE A VALUE STRING
STRASS:	POP	SP,A1		; GET L.H. STRING VARIABLE
	POP	SP,A0
STRASX:	CAMN	A0,-1(SP)	; [E055] IS L.H. = R.H. ? (S:=S; )
	JRST	STRAS2		;  YES - DON'T WASTE TIME
	PUSH	SP,A2		; NO - SAVE A2
	JUMPE	A0,STRAS1	; DOES L.H. STRING EXIST ?
	TLNN	A1,STRDYN	; YES - IS IT DYNAMIC ?
	JRST	STRAS1		; NO
	HRRZ	A1,A0
	SETZ	A0,
	PUSHJ	SP,GETOWN	; YES - DELETE IT

STRAS1:	SKIPE	-2(SP)		; [E045] EXTRA CHECKS FOR NULL STRINGS
	SKIPN	A2,-1(SP)	; [E045] WHICH MAY HAVE ZERO BYTE SIZE
	JRST	STRAS3		; [E045] QUICK EXIT FOR NULL STRINGS
	TLNE	A2,STRPRC	; IS R.H. THE RESULT OF A STRING PROC ?
	JRST	STRAS3		;  YES - DON'T COPY, JUST RETURN IT
	LDB	A2,[
	POINT	6,-2(SP),11]	; GET BYTE-SIZE
	MOVEI	A1,^D36
	IDIVI	A1,(A2)		; GET # BYTES/WORD
	MOVE	A0,-1(SP)	; GET LENGTH IN BYTES
	TLZ	A0,STRBCC	; ISOLATE LENGTH
	IDIVI	A0,(A1)		; TO WORDS
	SKIPE	A1
	ADDI	A0,1		; ROUND UP
	JUMPE	A0,STRAS3	; DON'T ASK GETOWN FOR 0 WORDS
	PUSH	SP,A0		; KEEP
	PUSHJ	SP,GETOWN	; GET SPACE
	POP	SP,A2
	ADDI	A2,-1(A1)	; FORM END-OF-BLT
	HRLI	A1,@-2(SP)	; MAKE A BLT POINTER
	HRRM	A1,-2(SP)	; SET NEW ADDRESS INTO STRING-VARIABLE
	BLT	A1,(A2)		; COPY

STRAS3:	POP	SP,A2		; RESTORE A2

STRAS2:	POP	SP,A1		; GET NEW
	TLO	A1,STRDYN	;  (DYNAMIC)
	TLZ	A1,STRPRC	;   (NON-PROCEDURE RESULT)
	POP	SP,A0		;    STRING VARIABLE
	TLZ	A0,77		; ENSURE INDEX FIELD CLEAR
EDIT(045); Initialize null value strings properly
	SKIPE	A0		; [E045] IF ALREADY A NULL STRING
	TDNN	A1,[77,777777]	; [E045] OR ONE WITH ZERO BYTES
	SETZB	A0,A1		; [E045] CLEAR POINTER AND COUNT
	JRST	CNC.AX		; RETURN
SUBTTL CPYARR - COPY ARRAY ROUTINE

; ON ENTRY:
; A1 = ADDRESS OF SOURCE ARRAY (MAY BE DESTROYED)
; A2 = ADDRESS OF DESTINATION ARRAY
; THAT PART OF THE ARRAY(A1) WHICH IS COMMON WITH
; ARRAY(A2) IS COPIED, WITH APPROPRIATE TYPE CONVERSION

CPYARR:	HRLZI	AX,(AX)		; SAVE OLD LINK IN LH OF AX
	MOVE	A3,1(A1)	; DV POINTER FOR SOURCE ARRAY
	MOVE	A4,1(A2)	; DV POINTER FOR DESTINATION ARRAY
	HLLZ	A5,A3
	HRRI	A5,1(SP)	; COMMON DV POINTER
	MOVE	A13,SP		; SAVE SP

CPYA1:	MOVE	A6,(A3)
	CAMGE	A6,(A4)
	MOVE	A6,(A4)		; LC = MAX(LB(A1),LB(A2))
	MOVE	A7,1(A3)
	CAML	A7,1(A4)
	MOVE	A7,1(A4)	; UC = MIN(UB(A1),UB(A2))
	CAMGE	A7,A6		; UC >= LC?
	JRST	CPYA3		; NO - ABORT COPY
	PUSH	SP,A6		; YES -
	PUSH	SP,A7		; SET LC, UC IN COMMON DV
	ADDI	A3,2		; MOVE ALONG DV POINTERS
	ADDI	A4,1
	AOBJN	A4,CPYA1	; AND CONTINUE IF MORE SUBSCRIPTS
	HLLZ	A6,A3
	HRRI	A6,1(SP)	; WORKING SUBSCRIPTS VECTOR
	MOVE	A7,A5

CPYA2:	PUSH	SP,(A7)		; INITIALIZE WORKING VECTOR
	ADDI	A7,1
	AOBJN	A7,CPYA2	; FROM COMMON DV
	MOVE	A3,(A1)		; GET TYPE AND IV ADDRESS OF SOURCE ARRAY
	MOVE	A4,(A2)		; GET TYPE AND IV ADDRESS OF DESTINATION ARRAY
	HLRZ	A7,A3
	ANDI	A7,$TYPE
	LSH	A7,-11
	HRLZ	A7,TYPTAB(A7)	; LOOK UP SOURCE ENTRY IN PARAM'S MAGIC TABLE
	HLRZ	A10,A4
	ANDI	A10,$TYPE
	LSH	A10,-11
	AND	A7,TYPTAB(A10)	; AND GATE WITH DESTINATION'S ENTRY
	JFFO	A7,CPYA4	; AND SORT IT ALL OUT!!!!!!!
				; (MISMATCHES FALL THROUGH HERE)
CPYA3:	HLRZ	AX,AX		; RESTORE OLD LINK
	MOVE	SP,A13		; RESTORE STACK POINTER
	POPJ	SP,0		; AND EXIT

CPYA4:	ROT	A10,-1		; SHIFT AROUND ODD BIT 
	JUMPGE	A10,.+2		; ODD ENTRY?
	SKIPA	A10,CPYA8(A10)	; YES - LOAD IT
	MOVS	A10,CPYA8(A10)	; NO - LOAD EVEN ENTRY

CPYA5:	MOVE	A7,A6		; TAKE COPY OF WORKING VECTOR ADDRESS
	HRRZ	A11,A3		; GET 0TH ILIFFE VECTOR ENTRY FOR SOURCE
	HRRZ	A12,A4		; AND FOR DESTINATION

CPYA6:	ADD	A11,(A7)	; ADVANCE BY NEXT SUBSCRIPT
	ADD	A12,(A7)
	AOBJP	A7,(A10)	; ANY MORE SUBSCRIPTS?
	MOVE	A11,(A11)	; YES - MOVE THROUGH ILIFFE VECTOR ENTRY
	MOVE	A12,(A12)
	JRST	CPYA6

CPYA8:	XWD	CPYA9,CPYA11	; I -> I, I -> R
	XWD	CPYA12,CPYA13	; I -> LR, R -> I
	XWD	CPYA9,CPYA14	; R -> R, R -> LR
	XWD	CPYA15,CPYA16	; LR -> I, LR -> R
	XWD	CPYA17,CPYA3	; LR -> LR, C -> C
	XWD	CPYA3,CPYA3	; C -> LC, LC -> C
	XWD	CPYA3,CPYA9	; LC -> LC, B -> B
	XWD	CPYA17,CPYA3	; S -> S, L -> L
	XWD	CPYA3,0		; N -> N

CPYA9:	MOVE	A0,(A11)	; I -> I, R -> R, B -> B

CPYA10:	MOVEM	A0,(A12)	; GENERAL SINGLE WORD STORE
	JRST	CPYA19

CPYA11:	FLTR	A0,(A11)	; I -> R
	JRST	CPYA10

CPYA12:	MOVE	A0,(A11)	; I -> LR
	JSP	AX,ILR
	JRST	CPYA18
CPYA13:	FIXR	A0,(A11)	; R -> I
	JRST	CPYA10

CPYA14:	MOVE	A0,(A11)	; R -> LR
	MOVEI	A1,0
	JRST	CPYA18

CPYA15:	ADD	A11,-1(A7)	; DOUBLE LAST SUBSCRIPT OF SOURCE
	DMOVE	A0,(A11)	; LR -> I
	JSP	AX,LRI
	JRST	CPYA10

CPYA16:	ADD	A11,-1(A7)	; DOUBLE LAST SUBSCRIPT OF SOURCE
				; LR -> R
	DMOVE	A0,(A11)
	JSP	AX,LRR
	JRST	CPYA10

CPYA17:	ADD	A11,-1(A7)	; DOUBLE LAST SUBSCRIPT OF SOURCE
	DMOVE	A0,(A11)	; LR -> LR, S -> S

CPYA18:	ADD	A12,-1(A7)	; DOUBLE LAST SUBSCRIPT OF DESTINATION
	DMOVEM	A0,(A12)	; GENERAL DOUBLE WORD STORE


CPYA19:	MOVEI	A11,(A6)	; REVERSE POINTER TO COMMON DV

CPYA20:	AOS	A12,-1(A7)	; GET AND INCREMENT LAST SUBSCRIPT
	CAMG	A12,-1(A11)	; GONE TOO HIGH?
	JRST	CPYA5		; NO - GO BACK FOR NEXT ELEMENT
	MOVE	A12,-2(A11)	; YES - REPLACE
	MOVEM	A12,-1(A7)	; BY MINIMUM VALUE
	SUBI	A11,2		; MOVE DOWN COMMON DV
	CAIG	A11,2(A13)	; DOWN TO FIRST SUBSCRIPT?
	JRST	CPYA3		; YES
	SOJA	A7,CPYA20	; NO - KEEP GOING
SUBTTL	GETOWN	- GET HEAP SPACE ROUTINE

; ON ENTRY,
; If A0 < 0, the space returned is immediately below the stack base,
; so as to be capable of extension
; If A0 = 0, A1 is the address of a space to be returned to the heap
; If A0 > 0, A0 is the number of words of heap space required.

; Where space is acquired, A1 contains the address of the first useful word

; Free heap space is referenced by a table addressed by %SYS2,
; the entries being formatted as follows:-

; 0 = null entry
; length,,pointer = free area in Heap
; The last word in a piece of table is either 0 or an AOBJN pointer
;  to another piece of table (the pieces of table are themselves in
;  the Heap).

; each heap area is preceeded by a 'chain word', formatted as follows:-

; LH = length of this area, including chain word
; RH = 0	area in use
;    = non-zero, pointer to area's entry in heap table

GETKNL:	; KERNEL OF GETOWN - A2 = TABLE POINTER (-LENGTH,,ADDR)
Edit(062); Use current top of heap if possible
	PUSH	SP,A2		; [E062] SAVE TABLE POINTER
	PUSH	SP,A3		; ALL ENTRIES REQUIRE TO SAVE A3
	JUMPL	A0,GET3		; FLEX ENTRY
	JUMPE	A0,GET2		; RETURN SPACE

GET1:				; ORDINARY GET-N-WORDS ENTRY
	ADDI	A0,1		; ALLOW FOR LINK-WORD
	HRROI	A3,-1		; INITIALIZE A3 AS FLAG/COMPARE WORD

GET13:	HLRZ	A1,(A2)		; GET SIZE OF NEXT SLOT
	SUB	A1,A0		;
	JUMPL	A1,GET15	; DIFFERENCE
	JUMPN	A1,GET14	; SPOT ON
	EXCH	A1,(A2)		; CLEAR HEAP TABLE ENTRY, LOAD POINTER
	HLLZS	(A1)		; CLEAR RHS OF CHAIN WORD
	JRST	GET97

GET14:	CAIL	A1,(A3)		; LARGE ENUF - CF WITH PREV
	JRST	GET15		; NO BETTER
	EDIT	(246)		; [246] FIX HEAP ALLOCATION
	PUSH	SP,A5		; [246] SAVE THIS AC BEFORE USING IT
	HRRZ	A5,(A2)		; [246] LOAD THIS ENTRY'S POINTER
	CAIN	A5,0		; [246] IS THIS HEAP ENTRY ALREADY IN USE?
	JRST	[			; [246]
		POP	SP,A5		; [246] YES, IT'S NO GOOD - RESTORE A5
		JRST	GET15		; [246] KEEP SCANNING HEAP TABLE
		]			; [246]
	POP	SP,A5		; [246] NO, RESTORE A5
	MOVEI	A3,(A1)		; [246] THIS ENTRY IS GOOD - REMEMBER IT
	HRLI	A3,(A2)

GET15:	AOBJN	A2,GET13	; KEEP TRYING
	SKIPE	A2,(A2)		; MORE TABLE ?
	JRST	GET13		;  YES - USE IT
	JUMPGE	A3,GET17
	MOVE	A2,-1(SP)	; [E062] GET TABLE AGAIN
	PUSH	SP,A0		; [E062] SAVE A0 (DESIRED SIZE)
	SETO	A0,		; [E062] FLAG NOTHING FOUND
	PUSHJ	SP,GETTOP	; [E062] GET TOPMOST CHUNK
	  TDZA	A1,A1		; [E062] NOT FOUND - LENGTH = 0
	HLRZ	A1,(A1)		; [E062] FOUND - GET LENGTH
	MOVN	A1,A1		; [E062] A1 = -(LENGTH OF CHUNK)
	ADD	A1,(SP)		; [E062] A1 = LENGTH TO EXTEND BY
	CCORE1	(A1)		; [E062] SHIFT THE STACK
	POP	SP,A0		; [E062] GET DESIRED LENGTH AGAIN
	MOVN	A1,A0		; [E062] GET WHERE IT WILL START
	ADDI	A1,(DB)		; [E062] BY COUNTING DOWN FROM DB
	HRLZM	A0,(A1)		; SET CHAIN-WORD
	JRST	GET97

GET17:	MOVS	A2,A3		; A2 IS LENGTH,,TABLE POINTER
	HRRZ	A1,(A2)		; BASE ADDR OF PIECE TO GIVE AWAY
	HRLZM	A0,(A1)		; SET ITS LINK WORD
	ADDB	A0,(A2)		; INCR POINTER IN TABLE
	HLLM	A2,(A2)		; SET LENGTH OF FREE PIECE
	HRRZ	A3,A0
	MOVEM	A2,(A3)		; SET ITS LINK WORD
	JRST	GET97		;  WHICH ADDS 1 TO A1 & RETURNS
GET2:				; A0 = 0 - RETURN SPACE ADDRESSED BY A1
	TLZ	DB,TMPFL1!TMPFL2; CLEAR TEMPORARY FLAG BITS
	HLRZ	A0,-1(A1)	; A0 IS LENGTH OF RETURNED PIECE
	ADDI	A0,-1(A1)	; NOW TOP ADDRESS + 1
	MOVEI	A1,-1(A1)	; GET ADDRESS OF BOTTOM OF PIECE

GET21:	SKIPN	A3,(A2)		; GET TABLE ENTRY - FREE ?
	JRST	GET24		; YES
	CAIE	A0,(A3)		; NO - PIECE IMMEDIATELY ABOVE RETURNED PIECE ?
	JRST	GET22		; NO
	HLLZ	A3,A3		; YES - MERGE. CLEAR RHS
	HRRM	A1,(A2)		; SET TABLE WORD TO POINT TO MERGED PIECES
	PUSH	SP,(A1)		; SAVE OLD BACK-POINTER
	HRRM	A2,(A1)		; AND SET BACK-POINTER TO THIS TABLE-ENTRY ADDR
	JRST	GET23

GET22:	HLRZ	A3,(A2)		; LENGTH OF TABLE'S PIECE
	ADD	A3,(A2)		; + ITS ADDR GIVES ITS TOP ADDR
	CAIE	A1,(A3)		; IMMEDIATELY BELOW RETURNED PIECE ?
	JRST	GET25		; NO
	PUSH	SP,(A1)		; SAVE OLD UPEPER TABLE POINTER
	HLLZ	A3,(A1)		; YES - MERGE. GET EXTRA LENGTH
	HRRZ	A1,(A2)		; GET LOWER ADDRESS

	EDIT(227)		; DO MEMORY MANAGEMENT MATH IN RIGHTHALF TO
				; PREVENT OVERFLOWS
GET23:	MOVSS	(A1)		; [227] SWAP TO PREPARE FOR RIGHTHALF MATH
	MOVSS	A3		; [227] SWAP A3 FOR RIGHTHALF MATH
	ADDB	A3,(A1)		; [227] PUT NEW LENGTH INTO LINK WORD
	MOVSS	(A1)		; [227] SWAP ANSWER BACK TO HOW IT SHOULD BE
	HRLM	A3,(A2)		; [227] PUT NEW LENGTH VALUE INTO TABLE
	POP	SP,A3		; GET OLD BACK-POINTER
	TRNE	A3,-1		; WAS IT FREE ?
	SETZM	(A3)		; YES, RELEASE ITS TABLE ENTRY
	TLO	DB,TMPFL1	; NO, REMEMBER WE WON'T NEED A TABLE SLOT
	JRST	GET25

GET24:	; WE'VE FOUND A FREE TABLE SLOT
	TLON	DB,TMPFL2	; IF WE HAVEN' FOUND ONE BEFORE,
	PUSH	SP,A2		;  SAVE ITS ADDRESS

GET25:	AOBJN	A2,GET21	; GET NEXT TABLE ENTRY.
	SKIPN	(A2)		; ANY MORE BITS OF TABLE ?
	JRST	GET25A		; NO.
	MOVE	A2,(A2)
	JRST	GET21		; YES - GO USE IT

GET25A:	TLNE	DB,TMPFL2	; NEED TO DECREMENT STACK ?
	POP	SP,A3		; YES
	TLNE	DB,TMPFL1	; STILL GOT TO PLANT TABLE ENTRY ?
	JRST	GET99		; NO - ALL OVER
	TLNE	DB,TMPFL2	; WAS THERE A FREE SLOT ?
	JRST	GET26		; YES - GO USE IT
	PUSH	SP,A0		; NO FREE SPACE IN TABLE: MUST GET ANOTHER PIECE
	PUSH	SP,A1		;  & CHAIN IT ON
	PUSH	SP,A2		;   (RECURSIVE, SO SAVE EVERYTHING)
	MOVEI	A0,HPCHN
	PUSHJ	SP,GETCLR	; GET IT, ZEROED (NOTE: NO WAY WILL THIS
				;  NEED ANOTHER TABLE SLOT !!)
	POP	SP,A2		; ADDRESS OF LAST WORD OF OLD PIECE
	MOVEI	A0,1-HPCHN	; LENGTH (LESS LINK-WORD) OF NEW PIECE
	HRL	A1,A0		; FORM LINK-WORD
	MOVEM	A1,(A2)		;  AND STORE IT AT END OF OLD PIECE
	MOVEI	A3,(A1)		; ADDR OF 1ST WORD OF NEW PIECE
	POP	SP,A1
	POP	SP,A0
GET26:	HLL	A1,(A1)		; LENGTH OF SPACE
	MOVEM	A1,(A3)		; MAKE TABLE ENTRY
	HLL	A3,A1		; AND BACK-POINTER
	MOVEM	A3,(A1)
	JRST	GET97
GET3:	PUSHJ	SP,GETTOP	; [E062] GET TOPMOST CHUNK
	  JRST	GET33		; [E062] NOT AVAILABLE
	HLLZS	(A1)		; CLEAR CHAIN WORD
	JRST	GET97

GET33:	PUSH	SP,DB		; SAVE CURRENT STACK BASE
	CCORE1	^D128		; SHIFT STACK 128 WORDS
	POP	SP,A1		; NOW OLD STACK BASE
	HRLZI	A2,^D128	; LOAD COUNT
	MOVEM	A2,0(A1)	; SET CHAIN WORD

GET97:	MOVEI	A1,1(A1)	; FIRST USEFUL WORD

GET99:
IFN FTGETCHK,<			;[251] CHECK HEAP TABLE CONSISTENCY
;[251] SCAN THE HEAP, INSURING THAT NO ENTRY OVERLAPS ANY OTHER.  A2 POINTS
;[251] TO THE REFERENCE ENTRY BEING CHECKED, AND A3 SCANS THROUGH THE TABLE.
;[251] FIRST, THE UPPER ADDRESS LIMIT OF THE ENTRY POINTED TO BY A3 IS CHECKED
;[251] TO SEE IF IT IS LESS THAN OR EQUAL TO THE LOWER ADDRESS LIMIT OF THE
;[251] REFERENCE ENTRY.  IF IT IS NOT, THEN ANOTHER CHECK IS MADE TO SEE
;[251] IF THE LOW ADDRESS LIMIT IS GREATER THAN OR EQUAL TO THE UPPER ADDRESS
;[251] LIMIT OF THE REFERENCE ENTRY.  IF IT IS, THEN THE ENTRY IS OK.  IF IT
;[251] IS NOT, THEN SOME PARTS OF EACH TABLE ENTRY OVERLAP AND THE TABLE IS BAD.
;[251] THE ENTIRE TABLE IS SCANNED AND EACH ENTRY COMPARED TO EVERY OTHER
;[251] ONE.  THIS ADDS CONSIDERABLE OVERHEAD AND SHOULD NOT NORMALLY BE USED.
	PUSH	SP,A4		;[251] SAVE A4 FOR HEAP ANALYSIS
	PUSH	SP,A5		;[251] AND A5
	MOVE	A2,%SYS2(DB)	;[251] GET HEAP TABLE PTR.
GET000:	MOVE	A3,A2		;[251] COPY AOBJN PTR. TO TABLE
	AOBJP	A3,GET002	;[251] START SCANNING AT NEXT ENTRY UNLESS DONE
GET001:	SKIPN	A4,(A2)		;[251] GET REFERENCE ENTRY'S LOW ADDRESS LIMIT
	JRST	GET003		;[251] NULL ENTRY, SKIP IT
	TLZ	A4,-1		;[251] CLEAR LENGTH OUT OF LEFT HALF
	SKIPN	A5,(A3)		;[251] GET NEXT HEAP COMPARISON ENTRY
	JRST	GETNXT		;[251] NULL, SKIP IT
	SUBI	A4,(A5)		;[251] NON-NULL, CHECK IT
	HLRZS	A5		;[251] MAKE 0,,LENGTH OUT OF HEAP ENTRY
	SUB	A4,A5		;[251] IS AREA'S TOP ADDR. ABOVE BOTTOM ADDR.?
	JUMPGE	A4,GETNXT	;[251] NO, ENTIRE SPACE IS BELOW, WE'RE SAFE
	HRRZ	A5,(A3)		;[251] YES, CHECK OVERLAP ON OTHER SIDE TOO
	MOVE	A4,(A2)		;[251] GET CURRENT TABLE ENTRY
	SUBI	A5,(A4)		;[251] GET DIFFERENCE
	HLRZS	A4		;[251] MAKE 0,,LENGTH OF CURRENT ENTRY
	SUB	A5,A4		;[251] DO AREAS OVERLAP AT ALL?
	JUMPL	A5,GETERR	;[251] YES HEAP TABLE IS BAD
GETNXT:	AOBJN	A3,GET001	;[251] NO, STEP TO NEXT ENTRY IN HEAP TABLE
GET002:	SKIPE	A3,(A3)		;[251] UNLESS DONE WITH THIS PART OF TABLE
	JRST	GET001		;[251] MORE TABLE, GO USE IT
GET003:	AOBJN	A2,GET000	;[251] STEP TO NEXT REFERENCE TABLE ENTRY
	SKIPE	A2,(A2)		;[251] UNLESS DONE WITH THIS PART OF TABLE
	JRST	GET000		;[251] CONTINUE IF MORE TABLE EXISTS
	POP	SP,A5		;[251] RESTORE AC'S
	POP	SP,A4		;[251]
>  ;[251] END IFN FTGETCHK
	POP	SP,A3	
	POP	SP,A2		; [E062] RESTORE A2
	POPJ	SP,

GETTOP:	HRRZ	A1,(A2)		; GET POINTER
	CAIGE	A0,(A1)		;
	MOVEI	A0,(A1)		; THIS ENTRY IS HIGHER
	AOBJN	A2,GETTOP
	SKIPE	A2,(A2)		; MORE TABLE ?
	JRST	GETTOP		; YES - USE IT
	JUMPL	A0,CPOPJ	; NONE FREE
	HRRZ	A1,A0		; HIGHEST ENTRY (ADDR OF SPACE)
	HLRZ	A0,(A1)		; LENGTH
	ADDI	A0,(A1)		; PLUS ADDR
	CAIE	A0,(DB)		; IS IT THE TOP ?
	POPJ	SP,		; [E062] NO  - JUST RETURN
	AOS	(SP)		; [E062] YES - SKIP RETURN
	HRRZ	A2,(A1)		; O.K.-GIVE IT AWAY
	SETZM	(A2)		; CLEAR TABLE ENTRY
CPOPJ:	POPJ	SP,		; [E062] RETURN
GETOWN:	MOVE	A2,%SYS2(DB)	; GET POINTER TO PUBLIC HEAP-TABLE
	PUSHJ	SP,GETKNL	; DO THE JOB
	IFN	FTGETCHK,<
	; ***** OPTIONAL HEAP INTEGRITY CHECKER *****

	SKIPE	%SYSOV(DB)	; FUNCT PRIVATE HEAP CHANGES
	JRST	GETX9		;  FORMAT OF OUR HEAP, SO WE CAN'T CHECK IT
	PUSH	SP,A3
	PUSH	SP,A1
	SETZ	A1,
	HRRZ	A2,%SYS2(DB)
	HLRE	A3,%SYS2(DB)	; - (LENGTH OF LIST -1)
	SUBI	A2,-1(A3)
	TLZ	A2,-1		; CLEAR LEFT HALF

GETX2:	MOVE	A3,(A2)
	TRNE	A3,-1		; ANY RIGHT HALF ?
	AOJA	A1,GETX1	; YES - UNNUSED - CHECK TABLE CONSISTENT

GETX3:	HLRZ	A0,A3		; GET SIZE
	JUMPE	A0,GETERR	; [263] ERROR IF ENTRY IS ZERO
	ADD	A2,A0		; MOVE TO NEXT CHUNK
	CAIGE	A2,(DB)		; END ?
	JRST	GETX2		; NO - CHECK NEXT CHUNK
	CAIE	A2,(DB)		; EXACTLY THERE ?
	JRST	GETERR		; NO
	CAML	A1,%SYS24(DB)	; KEEP TRACK OF
	MOVEM	A1,%SYS24(DB)	;  MAX # OF USED ENTRIES

GETX4:	POP	SP,A1		;   IN HEAP TABLE
	POP	SP,A3
	JRST	GETX9		; YES - IT'S ALL OK !!!

GETX1:	HRRZ	A0,A3		; [263] GET ADDRESS OF ENTRY
	CAIL	A0,(DB)		; [263] LEGITIMATE?
	JRST	GETERR		; [263] NO, ERROR
	HLL	A0,A3		; SIZE FROM LINK-WORD
	HRR	A0,A2		; ADDRESS OF CHUNK
	CAMN	A0,(A3)		; = TABLE-ENTRY ?
	TLNN	A0,-1		; AND NON-ZERO SIZE ?
	JRST	GETERR		; NOPE
	JRST	GETX3		; YES - OK

GETX9:	>	; END OF FTGETCHK
	SETZ	A0,		; THE OUTSIDE WORLD EXPECTS A0 = 0 (FOR DELETE)
	POPJ	SP,

	IFN	FTGETCHK,<
GETERR:	OUTSTR	[ASCIZ/
?ALGCEH CONSISTENCY ERROR IN HEAP HANDLER/]  ;[251]
	EXIT>			;[251]
SUBTTL GETCLR - GET ZERO-FILLED OWN SPACE

GETCLR:	PUSHJ	SP,GETOWN	; GET THE SPACE
	SETZM	(A1)
	HLRZ	A2,-1(A1)	; GET LENGTH OF SPACE
	SUBI	A2,2
	JUMPE	A2,GETCL2	; ONLY 1 WORD - DONE
	MOVEI	A5,1(A1)	; MAKE A
	HRL	A5,A1		;  BLT POINTER
	ADDI	A2,(A1)
	BLT	A5,(A2)		; ZEROES

GETCL2:	POPJ	SP,
SUBTTL RDOCT/PROCT - READ OCTAL WORD/PRINT OCTAL HALFWORD ROUTINES

; AN OCTAL WORD IS READ AND RETURNED IN A0

RDOCT:	SETZB	A0,A1		; CLEAR ACCUMULATOR AND DIGIT FLAG
	PUSHJ	SP,IGNICH	; IGNORE INVISIBLE  CHARACTERS
	CAIN	A13,"%"		; OCTAL MARKER?
	JRST	RDOCT1		; YES - OK

RDOCT4:	HLRZ	A1,%CHAN(DB)	; GET CHANNEL #
	IOERR	10,(A1)		; GO TO ERROR

RDOCT1:	JSP	AX,INCHR0	; [E145] GET NEXT CHARACTER
	CAIL	A13,"0"
	CAIL	A13,"8"		; IN RANGE 0 - 7?
	JRST	RDOCT3		; NO
	TLNE	A0,700000	; YES - TOP OIT SET?

RDOCT2:	SYSER2	3,0		; YES - COMPLAIN ABOUT OVERFLOW
	LSH	A0,3		; NO - SHIFT UP
	ADDI	A0,-"0"(A13)	; AND ADD IN OIT
	JOV	RDOCT2		; AND CHECK FOR OVERFLOW
	AOJA	A1,RDOCT1	; COUNT DIGITS AND CONTINUE

RDOCT3:	JUMPE	A1,RDOCT4	; TERMINATOR - DIGIT SEEN?
	POPJ	SP,0		; YES - EXIT

; ON ENTRY, THE HALFWORD IS IN A1

SPROCT:	MOVNI	A0,1		; SPECIAL ENTRY FOR CHANNEL -1
	EXCH	A0,%CHAN(DB)
	PUSHJ	SP,PROCT
	MOVEM	A0,%CHAN(DB)	; RESTORE CHANNEL NUMBERS
	POPJ	SP,0

PROCT:	MOVE	A2,[
	POINT	3,A1,17]	; SET UP BYTE POINTER
	MOVEI	A3,6		; AND BYTE COUNT

PROCT1:	ILDB	A13,A2		; GET NEXT OIT
	ADDI	A13,"0"		; ADD ASCII OFFSET
	JSP	AX,OUCHAR	; AND PRINT IT
	SOJN	A3,PROCT1	; ANY MORE OITS?
	POPJ	SP,0		; NO - EXIT
SUBTTL IO CONTROL BITS

; INBYTE FLAG BITS (LH OF CHANNEL NUMBER)

	BYTLA=400000		; LOOK AHEAD REQUIRED (MUST BE BIT 0)

; OUBYTE FLAG BITS (LH OF CHANNEL NUMBER)

	OPTR=400000		; BREAK OUTPUT

; CHANNEL BITS (RH OF CHANNEL NUMBER)

	LOGCHN=000020		; LOGICAL CHANNEL

; CONTROL AREA OFFSETS

	STRPTR=0		; STRING POINTER
	BYTPTR=1		; BYTE POINTER
	BYTCNT=2		; BYTE COUNT
	BDDOFF=3		; BIDIRECTIONAL DEVICE OUTPUT AREA OFFSET
	DEVNAM=3		; DEVICE NAME
	FILNAM=4		; FILE NAME
	FILEXT=5		; FILE EXTENSION
	FILPRT=6		; FILE PROTECTION
	FILPP=7			; FILE PROJECT-PROGRAMMER NUMBER
	DEVCAL=4		; DEVICE CONTROL AREA LENGTH
	FILCAL=4		; FILE CONTROL AREA LENGTH
SUBTTL INBYTE - BYTE INPUT ROUTINE

; INBYTE - NORMAL ENTRY
; NXTBYT - LOOK AHEAD ENTRY
; NON-SKIP EXIT FOR END-OF-FILE
; OK SKIP EXIT WITH BYTE IN A13
; USES A10,A11,A12,A13

; READ BLOCK FROM PHYSICAL DEVICE ROUTINE

INBLK:	SUBI	A10,(DB)	; DE-RELOCATE CHANNEL NUMBER
	HRLZI	A12,<IN>B53
	DPB	A10,[POINT 4,A12,12]  ; CONSTRUCT IN UUO
	XCT	A12		; AND READ BLOCK
	JRST	INBLK1		; OK
	MOVE	A12,[STATZ 740000]
	DPB	A10,[POINT 4,A12,12]  ; CONSTRUCT STATZ UUO
	XCT	A12		; AND GET STATUS

INBLK2:	IOERR	7,(A10)		; ERROR - REPORT IT
	AOS	(SP)		; EOF - SET UP SKIP RETURN
	JRST	INBLK3

INBLK1:	SKIPN	BYTCNT(A11)	; CHECK BYTE COUNT (TTY CROCK!)
	JRST	INBLK2		; NO BYTES

	;
	; Edit(1010)  Ignore nulls at start of buffer.
	;
	TLNN	A11,ABMODE	; [E1010] ASCII MODE ?
	JRST	INBLK3		; [E1010] NO - CONTINUE
INBLK4:	MOVE	A12,BYTPTR(A11)	; [E1010] YES - GET BYTE POINTER
	ILDB	A12,A12		; [E1010] GET FIRST BYTE OF BUFFER
	JUMPN	A12,INBLK3	; [E1010] NULL?
	IBP	BYTPTR(A11)	; [E1010] YES - SKIP IT
	SOSN	BYTCNT(A11)	; [E1010] BUFFER EMPTY ?
	JRST	INBLK+1		; [216][E1010] YES - GET ANOTHER
	JRST	INBLK4		; [E1010] NO -TRY NEXT BYTE

INBLK3:	ADDI	A10,(DB)	; RELOCATE CHANNEL NUMBER
	POPJ	SP,0

INBYTE:	TDZA	A10,A10		; NORMAL ENTRY
NXTBYT:	HRLZI	A10,BYTLA	; LOOK-AHEAD ENTRY
	HLR	A10,%CHAN(DB)	; GET CHANNEL NUMBER
	MOVEI	A13,(A10)	; SAVE FOR ERROR-MESSAGES
	ADDI	A10,(DB)	; AND RELOCATE IN DATA BASE
	SKIPN	A11,%IODR(A10)	; CHANNEL DEFINED?
	IOERR	2,(A13)		; NO - COMPLAIN
	TLNE	A11,INEOF	; END-OF-FILE?
	POPJ	SP,0		; YES - TAKE ERROR RETURN
	TLNE	A11,TTYDEV	; TTY DEVICE?
	JRST	INBT6		; YES
	JUMPG	A11,INBT14	; LOGICAL DEVICE?
	TLNE	A11,INOK	; NO - OK TO READ?
	JRST	INBT1		; YES
	TLNN	A11,ININT	; INITED FOR INPUT?
	IOERR	2,(A13)		; NO - FORBID INPUT
	TLNN	A11,DIRDEV	; DIRECTORY DEVICE?
	JRST	.+3		; NO
	TLNN	A11,INFIL	; YES - FILE OPEN
	IOERR	3,(A13)		; NO
	PUSHJ	SP,INBLK	; READ FIRST BLOCK
	JRST	INBT16		; NOT EOF
	TLO	A11,INEOF
	MOVEM	A11,%IODR(A10)	; EOF - SET FLAG
	POPJ	SP,0		; AND TAKE ERROR RETURN - A13 = CHAN #

INBT16:	TLO	A11,INOK	; SET INOK FLAG
	MOVEM	A11,%IODR(A10)

INBT1:	JUMPG	A10,INBT4	; LOOK AHEAD?

INBT2:	MOVE	A13,BYTPTR(A11)	; YES - GET BYTE POINTER
	ILDB	A13,A13		; AND GET NEXT BYTE

INBT3:	AOS	(SP)		; OK SKIP RETURN
	POPJ	SP,0

INBT4:	ILDB	A13,BYTPTR(A11)	; NO - GET NEXT BYTE
	SOSN	BYTCNT(A11)	; ANY BYTES LEFT IN BUFFER
	JRST	INBT5		; NO
	TLNN	A11,ABMODE	; YES - ASCII MODE?
	JRST	INBT3		; NO - EXIT

INBT17:	MOVE	A12,BYTPTR(A11)
	ILDB	A12,A12		; YES - LOOK AT NEXT BYTE
	JUMPN	A12,INBT3	; EXIT UNLESS NULL
	IBP	BYTPTR(A11)	; IF SO
	SOSE	BYTCNT(A11)	; SEARCH FOR NON-NULL
	JRST	INBT17

INBT5:	PUSHJ	SP,INBLK	; READ NEXT BLOCK
	JRST	INBT3		; OK

INBT15:	TLO	A11,INEOF	; END-OF-FILE
	MOVEM	A11,%IODR(A10)
	JRST	INBT3		; SET EOF FLAG BUT EXIT OK

INBT6:	TLNE	A11,INOK	; TTY - OK TO READ?
	JRST	INBT12		; YES
	TLNE	A11,TTYTTC	; NO - ON TTCALL?
	JRST	INBT7		; YES
	PUSHJ	SP,INBLK	; NO - READ NEXT BLOCK
	JRST	INBT11		; OK
	MOVEI	A13,CONZ	; EOF - GIVE THE USER A CONTROL-Z
	JRST	INBT15
INBT7:	MOVE	A12,[POINT 7,%IBUFF(DB)]; SET UP TTCALL BYTE POINTER
	MOVEM	A12,%TTY+BYTPTR(DB)
	MOVEI	A11,1		; INITIALIZE BYTE COUNT
	INCHWL	A13		; [255] GET FIRST CHARACTER
INBT8:	IDPB	A13,A12		; [255] STORE BYTE IN BUFFER
	CAIGE	A11,^D80	; [255] BUFFER FULL?
	INCHSL	A13		; [255] NO, GET NEXT CHR. IF ANY
	 JRST	INBT10		; [255] YES, OR END-OF-LINE
	AOJA	A11,INBT8	; [255] AND LOOP

INBT10:	HRRI	A10,-1(DB)	; POINT A10 TO CHANNEL -1
	MOVEM	A11,%TTY+BYTCNT(DB)
				; STORE BYTE COUNT
	MOVE	A11,%IODR(A10)	; RESTORE CHANNEL FLAGS

INBT11:	TLO	A11,INOK	; SET OK TO READ
	MOVEM	A11,%IODR(A10)

INBT12:	JUMPL	A10,INBT2	; LOOK AHEAD?
	ILDB	A13,BYTPTR(A11)	; NO - GET BYTE
	SOSN	BYTCNT(A11)	; AND DECREMENT BYTE COUNT
	JRST	INBT13		; END OF BUFFER
	MOVE	A12,BYTPTR(A11)
	ILDB	A12,A12		; LOOK AT NEXT BYTE
	JUMPN	A12,INBT3	; AND EXIT UNLESS NULL

INBT13:	TLZ	A11,INOK
	MOVEM	A11,%IODR(A10)	; CLEAR INOK FLAG
	JRST	INBT3		; BUT EXIT OK

INBT14:	JUMPL	A10,INBT2	; LOGICAL DEVICE - LOOK AHEAD?
	ILDB	A13,BYTPTR(A11)	; NO - GET BYTE
	SOSE	BYTCNT(A11)	; ANY MORE?
	JRST	INBT3		; YES
	JRST	INBT15		; NO
SUBTTL OUBYTE - BYTE OUTPUT ROUTINE

; ENTRY WITH BYTE IN A13
; NON-SKIP EXIT FOR END-OF-FILE
; OK SKIP EXIT
; USES A10,A11,A12,A13

; WRITE BLOCK TO PHYSICAL DEVICE ROUTINE

OUTBLK:	SUBI	A10,(DB)	; DE-RELOCATE CHANNEL NUMBER
	HRLZI	A12,<OUT>B53
	DPB	A10,[
	POINT	4,A12,12]	; CONSTRUCT OUT UUO
	XCT	A12		; AND WRITE BLOCK
	JRST	OUBLK1		; OK
	MOVE	A12,[
	STATZ	0,700000]
	DPB	A10,[
	POINT	4,A12,12]	; CONSTRUCT STATZ UUO
	XCT	A12		; AND GET STATUS

OUBLK2:	IOERR	7,(A10)		; ERROR - REPORT IT
	AOS	(SP)		; EOF ETC. - SET UP SKIP RETURN
	JRST	OUBLK3

OUBLK1:	SKIPN	BYTCNT(A11)	; CHECK BYTE COUNT (TTY CROCK!)
	JRST	OUBLK2

OUBLK3:	ADDI	A10,(DB)	; RELOCATE IO CHANNEL NUMBER
	POPJ	SP,0

OUBYTE:	TDZA	A10,A10		; NORMAL ENTRY
BRKBYT:	HRLZI	A10,OPTR	; BREAK OUTPUT ENTRY
	HRR	A10,%CHAN(DB)	; GET CHANNEL NUMBER
	MOVEI	A12,(A10)	; SAVEE FOR ERROR MESSAGES
	ADDI	A10,(DB)	; AND RELOCATE IN DATA BASE
	SKIPN	A11,%IODR(A10)	; CHANNEL DEFINED?
	IOERR	2,(A12)		; NO - COMPLAIN
	TLNE	A11,OUTEOF	; LOGICAL EOF?
	POPJ	SP,0		; YES - TAKE ERROR RETURN
	JUMPG	A11,OUBT6	; LOGICAL DEVICE?
	TLNE	A11,TTYDEV	; NO - TTY DEVICE?
	ADDI	A11,BDDOFF	; YES - OUTPUT OFFSET
	TLNE	A11,OUTOK	; OK TO WRITE?
	JRST	OUBT2		; YES
	TLNN	A11,OUTINT	; INITED FOR OUTPUT?
	IOERR	2,(A12)		; NO - FORBID OUTPUT
	TLNN	A11,DIRDEV	; DIRECTORY DEVICE?
	JRST	.+3		; NO
	TLNN	A11,OUTFIL	; YES - FILE OPEN?
	IOERR	3,(A12)		; NO
	TLNE	A11,TTYTTC	; TTY ON TTCALL?
	PUSHJ	SP,OUBT10	; YES - INITIALIZE (SKIP RETURN)
	PUSHJ	SP,OUTBLK	; DO FIRST OUT
	JRST	OUBT1		; OK
	TLO	A11,OUTEOF	; EOF
	MOVEM	A11,%IODR(A10)	; SET OUTEOF FLAG
	HRRZ	A13,%CHAN(DB)	; GET CHANNEL NUMBER
	POPJ	SP,0		; AND GIVE ERROR RETURN - A13 = CHAN #

OUBT1:	TLO	A11,OUTOK	; SET OK TO WRITE
	HLLM	A11,%IODR(A10)

EDIT(112); Don't make REDIRECTed files unnecessarily large
OUBT2:	TLNE	DB,INDDT	; [E112] If called from ALGDDT, and
	TLNE	A11,TTYDEV!TTYTTC;[E112] not going to terminal, ignore.
EDIT(174); do not duplicate last byte is redirected dump mode
	JRST	OUBT11		;[174] NOT ALGDDT CASE (USE EXISTING CODE)
	JUMPL	A10,OUBT3	;[174] ALGDDT CASE AND BREAK OUTPUT (IGNORE)
	JRST	OUBT12		;[174] ALGDDT CASE AND OUTBYTE
OUBT11:	JUMPL	A10,OUBT4	;[174] BREAK OUTPUT?
OUBT12:	TLNE	A11,TTYTTC	; [255] NO, IF TTY DON'T SEND NULL BYTES
	JUMPE	A13,OUBT3	; [255] JUMP IF NULL
	IDPB	A13,BYTPTR(A11)	;[174] NO - PLANT BYTE
	SOSN	BYTCNT(A11)	; DECREMENT BYTE COUNT
	JRST	OUBT4		; EXPIRED

OUBT3:	AOS	(SP)		; OK - SKIP RETURN
	POPJ	SP,0

OUBT4:	TLNE	A11,TTYTTC	; TTY ON TTCALL?
	JRST	OUBT5		; YES
	PUSHJ	SP,OUTBLK	; NO - WRITE BLOCK
	JRST	OUBT3		; OK
	TLO	A11,OUTEOF
	HLLM	A11,%IODR(A10)	; SET OUTEOF FLAG
	JRST	OUBT3

OUBT5:	MOVEI	A13,0
	IDPB	A13,%TTY+BDDOFF+BYTPTR(DB)
				; PLANT NULL TERMINATING BYTE
	TTCALL	3,%OBUFF(DB)	; AND OUTPUT BUFFER

OUBT10:	HRLZI	A12,440700
	HRRI	A12,%OBUFF(DB)	; SET UP INITIAL BYTE POINTER
	MOVEM	A12,%TTY+BDDOFF+BYTPTR(DB)
	MOVEI	A12,122		; AND INITIAL BYTE COUNT
	MOVEM	A12,%TTY+BDDOFF+BYTCNT(DB)
	JRST	OUBT3

OUBT6:	JUMPL	A10,OUBT7	; BREAK OUTPUT?
	IDPB	A13,BYTPTR(A11)	; NO - PLANT BYTE
	SOSE	BYTCNT(A11)	; DECREMENT BYTE COUNT
	JRST	OUBT3		; STILL OK

OUBT9:	TLO	A11,OUTEOF
	MOVEM	A11,%IODR(A10)	; SET EOF FLAG
	JRST	OUBT3

OUBT7:	MOVEI	A13,0		; BREAK OUTPUT

OUBT8:	SOSGE	BYTCNT(A11)
	JRST	OUBT9
	IDPB	A13,BYTPTR(A11)	; FILL UP WITH NULL BYTES
	JRST	OUBT8
SUBTTL READ - READ NUMBER ROUTINE

; ON ENTRY A2 = MODE REQUIRED:

;	0	INTEGER
;	1	REAL
;	2	LONG REAL
;	4	ANY (AS IT COMES)

; ON EXIT THE NUMBER IS IN

;	A0	INTEGER OR REAL
;	A0,A1	LONG REAL

; AND IF THE ENTRY WAS 'ANY', THE TYPE IS IN A2

; FLAGS (LH OF A2):

	DECPNT=400000		; DECIMAL POINT SEEN (MUST BE BIT 0)
	IGNDIG=200000		; IGNORE DIGITS
	MANDIG=100000		; DIGIT SEEN IN MANTISSA
	EXPDIG=040000		; DIGIT SEEN IN EXPONENT
	MANSGN=020000		; MANTISSA SIGN
	EXPSGN=010000		; EXPONENT SIGN
	EXPOVL=004000		; EXPONENT OVERFLOW

; TYPES (LH AND RH OF A2):

	SREAL=1			; REAL
	LREAL=2			; LONG REAL
	ANY=4			; ANY
; SERVICE ROUTINES FOR READ

; SUPPLIES ASCII BYTE IN A13
; LINK IS IN AX

INCHAR:
	TLNE	DB,INDDT	; IF DDT 
	  JRST	DDTIN%		;  LET HIM DO IT.
	PUSHJ	SP,INBYTE	; GET NEXT BYTE
	IOERR	6,(A13)		; END OF FILE - A13 = CHAN #
	JRST	CNC.AX

	;
	EDIT(145) ; Make EOF a terminator.
	;
INCHR0:	TLNE	DB,INDDT	; [E145] If in DDT
	  JRST	DDTIN%		; [E145] ..then let him do it.
	PUSHJ	SP,INBYTE	; [E145] Get next byte.
EDIT (206); IF TRAPPING FOR EOF, USE TRAP
	SKIPA			;[206] EOF, CHECK TO SEE IF WE ARE TRAPPING IT
	JRST	CNC.AX		; [E145]
	PUSH	SP,A13		;[206] SAVE THE CHANNEL NUMBER
	MOVEI	A13,^D38	;[206] CHECK TO SEE IF WE ARE TRAPPING EOF
	ADDI	A13,(DB)	;[206] RELOCATE THE TRAP NUMBER IN THE D.B.
	HRRZ	A13,%TRAPS(A13)	;[206] GET ADDRESS OF TRAP BLOCK, OR ZERO
	SKIPN	A13		;[206] SKIP IF A TRAP IS SET HERE
	 JRST	INCHR1		;[206] NONE SET, GIVE A LF
	POP	SP,A13		;[206] TRAP SET, RESTORE CHANNEL NUMBER
	IOERR	6,(A13)		;[206] AND GIVE THE ERROR
	JRST	CNC.AX		;[206] AND RETURN
INCHR1:	POP	SP,A13		;[206] NO TRAP SET, RETURN LF LIKE EDIT 145
	MOVEI	A13,LF		;[206] AFTER POPPING THE STACK
	JRST	CNC.AX		;[206] RETURN WITH FREE LF
; IGNORE INVISIBLE CHARACTERS

IGNICH:	JSP	AX,INCHAR	; GET CHARACTER
IGN0:	JUMPE	A13,IGNICH	; IGNORE NULLS
	CAIE	A13," "
	CAIN	A13,"	"
	JRST	IGNICH		; IGNORE SPACES AND TABS
	CAIL	A13,LF
	CAILE	A13,CR
	POPJ	SP,0
	JRST	IGNICH		; IGNORE CR, LF, VT AND FF
READ.:	HLRZ	A1,%CHAN(DB)	; GET CURRENT INPUT CHANNEL NUMBER
	ADDI	A1,(DB)
	MOVE	A1,%IODR(A1)	; GET CHANNEL ENTRY
	TLNN	A1,ABMODE	; ASCII OR BINARY?
	JRST	READ37		; BINARY
	SETZB	A0,A1		; CLEAR ACCUMULATORS
	SETZB	A3,A4		; CLEAR DECIMAL PLACE COUNT
				; AND BINARY EXPONENT CORRECTION
	HRL	A2,A2		; COPY FLAGS TO LH OF A2
	ANDCMI	A2,ANY		; AND CLEAR ANY FLAG IN RH
	PUSHJ	SP,IGNICH	; IGNORE INVISIBLE CHARACTERS
	CAIN	A13,"+"		; LEADING "+"?
	JRST	READ1		; YES
	CAIE	A13,"-"		; LEADING "-"?
	JRST	READ2		; NO
	TLO	A2,MANSGN	; YES - FLAG MANTISSA NEGATIVE

READ1:	JSP	AX,INCHR0	; [E145] GET NEXT CHARACTER

READ2:	CAIL	A13,"0"
	CAIL	A13,"0"+^D10	; IN RANGE 0 - 9?
	JRST	READ10		; NO
	TLNE	A2,IGNDIG	; YES - IGNORE DIGIT?
	JRST	READ8		; YES
	TLO	A2,MANDIG	; NO - FLAG DIGIT SEEN
	HLRZ	AX,READ13(A2)
	JRST	CNC.AX		; USE APPROPRIATE SEQUENCE

; INTEGER NUMBER SEQUENCE

READ3:	MOVE	A0,A1
	IMULI	A1,^D10		; MULTIPLY BY TEN
	JOV	READ4		; OVERFLOW?
	ADDI	A1,-"0"(A13)	; NO - ADD IN DIGIT
	JOV	READ4		; OVERFLOW NOW?
	JRST	READ1		; NO - OK

READ4:	IORI	A2,LREAL	; CONVERT TO LONG REAL
	MOVE	A1,A0		; RESTORING OLD MANTISSA
	MOVEI	A0,0		; IN LONG FORM
; LONG REAL NUMBER SEQUENCE

READ5:	MOVE	A7,A0
	MOVE	A5,A1
	MULI	A5,^D10		; MULTIPLY LOW ORDER WORD BY TEN
	IMULI	A0,^D10		; MULTIPLY HIGH ORDER WORD BY TEN
	EXCH	A6,A1		; REPLACE OLD LOW ORDER WORD BY NEW ONE,
				; AND SAVE OLD ONE
	ADD	A0,A5		; ADD CARRY INTO HIGH ORDER WORD
	TLO	A1,400000	; FLAG LOW ORDER WORD
	ADDI	A1,-"0"(A13)	; AND ADD IN DIGIT
	TLZN	A1,400000	; AND IF CARRY OCCURED
	ADDI	A0,1		; INCREMENT HIGH ORDER WORD
	TLNE	A0,777000	; NUMBER TOO LARGE?
	JRST	READ7		; YES

READ6:	JUMPGE	A2,READ1	; NO - DECIMAL POINT SEEN?
	SOJA	A3,READ1	; YES - INCREMENT DECIMAL PLACE COUNT

READ7:	TLO	A2,IGNDIG	; SET IGNORE DIGIT FLAG
	MOVE	A0,A7
	MOVE	A1,A6		; AND RESTORE OLD MANTISSA
	CAIGE	A13,"5"		; DIGIT >= 5?
	JRST	READ8		; NO
	TLO	A1,400000	; YES - FLAG LOW ORDER WORD
	ADDI	A1,1		; AND INCREMENT IT
	TLZN	A1,400000	; AND IF CARRY OCCURED
	ADDI	A0,1		; INCREMENT HIGH ORDER WORD
	TLNN	A0,777000	; TOO BIG NOW?
	JRST	READ8		; NO
	ASHC	A0,-1		; YES - SHIFT IT DOWN
	ADDI	A4,1		; AND INCREMENT BINARY EXPONENT CORRECTION

READ8:	JUMPL	A2,READ1	; DECIMAL POINT SEEN?
	AOJA	A3,READ1	; NO - DECREMENT DECIMAL PLACE COUNT
; REAL NUMBER SEQUENCE

READ9:	MOVE	A0,A1
	IMULI	A1,^D10		; MULTIPLY BY TEN
	ADDI	A1,-"0"(A13)	; AND ADD IN DIGIT
	TLNN	A1,777000	; TOO LARGE?
	JRST	READ6		; NO
	TLO	A2,IGNDIG	; YES - SET IGNORE DIGIT FLAG
	MOVE	A1,A0		; AND RESTORE OLD MANTISSA
	CAIGE	A13,"5"		; DIGIT >= 5?
	JRST	READ8		; NO
	ADDI	A1,1		; YES - INCREMENT MANTISSA
	TLNN	A1,777000	; TOO BIG NOW?
	JRST	READ8		; NO
	ASH	A1,-1		; YES - SHIFT IT DOWN
	AOJA	A4,READ8	; AND INCREMENT BINARY EXPONENT CORRECTION

READ10:	CAIE	A13,"."		; DECIMAL POINT?
	JRST	READ12		; NO
	TLOE	A2,DECPNT	; ALREADY FOUND?
	JRST	READ21		; YES - GO AND COMPLAIN
	MOVEI	AX,READ1	; SET RETURN LINK

; SMALL SUBROUTINE FOR CONVERTING INTEGER TO REAL OR LONG REAL

READ11:	TRNE	A2,SREAL!LREAL	; INTEGER TYPE?
	JRST	CNC.AX		; NO - RETURN
	TLNN	A1,777000	; LONG MANTISSA?
	TROA	A2,SREAL	; NO - SET REAL TYPE
	IORI	A2,LREAL	; YES - SET LONG REAL TYPE
	MOVEI	A0,0		; CLEAR HIGH ORDER WORD
	JRST	CNC.AX		; AND EXIT

; END OF MANTISSA SEQUENCE

READ12:	CAIE	A13,"&"		; IS IT "&"
	CAIN	A13,"@"		; OR "@"?
	JRST	READ15		; YES
	CAIE	A13,"E"		; IS IT "E" (FOR FORTRAN'S SAKE)
	CAIN	A13,"D"		; OR "D"?
	JRST	READ16		; YES
	CAIE	A13,"+"		; CHECK FOR
	CAIN	A13,"-"		; ILLEGAL TERMINATORS
	JRST	READ21		; AND COMPLAIN IF FOUND
	TLNN	A2,MANDIG	; WAS THERE A MANTISSA?
	JRST	READ21		; NO - COMPLAIN
	MOVE	A5,A0
	MOVE	A6,A1		; TAKE COPY OF MANTISSA
	HRRZ	AX,READ13(A2)
	JRST	CNC.AX		; AND USE APPROPRIATE SEQUENCE
READ13:	XWD	READ3,READ14	; SEQUENCE DISPATCH TABLE
	XWD	READ9,READ23
	XWD	READ5,READ27

; INTEGER TERMINAL SEQUENCE

READ14:	MOVE	A0,A1
	TLNE	A2,MANSGN	; SHOULD IT BE NEGATIVE?
	MOVN	A0,A0		; YES - NEGATE
	JRST	READ35		; PROCEDE TO EXIT SEQUENCE

; EXPONENT SEQUENCE

READ15:	JSP	AX,INCHR0	; [E145] "&" OR "@" FOUND
	CAIE	A13,"&"
	CAIN	A13,"@"		; ANOTHER ONE?
	JRST	READ16		; YES
	PUSHJ	SP,IGN0		; IGNORE ANY INVISIBLES
	JRST	.+2

READ16:	PUSHJ	SP,IGNICH	; IGNORE INVISIBLES
	JSP	AX,READ11	; FIX MANTISSA UP
	TLNN	A2,MANDIG	; DOES MANTISSA HAVE DIGITS?
	MOVEI	A1,1		; NO - FORCE A ONE
	DMOVE	A5,A0		; SAVE MANTISSA
	SETZB	A0,A1		; CLEAR ACCUMULATORS
	CAIN	A13,"+"		; "+"?
	JRST	READ18		; YES
	CAIE	A13,"-"		; "-"?
	JRST	READ19		; NO
	TLOA	A2,EXPSGN	; YES - FLAG EXPONENT NEGATIVE (AND SKIP!)

READ17:	TLO	A2,EXPOVL	; FLAG EXPONENT OVERFLOW

READ18:	JSP	AX,INCHR0	; [E145] GET NEXT CHARACTER

READ19:	CAIL	A13,"0"
	CAIL	A13,"0"+^D10	; IN RANGE 0 - 9?
	JRST	READ20		; NO
	TLNE	A2,EXPOVL	; YES - EXPONENT OVERFLOW SET?
	JRST	INCHR0		; [E145] YES - IGNORE DIGIT
	TLO	A2,EXPDIG	; FLAG DIGIT SEEN
	MULI	A0,^D10		; MULTIPLY BY TEN
	JUMPN	A0,READ17	; OVERFLOWED?
	EXCH	A0,A1		; NO
	TLO	A0,400000	; FLAG EXPONENT
	ADDI	A0,-"0"(A13)	; AND ADD IN DIGIT
	TLZN	A0,400000	; DID IT OVERFLOW?
	JRST	READ17		; YES
	JRST	READ18		; NO - CARRY ON
READ20:	CAIE	A13,"+"		; END OF EXPONENT
	CAIN	A13,"-"		; TEST FOR ILLEGAL TERMINATORS
	JRST	READ21
	CAIE	A13,"&"
	CAIN	A13,"@"
	JRST	READ21
	CAIE	A13,"D"
	CAIN	A13,"E"
	JRST	READ21
	CAIE	A13,"."
	TLNN	A2,EXPDIG	; AND CHECK DIGITS SEEN
	JRST	READ21		; COMPLAIN - BAD CHARS
	TLNE	A2,EXPOVL	; EXPONENT OVERFLOW?
	JRST	READ22		; YES - COMPLAIN
	TLNN	A2,EXPSGN	; SHOULD EXPONENT BE NEGATIVE?
	MOVN	A0,A0		; NO - FORM NEGATIVE EXPONENT
	SUB	A3,A0		; TRUE NEGATIVE EXPONENT
	CAILE	A3,^D38		; TOO LARGE?
	JRST	READ22		; YES - GIVE OVERFLOW
	TRNN	A2,LREAL	; LONG REAL TYPE

READ23:	TLNE	A2,LREAL	; OR LONG REAL RESULT REQUIRED?
	JRST	READ27		; YES

; REAL TERMINAL SEQUENCE

	MOVE	A0,A6		; NO - ONLY REAL
	JUMPE	A0,READ35	; ESCAPE FOR ZERO MANTISSA
	TLO	A0,233000
	FADRI	A0,000000	; STANDARDIZE MANTISSA
	FSC	A0,(A4)		; AND ALLOW FOR BINARY EXPONENT CORRECTION
	TLNE	A2,MANSGN	; SHOULD MANTISSA BE NEGATIVE?
	MOVN	A0,A0		; YES - NEGATE IT
	JUMPE	A3,READ35	; ANY EXPONENT?
	MOVM	A4,A3		; EXPONENT MAGNITUDE

READ24:	CAIG	A4,^D38		; EXPONENT VERY SMALL OR LARGE?
	JRST	READ25		; NO
	JUMPGE	A3,READ22	; IF LARGE - YOU LOSE!
	FDVR	A0,STEN38	; YES - DIVIDE BY 1.0&38
	JUMPE	A0,READ35	; AND EXIT IF UNDERFLOWED
	SUBI	A4,^D38		; OTHERWISE CUT DOWN EXPONENT
	JRST	READ24		; AND TRY AGAIN

READ25:	JUMPL	A3,READ26	; POSITIVE EXPONENT?
	FMPR	A0,STEN(A4)	; YES - MULTIPLY
	JFOV	READ22		; OVERFLOWED?
	JRST	READ35		; NO - EXIT

READ26:	FDVR	A0,STEN(A4)	; DIVIDE
	JRST	READ35		; AND EXIT

READ21:	HLRZ	A10,%CHAN(DB)
	IOERR	10,(A10)

READ22:	HLRZ	A10,%CHAN(DB)
	IOERR	11,(A10)
; LONG REAL TERMINAL SEQUENCE

READ27:	JUMPN	A5,READ28
				; HIGH ORDER WORD = 0?
	JUMPE	A6,READ34	; YES - LOW ORDER WORD = 0

READ28:	TLNE	A5,000400	; NO - BIT 9 SET?
	JRST	READ29		; YES - OK
	ASHC	A5,1		; NO - SHIFT UP
	SOJA	A4,READ28	; AND INCREMENT BINARY EXPONENT CORRECTION

READ29:	ADDI	A4,276		; CALCULATE CORRECT EXPONENT
	DPB	A4,[
	POINT	9,A5,8]		; AND FORM HIGH WORD
	TLNE	A2,MANSGN	; SHOULD IT BE NEGATIVE?
	DMOVN	A5,A5		; YES - NEGATE IT
	JUMPE	A3,READ34	; ANY EXPONENT?
	MOVM	A4,A3		; EXPONENT MAGNITUDE

READ31:	CAIG	A4,^D38		; EXPONENT VERY SMALL OR LARGE
	JRST	READ32		; NO
	JUMPGE	A3,READ22	; IF LARGE - YOU LOSE!
	MOVEI	A10,^D38
	JSP	AX,DFDVR	; YES - DIVIDE BY 1.0&&38
	JUMPE	A5,READ34	; EXIT IF UNDERFLOWED
	SUBI	A4,^D38		; OTHERWISE CUT DOWN EXPONENT
	JRST	READ31		; AND TRY AGAIN

READ32:	MOVE	A10,A4
	JUMPL	A3,READ33	; POSITIVE EXPONENT?
	JSP	AX,DFMPR	; YES - MULTIPLY
	JRST	READ22		; OVERFLOW?
	JRST	READ34		; NO - EXIT

READ33:	JSP	AX,DFDVR	; DIVIDE
	JRST	READ34

READ34:	DMOVE	A0,A5
; EXIT SEQUENCE

READ35:	LDB	A3,[
	POINT	3,A2,17]
	ANDI	A2,-1		; DATA TYPE
	POP	SP,AX		; MOVE LINK TO AX
	XCT	READ36(A2)

READ36:	JRST	CNC.AX		; INTEGER NUMBER
	JUMPE	A3,RI		; REAL NUMBER
	JUMPE	A3,LRI		; LONG REAL NUMBER

; BINARY READ

READ37:	PUSHJ	SP,INBYTE	; READ NEXT WORD
	IOERR	6,(A13)		; EOF - CHANNEL # IN A13
	MOVE	A0,A13
	CAIE	A2,2		; LONG REAL?
	POPJ	SP,0		; NO
	PUSHJ	SP,INBYTE	; YES - READ SECOND WORD
	IOERR	6,(A13)		; EOF - CHANNEL # IN A13
	MOVE	A1,A13
	POPJ	SP,0
SUBTTL PRINT - PRINT NUMBER ROUTINE

; ON ENTRY THE NUMBER IS IN

;	A0	INTEGER, REAL
;	A0,A1	LONG REAL

; A2 = TYPE OF VARIABLE:

;	0	INTEGER
;	1	REAL
;	2	LONG REAL

; A3,A4 = MODE OF PRINTING REQUIRED:

;	A3	NUMBER OF DIGITS BEFORE POINT (M)
;	A4	NUMBER OF DIGITS AFTER POINT (N)

;	(M,0)	INTEGER MODE
;	(M,N)	FIXED POINT MODE
;	(0,N)	FLOATING POINT MODE
;	(0,0)	'STANDARD' MODE

; SERVICE ROUTINES FOR PRINT

; PRINTS ASCII BYTE IN A13
; LINK IS IN AX

PRIN1:	SKIPA	A13,["."]	; SPECIAL ENTRY FOR DECIMAL POINT
SPACE%:	MOVEI	A13," "		; SPECIAL ENTRY FOR SPACE

OUCHAR:	PUSHJ	SP,OUBYTE	; OUTPUT BYTE
EDIT(126); Channel # in A12 not A13.
	IOERR	6,(A12)		; [E126] END OF FILE - CHAN # IN A12
	JRST	CNC.AX

BRKCHR:	PUSHJ	SP,BRKBYT	; BREAKOUTPUT
	IOERR	6,(A12)		; [E126] END OF FILE
	JRST	CNC.AX

; PRINT SIGN ROUTINE

; PRINTS SPACE OR "-" ACCORDING AS NUMSGN IN A2 IS UNSET OR SET
; LINK IS IN AX

PRIN3:	MOVEI	A13," "
	TLNE	A2,NUMSGN	;
	MOVEI	A13,"-"		; SELECT SIGN
	TLZN	A2,NUMSGN	; IF NEGATIVE
	TLZN	A2,NOSIGN	; OR NOT NOSIGN
	AOJA	A3,OUCHAR	; THEN PRINT IT
	JRST	CNC.AX		; ELSE RETURN.

; OUTPUT DIGIT ROUTINE

; GETS DIGIT FROM DIGIT STACK AND PRINTS IT
; LINK IS IN AX

PRIN4:	MOVEI	A13,"0"
	TLNE	A2,DIGEXH	; DIGITS EXHAUSTED?
	JRST	OUCHAR		; YES
	ADD	A13,(A7)	; GET NEXT DIGIT
	SOJN	A6,.+2		; TOTAL COUNT EXPIRED?
	TLO	A2,DIGEXH	; YES - FLAG DIGITS EXHAUSTED
	AOJA	A7,OUCHAR	; MOVE POINTER AND PRINT DIGIT

PRINT.:	HRRZ	A5,%CHAN(DB)	; GET OUTPUT CHANNEL NUMBER
	ADDI	A5,(DB)
	MOVE	A5,%IODR(A5)	; AND GET CHANNEL ENTRY
	TLNN	A5,ABMODE	; ASCII OR BINARY?
	JRST	PRIN54		; BINARY
	JUMPN	A3,PRIN13	; ANY DIGITS BEFORE POINT?
	JUMPN	A4,PRIN13	; OR AFTER IT?
	XCT	PRIN5(A2)	; NO - 'STANDARD' MODE
	JRST	PRIN13

PRIN5:	MOVEI	A3,INTDIG	; STANDARD INTEGER FORMAT
	MOVEI	A4,SRDIG-2	; STANDARD REAL FORMAT
	MOVEI	A4,^D15		; STANDARD LONG REAL FORMAT - LESS 2 FOR BOTH

; INTEGER PRINT ROUTINE

DPRNT%:	PUSH	SP,A13		; SAVE DEBUGGER'S FLAG REGISTER.
	HRLZI	A2,NOSIGN	; INTEGER SPECIAL PRINT FOR DEBUGGER.
	MOVEI	A4,0
	MOVEI	A3,1
	PUSHJ	SP,PRIN6
	POP	SP,A13		; RESTORE DEBUGGER'S FLAGS.
	POPJ	SP,

IPRNT%:
IPRINT:	MOVEI	A3,1		; SPECIAL INTEGER PRINT
	SETZB	A2,A4

PRIN6:	JUMPGE	A0,PRIN7	; NEGATIVE?
	TLO	A2,NUMSGN	; YES - SET SIGN FLAG
	MOVN	A0,A0		; AND NEGATE
	JOV	[TLO A2,INTOVL		; OVERFLOWED - SET FLAG
		MOVE	A0,[^D24359738368]  ; AND LOAD 2^35 - 10^10
		JRST	PRIN7]

PRIN7:	MOVEI	A5,1		; SET UP DIGIT COUNT

PRIN8:	IDIVI	A0,^D10		; AND GENERATE DIGITS IN REVERSE
	PUSH	SP,A1		; AND SAVE THEM ON THE STACK
	JUMPE	A0,PRIN9	; ANY LEFT?
	AOJA	A5,PRIN8	; YES - COUNT AND CARRY ON

PRIN9:	TLNE	A2,INTOVL	; DID OVERFLOW OCCUR?
	AOS	(SP)		; YES - PRODUCE 2^35!!!

PRIN10:	CAML	A5,A3		; ANY LEADING SPACES?
	JRST	PRIN11		; NO
	JSP	AX,SPACE%	; YES - PRINT ONE
	SOJA	A3,PRIN10	; AND DECREASE M UNTIL FINISHED

PRIN11:	MOVEI	A3,(A5)		; TELL WORLD (DEBUGGER) HOW MUCH WE PRINTED.
	JSP	AX,PRIN3	; PRINT SIGN
PRIN12:	POP	SP,A13		; POP UP DIGIT
	ADDI	A13,"0"		; ADD ASCII OFFSET
	JSP	AX,OUCHAR	; AND PRINT IT
	SOJN	A5,PRIN12	; REPEAT UNTIL FINISHED
	POPJ	SP,0		; EXIT FROM ROUTINE

PRIN13:	MOVEI	A13,0		; CLEAR EXPONENT
	JUMPG	A2,PRIN17	; JUMP UNLESS INTEGER NUMBER
	JUMPE	A4,PRIN6	; USE PRIN6 IF INTEGER MODE
	JUMPE	A3,PRIN14	; JUMP IF FLOATING POINT MODE
	PUSHJ	SP,PRIN6	; FIXED POINT MODE - USE PRIN6
	JSP	AX,PRIN1	; PRINT DECIMAL POINT
	MOVEI	A13,"0"
	SOJGE	A4,OUCHAR	; AND N ZEROS
	POPJ	SP,0

PRIN14:	JUMPGE	A0,PRIN15	; FLOATING POINT MODE - NEGATIVE?
	TLO	A2,NUMSGN	; YES - SET SIGN FLAG
	MOVN	A0,A0		; AND NEGATE
	JOV	[
	MOVSI	A0,244400	; OVERFLOW - FORM 2.0^35
	JRST	PRIN18]

PRIN15:	CAML	A0,[^D100000000]  ; 9 OR MORE DIGITS?
	JRST	PRIN16		; YES
	FLTR	A0,A0		; NO - CONVERT TO REAL
	JRST	PRIN18

PRIN16:	JSP	AX,ILR		; CONVERT TO LONG REAL
	TLO	A2,LNGMAN	; AND FLAG LONG MANTISSA
	JRST	PRIN28

PRIN17:	SOJG	A2,PRIN26	; JUMP IF LONG REAL NUMBER
; REAL STANDARDIZATION SEQUENCE

	FADRI	A0,000000	; ENSURE STANDARDIZED
	JFOV	[
	MOVEI	A0,0		; BAD NUMBER - ZERO IT
	JRST	PRIN22]
	JUMPGE	A0,PRIN18	; NUMBER NEGATIVE?
	TLO	A2,NUMSGN	; YES - SET SIGN FLAG
	MOVN	A0,A0		; AND NEGATE IT

PRIN18:	JUMPE	A0,PRIN22	; ESCAPE IF ZERO
	MOVE	A5,A0
	CAML	A0,STEN		; NUMBER < 1.0?
	JRST	PRIN19		; NO
	TLO	A2,NUMRNG	; YES - SET RANGE FLAG
	CAML	A0,STENM1	; NUMBER < 0.1?
	JRST	PRIN25		; NO - IN RANGE
	CAMGE	A0,[
	XWD	002663,437347]	; VERY SMALL NUMBER?
	JRST	PRIN23		; YES - SAVE OVERFLOWS!
	MOVSI	A5,(1.0)
	FDVR	A5,A0		; TAKE RECIPROCAL

PRIN19:	HRLZI	A13,-^D38	; LOAD COUNTER

PRIN20:	CAML	A5,STEN1(A13)	; COMPARE WITH TABLE
	AOBJN	A13,PRIN20	; UNTIL LARGER ENTRY FOUND
	JUMPL	A13,PRIN21	; ENTRY FOUND?
	JUMPL	A2,PRIN24	; NO - LOW RANGE?
	FDVR	A0,STEN38	; NO
	FDVR	A0,STEN1	; - DIVIDE BY 1.0&39
	AOJA	A13,PRIN25

PRIN21:	ANDI	A13,-1		; ENTRY FOUND - CLEAR OUT COUNT
	JUMPL	A2,PRIN24	; LOW RANGE?
	FDVR	A0,STEN1(A13)	; NO - DIVIDE TO BRING INTO RANGE

PRIN22:	AOJA	A13,PRIN25	; AND CORRECT EXPONENT

PRIN23:	MOVEI	A13,^D38	; DEAL WITH OVERFLOW IN RECIPROCAL

PRIN24:	FMPR	A0,STEN(A13)	; LOW RANGE - MULTIPLY TO BRING INTO RANGE
	MOVN	A13,A13		; NEGATIVE EXPONENT
PRIN25:	MOVEI	A5,SRDIG	; SET MAXIMUM SINGLE PRECISION LENGTH
	JUMPE	A0,PRIN36	; SAVE TIME FOR ZERO
	LDB	A7,[
	POINT	9,A0,8]		; EXTRACT EXPONENT
	TLZ	A0,377000	; AND CLEAR IT OUT
	ASH	A0,-170(A7)	; AND CONVERT TO FRACTIONAL FORM
	JOV	[
	MOVE	A0,[
	XWD	031463,146315]
	AOJA	A13,PRIN36]	; CORRECT IF OVERFLOWED
	JRST	PRIN36
; LONG REAL STANDARDIZATION SEQUENCE

PRIN26:	DFAD	A0,LTEN		; LTEN IS DOUBLE ZERO
	JUMPGE	A0,PRIN27
	TLO	A2,NUMSGN
	DMOVN	A0,A0

PRIN27:	TLO	A2,LNGEXP	; FLAG LONG EXPONENT

	;
	Edit(164);  Never force single precision for KI10.
	;
	; [E164] Delete three lines.
	;
PRIN28:	TLO	A2,LNGMAN	; FLAG LONG MANTISSA
	DMOVE	A5,A0
	CAMN	A0,HTEN
	CAMGE	A1,LTEN		; SAME IN BOTH CASES
	CAML	A0,HTEN		; NUMBER < 1.0?
	JRST	PRIN30		; NO
	TLO	A2,NUMRNG	; YES - SET RANGE FLAG
	MOVE	A10,LTEN-1
	CAMN	A0,HTENM1
	CAMGE	A1,A10
	CAML	A0,HTENM1	; NUMBER < 0.1?
	JRST	PRIN35		; NO - IN RANGE
	JUMPE	A5,PRINGD	; [260] PRINT ZERO AS 0, NOT 0&&-39
	CAMGE	A5,[2663,,437347]; [260] VERY SMALL NUMBER?
	JRST	PRIN33		; YES - SAVE OVERFLOWS!
	MOVSI	A0,(1.0)
	FDVR	A0,A5		; TAKE SINGLE PRECISION RECIPROCAL

PRIN30:	HRLZI	A13,-^D38	; LOAD COUNTER

PRIN31:	CAML	A0,HTEN1(A13)	; COMPARE WITH TABLE
	AOBJN	A13,PRIN31	; UNTIL LARGER ENTRY FOUND
	EDIT(231)		; FIX "PRINT" PROCEDURE FOR VALUES LESS THAN 1
				; WITH MANTISSAS NEAR 1
	DMOVEM	A0,A01TMP(DB)	; [231] SAVE A0, A1 IN CASE OF ERROR LATER
	DMOVEM	A5,A56TMP(DB)	; [231] SAVE A5, A6 IN CASE OF ERROR TOO
	MOVEM	A13,A13TMP(DB)	; [231] SAVE A13 IN CASE OF ERROR
JBS231:	JUMPL	A13,PRIN32	; NO, THEN WAS A TABLE ENTRY FOUND?
	JUMPL	A2,PRIN34	; NO - LOW RANGE?
	MOVEI	A10,^D38	; NO
	JSP	AX,DFDVR
	MOVEI	A10,^D1
	JSP	AX,DFDVR	; DIVIDE BY 1.0&&39
	AOJA	A13,PRIN35
PRIN32:	ANDI	A13,-1		; ENTRY FOUND - CLEAR OUT COUNT
	JUMPL	A2,PRIN34	; LOW RANGE?
	MOVEI	A10,1(A13)
	JSP	AX,DFDVR	; NO - DIVIDE TO BRING INTO RANGE
	AOJA	A13,PRIN35	; AND CORRECT EXPONENT

PRINGD:	SKIPA	A13,[-1]	; [260] EXPONENT IS ZERO, COMPENSATE
PRIN33:	MOVEI	A13,^D38	; DEAL WITH OVERFLOW IN RECIPROCAL

PRIN34:	MOVE	A10,A13		; LOW RANGE
	JSP	AX,DFMPR	; MULTIPLY TO BRING INTO RANGE
	HALT	.		; OVERFLOW CANNOT OCCUR!
	MOVN	A13,A13		; NEGATIVE EXPONENT

PRIN35:	DMOVE	A0,A5		; RESTORE RESULT TO A0,A1
	MOVEI	A5,^D19		; SET MAXIMUM DOUBLE PRECISION LENGTH
	LDB	A7,[
	POINT	9,A0,8]		; EXTRACT EXPONENT
	TLZ	A0,377000	; AND CLEAR IT OUT
	ASHC	A0,-170(A7)	; AND CONVERT TO FRACTIONAL FORM
	JOV	[DMOVE	A0,A01TMP(DB)	; [231] RESTORE A0, A1 AFTER OVERFLOW
		DMOVE	A5,A56TMP(DB)	; [231] RESTORE A5, A6
		MOVE	A13,A13TMP(DB)	; [231] RESTORE A13
		SUB	A13,[1,,1]	; [231] MODIFY SO IT'LL WORK THIS TIME
		JRST	JBS231]		; [231] TRY AGAIN
; ROUNDING AND DIGIT GENERATION SEQUENCE

PRIN36:	MOVEI	A6,1(A4)	; NUMBER OF DIGITS TO BE PRINTED
	JUMPE	A3,PRIN37	; = N+1 IF FLOATING POINT FORMAT,
	ADD	A6,A13
	SOJGE	A6,PRIN37
	MOVEI	A6,0		; MAX (N+E, 0) IF FIXED POINT FORMAT

PRIN37:	CAILE	A6,(A5)		; BUT NEVER MORE THAN
	MOVEI	A6,(A5)		; MAXIMUM PERMITTED
	MOVE	A5,SP		; MARK BOTTOM OF DIGIT STACK
	PUSH	SP,LTEN		; AND ALLOW FOR POSSIBLE OVERFLOW
	MOVEI	A7,1(A6)	; NUMBER OF DIGITS TO BE PRODUCED
	TLNE	A2,LNGMAN	; LONG MANTISSA?
	JRST	PRIN39		; YES

PRIN38:	MULI	A0,^D10		; MULTIPLY BY 10
	PUSH	SP,A0		; STORE DIGIT ON DIGIT STACK
	MOVE	A0,A1		; AND SET UP NEW FRACTION
	SOJN	A7,PRIN38
	JRST	PRIN40

PRIN39:	MOVE	A10,A1
	MULI	A10,^D10	; MULTIPLY LOW ORDER WORD BY 10
	MOVE	A1,A11		; AND RESET LOW ORDER FRACTION
	MOVE	A11,A0
	MULI	A11,^D10	; MULTIPLY HIGH ORDER WORD BY 10
	TLO	A12,400000	; FLAG LOW ORDER SIGN BIT OF RESULT
	ADD	A12,A10		; AND ADD CARRY FROM LOW ORDER MULTIPLY
	TLZN	A12,400000	; AND IF IT OVERFLOWS
	ADDI	A11,1		; INCREMENT HIGH ORDER CARRY
	MOVE	A0,A12		; RESET HIGH ORDER FRACTION
	PUSH	SP,A11		; STORE DIGIT ON DIGIT STACK
	SOJN	A7,PRIN39

PRIN40:	MOVEI	A10,-1(SP)	; ADDRESS OF LAST DIGIT TO BE PRINTED
	MOVE	A12,1(A10)
	CAIGE	A12,5		; WOULD ROUNDING GENERATE CARRY?
	JRST	PRIN42		; NO

PRIN41:	AOS	A12,(A10)	; INCREMENT DIGIT
	CAIE	A12,^D10	; ANY CARRY?
	JRST	PRIN42		; NO
	SETZM	(A10)		; YES - REPLACE BY ZERO
	SOJA	A10,PRIN41	; KEEP GOING
PRIN42:	MOVEI	A7,1(A5)	; ADDRESS OF OVERFLOW DIGIT
	SKIPE	(A7)		; OVERFLOW OCCURRED?
	AOJA	A13,PRIN43	; YES - INCREMENT EXPONENT
	ADDI	A7,1		; NO - MOVE TO FIRST DIGIT

PRIN43:	MOVE	A0,A13		; TRANSFER EXPONENT TO SAFE PLACE
	JUMPE	A3,PRIN50	; JUMP IF FLOATING POINT MODE
; FIXED POINT PRINTING SEQUENCE

	JUMPG	A0,.+2
	JUMPL	A2,PRIN48	; JUMP IF NUMBER < 1.0
	MOVEI	AX,PRIN44

PRIN44:	CAMGE	A0,A3		; LEADING SPACES REQUIRED?
	SOJA	A3,SPACE%
	JSP	AX,PRIN3	; PRINT SIGN
	JSP	AX,PRIN4	; OUTPUT INTEGRAL DIGIT
	SOJN	A0,PRIN4	; RETURN IF MORE DIGITS
	JUMPE	A4,PRIN46	; ANY FRACTION?
	JSP	AX,PRIN1	; YES - PRINT DECIMAL POINT

PRIN45:	JSP	AX,PRIN4	; OUTPUT FRACTIONAL DIGIT
	SOJN	A4,PRIN4	; RETURN IF MORE DIGITS

PRIN46:	MOVE	SP,A5		; RESTORE STACK
	POPJ	SP,0		; EXIT

PRIN47:	JSP	AX,SPACE%	; PRINT LEADING SPACES

PRIN48:	SOJN	A3,PRIN47	; ANY LEFT?
	JSP	AX,PRIN3	; NO - PRINT SIGN
	MOVEI	A13,"0"
	JSP	AX,OUCHAR	; OUTPUT A ZERO
	JUMPE	A4,PRIN46	; FRACTION TO BE PRINTED?
	JSP	AX,PRIN1	; YES - OUTPUT DECIMAL POINT

PRIN49:	AOJG	A0,PRIN45	; OUTPUT ZEROS IF REQUIRED
	MOVEI	A13,"0"
	JSP	AX,OUCHAR
	SOJN	A4,PRIN49
	JRST	PRIN46		; NO DIGITS REQUIRED!
; FLOATING POINT PRINTING SEQUENCE

PRIN50:	JSP	AX,PRIN3	; FLOATING POINT MODE - OUTPUT SIGN
	JSP	AX,PRIN4	; OUTPUT FIRST DIGIT
	JSP	AX,PRIN1	; AND DECIMAL POINT
	JSP	AX,PRIN4	; OUTPUT FRACTIONAL DIGIT
	SOJN	A4,PRIN4	; RETURN IF MORE DIGITS
	SOJE	A0,PRIN52	; CALCULATE EXPONENT - ESCAPE IF ZERO

PRIN51:	MOVEI	A13,"&"
	JSP	AX,OUCHAR	; OUTPUT "&"
	TLZE	A2,LNGEXP
	JRST	PRIN51		; AND SECOND ONE IF LONG REAL NUMBER
	MOVEI	A3,2		; AND SET DIGIT COUNT
	MOVE	SP,A5		; RESTORE STACK POINTER
	JRST	PRIN6		; AND LET PRIN6 DO THE WORK

PRIN52:	MOVEI	A3,4		; SUPPRESS ZERO EXPONENT
	TLZE	A2,LNGEXP
	MOVEI	A3,5		; TAKING ACCOUNT OF LONG REAL
	MOVEI	AX,PRIN53

PRIN53:	SOJGE	A3,SPACE%	; AND OUTPUT SPACES
	JRST	PRIN46

; BINARY READ

PRIN54:	MOVE	A13,A0
	JSP	AX,OUCHAR	; OUTPUT FIRST WORD
	CAIE	A2,2		; LONG REAL?
	POPJ	SP,0		; NO
	MOVE	A13,A1
	JSP	AX,OUCHAR	; YES - OUTPUT SECOND WORD
	POPJ	SP,0
SUBTTL DOUBLE PRECISION MULTIPLY/DIVIDE

; ON ENTRY:
; THE LEFT HAND OPERAND IS IN A5,A6
; THE RIGHT HAND OPERAND IS IN HTEN AND LTEN, INDEXED BY A10
; THE LINK IS IN AX
; ON EXIT:
; THE RESULT IS IN A5,A6
; FOR MULTIPLY ONLY:
; ERROR RETURN IF OVERFLOW
; OK SKIP RETURN

DFMPR:	MOVE	A7,HTEN(A10)
	MOVE	A10,LTEN(A10)
	DFMP	A5,A7		; MULTIPLY
	JFOV	CNC.AX		; OVERFLOW?
	AOJA	AX,CNC.AX	; NO

DFDVR:	MOVE	A7,HTEN(A10)
	MOVE	A10,LTEN(A10)
	DFDV	A5,A7		; DIVIDE
	JRST	CNC.AX
SUBTTL SELIN/SELOUT - SELECT INPUT/OUTPUT ROUTINES

; ON ENTRY A1 = CHANNEL NUMBER TO BE SELECTED

SELIN:	JUMPL	A1,SEL1		; ALWAYS ALLOW CHANNEL -1
	MOVEI	A2,(A1)
	ADDI	A2,(DB)		; RELOCATE IO DIRECTORY
	SKIPE	A2,%IODR(A2)	; CHANNEL DEFINED?
	TLNN	A2,ININT	; YES - DEVICE INITED FOR INPUT?
	IOERR	2,(A1)		; NO - COMPLAIN

SEL1:	HRLM	A1,%CHAN(DB)	; YES - SELECT IT
	POPJ	SP,0

SELOUT:	JUMPL	A1,SEL2		; ALWAYS ALLOW CHANNEL -1
	MOVEI	A2,(A1)
	ADDI	A2,(DB)		; RELOCATE IO DIRECTORY
	SKIPE	A2,%IODR(A2)	; CHANNEL DEFINED?
	TLNN	A2,OUTINT	; YES - DEVICE INITED FOR OUTPUT?
	IOERR	2,(A1)		; NO - COMPLAIN

	;
	; Edit(1012)  Do a BREAKOUTPUT if SELECTing away from TTY:
	;
SEL2:	HRRZ	A2,%CHAN(DB)	; [E1012] GET CURRENT OUTPUT CHANNEL
	ADDI	A2,(DB)		; [E1012] RELOCATE IT
	MOVE	A2,%IODR(A2)	; [E1012] AND GET CHANNEL STATUS
	TLNE	A2,TTYDEV!TTYTTC; [E1012] IF CURRENT DEVICE IS A TTY
	JSP	AX,BRKCHR	; [E1012] ... THEN BREAKOUTPUT
	HRRM	A1,%CHAN(DB)	; [E1012] SELECT NEW CHANNEL
	POPJ	SP,0
SUBTTL INPT/OUTPT - INPUT/OUTPUT DEVICE INITIALIZATION ROUTINE

; ON ENTRY:
; A0 = DEVICE NAME (IF PHYSICAL DEVICE), OR STRING ADDRESS (IF LOGICAL DEVICE)
; LH(A1) = NUMBER OF BUFFERS REQUIRED (PHYSICAL DEVICES ONLY)
; RH(A1) = CHANNEL NUMBER
; A2 = MODE (PHYSICAL DEVICES ONLY)

; DEVCHR FLAGS (LH):

	DEVDDS=400000		; DTA DIRECTORY IN STORE
	DEVDSK=200000		; DSK
	DEVCDR=100000		; CDR/CDP
	DEVLPT=040000		; LPT
	DEVTAJ=020000		; TTY ATTACHED TO JOB
	DEVTUC=010000		; TTY IN USE AS USER'S CONSOLE
	DEVTIO=004000		; TTY IN USE FOR IO
	DEVDSP=002000		; DISPLAY
	DEVLDT=001000		; LONG DISPATCH TABLE
	DEVPTP=000400		; PTP
	DEVPTR=000200		; PTR
	DEVDTA=000100		; DTA
	DEVAA=000040		; DEVICE AVAILABLE OR ASSIGNED TO THIS JOB
	DEVMTA=000020		; MTA
	DEVTTY=000010		; TTY
	DEVDIR=000004		; DIRECTORY DEVICE
	DEVIN=000002		; DEVICE CAN DO INPUT
	DEVOUT=000001		; DEVICE CAN DO OUTPUT

; DEVTYP FLAGS (LH):

	DEVSPL=000020		; DEVICE IS SPOOLED

; IO FLAGS (LH OF A2):

	INFLG=DEVIN		; INPUT FLAG
	OUTFLG=DEVOUT		; OUTPUT FLAG
; IO DIRECTORY SETUP FLAG COMBINATIONS:

	IODSKI=PLDEV!DIRDEV!INDEV!ININT!OUTDEV
	IOCDR=PLDEV!INDEV!ININT
	IOLPT=PLDEV!OUTDEV!OUTINT
	IODSKO=PLDEV!DIRDEV!INDEV!OUTDEV!OUTINT
	IOCDP=PLDEV!OUTDEV!OUTINT
	IOPTP=PLDEV!OUTDEV!OUTINT
	IOPTR=PLDEV!INDEV!ININT
	IODTAI=PLDEV!DIRDEV!INDEV!ININT!OUTDEV
	IOMTAI=PLDEV!SPOPRN!INDEV!ININT!OUTDEV
	IOTTYI=PLDEV!TTYDEV!INDEV!ININT!OUTDEV
	IOTTYO=PLDEV!TTYDEV!INDEV!OUTDEV!OUTINT
	IOTTYB=IOTTYI!IOTTYO
	IODTAO=PLDEV!DIRDEV!INDEV!OUTDEV!OUTINT
	IOMTAO=PLDEV!SPOPRN!INDEV!OUTDEV!OUTINT
	IOPLT=PLDEV!PLTDEV!OUTDEV!OUTINT
	IOLOGI=INDEV!ININT!INOK
	IOLOGO=OUTDEV!OUTINT!OUTOK
	IOTTC=PLDEV!TTYDEV!TTYTTC!ABMODE!INDEV!ININT!OUTDEV!OUTINT

; JFFO IGNORE FLAGS:

	JFFFLG=DEVDDS!DEVTAJ!DEVTUC!DEVTIO!DEVLDT!DEVAA!DEVDIR!DEV