.TITLE	LISP		
; JEFFREY KODOSKY
; APPLIED RESEARCH LABS
; UNIVERSITY OF TEXAS, AUSTIN, TX
; JUNE-75	REVISED  NOV-75
;
;	FILE		CONTENTS
;    LISP.MAC	    (THIS MODULE) INIT CODE,TRAP HANDLER, ETC.
;    LSPLIB.OBJ	    LIBRARY OF LISP FUNCTIONS AND UTILITY FCTS.
;    LSPMAC.MAC	    PARAMETERS, DEFINITIONS, AND MACROS FOR SOURCES
;    <ATOM>.MAC	    LISP FUNCTION AND UTILITY FUNCTION SOURCES
;
;
; RESTRICTIONS:
;	1)  LISP WILL ONLY EXECUTE IN THE BACKGROUND OF A
;	    RT-11 V02C OPERATING SYSTEM.  IT IS NOT REENTERABLE.
;	2)  LISP REQUIRES LOCATIONS 0 & 2 BUT THE RT-11 MONITOR
;	    WILL NOT PROTECT THEM NOR ALLOW THEM TO BE SPECIFIED
;	    IN THE F/B CONTEXT SWITCH PROCESS.  LISP THEREFORE
;	    USURPS THEM.  THEY ARE RESTORED ON EXIT EXCEPT IN
;	    THE CASE WHERE CTRL/C WAS TYPED.  A REBOOT IS
;	    RECOMMENDED AFTER A CTRL/C ABORT.  CARE SHOULD BE
;	    EXERCISED TO AVOID RUNNING ANY FOREGROUND PROGRAM
;	    WHICH IS SENSITIVE TO THE CONTENTS OF 0 & 2.
;
; MODIFIED	DEC-80
; DAVID R. WARNER, JR.
; COLLEGE OF LAW
; OHIO NORTHERN UNIVERSITY
; ADA,OHIO
;
;
; MODIFICATION NOTES:
;	LISP AS MODIFIED WILL EXECUTE UNDER RSTS V7.0-07 USING
;	THE RT11 EMULATOR. THE TARGET RUNTIME SYSTEM IS DEFINED
;	IN LSPMAC.
;		CTRL/C TRAPPING IS IMPLEMENTED UNDER RSTS SO THAT
;	ANY FILES ENTERED AT THE TIME A CTRL/C IS TYPED WILL BE
;	MADE PERMANENT.  HOWEVER, IO IN PROCESS WILL BE INTERRUPTED
;	AND PARTIALLY WRITTEN BUFFERS MIGHT NOT BE PRESERVED.
;
;
;******** DEFINITIONS
;
ERRWD=52
RMON=54
USR=266
	.PAGE
; THE FOLLOWING CONDITIONAL ASSEMBLY PARAMETERS: NOARRY, NODBUG,
; NOMATH, NOSTRG, NOAUXF, WILL CAUSE THE ASSOCIATED FUNCTIONS TO
; BE LEFT OUT OF THE RESULTING LISP SAVE FILE.  FOR FINER CONTROL
; OF SELECTED FUNCTIONS A GROUP CAN BE LEFT UNDEFINED AND ONLY
; THOSE FUNCTIONS DESIRED CAN BE LINKED.  E.G. DEFINE NOAUXF AND
; INCLUDE CSUBST=1, CSUBLIS=1 TO GENERATE A SAVE FILE WITH THE
; SUBLIS AND SUBST FUNCTIONS BUT NO OTHER FUNCTIONS IN THE AUXF
; GROUP.
;
.IF	NDF,NOARRY
CARRAY=1
.ENDC

.IF	NDF,NODBUG
CERRSET=1
CTRACE=1
CTRSET=1
CUNDEF=1
CUNTRACE=1
CUNTRSET=1
.ENDC

.IF	NDF,NOMATH
CADD1=1
CDIFFERENCE=1
CDIVIDE=1
CFLOAT=1
CFIX=1
CGREATERP=1
CLSHIFT=1
CMAX=1
CMIN=1
CMINUS=1
CPLUS=1
CRANDOM=1
CSUB1=1
CTIMES=1
.ENDC

.IF	NDF,NOSTRG
CSTRING=1
.ENDC

.IF	NDF,NOAUXF
CGENSYM=1
CLOGAND=1
CLOGOR=1
CLOGXOR=1
CSEARCH=1
CSELECT=1
CSIZE=1
CSUBLIS=1
CSUBST=1
CTEMPUS=1
.ENDC

; THE FOLLOWING CONDITIONAL ASSEMBLY PARAMETERS CAN BE INDIVIDUALLY
; DEFINED/UNDEFINED TO GENERATE A SAVE FILE INCLUDING/EXCLUDING
; THE ASSOCIATED FUNCTIONS RESPECTIVELY.

CADDR=1
CALIST=1
CALPHAP=1
CAND=1
CAPPEND=1
CCONC=1
CCOPY=1
CDEFINE=1
CDEFLIST=1
CEFFACE=1
CFREE=1
CEVALQUOTE=1
CGO=1
CGRADP=1
CLENGTH=1
CLOAD=1
CLOOK=1
CMAP=1
CMEMBER=1
CMEMQ=1
COR=1
CPROG=1
CPROP=1			; (DRW AUG-25-80)
CREMOB=1
CREMPROP=1
CRETURN=1
CREVIP=1
CREVERSE=1
CRPLACA=1

; THE FOLLOWING CONDITIONAL DEPENDENCIES REFLECT THE SUPPORTING
; FUNCTIONS OF A GIVEN FUNCTION OR THE ASSOCIATED FUNCTIONS
; WHICH ARE GROUPED IN THE SAME SOURCE FILE.

.IF	DF,CGREATERP!CLESSP
CGREATERP=1
CLESSP=1
.ENDC

.IF	DF,CMAP!CMAPC!CMAPCON!CMAPCAR!CMAPLIST
CMAP=1
CMAPC=1
CMAPCON=1
CMAPCAR=1
CMAPLIST=1
.ENDC

.IF	DF,CSTRING!CEXPLODE!CVALUE!CSTRLEN!CSEGMENT!CPOSITION
CSTRING=1
CEXPLODE=1
CVALUE=1
CSTRLEN=1
CSEGMENT=1
CPOSITION=1
.ENDC

.IF	DF,CARRAY!CCLARRAY
CARRAY=1
CCLARRAY=1
CINDEX=1
.ENDC

.IF	DF,CADD1!CDIFFERENCE!CPLUS!CSUB1!CADR!CSBR!FPU
CADR=1		;ADR HAS FPU OVERFLOW HANDLER FOR MLR & DVR
CSBR=1
.ENDC

.IF	DF,CARRAY!CTIMES
CMLI=1
.ENDC

.IF	DF,CARRAY!CUNTRACE!CUNTRSET
CREMPROP=1
.ENDC

.IF	DF,CMAX!CGREATERP!CMIN
CCMR=1
.ENDC

.IF	DF,CDIVIDE!CQUOTIENT!CREMAINDER!CRECIP
CDVI=1
CDVR=1
CDIVIDE=1
CQUOTIENT=1
CREMAINDER=1
CRECIP=1
.ENDC

.IF	DF,CRPLACA!CPRLD!CEFFACE
CRPLACA=1
CRPLD=1
.ENDC

.IF	DF,CFREE
CLENGTH=1
.ENDC

.IF	DF,CSUBLIS
CSUBST=1
.ENDC

.IF	DF,CDEFINE
CDEFLIST=1
.ENDC
;
; THE FOLLOWING CONDITIONAL ASSEMBLY PARAMETERS ENABLE CTRL/C TRAP UNDER RSTS
; (DRW 31-AUG-80)
;
	.IF	DF,RSTS
	CCTRLC=1
	.GLOBL	CTRLC,CCSTOR
	.ENDC
;
;
;******** INITIALIZATION SECTION
; NOTE THAT THE INIT CODE AND PNAME TABLE ARE IN THE UNNAMED
; PSECT WHICH IS OVERLAID BY AUXILIARY BUFFER SPACE.
;
	.PSECT			; (DRW 11-AUG-80)
	.GLOBL	LISP
	.MCALL	.CSISPC,.FETCH,.LOOKUP,.EXIT,.SETTOP,.GTIM
	.MCALL	.PRINT,.WAIT,.CLOSE,.SFPA,.SRESET,.ENTER
LISP:	.IF	DF,RSTS	
	.IF	NDF,RSX
	MOV	#28.,R0		; GRAB ALL THE CORE
	.GETCOR			;    WE NEED TO RUN (DRW 19-NOV-80)
	.ENDC
	.ENDC
	MOV	#TRAPH,@#34	;INITIALIZE TRAP VECTOR
	CLR	@#36
	.GTIM	#AREA,#STIME	;STORE PROGRAM START TIME
	MOV	HBOUND,R5	;POINTER TO FREE MEMORY
	SUB	#39.*2,SP	;ROOM FOR DV SPEC BLK
	MOV	SP,R4
	.CSISPC	R4,#DEFEXT
	BCS	CSIERR
	CLR	R3		;INDEX FOR I/O TABLE
	TST	@R4		;CHECK FOR CHANNEL 0 USED
	BNE	8$
	MOV	(PC)+,@R4	;USING TT: BY DEFAULT
	  .RAD50	/TT/
	BR	1$
8$:	CMP	@R4,(PC)+
	  .RAD50	/TT/
	BEQ	1$		;JUMP IF USING TT: BY REQUEST
	CLR	(R5)+		;SIZE WORD FOR MEM SPACE MANAGEMENT
	.FETCH	R5,R4		;FETCH THE DEVICE
	MOV	R0,-(R5)
	SUB	R5,@R5
	MOV	R0,R5
	.ENTER	#AREA,#0,R4,#0	;OPEN THE FILE
	BCS	USERRM		;ERROR IF NO ROOM
	MOV	#LISP+512.,BFRTBL	;ASSIGN A BUFFER
1$:	MOV	#-1,FLGTBL	;FILL IN I/O SLOT 0
	MOV	@R4,DEVTBL	;SAVE DEVICE MNEMONIC
	ADD	#3*5*2,R4	;IGNORE ANY OTHER OUTPUT SPECS
	MOV	#6,R1		;NUMBER OF INPUT SPECS
	INC	R3		;NEXT I/O SLOT
	MOV	#177401,R2	;NO PREVIOUS INPUT CHANNEL
	TST	@R4		;CHECK FOR FIRST INPUT
	BNE	3$
	MOV	(PC)+,@R4
	  .RAD50	/TT/
	BR	5$		;USING TT BY DEFAULT
3$:	CMP	@R4,(PC)+
	  .RAD50	/TT/
	BEQ	5$		;JUMP IF USING TT BY REQUEST
	CLR	(R5)+
	.FETCH	R5,R4
	MOV	R0,-(R5)
	SUB	R5,@R5
	MOV	R0,R5
	.LOOKUP	#AREA,R3,R4	;OPEN THE FILE
	BCS	CSIERR
5$:	ASL	R3		;SLOT OFFSET
	MOV	R2,FLGTBL(R3)	;LINK TO NEXT INPUT
	MOV	R3,R2
	ASR	R2
	SWAB	R2
	INC	R2
	INCB	INSYS		;SYSIN IS NEXT CHANNEL
	MOV	@R4,DEVTBL(R3)
	ASR	R3		;BACK TO CHANNEL NUMBER
	INC	R3		;NEXT CHANNEL TO USE
18$:	ADD	#4*2,R4		;ON TO NEXT INPUT SPEC
	DEC	R1
	BEQ	LISP01		;JUMP IF NO MORE
	TST	@R4
	BEQ	18$		;JUMP IF NEXT IS UNUSED
	BR	3$		;ELSE LOOP BACK TO PROCESS IT
USERRM:	.PRINT	#USERM		;(DRW  11-AUG-80)
	BR	FILERR		; (DRW 11-AUG-80)
CSIERR:	.PRINT	#BADCS
FILERR:	CLRB	INSYS
	.SRESET
	MOV	#16.,R1
1$:	CLR	FLGTBL(R1)
	CLR	BFRTBL(R1)
	SUB	#2,R1
	BPL	1$
	MOV	@#42,SP		;RESET STACK
	JMP	LISP
LISP01:	DEC	R3		;ASSIGN BUFFER TO LAST INPUT SPEC
	ASL	R3
	MOV	#LISP+512.,BFRTBL(R3)
	TST	BFRTBL
	BEQ	1$		;JUMP IF NO OUT BUFFER
	ADD	#512.,BFRTBL(R3)	;ELSE CORRECT BUFFER ADDR
1$:	SUB	#2,R3		;IF ONLY ONE INPUT THEN NO SUBSYSTEMS
	MOV	R3,SUBSYS
	MOV	(SP)+,R0
	BEQ	LISP06		;COLLECT SWITCH INFO IF ANY PRESENT
LISP05:	MOV	(SP)+,R1	;POP SWITCH NAME
	BMI	.+6		;JUMP IF IT HAS A VALUE
	MOV	#1,-(SP)	;OTHERWISE INSERT A DEFAULT FLAG VALUE
	SUB	#'A,R1		;SWITCH NAME - 'A
	BIC	#177740,R1	;5 BIT SWITCH TABLE INDEX
	ASL	R1		;BYTE OFFSET
	MOV	(SP)+,SWDATA(R1);STORE SWITCH VALUE
	DEC	R0		;LOOP BACK FOR MORE SWITCHES
	BGT	LISP05
LISP06:	ADD	#39.*2,SP	;CLEAR STACK
	ASL	ASWVAL		;ALLOCATE ARRAY SPACE
	BNE	9$
	BIT	#2,R5		;NONE TO ALLOCATE: FIX FREE SPACE POINTER
	BEQ	4$
	BR	3$
9$:	MOV	R5,AVAIL	;SET UP AVAIL LIST
	MOV	ASWVAL,(R5)+
	CLR	@R5
	TST	-(R5)
	ADD	@R5,R5		;TOP OF ARRAY SPACE
	BIT	#2,R5
	BEQ	4$
	ADD	#2,@AVAIL	;ADD A WORD TO ARRAY SPACE
3$:	TST	(R5)+		;FORCE FREE SPACE TO START ON EVEN WORD
4$:	MOV	R5,FSTART
	MOV	R5,ASTART
	MOV	@#RMON,R1	;ESTABLISH HIGH LIMIT OF
	MOV	USR(R1),R0	;AVAILABLE CORE.  REQUEST UP
	CMP	R0,@#50		;TO USR UNLESS IT IS ALREADY SWAPPING
	BLOS	1$
	TST	MSWVAL		;OR UNLESS M SWITCH SET IN WHICH
	BEQ	.+4		;CASE REQUEST USR SWAP STATE
1$:	CLR	R0
	TST	-(R0)
	.SETTOP			;RETURN WITH R0 POINTING TO LAST
	TST	(R0)+		;ALLOWED WORD
	MOV	R0,ENDLSP	;SAVE POINTER TO END OF LISP
	MOV	R0,R5		;INIT ARG STACK POINTER
	ASL	SSWVAL		;NUMBER OF BYTES TO ALLOW FOR STACKS
	SUB	SSWVAL,R0	;POINT TO START OF STACKS
	BIC	#3,R0		;AND MAKE IT AN EVEN WORD BOUNDARY
	MOV	R0,SSTART	;SAVE POINTER
	MOV	R0,R4		;INIT SUBR STACK POINTER
	MOV	FSTART,R1	;CLEAR FREE WORD SPACE AND
	MOV	#FLIST,R2	;MAKE A FREE CELL LIST
LISP07:	MOV	R1,@R2		;CHAIN A CELL TO THE LIST
	CLR	(R1)+		;CLEAR THE CAR
	MOV	R1,R2		;SAVE CDR POINTER
	TST	(R1)+		;POINT TO NEXT CAR
	CMP	R1,R4		;TOP OF FREE SPACE YET?
	BLO	LISP07		;LOOP BACK IF NOT
	CLR	@R2		;OTHERWISE END FREE CELL LIST
	CLR	R0		;SAVE LOCATIONS 0 & 2
	MOV	(R0)+,-(SP)
	MOV	@R0,-(SP)
; LOAD FLOATING POINT TRAP VECTOR IF FIS EXISTS
	.IFDF	FIS
	.SFPA	#AREA,#FISTRAP
	.ENDC
; IF FPU EXISTS CAUSE REGS TO CONTEXT SWITCH
	.IFDF	FPU
	.SFPA	#AREA,#1
; DISABLE FPU INTERRUPTS
	.WORD	170127,040000	;LDFPS #40000
	.ENDC
; BUILD THE OBLIST
	MOV	FLIST,R0
	MOV	R0,-(R5)	;THE OBLIST IS THE FIRST ITEM ON
	MOV	R0,$OBLST	;THE ARG STACK
	ADD	#128.,R0	;GRAB THE FIRST 32 CELLS OF THE LIST
	MOV	R0,FLIST	;SAVE THE REST OF THE FREE LIST
	CMP	R0,R4		;IF FREE SPACE IS ALREADY EXHAUSTED
	BLO	LISP08		;THEN FATAL ERROR
	.PRINT	#NOROOM
	CLR	R0
	.EXIT
LISP08:	CLR	-(R0)		;TERMINATE OBLIST PROPERLY
; INSTALL BUILT IN ATOMS ON OBLIST
;	FIRST DO THE APVAL NIL AS A SPECIAL CASE
	MOV	#APOINT,-(SP)	;TABLE OF ATOM POINTERS
	MOV	#PNAMES,-(SP)	;LIST OF ASCII PNAMES
	MOV	@SP,R3		;POINT TO "NIL"
	QPNMBLD			;MAKE A LITERAL ATOM WITH NULL PROP.LST
	MOV	R3,@SP		;SAVE UPDATED PNAME LIST POINTER
	CLR	R1		;PUT NIL HEADER AT 0,2
	MOV	(R5)+,R0	;POP CAR AND CDR OF NIL
	MOV	(R0)+,(R1)+	;INTO SPECIAL CELL
	MOV	(R0)+,(R1)+
	CLR	-(R5)		;NOW INSTALL NIL ON OBLIST
	QATMOBL
	TST	(R5)+		;DISCARD VALUE OF ATMOBL
;
;	NEXT INSTALL ALL THE INDICATORS AND BUILT-IN APVALS
	MOV	#APVNUM+INDNUM,-(SP)	;TOTAL NUMBER
LISP09:	MOV	2(SP),R3	;POINTER TO NEXT ASCII PNAME
	QPNMBLD			;MAKE A LITERAL ATOM
	MOV	R3,2(SP)	;SAVE UPDATED POINTER
	QATMOBL			;INSTALL ATOM ON OBLIST
	MOV	4(SP),R0
	MOV	(R5)+,(R0)+	;POP IT INTO TABLE OF ATOM PTRS
	MOV	R0,4(SP)	;AND SAVE UPDATED TABLE POINTER
	DEC	@SP
	BGT	LISP09		;LOOP BACK FOR MORE INDICATORS OR APVALS
;    NOW BUILD PROPERTY LISTS FOR BUILT-IN APVALS
	CLR	-(R5)		;NIL:=NIL
	MOV	APVAL,-(R5)	;INDICATOR
	CLR	-(R5)		;ATOM
	QPUT			;PUT[NIL;APVAL;NIL]
	TST	(R5)+		;IGNORE THE VALUE OF PUT
	SUB	#2*APVNUM,4(SP)	;POINT BACK TO START OF APVALS
	CLR	-(R5)		;ANSWER:=NIL
	JSR	PC,APPUT
	CLR	-(R5)		;F:=NIL
	JSR	PC,APPUT
	CLR	-(R5)		;%G:=.T. OR NIL
	TST	GSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	CLR	-(R5)		;%I:=.T. OR NIL
	TST	ISWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	MOV	LSWVAL,-(SP)	;%L:=L SWITCH VALUE
	QI2ATM
	JSR	PC,APPUT
	MOV	$OBLST,-(R5)	;OBLIST:=$OBLST
	JSR	PC,APPUT
	CLR	-(R5)		;%O:=.T. OR NIL
	TST	OSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	CLR	-(R5)		;%R:=.T. OR NIL
	TST	RSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	MOV	.T.,-(R5)	;T:=.T.
	JSR	PC,APPUT
	CLR	-(R5)		;%T:=.T. OR NIL
	TST	TSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	CLR	-(R5)		;%W:=.T. OR NIL
	TST	WSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	CLR	-(R5)		;%X:=.T. OR NIL
	TST	XSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	CLR	-(R5)		;%Z:=.T. OR NIL
	TST	ZSWVAL
	BEQ	.+6
	MOV	.T.,@R5
	JSR	PC,APPUT
	MOV	.T.,-(R5)	;.T.:=.T.
	JSR	PC,APPUT
;    NEXT INSTALL ALL THE SUBRS AND FSUBRS
	MOV	#FCTNUM,@SP
LISP20:	MOV	2(SP),R3	;POINTER TO NEXT ASCII PNAME
	QPNMBLD			;MAKE A LITERAL ATOM
	MOV	R3,2(SP)	;SAVE UPDATED POINTER
	QATMOBL			;INSTALL ATOM ON OBLIST
	MOV	4(SP),R2
	MOV	(R5)+,(R2)+	;POP IT INTO TABLE OF ATOM PTRS
	MOV	R2,4(SP)	;AND SAVE UPDATED POINTER
	MOV	2(SP),R3
	MOVB	(R3)+,-(SP)	;PICK UP ARGCNT
	BMI	LISP21		;JUMP IF FSUBR
	MOVB	(R3)+,1(SP)	;PICK UP TRAP CODE
	QI2ATM			;MAKE AN INTEGER ATOM
	MOV	SUBR,-(R5)	;INDICATOR
	BR	LISP22
LISP21:	MOVB	(R3)+,1(SP)	;PICK UP TRAP CODE
	QI2ATM
	MOV	FSUBR,-(R5)	;PUSH INDICATOR
LISP22:	MOV	R3,2(SP)	;SAVE UPDATED POINTER
	MOV	-(R2),-(R5)	;PUSH ATOM
	QPUT
	TST	(R5)+		;IGNORE VALUE OF PUT
	DEC	@SP
	BGT	LISP20		;LOOP BACK FOR MORE SUBRS OR FSUBRS
	ADD	#6,SP		;CLEAR TEMPORARIES FROM STACK
; INITIALIZATION IS COMPLETE
; LINK IN EXTRA AUXILLIARY BUFFER SPACE
	MOV	AVAIL,R0
	MOV	#SPARE-1024.,R2
	MOV	#LISP+512.,R1
	TST	BFRTBL
	BEQ	1$
	ADD	#512.,R1
	SUB	#512.,R2
1$:	MOV	R1,AVAIL
	JMP	LISP30
;
; SPECIAL INIT SUBROUTINE FOR APVALS
APPUT:	MOV	APVAL,-(R5)	;INDICATOR
	MOV	@6(SP),-(R5)	;ATOM
	QPUT			;PUT[<ATOM>;APVAL;<VALUE>]
	TST	(R5)+		;IGNORE VALUE OF PUT
	ADD	#2,6(SP)	;UPDATE POINTER TO TABLE OF ATOM PTRS
	RTS	PC
; TEMPORARY DATA
	.NLIST	BEX
NOROOM:	.ASCIZ	/? NO ROOM IN LISP/
BADCS:	.ASCIZ	/? BAD COMMAND STRING/
USERM: .ASCIZ	/? NO ROOM FOR USER/	;(DRW 11-AUG-80)
	.EVEN
	.LIST	BEX
;
;
	.PSECT	XTCODE
	.GLOBL	LSPXT
LISP30:	MOV	R2,(R1)+	;FINISH AUX BUFFER INSERTION
	MOV	R0,@R1
	.IF	NDF,RT11
	MOV	R2, TMPLNK	; SAVE INITIAL SIZE WORD AND
	MOV	R0, TMPLNK + 2	;	LINK FOR USE IN RELEASE OF BUFFER FOR
	.ENDC			;	THE 1ST SUBSYSTEM FILE (DRW 5-DEC-80).
;
;	SETCC -- ENABLE CTRL/C TRAPPING UNDER RSTS ( DRW 4-SEPT-80)
;
	.IF	DF,CCTRLC
	MOV	SP,CCSTOR	; SAVE SP FOR RESTORATION IF CTRL/C
	MOV	R0,CCSTOR + 2	; SAVE R0		"
	MOV	R1,CCSTOR + 4	; SAVE R1		"
	MOV 	R2,CCSTOR + 6	; SAVE R2		"
	MOV	R3,CCSTOR + 10	; SAVE R3		"
	MOV	R4,CCSTOR + 12	; SAVE R4		"
	MOV	R5,CCSTOR + 14	; SAVE R5		"
	MOV	R0,-(SP)	
	MOV	#CTRLC,R0
	.IF	DF,RSX
	MOV	R0,@#24		; ENABLE CTRL/C TRAP FOR RSX (SEE SCCA$)
	.IFF
	.SETCC			; ENABLE CTRL/C TRAP FOR RT11
	.ENDC
	MOV	(SP)+,R0	
	.ENDC
	QMAINLOOP		; AND AWAY WE GO !!!!!!!!!!
LSPXT:	CLR	R3		;OUTPUT ANY PARTIAL BUFFER
	QPRNT
	MOV	#8.,R1		;CLOSE ANY OPEN CHANNELS
1$:	.WAIT	R1
	BCS	2$
	.CLOSE	R1
2$:	DEC	R1
	BGE	1$
	MOV	@#42,R0		;STACK LOCATION FROM SYSCOM AREA
	CLR	R1
	MOV	-(R0),(R1)+	;RESTORE WORDS 0 & 2
	MOV	-(R0),@R1
	CLR	R0		;HARD EXIT
	.EXIT
	.PAGE
	.PSECT	TRAPHD
;******** TRAP HANDLER
; CALL PC IS TRANSFERRED TO SUBR STACK, PSW DISCARDED.
; C-BIT IS CLEARED PRIOR TO DISPATCHING TO FUNCTION.
; R0 IS DESTROYED.  ON ENTRY TO FUNCTION AT LEAST ONE STACK
; SPACE IS AVAILABLE.
TRAPH:	MOV	(SP)+,R0	;GET RETN PC
	TST	(SP)+		;DISCARD PSW
	TST	@R0		;IF CALL IS FOLLOWED BY .WORD 0 THEN
	BEQ	.+4		;DON'T SAVE RETURN PATH, OTHERWISE
	MOV	R0,(R4)+	;PUT RETN PC ON SUBR STACK
	MOV	-(R0),-(SP)	;GET TRAP INSTRUCTION
	CLRB	1(SP)		;SAVE LOW BYTE CODE
	MOV	(SP)+,R0
	CMP	R4,R5		;CHECK FOR ADEQUATE STACK SPACE
	BHIS	TRAPER		;JUMP IF NONE LEFT
TRAP01:	ASL	R0		;FORM A BYTE OFFSET
	JMP	@TTABLE(R0)	;DISPATCH TO FUNCTION
TRAPER:	CMP	R0,#320		;ALWAYS DISPATCH IF DESTINATION IS
	BGE	TRAP01		;ANOTHER ERROR ROUTINE
	JMP	@TTABLE+<2*<QG2ERR&377>>	;OTHERWISE STACK OVFL
;
; FIS TRAP CATCHER
	.IFDF	FIS
FISTRAP:.SFPA	#AREA,#FISTRAP	;RESET CATCHER
	RTI			;JUST RETURN (V BIT WILL BE SET)
	.ENDC
;
;******** TABLE BUILDING CODE
; TABLE ENTRY MACRO DEFINITIONS:
;
;**** UTILITY FUNCTIONS:
	.MACRO	ENTERU	NAME
	.PSECT	DSPTCH
;	ONLY HAVE ENTRY IN DISPATCH TABLE
	.GLOBL	Q'NAME,NAME
Q'NAME=TRAP+<<.-TTABLE>/2>
	.WORD	NAME
	.ENDM
;
; CONDITIONAL ENTERU
	.MACRO	ENTRUC	NAME
	.IF	DF,C'NAME
	ENTERU	<NAME>
	.ENDC
	.ENDM
;
;**** SUBRS:
	.MACRO	ENTERS	NAME,ARGCNT,PNAME
	.PSECT	APTRS
;	ENTRY IN ATOM POINTER TABLE
	.GLOBL	Y'NAME
Y'NAME:	.WORD	0
FCTNUM=FCTNUM+1
	.PSECT	DSPTCH
;	ENTRY IN DISPATCH TABLE
	.GLOBL	Q'NAME,NAME
Q'NAME=TRAP+<<.-TTABLE>/2>
	.WORD	NAME
	.PSECT	FSIZE
;	ENTRY IN FUNCTION SIZE TABLE
	.GLOBL	Z'NAME
	.WORD	Z'NAME
	.PSECT
;	ENTRY IN ATOM PNAME TABLE
	.IF	NB,PNAME
	.ASCIZ	/PNAME/
	.IFF
	.ASCIZ	/NAME/
	.ENDC
	.BYTE	ARGCNT,Q'NAME&377
	.ENDM
;
; CONDITIONAL ENTERS
	.MACRO	ENTRSC	NAME,ARGCNT,PNAME
	.IF	DF,C'NAME
	ENTERS	<NAME>,<ARGCNT>,<PNAME>
	.ENDC
	.ENDM
;
;**** FSUBRS:
	.MACRO	ENTERF	NAME,PNAME
	.PSECT	APTRS
;	ENTRY IN ATOM POINTER TABLE
	.GLOBL	Y'NAME
Y'NAME:	.WORD	0
FCTNUM=FCTNUM+1
	.PSECT	DSPTCH
;	ENTRY IN DISPATCH TABLE
	.GLOBL	Q'NAME,NAME
Q'NAME=TRAP+<<.-TTABLE>/2>
	.WORD	NAME
	.PSECT	FSIZE
;	ENTRY IN FUNCTION SIZE TABLE
	.GLOBL	Z'NAME
	.WORD	Z'NAME
	.PSECT
;	ENTRY IN ATOM PNAME TABLE
	.IF	NB,PNAME
	.ASCIZ	/PNAME/
	.IFF
	.ASCIZ	/NAME/
	.ENDC
	.BYTE	-1,Q'NAME&377
	.ENDM
;
; CONDITIONAL ENTERF
	.MACRO	ENTRFC	NAME,PNAME
	.IF	DF,C'NAME
	ENTERF	<NAME>,<PNAME>
	.ENDC
	.ENDM
;
;**** INDICATORS:
	.MACRO	ENTERI	NAME,PNAME
	.PSECT	APTRS
;	ENTRY IN ATOM POINTER TABLE
	.GLOBL	NAME
NAME:	.WORD	0
INDNUM=INDNUM+1
	.PSECT
;	ENTRY IN ATOM PNAME TABLE
	.IF	NB,PNAME
	.ASCIZ	/PNAME/
	.IFF
	.ASCIZ	/NAME/
	.ENDC
	.ENDM
;
;**** BUILT IN APVALS:
	.MACRO	ENTERA	NAME,PNAME
	.PSECT	APTRS
;	ENTRY IN ATOM POINTER TABLE
	.GLOBL	NAME
NAME:	.WORD	0
APVNUM=APVNUM+1
	.PSECT
;	ENTRY IN ATOM PNAME TABLE
	.IF	NB,PNAME
	.ASCIZ	/PNAME/
	.IFF
	.ASCIZ	/NAME/
	.ENDC
	.ENDM
;
;
; NOW BUILD THE TABLES.
;	NOTES:	1) TO ADD AN INDICATOR, SUBR, FSUBR, ERROR
;		   HANDLER, OR UTILITY ROUTINE MERELY INSERT
;		   ANOTHER ENTER* MACRO CALL IN THE APPROPRIATE
;		   PLACE.
;		2) TO ADD A BUILT-IN APVAL INSERT ANOTHER ENTERA
;		   MACRO CALL AND EDIT THE INIT CODE TO PROPERLY
;		   INITIALIZE THE APVAL.
;
; INIT COUNTERS AND TABLE POINTERS
INDNUM=0
APVNUM=0
FCTNUM=0
	.PSECT	APTRS
	.GLOBL	APOINT
APOINT:
	.PSECT
PNAMES:	.ASCIZ	/NIL/		;NIL MUST BE FIRST IN PNAME LIST
	.PSECT	DSPTCH
	.GLOBL	TTABLE
TTABLE:
	.PSECT	FSIZE
	.GLOBL	FCTSIZ
FCTSIZ:
;
; TO GENERATE TABLES PROPERLY INDICATORS MUST COME FIRST,
; THEN APVALS, THEN UTILITY ROUTINES, THEN SUBRS AND FSUBRS,
; AND LASTLY ERROR ROUTINES.  THE ORDER IN ANY PARTICULAR GROUP
; IS IMMATERIAL EXCEPT THAT THE APVAL ORDER MUST BE THE SAME
; HERE AS IN THE APVAL INITIALIZATION CODE.
;
; INDICATORS:
	ENTERI	APVAL
	ENTERI	EXPR
	ENTERI	FEXPR
	ENTERI	FSUBR
	ENTERI	FUNARG
	ENTERI	FUNCTION
	ENTERI	LABEL
	ENTERI	LAMBDA
	ENTERI	QUOTE
	ENTERI	SUBR
	ENTERI	EOF,<%EOF>
;
; BUILT-IN APVALS:
	ENTERA	ANSWER,<%ANS>
	ENTERA	F
	ENTERA	GSW,<%G>
	ENTERA	ISW,<%I>
	ENTERA	LSW,<%L>
	ENTERA	OBLIST
	ENTERA	OSW,<%O>
	ENTERA	RSW,<%R>
	ENTERA	T
	ENTERA	TSW,<%T>
	ENTERA	WSW,<%W>
	ENTERA	XSW,<%X>
	ENTERA	ZSW,<%Z>
	ENTERA	.T.,<*T*>
;
; DISPATCH TABLE
;	UTILITY ROUTINES FIRST
	ENTERU	GETC		;FREE CELL FETCHER
	ENTERU	HASH		;PNAME HASHER
	ENTERU	STRBLD		;STRING ATOM BUILDER
	ENTERU	PNMBLD		;PNAME BUILDER
	ENTERU	ATMOBL		;OBLIST INSTALLER
	ENTERU	I2ATM		;FIXED POINT NUMERIC ATOM MAKER
	ENTERU	TIMER		;ELAPSED TIME CALCULATOR
	ENTERU	PRNT		;ASCII BUFFER PRINTER
	ENTERU	SPL		;PROPERTY LIST SEARCHER
	ENTERU	RI		;REAL TO INTEGER CONVERTER
	ENTERU	IR		;INTEGER TO REAL CONVERTER
	ENTERU	IDR		;DOUBLE INTEGER TO REAL CONVERTER
	ENTERU	ATM2N		;ATOMIC NUMBER EXTRACTOR
	ENTERU	LEXICL		;LEXICAL CLASS IDENTIFIER
	ENTERU	PARLBL		;PARENTHESIS LABELLER
	ENTERU	OCI		;OCTAL INPUT CONVERTER
	ENTERU	ICI		;INTEGER INPUT CONVERTER
	ENTERU	RCI		;FLOATING POINT INPUT CONVERTER
	ENTERU	ICO		;INTEGER OUTPUT CONVERTER
	ENTERU	OCO		;OCTAL OUTPUT CONVERTER
	ENTERU	ECO		;E FORMAT FLOATING OUTPUT CONVERTER
	ENTERU	FCO		;F FORMAT FLOATING OUTPUT CONVERTER
	ENTERU	GCO		;G FORMAT FLOATING OUTPUT CONVERTER
	ENTERU	R2ATM		;FLOATING POINT NUMERIC ATOM MAKER
	ENTERU	PNBUFI		;PNAME BUFFER CHARACTER INSERTER
	ENTERU	RDCHAR		;CHARACTER FETCHER
	ENTERU	RDBKUP		;INPUT POINTER BACKSPACER
	ENTERU	ATM2AS		;ATOM TO ASCII CONVERTER
	ENTRUC	MLI		;INTEGER MULTIPLIER
	ENTERU	MLR		;REAL MULTIPLIER
	ENTRUC	ADR		;REAL ADDER
	ENTRUC	SBR		;REAL SUBTRACTER
	ENTRUC	DVI		;INTEGER DIVIDER
	ENTRUC	DVR		;REAL DIVIDER
	ENTRUC	CMR		;REAL COMPARATOR
	ENTRUC	INDEX		;ARRAY INDEXER
	ENTERU	ALLOCATE	;MEMORY ALLOCATOT
	ENTERU	RELEASE		;MEMORY RECLAIMER
	ENTERU	ILINK		;SYSIN LINKER
	ENTRUC	CTRLC		;CTRL/C TRAP HANDLER (DRW 31-AUG-80)
;
;	SUBRS AND FSUBRS
;	SET UP NEW POINTERS
	.PSECT	APTRS
	.GLOBL	FCTATM
FCTATM:
	.PSECT	DSPTCH
	.GLOBL	FCTLOW
FCTLOW:
;
	ENTRSC	ADDR,1
	ENTRSC	ADD1,1
	ENTERS	ADVANCE,1
	ENTRSC	ALIST,0
	ENTRSC	ALPHAP,2
	ENTRFC	AND
	ENTRSC	APPEND,2
	ENTERS	APPLY,2
	ENTRSC	ARRAY,2
	ENTERS	ATOM,1
	ENTERS	CAR,1
	ENTERS	CARCDR,1,<C..R>		;C.R FUNCTION HANDLER
	ENTERS	CDR,1
	ENTERS	CHLEX,2
	ENTRSC	CLARRAY,1
	ENTERS	CLOSE,1
	ENTRFC	CONC
	ENTERF	COND
	ENTERS	CONS,2
	ENTRSC	COPY,1
	ENTRSC	DEFINE,1
	ENTRSC	DEFLIST,2
	ENTRSC	DIFFERENCE,2
	ENTRSC	DIVIDE,2
	ENTRSC	EFFACE,2
	ENTERS	ENTER,1
	ENTERS	EQ,2
	ENTERS	EQN,2
	ENTERS	EQUAL,2
	ENTERS	ERROR,1
	ENTRSC	ERRSET,3
	ENTERS	EVAL,1
	ENTRSC	EVALQUOTE,2
	ENTERS	EVLIS,1
	ENTRSC	EXPLODE,1
	ENTRSC	FIX,1
	ENTERS	FIXP,1
	ENTRSC	FLOAT,1
	ENTERS	FLOTP,1,<FLOATP>
	ENTRSC	FREE,0
	ENTRFC	GENSYM
	ENTERS	GET,2
	ENTRFC	GO
	ENTRSC	GRADP,2
	ENTRSC	GREATERP,2
	ENTERS	INFP,1
	ENTERS	INPUT,1
	ENTERS	INTERN,1
	ENTERS	KILL,1
	ENTRSC	LENGTH,1
	ENTRSC	LESSP,2
	ENTERF	LIST
	ENTRSC	LOAD,1
	ENTRFC	LOGAND
	ENTRFC	LOGOR
	ENTRFC	LOGXOR
	ENTRSC	LOOK,1
	ENTERS	LOOKUP,1
	ENTRSC	LSHIFT,2
	ENTERS	MAINLOOP,0
	ENTRSC	MAP,2
	ENTRSC	MAPC,2
	ENTRSC	MAPCAR,2
	ENTRSC	MAPCON,2
	ENTRSC	MAPLIST,2
	ENTRFC	MAX
	ENTRSC	MEMBER,2
	ENTRSC	MEMQ,2
	ENTRFC	MIN
	ENTRSC	MINUS,1
	ENTERS	MNUSP,1,<MINUSP>
	ENTERS	NCONC,2
	ENTERS	NOT,1
	ENTERS	NULL,1
	ENTERS	NUMBERP,1
	ENTERS	ONEP,1
	ENTRFC	OR
	ENTERS	OUTPUT,2
	ENTERS	PAIR,2
	ENTRFC	PLUS
	ENTERS	PNAME,1
	ENTERS	POSITION,3
	ENTERS	PRINT,1
	ENTERS	PRIN1,1
	ENTRFC	PROG
	ENTERF	PROGN
	ENTRSC	PROP,3
	ENTERS	PUT,3
	ENTRSC	QUOTIENT,2
	ENTRSC	RANDOM,1
	ENTERS	READ,0
	ENTRSC	RECIP,1
	ENTERS	RECLAIM,0
	ENTRSC	REMAINDER,2
	ENTRSC	REMOB,1
	ENTRSC	REMPROP,2
	ENTRSC	RETURN,1
	ENTRSC	REVERSE,1
	ENTRSC	REVIP,1,<REVERSIP>
	ENTRSC	RPLACA,2
	ENTRSC	RPLD,2,<RPLACD>
	ENTERS	SASSOC,3
	ENTRSC	SEARCH,4
	ENTRSC	SEGMENT,3
	ENTRFC	SELECT
	ENTERS	SET,2
	ENTERF	SETQ
	ENTRSC	SIZE,1
	ENTRFC	STRING
	ENTERS	STRGP,1,<STRINGP>
	ENTRSC	STRLEN,1
	ENTRSC	SUBLIS,2
	ENTRSC	SUBST,3
	ENTRSC	SUB1,1
	ENTERS	SYSIN,1
	ENTERS	SYSOUT,1
	ENTRSC	TEMPUS,0
	ENTERS	TERPRI,0
	ENTRFC	TIMES
	ENTRSC	TRACE,1
	ENTRSC	TRSET,1,<TRACESET>
	ENTRFC	UNDEF
	ENTRSC	UNTRACE,1
	ENTRSC	UNTRSET,1,<UNTRACESET>
	ENTRSC	VALUE,1
	ENTERS	ZEROP,1
;
; FILL UP DISPATCH TABLE WITH TRAP ERROR POINTERS UNTIL TRAP+320
	.PSECT	DSPTCH
	.GLOBL	FCTDTL,T1ERR
FCTDTL:				;LISP FUNCTION DISPATCH TABLE LIMIT
	.REPT	320-<<.-TTABLE>/2>
	.WORD	T1ERR
	.ENDM
;
;	ERROR HANDLERS
	ENTERU	A1ERR
	ENTERU	A2ERR
	ENTERU	A3ERR
	ENTERU	A4ERR
	ENTERU	A5ERR
	ENTERU	A6ERR
	ENTERU	A7ERR
	ENTERU	A8ERR
	ENTERU	A9ERR
	ENTERU	A10ERR
	ENTERU	F1ERR
	ENTERU	F2ERR
	ENTERU	G1ERR
	ENTERU	G2ERR
	ENTERU	GC1ERR
	ENTERU	GC2ERR
	ENTERU	I1ERR
	ENTERU	I2ERR
	ENTERU	I3ERR
	ENTERU	I4ERR
	ENTERU	I5ERR
	ENTERU	IO1ERR
	ENTERU	IO2ERR
	ENTERU	IO3ERR
	ENTERU	IO4ERR
	ENTERU	O1ERR
	ENTERU	O2ERR
	ENTERU	R1ERR
	ENTERU	R2ERR
	ENTERU	R3ERR
	ENTERU	R4ERR
	ENTERU	R5ERR
	ENTERU	R6ERR
	ENTERU	T1ERR
	ENTERU	T2ERR
	ENTERU	T3ERR
;
; FILL UP ANY UNUSED PORTION OF THE DISPATCH TABLE
	.PSECT	DSPTCH
	.REPT	400-<<.-TTABLE>/2>
	.WORD	T1ERR
	.ENDM
;
; AFTER INITIALIZATION THE INIT CODE AND PNAME TABLE ARE
; USED AS AUXILIARY BUFFER SPACE AND SCRATCH SPACE
	.PSECT
	.EVEN
SPARE=.-LISP
	.PSECT	APTRS
	.GLOBL	APTEND
APTEND:
;
; THIS COMPLETES THE TABLE GENERATION CODE.
; THE FOLLOWING IS A SKETCH OF THE TABLE STRUCTURES:
;   BLANK PSECT...
;	LISP:	<INIT CODE>
;	PNAMES:	.ASCIZ	/NIL/
;		.ASCIZ	/<INDICATOR PNAME>/
;		...
;		.ASCIZ	/<BUILT-IN APVAL PNAME>/
;		...
;		.ASCIZ	/<SUBR OR FSUBR PNAME>/
;			.BYTE ARGCNT (MINUS 1 IF FSUBR)
;			.BYTE TRAPCODE
;		...
;	SPARE=.-LISP
;
;   ATOM POINTER PSECT...APTRS
;	APOINT:
;	<INDICATOR NAME>:   .WORD <INDICATOR ATOM ADDRESS>
;	...
;	<BUILT-IN APVAL NAME>:   .WORD <B.I. APVAL ATOM ADDR.>
;	...
;	FCTATM:
;	Y'<SUBR/FSUBR NAME>:   .WORD <S/F ATOM ADDRESS>
;	...
;	APTEND:
;
;   DISPATCH TABLE PSECT...DSPTCH
;	TTABLE:	.WORD	<UTILITY FCT ENTRY ADDR>
;		...
;	FCTLOW:	.WORD	<SUBR/FSUBR ENTRY(AND LOW) ADDRESS>
;		...
;	FCTDTL:	.WORD	<DISPATCH ERROR ROUTINE ENTRY>
;		...
;	(TTABLE+2*320):	.WORD	<ERROR HANDLER ENTRY ADDRESS>
;		...
;
;   FUNCTION SIZE PSECT...FSIZE
;	FCTSIZ:	.WORD	Z'<SUBR/FSUBR NAME>
;		...
; DUE TO REMNANTS OF CODE IN OTHER MODULES WHICH REFERENCE THE
; FOLLOWING FUNCTIONS, THEY MUST BE STUBBED WHEN GENERATING A
; SAVE FILE WITHOUT THEM.

.IF	NDF,CINDEX!CERRSET!CPROG!CARRAY!CALIST!CTRACE!CTRSET
	.PSECT	STUB
.IF	NDF,CINDEX
	.GLOBL	QINDEX
	QINDEX=QT1ERR		;NON-EXISTING FUNCTION
.ENDC
.IF	NDF,CERRSET
	.GLOBL	ADERST
	ADERST=1		;ILLEGAL RETURN PC
.ENDC
.IF	NDF,CPROG
	.GLOBL	YPROG,QPROG,ADPROG
	ADPROG=1		;ILLEGAL RETURN PC
	QPROG=QT1ERR		;NON-EXISTING FUNCTION
YPROG:
.ENDC
.IF	NDF,CARRAY
	.GLOBL	YARRAY
YARRAY:
.ENDC
.IF	NDF,CALIST
	.GLOBL	YALIST
YALIST:
.ENDC
.IF	NDF,CTRACE
	.GLOBL	YTRACE
YTRACE:
.ENDC
.IF	NDF,CTRSET
	.GLOBL	YTRSET
YTRSET:
.ENDC
.IF	NDF,CPROG!CARRAY!CALIST!CTRACE!CTRSET
	.WORD	-4		;POINTER TO NON-EXISTING ATOM
.ENDC
.ENDC
	.PAGE
	.PSECT	DATAB
;******** DATA BLOCK
	.GLOBL	FSTART,SSTART,ASTART,ENDLSP,HBOUND
; CORE MAP POINTERS
FSTART:	.WORD	0		;START OF FREE CELL SPACE
SSTART:	.WORD	0		;START OF ARG & SUBR STACK SPACE
ASTART:	.WORD	0		;START OF ARRAY SPACE
ENDLSP:	.WORD	0		;1ST NON-LISP WORD
LBOUND:	.LIMIT			;LISP LOW BOUND (DEFAULT BASE OF SP STACK)
HBOUND=.-2			;LISP INTERPRETER HIGH BOUND
	.GLOBL	PNBUF,PNBUFL,PCBUF,PCBUFL
PNBUF=LISP			;PRINT NAME BUFFER
PNBUFL=256.
PCBUF=PNBUF+PNBUFL		;PARANTHESIS COUNT BUFFER
PCBUFL=256.
.IIF	LT,SPARE-PNBUFL-PCBUFL-1024.-16.	.ERROR
	.GLOBL	FLIST,$ALIST,$OBLST
	; INTERNAL LISP VALUED GLOBALS
FLIST:	.WORD	0		;POINTER TO FREE CELL LIST
$ALIST:	.WORD	0		;CURRENT ASSOCIATION LIST
$OBLST:	.WORD	0		;POINTER TO OBJECT LIST
	.GLOBL	STIME,ETIME
; TIMERS:
STIME:	.WORD	0,0		;PROGRAM START TIME (HI,LO TICS)
ETIME:	.WORD	0,0		;TOP LEVEL EVAL START TIME
; SUBR VALUE OF C.R FUNCTION ATOM
	.GLOBL	C....R
C....R=400*<QCARCDR&377>+1
	.GLOBL	FLGTBL,DEVTBL,BLKTBL,BFRTBL,PTRTBL
	.GLOBL	INSYS,OUTSYS,SUBSYS
; I/O INFORMATION
FLGTBL:	.WORD	0,0,0,0,0,0,0,0,0	;CHANNEL USE FLAGS, LO BYTE:
				;0=AVAIL,1=INPUT,2=LOOKUP'D,-1=OUTPUT,-2=ENTER'D
				;HI BYTE: PREVIOUS CHANNEL (SYSIN/SYSOUT)
DEVTBL:	.WORD	0,0,0,0,0,0,0,0,0	;DEVICE NAME
BLKTBL:	.WORD	0,0,0,0,0,0,0,0,0	;RELATIVE BLOCK IN FILE
BFRTBL:	.WORD	0,0,0,0,0,0,0,0,0	;I/O BUFFER ADDRESS
PTRTBL:	.WORD	0,0,0,0,0,0,0,0,0	;OFFSET INTO BUFFER FOR NEXT CHAR
INSYS:	.BYTE	0,377			;LO BYTE=SYSIN, HI BYTE=CURRENT INPUT CHANNEL
OUTSYS:	.BYTE	0,377			;LO BYTE=SYSOUT, HI BYTE=CURRENT OUTPUT CHANNEL
SUBSYS:	.WORD	0			;NON-ZERO WHILE READING SUBSYSTEMS
					; + WHILE READING SUBSYSTEM FROM CSI
					; - WHILE READING CALLED SUBSYSTEM
	.GLOBL	AVAIL
AVAIL:	.WORD	0			;FREE MEMORY LIST: 1ST WORD OF BLOCK IS SIZE
					;IN BYTES, 2ND WORD IS POINTER TO NEXT BLOCK
	.IF	NDF,RT11
	.GLOBL	TMPLNK
TMPLNK:	.WORD	0,0			; TEMPORARY BUFFER LINKAGE INFORMATION
	.ENDC
	.GLOBL	AREA,DEFEXT
AREA:	.BLKW	10			;EMT ARGUMENT LIST
DEFEXT:	.RAD50	/LSP/			;DEFAULT EXTENSIONS FOR .CSIGEN
	.RAD50	/LST/
	.WORD	0,0
;
; RAW SWITCH DATA AND DEFAULTS
SWDATA:
	.GLOBL	GSWVAL,ISWVAL,LSWVAL,OSWVAL,RSWVAL,TSWVAL,WSWVAL
	.GLOBL	XSWVAL,ZSWVAL
ASWVAL:	.WORD	0,0,0,0,0,0
GSWVAL:	.WORD	0,0
ISWVAL:	.WORD	0,0,0
LSWVAL:	.WORD	1
MSWVAL:	.WORD	0,0
OSWVAL:	.WORD	0,0,0
RSWVAL:	.WORD	0
SSWVAL:	.WORD	1000.
TSWVAL:	.WORD	0,0,0
WSWVAL:	.WORD	0
XSWVAL:	.WORD	0,0
ZSWVAL:	.WORD	0
;
;
	.END	LISP