perm filename IOSER[S,AIL]1 blob sn#000857 filedate 1972-09-24 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00040 PAGES VERSION 16-2(37)
RECORD PAGE   DESCRIPTION
 00001 00001
 00004 00002	HISTORY
 00007 00003	Indices, Bits for IOSER 
 00009 00004	Simio, Ioinst, Lpryer, Cserr 
 00013 00005	Getchn 
 00016 00006	Filnam 
 00019 00007	Flscan 
 00021 00008	Open 
 00026 00009	
 00031 00010	Release 
 00033 00011	Lookup, Enter 
 00036 00012	Fileinfo 
 00038 00013	Out 
 00041 00014	Input 
 00050 00015	Realin, Realscan 
 00052 00016	Intin, Intscan 
 00054 00017	
 00057 00018	
 00061 00019	
 00063 00020	
 00064 00021	
 00066 00022	
 00068 00023	Arryout, Wordout 
 00072 00024	Arryin, Wordin 
 00077 00025	Linout 
 00080 00026	Breakset 
 00084 00027	Setbreak 
 00086 00028	Stdbrk 
 00088 00029	Close, Closin, Closo
 00090 00030	Mtape 
 00092 00031	 Useti, Useto, Rename 
 00094 00032	Usercon 
 00096 00033	Ttyuuo functions 
 00099 00034	
 00107 00035	Ptyuuo functions 
 00115 00036	Array Stuff 
 00122 00037	  bexit & stkuwd  
 00130 00038	 array info & the like 
 00133 00039	 the procedure item routines
 00137 00040	
 00142 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  202000000045  ⊗;


COMMENT ⊗
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL →→ APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72 
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72 
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# {WD-ARRY}{IN-OUT} WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
COMMENT ⊗Indices, Bits for IOSER ⊗
	LSTON	(IOSER)

IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
 ;SEE GOGOL FOR MORE DETAILS
 ; FORMAT OF CDBs
 DMODE	←← 0	;DATA MODE
 DNAME	←← 1	;DEVICE
 BFHED	←← 2	;HEADER POINTERS
 OBPNT	←← 3	;OUTPUT BUFFER POINTER
 OBP	←← 4	;OUTPUT BYTE POINTER
 OCOWNT	←← 5	;OUTPUT BYTE COUNT
 ONAME	←← 6	;OUTPUT FILE NAME -- FOR INFORMATION ONLY
 OBUF	←← 7	;OUTPUT BUFFER LOCATION
 IBPNT	←←10	;SAME STUFF FOR INPUT
 IBP	←←11
 ICOWNT	←←12
 INAME	←←13
 IBUF	←←14
 ICOUNT	←←15	;INPUT DATA COUNT LIMIT ADDRESS
 BRCHAR	←←16	;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
 TTYDEV  ←←16	;LH -1 IF DEVICE IS A TTY -- USED BY OUT
 ENDFL	←←17	;INPUT END OF FILE FLAG ADDR
 ERRTST	←←20	;USER ERROR BITS SPECIFICATION WORD
 PGNNO	←←21	;SAME THING IF IT IS INCLUDED

 ; SIMIO INDICES

 ↓IOSTATUS	←←0
 ↓IOIN		←←1	;SEE EXPLANATIONS IN SIMIO ROUTINE
 ↓IODIN		←←2
 ↓IOOUT		←←3
 ↓IODOUT		←←4
 ↓IOCLOSE	←←5
 ↓IORELEASE	←←6
 ↓IOINBUF	←←7
 ↓IOOUTBUF	←←10
 ↓IOSETI		←←11
 ↓IOSETO		←←12
 ; 13 UNUSED
 ↓IOOPEN		←←14
 ↓IOLOOKUP	←←15
 ↓IOENTER	←←16
 ↓IORENAME	←←17
⊗
COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
	  ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗

DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
 CHNL contains I/O channel number
 other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
 If the INDEX is ≤12, and if the instruction skips (error or EOF),
 status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
 can test it, or an error message is provided (depending on user-
 enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
 that the channel cannot be referenced indirectly.
⊗

↑↑SIMIO:	PUSHJ	P,.+1		;SAVE PC OF XCT
	PUSH	P,C		;SAVE C
	MOVE	C,-1(P)		;ASSUME SKIP RETURN
	LDB	C,[POINT 4,-1(C),12] ;INDEX OF XCT
	JUMPE	C,USTST		;WANT STATUS BITS ONLY
	CAIL	C,13		;NOW SPLIT HIGH AND LOW INDICES
	 JRST	 ALTIO		;SKIP RETURN CHECK ONLY
	MOVE	C,IOINST(C)	;GET INSTRUCTION
	DPB	CHNL,[POINT 4,C,12]	;CHANNEL NUMBER
	XCT	C		;DO OPERATION
	 JRST	 USOUT		;ALL KOSHER, NO EOF OR ERR
USTST:	MOVE	C,[GETSTS C]	;WHA-
	DPB	CHNL,[POINT 4,C,12] ; T HAPPEN-
	XCT	C		;	  ED?
	TRZ	C,10000		;IOACT BIT, USER LOOKUP CHECK BIT
	HRLZM	C,@ENDFL(CDB)	;GIVE USER THE BITS
	TDNN	C,ERRTST(CDB)	;ANY HE CAN'T HANDLE?
	JUMPA	CHNL,USSKIP	;NOPE, JUST SKIP-RETURN
	ERR	<I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
USSKIP:	AOS	-1(P)		;SKIP-RETURN
USOUT:	POP	P,C		;RESTORE C
	POPJ	P,		;DONE

ALTIO:	MOVE	C,IOINST(C)	;GET INSTR
	DPB	CHNL,[POINT 4,C,12]
	XCT	C		;DO IT
	JRST	USOUT		;NO SKIP
	JRST	USSKIP		;SKIP


DSCR INSTRUCTION TABLE
⊗
IOINST←.-1		;IOSTATUS ←← 0  GET STATUS
	IN		;IOIN     ←← 1  BUFFERED INPUT
	IN D		;IODIN	  ←← 2  DUMP MODE INPUT
	OUT		;IOOUT	  ←← 3  BUFFERED OUTPUT
	OUT D		;IODOUT	  ←← 4  DUMP MODE OUTPUT
	CLOSE (D)	;IOCLOSE  ←← 5  CLOSE I,O, OR BOTH
	RELEASE		;IORELEASE←← 6
	INBUF (A)	;IOINBUF  ←← 7
	OUTBUF (A)	;IOOUTBUF ←←10
	USETI (A)	;IOSETI	  ←←11
	USETO (A)	;IOSETO	  ←←12
	0		; UNUSED
	OPEN DMODE(CDB)	  ;IOOPEN	  ←←14
	LOOKUP FNAME(USER);IOLOOKUP←←15
	ENTER FNAME(USER);IOENTER  ←←16
	RENAME FNAME(USER);IORENAME←←17

HERE(CSERR)	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;STANDARD PLACE
	ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
	JRST	@UUO1(USER)	;RETURN OK

HERE (LPRYER) ERR	<DATUM OF ARRAY NOT THERE>,1
	POPJ	P,

ENDCOM(SAV)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
COMMENT ⊗Getchn ⊗

DSCR Getchn, Getchan

PAR A -- addr of ASCII for routine name
 CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
 CDB contains → actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
 if error occurs (channel out of bounds, already open), a fatal message
  is printed, using the address in A to get the routine name.
 This routine is called by most I/O routines, having saved ACs and 
  fetched CHNL.
⊗

GETCHN:
	HRLI	A,(<TTCALL 3,0>)	;PREPARE FOR ERR MESS
	TRZE	CHNL,777760	;CHECK FOR VALID CHANNEL NO
	 JRST	 NOTVALID	;INVALID CHANNEL NUMBER
	SKIPE	CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
	POPJ	P,

NOTOPN:	
	XCT	A		;PRINT ROUTINE NAME
	ERR	<: CHANNEL OR FILE NOT OPEN>


NOTVALID:
	XCT	A		;ROUTINE NAME
	ERR	<: CHANNEL NUMBER INVALID>


DSCR INTEGER←GETCHAN;
CAL SAIL
⊗

HERE (GETCHAN)
	MOVE	USER,GOGTAB
	ADD	USER,[XWD A,CHANS]	;MAKE @ WORD
	MOVEI	A,1			;START AT CHANNEL 1
CHLUP:	SKIPN	@USER			;IF CHANNEL IS FREE,
	POPJ	P,			; RETURN
	CAIGE	A,17			;CYCLE TO 0?
	AOJA	A,CHLUP			;NO, TRY NEXT
	MOVEI	A,0			;TRY 0
	SKIPE	@USER			;FREE?
	HRROI	A,-1			;NOPE
	POPJ	P,			;DONE

ENDCOM(CHN)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗

DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
 of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
 EXT(USER): SIXBIT /extension,,0/
 0
 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗

↑↑FILNAM:
	SUB	SP,X22		;ADJUST STACK
	FOR II←1,3 <
	SETZM	FNAME+II(USER)>
	MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
	PUSHJ	P,FLSCAN	;GET FILE NAME
	JUMPE	Y,FLDUN	;FILE NAME ONLY
	CAIE	Y,"."		;EXTENSION?
	JRST	FLEXT		;NO, CHECK PPN
	MOVEI	X,FNAME+1(USER)
	PUSHJ	P,FLSCAN
FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
	CAIE	Y,"["
	JRST	FLERR		;INVALID CHARACTER
	PUSHJ	P,[

	RJUST:	SETZM	PROJ(USER)
		MOVEI	X,PROJ(USER)
		PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
		MOVE	X,PROJ(USER)
		IMULI	D,-6		;SHIFT FACTOR
		LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
	
IFE SIXSW,<
		MOVEI	X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
		MOVE	D,PROJ(USER)	;WAS A HLLZ
;;
	FBACK:	MOVEI	C,0
		LSHC	C,6		;GET A SIXBIT CHAR
		CAIL	C,'0'
		CAILE	C,'7'
		JRST	FLERR		;INVALID OCTAL
		LSH	X,3
		IORI	X,-'0'(C)
		JUMPN	D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
	FPOP:	POPJ	P,]

	HRLZM	X,FNAME+3(USER)
	CAIE	Y,","
	JRST	FLERR		;INVALID CHAR
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
	HRRM	X,FNAME+3(USER)
	CAIN	Y,"]"
FLDUN:	AOS	(P)		;SUCCESSFUL
FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT

ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗

DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
 1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
 break (punctuation) char in Y (0 if string exhausted)
 D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗

↑↑FLSCAN:  
	HRRZS	1(SP)		;WANT ONLY LENGTH PART
	MOVEI	D,6		;MAX NUMBER PICKED UP
	SETZM	(X)		;ZERO DESTINATION
	HRLI	X,440600	;BYTE POINTER NOW
FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
	SOSGE	1(SP)		;TEST 0-LENGTH STRING
	 POPJ	 P,
	ILDB	Y,2(SP)		;GET BYTE
	CAIE	Y,"."		;CHECK VALID BREAK CHAR
	CAIN	Y,"["
	POPJ	P,
	CAIE	Y,"]"
	CAIN	Y,","
	POPJ	P,
	JUMPE	D,FLN1		;NEED NO MORE CHARS
	TRZN	Y,100		;MOVE 100 BIT TO 40 BIT
	TRZA	Y,40		; TO CONVERT TO SIXBIT
	TRO	Y,40		; (NO CHECKING)
	IDPB	Y,X		;PUT IT AWAY
	SOJA	D,FLN1		;CONTINUE

ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE>,<SAVE,RESTR,CORGET,FLSCAN,SIMIO,X22,X11,CORREL>
	  ,<OPEN AND RELEASE ROUTINES>)
COMMENT ⊗Open ⊗

DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
 device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF 
 addresses in a newly allocated CDB (channel data block). Store 
 all necessary information to carry out I/O on this channel
 in the CDB. Mark the channel open.
⊗

.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
	PUSH	P,-7(P)
	PUSHJ	P,RELEASE	;SIMPLE

; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB

	PUSHJ	P,SAVE		;SAVE ACS
	MOVEI	C,IOTLEN	;SIZE
	PUSHJ	P,CORGET	;OBTAIN A BLOCK
	 JRST	 BADOPN		;CAN'T GET IT
	MOVE	CDB,B		;CDB→CHANNEL TABLE
	MOVEI	LPSA,0		;NOW GET READY IN CASE OF ERROR
	SUB	SP,X22

; FILL IT WITH NON-CONTROVERSIAL THINGS

	POP	P,TEMP		;RETURN ADDRESS
	POP	P,ENDFL(CDB)	;END OF FILE FLAG ADDRESS
	POP	P,BRCHAR(CDB)	;BREAK CHAR ADDRESS
	POP	P,ICOUNT(CDB)	;INPUT COUNT ADDRESS
	POP	P,OBUF(CDB)	;NUMBER OF OUTPUT BUFFERS
	POP	P,IBUF(CDB)	;NUMBER OF INPUT BUFFERS
	POP	P,Z		;DATA MODE
	POP	P,CHNL		;DATA CHANNEL
	CHKCHN	CHNL,<OPEN>	;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;;		   AVOID REFERENCES TO PGNNO, WHICH IS ≡ ERRTST!
	HRRZI	X,750000	;ERROR BITS POSSIBLY ENABLED  -- WAS A HRROI
;;#HA#
	ANDCM	X,Z		;ERROR BITS ACTUALLY ENABLED ARE 0
	MOVEM	X,ERRTST(CDB)	;SAVE ENABLATIONS
	TRZ	Z,750000	;REMOVE IRRELEVANT BITS
	TLNE	Z,-1		;CHECK VALIDITY SOMEWHAT
	 ERR	 <OPEN: INVALID DATA MODE>,1
	MOVEM	Z,DMODE(CDB)	;STORE MODE
;;#HA# SEE JUST ABOVE
NOEXPO <
	SETZM	PGNNO(CDB)	;PAGE NUM FOR DISPLAY FEATURE
>;NOEXPO
;;#HA#

; GET DEVICE NAME

	MOVEI	X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
	PUSHJ	P,FLSCAN	;GET DEVICE NAME
	SKIPE	Y		;ASSURE VALID SIXBIT
	 ERR	 <OPEN: INVALID DEVICE NAME>,1

;IF TTY, MARK TTYDEV FOR OUT

	HLRZ	TEMP,DNAME(CDB)	;GET LH DEVICE NAME
	MOVSI	Z,400000	;BIT TO MARK WITH
	CAIE	TEMP,'TTY'	;IF TTY OR PTY,
	CAIN	TEMP,'PTY'	; ,
	 IORM	 Z,TTYDEV(CDB); IT'S A TTY

; NOW SET HEADER PTRS IN CDB

	HRRZI	Z,-1		;TO TEST RIGHT HALF
	SETZM	BFHED(CDB)	;CLEAR HEADER POINTER
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIL	E,15		;DUMP MODE?
	 JRST	 AGNN		; YES, NO BUFFER HEADER WORD
	MOVEI	TEMP,OBPNT(CDB)	;IF OUTPUT, SET POINTER
	TDNE	Z,OBUF(CDB)	;ANY OUTPUT BUFFERS?
	 HRLM	 TEMP,BFHED(CDB)
	MOVEI	TEMP,IBPNT(CDB)	;SAME FOR INPUT
	TDNE	Z,IBUF(CDB)	;ANY INPUT BUFFERS?
	 HRRM	 TEMP,BFHED(CDB)

; NOW OPEN THE FILE, GET THE BUFFERS,ETC.

AGNN:	XCT	IOOPEN,SIMIO		; OPEN CHAN,MODE
	 JRST	 [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
			 JRST	NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
			 JRST	RTRY]

COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER   ---  DEC. 1970
 If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
	MOVEI	Z,0		;FOR DUMMY (AND REAL) OUTBUF
	PUSHJ	P,GETBFS	;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
	ADDI	CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
	MOVEI	Z,-1
	PUSHJ	P,GETBFS	;GET CORE, DO INBUFS
	SUBI	CDB,OBUF-OBPNT+1;RE-RELOCATE

; FINISH OUT -- SET EOF FLAG IF DESIRED

STNIT:	;SETOM	JOBFF		;ONE MUST KNOW WHAT HE IS DOING TO USE
	MOVEM	CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
	SETZM	@ENDFL(CDB)	;MARK OPEN SUCCESSFUL
	JRST	RESTR		;RESTORE ACS, RETURN

BADOPN:	HRRZ	TEMP,JOBREN	;NEXT START WILL ASK ALLOC
	HRRM	TEMP,JOBSA	;QUESTION
	ERR	<TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>

RTRY:	TERPRI	<OPEN: DEVICE NOT AVAILABLE>
	TERPRI	<TYPE "R" TO RETRY, "X" TO BLOW UP>
	PRINT	<?>
	TTCALL	TEMP
	CAIN	TEMP,"R"	;TRY AGAIN?
	 JRST	 AGNN		;YES
	CALLI	12		;EXIT

GETBFS:	SETZM	ONAME(CDB)	;CLEAR FILE NAME
	HRRZ	Y,OBUF(CDB)	;NUMBER OF BUFFERS
	HLRZ	D,OBUF(CDB)	;SIZE
	JUMPE	Y,GBUFRT	;NO BUFFERS
	JUMPE	D,GETDES	;WANTS DEFAULT SIZE
	ANDI	D,7777		;MAX BUFFER SIZE
	HRLZ	A,D		;SIZE IN LH
	PUSHJ	P,GETCOR	;GET THE CORE (SURPRISE!)
	SETZM	OCOWNT(CDB)	;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
	CAIL	E,15		;DUMP MODE?
	 JRST	 GBUFRT		; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
	MOVEM	B,JOBFF		;B FROM CORGET HAS BUFFER AREA ADDRESS
	SUBI	D,2		;GETCOR INCREMENTED
;;#GD#
	HRRZ	C,Y
	MOVE	A,[UINBF C]
	JUMPN	Z,.+2
	MOVE	A,[UOUTBF C]
	DPB	CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
	XCT	A		;DO THE ALLOCATIONS
;;#GD#
	POPJ	P,
>;NOEXPO
EXPO <
	ADDI	B,1		;SECOND WORD
BUFC1:	HRR	A,B
	SOJLE	Y,BUFC2
	ADD	B,D		;NEXT ONE
	MOVEM	A,(B)		;MAKE POINT TO PREV
	JRST	BUFC1

BUFC2:	MOVE	B,OBUF(CDB)	;BACK TO FIRST
	MOVEM	A,1(B)		;LINK IT TOO
	HRLI	A,400000	;RING-USE BIQ
	MOVEM	A,OBPNT(CDB)	;BUFFER PTR
	POPJ	P,
>;EXPO

GETCOR:	ADDI	D,2		;+2 FOR ACCOUNTING
	MOVE	C,D
	IMUL	C,Y		;TOTAL CORE NEEDED
	PUSHJ	P,CORGET	;GRAB IT
	ERR	<OPEN: NOT ENUFF CORE FOR BUFFERS>
	HRRZM	B,OBUF(CDB)	;SAVE SO CAN RELEASE
	POPJ	P,

GETDES:	MOVEI	A,1		;1 DUMMY BUFFER
	CAIL	E,15		;GOOD OLD DUMP MODE?
	 JRST	 [MOVEI D,202	;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
		  JRST GDIT]	; WORK IN DUMP MODE
	MOVEI	TEMP,BRKDUM-1(USER)
	MOVEM	TEMP,JOBFF
	PUSHJ	P,GETIOB	;DUMMY IN/OUBUF
	LDB	D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
GDIT:	PUSHJ	P,GETCOR	;GET THE CORE
	SETZM	OCOWNT(CDB)	;CLEAR BYTE COUNT
	CAIL	E,15		;DUMP MODE?
	JRST	GBUFRT		;YES, NO BUFFER STRUCTURE
	MOVEM	B,JOBFF
	MOVE	A,Y		;NUMBER OF BUFFERS
	PUSHJ	P,GETIOB	;NOW FOR REAL
GBUFRT:	SETOM	JOBFF		;FOR SPITE
	POPJ	P,

GETIOB:	SKIPN	Z
	XCT	IOOUTBUF,SIMIO	;DO OUTBUF
	SKIPE	Z
	XCT	IOINBUF,SIMIO	;INBUF
	POPJ	P,
SUBTTL	RELEASE
COMMENT ⊗Release ⊗

DSCR RELEASE(CHANNEL NO);
CAL SAIL
⊗

COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗


HERE(RELEASE)
.RELS:
	SETOM	JOBFF		;MARK INVALID
	PUSHJ	P,SAVE		;SAVE REGS, GET USER, SAVE RETURN
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)	;CHANNEL #
	CHKCHN	CHNL,<RELEASE> ;VALIDATE
	SKIPN	CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
	 JRST	 RESTR		;CHANNEL NOT OPEN, FORGET IT
	SETZM	@CDBLOC(USER)	;CLEAR CHANS TABLE ENTRY
	XCT	IORELEASE,SIMIO	;RELEASE CHAN,0
	HRRZ	B,IBUF(CDB)	;RELEASE ANY INPUT
	PUSHJ	P,BUFREL	; BUFFERS
	HRRZ	B,OBUF(CDB)	;ALSO OUTPUT
	PUSHJ	P,BUFREL	; BUFFERS
NORELO:	HRRZ	B,CDB		;WHERE TO RELEASE
	PUSHJ	P,CORREL	;GIVE CDB BACK
	JRST	RESTR		;RESTORE AND RETURN

BUFREL:	JUMPN	B,CORREL	;RELEASE IF ANY TO RELEASE
	POPJ	P,		;ELSE RETURN

ENDCOM (OPN)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
	  ,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
	  ,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
COMMENT ⊗Lookup, Enter ⊗

DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
	a format acceptable to FILNAM above. If successful,
	FAILURE_FLAG (called by reference) is zeroed. It is
	otherwise set to -1 in LH, error code in RH.
⊗


.LOK:
HERE (LOOKUP) PUSHJ	P,SAVE
	LOADI7	A,<LOOKUP>
	PUSH	P,[XCT	IOLOOKUP,SIMIO]	;LOOKUP CH,FILE
	MOVEI	B,INAME			;TO STORE FILE NAME
	JRST	LOKENT			;DO THE OPERATION

DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

HERE (ENTER)
	PUSHJ	P,SAVE
	LOADI7	A,<ENTER>
	PUSH	P,[XCT IOENTER,SIMIO]	;ENTER CH,FILE
	MOVEI	B,ONAME			;TO STORE FILE NAME
LOKENT:
	MOVE	LPSA,X33		;PARAM ADJUST FOR RESTR
	MOVE	CHNL,-3(P)		;GET CHANNEL #
	PUSHJ	P,GETCHN		;VALIDATE
	SETZM	@-2(P)			;ASSUME SUCCESS
	PUSHJ	P,FILNAM		;GET FILE
	 JRST	 BADSPC			; NO GOOD, REPORT ERROR
	ADD	B,CDB			;ADDR OF FILE NAME HOLDER
	MOVEW	(<(B)>,<FNAME(USER)>)	;STORE IT
;;#HA# SEE OPEN CODE
NOEXPO <
	SETZM	PGNNO(CDB)		;CLEAR PAGE NO FOR "D" FEATURE
>;NOEXPO
;;#HA#
	POP	P,X			;INSTRUCTION TO DO
	MOVE	Y,[JRST ELERR]		;FAILURE
	MOVE	Z,[JRST RESTR]		;SUCCESS
ENF1:	JRST	X			;ENTER/LOOKUP

BADSPC:	POP	P,(P)			;REMOVE IO INSTRUCTION
	HRRZ	TEMP,ERRTST(CDB)	;GET USER-ENABLE BITS
	TRNE	TEMP,10000		;ENABLED FOR HANDLING BAD FILE SPECS?
	ERR	<LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR:	HRRZ	TEMP,FNAME+1(USER)	;WHY DID IT BLOW?
	HRROM	TEMP,@-1(P)		;TELL THE USER
	JRST	RESTR
COMMENT ⊗Fileinfo ⊗

DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗

Comment ⊗ This routine gives the user the entire 6 word block
  from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗

HERE (FILEINFO)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;GET RID OF IT, MARK LAST SAIL CALL
	POP	P,LPSA			;ARRAY ADDRESS WHERE INFO IS TO GO
	SKIPGE	-2(LPSA)		;MAKE SURE IT'S NOT A STRING ARRAY
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVE	TEMP,-1(LPSA)		;TOTAL ARRAY SIZE WORD
	CAML	TEMP,[XWD 1,6]		;MUST BE 1-D, AT LEAST 6 WORDS
	CAMLE	TEMP,[XWD 1,-1]		;BUT NOT 2-D
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVEI	TEMP,5(LPSA)		;BLT TERMINATOR
	HRLI	LPSA,FNAME(USER)	;SOURCE OF VALUABLE INFORMATION
	BLT	LPSA,(TEMP)		;GIVE!
	JRST	@UUO1(USER)		;GONE

ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
	  ,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗

DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY    ⊗

.OUT.:
HERE (OUT)	PUSHJ	P,SAVE		;ACS, GET USER, SAVE RETURN FOR ERROR
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	LOADI7	A,<OUT>
	PUSHJ	P,GETCHN	;VALIDATE AND GET CDB, ETC.
	HRRE	Z,-1(SP)	;#CHARS
	POP	SP,D
	SUB	SP,X11
	MOVE	B,OBP(CDB)
	MOVE	A,OCOWNT(CDB)
	JRST	.OUT1


.OUT:	SOJLE	A,OUT1		;NEED OUTPUT??
.OUT2:	ILDB	X,D		;GET A CHAR
	IDPB	X,B		;PUT IT AWAY
.OUT1:	SOJGE	Z,.OUT		;LOOP
OUTDUN:	MOVEM	B,OBP(CDB)	;PUT BP AWAY
	MOVEM	A,OCOWNT(CDB)	;COUNT AWAY
	SKIPGE	TTYDEV(CDB)	;TTY?
	XCT	IOOUT,SIMIO	; YES, FORCE OUTPUT
	JRST	RESTR
	JRST	RESTR

OUT1:	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;MODE
	CAIL	TEMP,15		;DUMP?
	 JRST	 DMPO		;YES
	MOVEM	B,OBP(CDB)	;PUT REAL BP AWAY
	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED IN SIMIO
	MOVE	B,OBP(CDB)	;NEW BP
	MOVE	A,OCOWNT(CDB)	;NEW COUNT
	JRST	.OUT2		;CONTINUE

; SPECIAL DUMP-MODE OUTPUT STUFF

DMPO:	PUSH	P,D
	HRRZ	D,OBUF(CDB)	;→BUFFER AREA
	SUBI	D,1		;ADDR-1 FOR IOWD
	HRLI	D,-=128		;-WORD COUNT
	MOVEI	D+1,0
	XCT	IODOUT,SIMIO	;OUT D,
	JFCL			;ERRORS HANDLED IN SIMIO
OKO:	HRRZ	B,D		;SAVE ADDR
	HRLI	D,1(D)		;BLT WORD
	HRRI	D,2(D)
	SETZM	-1(D)
	BLT	D,=128(B)	;CLEAR BUFFER
	POP	P,D		;RESTORE INPUT BYTE POINTER
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	B,700		;POINT 7,-1(1ST WORD),35
	MOVEM	B,OBP(CDB)
	MOVEI	A,5*=128	;CHAR COUNT
	MOVEM	A,OCOWNT(CDB)
	JRST	.OUT2		;AFTER OUTPUT SIMULATION, GO ON

ENDCOM(OUT)
COMPIL(INP,<INPUT>
	  ,<SAVE,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,X33,NOTOPN,GOGTAB
NOEXPO <
EXTERNAL PGDS
>;NOEXPO
>
	  ,<STRING INPUT ROUTINE>)
COMMENT ⊗Input ⊗

DSCR  "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗

.IN.:
HERE (INPUT)	
	MOVE	USER,GOGTAB	;GET TABLE POINTER
	MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	CHNL,-2(P)	;CHANNEL #
	LOADI7	A,<IN>		;ROUTINE NAME
	PUSHJ	P,GETCHN	;SET UP, VALIDATE
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIGE	E,15		;DUMP MODE?
	SETZM	@ENDFL(CDB)	;NO, HELP USER ASSUME NO EOF,ERR
	SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
	HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
	SKIPL	C,-1(P)		;GET TABLE #, CHECK IN BOUNDS
	CAILE	C,=18
	ERR	<IN: THERE ARE ONLY 18 BREAK TABLES>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	Q,BRKMSK(C)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
	
.IN:	SOSG	ICOWNT(CDB)	;BUFFER EMPTY?
	JRST	DOINP		;YES, GET MORE
IN1:	
	ILDB	D,IBP(CDB)	;GET NEXT CHARACTER
	TDNE	Z,@IBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
	JRST	INLINN		;YES, GO SEE WHAT TO DO
IN2:
	JUMPE	D,.IN		;ALWAYS IGNORE 0'S
	TDNE	Q,@Y		;MUST WE DO SOMETHING SPECIAL?
	JRST	INSPC		;YES, HANDLE

MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
	AOJL	B,.IN		;GET SOME MORE
	JRST	DONE1

INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
	TDNN	TEMP,Q		;  (CHOOSE ONE)
	JRST	.IN		;IGNORE

;  BREAK -- STORE BREAK CHAR, FINISH OFF

DONE:	MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
	MOVE	Y,-1(P)	;TABLE # AGAIN
	ADD	Y,USER		;RELOCATE
	SKIPN	Y,DSPTBL(Y)	;WHAT TO DO WITH BREAK CHAR?
	JRST	DONE1		;SKIP IT
	JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING

RETAIN:	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	JRST	DONE1

APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
	AOJA	B,DONE1		;ONE MORE TO COUNT

INEOF1: POP	P,D+1		;LEFT OVER FROM DUMP MODE ROUT

;  DONE -- MARK STRING COUNT WORD

DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
	ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
;;#GI#
	MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
	SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
	JRST	@3(P)		;RETURN

;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
;  NOT A LINE NUMBER FOR NEXT TIME
; GET A NEW BUFFER

DOINP:	CAIL	E,15		;DUMP MODE?
	 JRST	 DMPI		; YES
	XCT	IOIN,SIMIO	;IN CHAN,0
	 JRST	 IN1		;ALL OK, CONTINUE
	 JRST	 DONE1		;ERROR OR EOF, QUIT

; DUMP MODE SIMULATION OF SAME
DMPI:	PUSH	P,D+1
	HRRZ	D,IBUF(CDB)	;→BUFFER AREA
	SUBI	D,1
	HRLI	D,-=128
	MOVEI	D+1,0
	XCT	IODIN,SIMIO	;IN CHAN,D
	 JRST	OKI
	 JRST	INEOF1		;REMOVE D,QUIT
OKI:	POP	P,D+1
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	D,700
	MOVEM	D,IBP(CDB)
	MOVEI	A,5*=128
	MOVEM	A,ICOWNT(CDB)
	JRST	IN1		;DONE SIMULATING, RETURN

INLINN:
NOEXPO <
	SKIPN	PGNNFL(USER)	;WANT LINE NO DISPLAY?
	 JRST	 NOPGNN		;NO
	MOVE	TEMP,@IBP(CDB)
	TRO	TEMP,1
	MOVEM	TEMP,PGDS+7	;STORE IN BUFFER
	CAMN	TEMP,[ASCID /     /]
	AOS	PGNNO(CDB)
	MOVE	TEMP,PGNNO(CDB)
	ADDI	TEMP,1
	PUSH	P,TEMP+1
	IDIVI	TEMP,=10
	ADDI	TEMP,60
	DPB	TEMP,[POINT 7,PGDS+5,20]
	ADDI	TEMP+1,60
	DPB	TEMP+1,[POINT 7,PGDS+5,27]
	POP	P,TEMP+1
	MOVNI	TEMP,1		;GET CHARACTERISTICS
	TTCALL	6,TEMP		; OF CONSOLE
	TLNE	TEMP,400000	;DON'T DISPLAY IF NOT ON A DISPLAY DEVICE
	DPYOUT	16,PGDS
>;NOEXPO
NOPGNN:
	MOVE	TEMP,-1(P)	;GET LINE NUMBER DISPOSITION FLAG,
	ADD	TEMP,USER	;RLC+TABLE
	SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
	 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING

	JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
	JRST	.IN		; CONTINUE

EATLIN:
	AOS	IBP(CDB)	;FORGET IT ENTIRELY
	MOVNI	5		;INDICATE SKIPPING SIX
	ADDB	ICOWNT(CDB)	;IN COUNT
	SKIPLE			;OVERFLOW BUFFER?
	JRST	(TEMP)		;NO, CONTINUE
	CAIL	E,15
	 ERR	 <CAN'T HANDLE THIS FILE IN DUMP MODE>
	XCT	IOIN,SIMIO	;YES, GET TAB FROM NEXT BUFFER
	 JRST	OKLN		;GOT IT, CONTINUE
	 JRST	DONE1

OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
	JRST	[MOVEI TEMP,20000	;THEN EOF COMES NEXT
		 IORM  TEMP,@ENDFL(CDB)
		 JRST  DONE1]	;ALL DONE
	IBP	IBP(CDB)	;GET OVER TAB FINALLY
	JRST	(TEMP)		;AND CONTINUE


GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
	 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
	SKIPL	TEMP,@IBP(CDB)	;NEGATED LINE NO
	MOVNS	TEMP
	MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
	JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
	JRST	DONE1		;FINISH UP
GVLLN:
	SETOM	@BRCHAR(CDB)	;TELL THE USER
	AOS	ICOWNT(CDB)	;REVERSE THE SOSLE
	MOVEI	Y,1		;TURN OFF LINE NUMBER 
	ANDCAM	Y,@IBP(CDB)	;  BIT
	MOVSI	Y,070000	;BACK UP BYTE POINTER
	ADDM	Y,IBP(CDB)
	JRST	DONE1		;FINISH OFF IN BAZE OF GORY

ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
	  ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
COMMENT ⊗Realin, Realscan ⊗

DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A AND TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST REALFN

DSCR REAL←REALSCAN(@"STRING");
CAL SAIL
⊗

HERE (REALSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
REALFN:	SETZ D,;		POS SIGN
	JUMPE A,ADON
	JUMPG A,FPOS
	SETO D,;		NUMBER NEGATIVE
	MOVNS A
FPOS:	;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
	JFFO A,.+1;		NUMBER OF LEADING ZEROS IN B
	ASH A,-1(B);		BIT0=0, BIT1=1
	MOVN X,B;		BIN EXPONENT -2
	JUMPE C,FLO;		IF TEN EXPONENT ZERO THEN FINISH
	JUMPL C,FNEG
	CAIL C,100;		CHECK BOUND OF EXPOENT
	JRST ERROV1
	SETZ Y,
	JRST TEST
FNEG:	MOVNS C
	CAIL C,100
	JRST ERROV1
	MOVEI Y,6
TEST:	TRNE C,1;		DEPENDING ON LOW ORDER BIT OF EXP
	JRST MULT;		EITHER MULTIPLY 
NEXT:	ASH C,-1;		OR DON'T.
	AOJA Y,TEST;		INDEX INTO MULTIPLIER TABLE
MULT:	ADD X,.CH.(Y);		EXPONENT
	JSP Q,LFMP
DTEST:	SOJG C,NEXT
FLO:	IDIVI A,1B18
	FSC A,255
	FSC B,234
	FADR A,B
	SKIPE D
	MOVNS A
	FSC A,(X);		SCALE
	JRST ALLDON

LFMP:
	;MULTIPLIES AND NORMALIZES
	MUL A,.MT.(Y)
	TLNE A,200000
	JRST (Q)
	ASHC A,1
	SOJA X,(Q)
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
COMMENT ⊗Intin, Intscan ⊗

DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (INTIN)
	;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
	;USES NUMIN TO PERFORM FREE FIELD SCAN

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A, TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST INTFN

DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗

HERE (INTSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
INTFN:	JUMPE A,ADON
	JUMPE C,ADON
	JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
	CAIL C,13
	JRST ERROV1
	IMUL A,.TEN.(C)
	JRST ALLDON
DIVOUT:	MOVNS C
	CAIL C,13
	JRST [SETZ A,
		JRST ADON ]
	MOVE C,.TEN.(C)
	IDIV A,C
	ASH C,-1
	CAML B,C;		ROUND POSITIVELY
	AOJA A,ALLDON
	MOVNS B
	CAML B,C
	SOJ A,
ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
ADON:	MOVEM A,RACS+1(USER)
	JRST RESTR
ERROV1:	PUSHJ P,ERROV
	JRST ADON
	SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL

DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
NUMIN:
	;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
	;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
	;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
	;SCANNING IS ACCORDING TO THE FOLLOWING BNF
	;<NUMBER>::=<DEL><SIGN><NUM><DEL>
	;<NUM>	::=<NO>|<NO><EXP>|<EXP>
	;<NO>	::=<INTEGER>|<INTEGER>.|
	;	   <INTEGER>.<INTEGER>|.<INTEGER>
	;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
	;<EXP>	::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
	;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
	;<SIGN>	::=+|-|<EMPTY>
	;NULL AND CARR. RET. ARE IGNORED.
	;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
	;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
	;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
	;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
	;CLASS 0	NULL, CARR RET, NOTHING
	;CLASS 1	.
	;CLASS 2	-
	;CLASS 3	+
	;CLASS 4	@,E
	;CLASS 5	ANY OTHER CHARACETR
	;CLASS 6 	END OF FILE
	;TAB(200) IS USED FOR FND OF FILE
	;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
	;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
	DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
	HRRE X,TAB(D)
	JRST @.+2(X)
	JUMP DIG
	JRST .-4
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP EOF>

	DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
	SETZ X,
	LSHC X,3
	JRST @.+1(X)
	JUMP NULL
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP CHA>

	MOVE CHNL,-2(P)
	LOADI7 A,<IN>
	PUSHJ P,GETCHN;		SET UP FOR INPUT
	SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
	SETZM @BRCHAR(CDB)
	MOVE LPSA,[JSP X,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	POPJ P,

SCAN:	JOV .+1
	SETO Q,
	SETZ	Y,
	SETZB A,C;		NUMBER		EXPOENT
MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
	AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
	JRST MORE

DIG1:	SETZ Q,;		FLAG REG.
	ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)

SIG1:	TRO Q,4;		NEGATIVE SIGN
SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)

EXP1:	MOVEI A,1
	ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)

SIG3:	MOVNS A
SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)

FRA1:	TRO Q,1;		DECIMAL POINT
	SOJ C,
	ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)

SIG5:	TRO Q,4;		NEGATIVE SIGN
SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)

EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
EXP5:	XCT LPSA;		GET NEXT CHARACTER
EXP9:	HLRE B,TAB(D)
	JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
	IMULI FF,12
	ADD FF,B
	JRST EXP5

	XCT LPSA
EEXP:	AHEAD(EXP9,ERR2,ERR5,ERR5,ERR1,EN,EN)
EN:	TRNE Q,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

DONE:	ANDI D,177
	JUMPGE Q,.+2
	SETO D,
	POPJ P,

INT1:	HLRE A,TAB(D);		FIRST DIGIT
	TRNE Q,4
	MOVNS A;		NEGATE IF NECESSARY
INT2:	XCT LPSA;		GET NEXT CHARACTER
INT5:	HLRE B,TAB(D)
	JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
	TRNE Q,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
	SOJ C,
	TRNE Q,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3:	AOJA C,INT2
	MOVE X,A
	IMULI A,12
	TRNE Q,4;		NEGATE DIGIT IS SIGN NEGATIVE
	MOVNS B
	ADD A,B
	JOV INT4;		CHECK FOR OVERFLOW
	JRST INT2;		IF SO USE LAST VALUE

INT4:	TRO Q,2
	MOVE A,X
	JRST INT3

	XCT LPSA
EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)

DP1:	TROE Q,1
	JRST ERR2
	XCT LPSA
	AHEAD(INT5,ERR2,ERR5,ERR5,EXP6,DONE,DONE)

EXP6:	SETZ Q,
	XCT LPSA
	AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)

EXP7:	TRO Q,4
EXP8:	XCT LPSA
	AHEAD(EXP2,ERR2,ERR5,ERR5,ERR1,ERR1,ERR1)

NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST NCH2
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
	JRST (X);		RETURN

NCH2:	XCT IOIN,SIMIO;		INPUT
	JRST NCH1		;ALL OK
				;EOF OR DATA ERROR

NCH7:	MOVEI D,200
	JRST (X)

NCH5:	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI TEMP,5;		MOVE OVER IT
	ADDB TEMP,ICOWNT(CDB)
	SKIPLE TEMP;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	XCT IOIN,SIMIO

NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IBP(CDB)
	JRST NCH

STRIN:	MOVE LPSA,[JSP X,NCHA]
	HRRZ Z,-3(P)
	HRRZ Z,-1(Z)
	PUSHJ P,SCAN
	HRRZ X,-3(P)
	SOS (X)			;BACK UP BYTE POINTER
	FOR II←1,4<
	IBP (X)>
	AOJ Z,
	HRRM Z,-1(X)
	MOVEM D,@-2(P)		;STORE BREAK CHARACTER
	POPJ P,

NCHA:	SOJL Z,NCH7
	HRRZS	-4(P)
	ILDB D,@-4(P)
	JRST (X)

ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)

ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)

ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)

ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)

ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)

RZ:	SETZ A,
	JRST DONE

TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,6,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6

ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)

DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗

↑↑.CH.:	4
	7
	16
	33
	66
	153
	777777777775
	777777777772
	777777777763
	777777777746
	777777777713
	777777777626
↑↑.MT.:	240000000000
	310000000000
	234200000000
	276570200000
	216067446770
	235613266501
	314631463147
	243656050754
	321556135310
	253630734215
	346453122767
	317542172553
↑↑.TEN.:	1
	=10
	=100
	=1000
	=10000
	=100000
	=1000000
	=10000000
	=100000000
	=1000000000
	=10000000000

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
	  ,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
	  ,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
COMMENT ⊗Arryout, Wordout ⊗

DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYOUT)
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 4,4]
ARO:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYOUT>
	PUSHJ	P,GETCHN
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
	CAIGE	TEMP,10		;MAKE SURE AT LEAST BINARY MODE
	 ERR	 <ARRYOUT: MODE MUST BE '14,'10, OR '17, NOT >,6
	MOVE	0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;COMMON DUMP MODE ROUTINE

OUTRAY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYOUT: NEGATIVE WORD COUNT, VALUE IS>,6

;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE

WOUT2:	SKIPG	E,OCOWNT(CDB)	;# WORDS LEFT IN BUFFER
	JRST	WOUT5		;BETTER GET ANOTHER BUFFER
	JUMPE	B,RESTR		;NOTHING LEFT TO DO
	IBP	OBP(CDB)	;MAKE SURE PTRS TO FIRST WORD
	MOVE	C,OBP(CDB)	;"TO" ADDR
	HRRZI	D,(C)		;FOR BLT TERMINATION CALCULATION
	HRLI	C,(A)		;"FROM" ADDR
	CAIGE	B,(E)		;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
				;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
				;IF WE JUST FILL THE BUFFER)
	JRST	WOUT3		;YES
	ADDI	D,-1(E)		;FINAL ADDR
	BLT	C,(D)		;DO IT!
	ADDI	A,(E)		;UPDATE PTR
	SUBI	B,(E)		;AND COUNT
	SETZM	OCOWNT(CDB)
	HRRM	D,OBP(CDB)
WOUT5:	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED ALREADY
	JRST	WOUT2		;TRY NEXT CHUNK

WOUT3:	JUMPLE	B,RESTR		;NOTHING TO MOVE
	SUBI	B,1
	ADD	D,B		;END OF BLOCK
	BLT	C,(D)		;MOVE IT
	SUBI	E,1(B)		;FIX LENGTH
	MOVEM	E,OCOWNT(CDB)	;
	ADDM	B,OBP(CDB)	;FIX BYTE POINTER
;;#FQ# (1-4)
	JRST	RESTR		;LEAVE LIKE A TREE AND MAKE

DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗

HERE (WORDOUT)			;WRITE ONE WORD
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)
	LOADI7	A,<WORDOUT>
	PUSHJ	P,GETCHN
	LDB	A,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	A,15		;A DUMP MODE?
	 JRST	 DMPWO		;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO:	SOSL	OCOWNT(CDB)	;BUFFER FULL?
	 JRST	 WOKO		;NO
	XCT	IOOUT,SIMIO	;YES, WRITE IT
	 JFCL			; ERRORS HANDLED ELSEWHERE
	JRST	WDO		;GO BACK AND DO IT RIGHT
WOKO:	MOVE	TEMP,-1(P)	;THING TO BE WRITTEN
	IDPB	TEMP,OBP(CDB)	;WRITE IT
	JRST	RESTR

DMPWO:	MOVE	LPSA,[XWD 7,7]	;ACCOUNT FOR EVERYTHING
	MOVEI	TEMP,-1(P)	;→WORD TO BE WRITTEN
	PUSH	P,-2(P)		;CHANNEL
	PUSH	P,TEMP		;ADDR OF WORD
	PUSH	P,[1]		;COUNT
	PUSHJ	P,ARO		;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)
COMMENT ⊗Arryin, Wordin ⊗

DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYIN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
ARI:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYIN>
	PUSHJ	P,GETCHN
	SETZM	@ENDFL(CDB)	;ASSUME NO END OF FILE
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
	CAIGE	TEMP,10
	 ERR	 <ARRYIN: MODE MUST BE '10 OR '14 OR '17, NOT >,6
	MOVE	0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;USE COMMON ROUTINE

;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYIN: NEGATIVE WORD COUNT, VALUE IS >,6
WIN3:	JUMPE	B,RESTR		;NOTHING LEFT TO DO
	SKIPG	E,ICOWNT(CDB)	;#LEFT IN BUFFER
	JRST	WIN5
	IBP	IBP(CDB)	;MAKE SURE PTS TO NEXT
	HRL	C,IBP(CDB)	;ADDR OF FIRST WORD TO READ
	MOVEI	D,(A)		;FOR BLT TERMINATION
	HRR	C,A		;"TO" ADDRESS
	CAIG	B,(E)		;ENOUGH HERE?
	JRST	WIN4		;YES
	ADDI	D,-1(E)		;NO, FINISH THIS BUFFER
	BLT	C,(D)
	ADD	A,E		;FIX INPUT POINTER
	SUB	B,E		;FIX INPUT COUNT
WIN5:	XCT	IOIN,SIMIO	;DO INPUT
	JRST	WIN3		;OK, GO AHEAD
	JRST	WIEOF1		;EOF OR ERROR, LEAVE

WIN4:	ADDI	D,-1(B)		;FINISH UP
	BLT	C,(D)
	SUB	E,B		;FIX UP COUNT
	SUBI	B,1		;PREPARE TO CORRECT BP
	MOVEM	E,ICOWNT(CDB)	;UPDATE WORDS LEFT
	ADDM	B,IBP(CDB)	; POINTER
;;#FQ# (3-4)
	JRST	RESTR		;LEAVE

WIEOF1:	MOVE	TEMP,-1(P)	;#WORDS WANTED -1
	SUBM	TEMP,B		;#INPUT IN RH
WIN2:	HRRM	B,@ENDFL(CDB)	;#INPUT IN RH, ERR OR EOF BITS IN LH
	JRST	RESTR

DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗

HERE (WORDIN)			;READ ONE WORD -- USE ARRYIN
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	LOADI7	A,<WORDIN>
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	PUSHJ	P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
	LDB	TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	TEMP,15		;DUMP MODE?
	 JRST	 DUMPWI		; YES
	SETZM	@ENDFL(CDB)
WI:	SOSL	ICOWNT(CDB)
	 JRST	 WOKI		;ALL OK
	XCT	IOIN,SIMIO
	 JRST	 WI		;OK, GO BACK TO KEEP COUNT RIGHT
	 TDZA	 A,A		;RETURN 0, WITH ERROR
WOKI:	ILDB	A,IBP(CDB)	;OK, RETURN NEXT WORD
	MOVEM	A,RACS+1(USER)	;RESULT
	JRST	RESTR

DUMPWI:	MOVE	LPSA,[XWD 6,6]
	MOVEI	TEMP,RACS+1(USER);RESULT GOES HERE
	PUSH	P,-1(P)		;CHANNEL
	PUSH	P,TEMP		;ADDRESS
	PUSH	P,[1]		;1 WORD TRANSFER
	PUSHJ	P,ARI		;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)

ARYDMP:	
	MOVN	TEMP,-1(P)		;-WORD COUNT
	JUMPGE	TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
	SOS	D,-2(P)			;STARTING ADDR - 1
	HRL	D,TEMP			;IOWD -COUNT,STARTING ADDR -1
	MOVEI	D+1,0			;TERMINATE THE READ
	MOVE	A,[JRST RESTR] ;IF IT SUCCEEDS
	MOVE	B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
	JRST	0		;GO DO DUMP I/O

ENDCOM(WRD)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
COMMENT ⊗Linout ⊗

DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗

HERE (LINOUT)
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)	;CHANNEL
	LOADI7	A,<LINOUT>
	PUSHJ	P,GETCHN	;CHANNEL DATA
	MOVE	TEMP,OBP(CDB)	;ADJUST TO FULL WORD
	HRRZ	A,OCOWNT(CDB)	;DON'T FORGET COUNT
LINOLP:	TLNN	TEMP,760000	;LINED UP?
	 JRST	 OKLIGN		; YES
	IBP	TEMP		;0 WILL BE THERE
	SOJA	A,LINOLP

OKLIGN:	MOVEM	TEMP,OBP(CDB)
	MOVEM	A,OCOWNT(CDB)	;REPLACE UPDATED THINGS
	CAIGE	A,=10		;ENOUGH ROOM FOR 2 WORDS?
	 XCT	 IOOUT,SIMIO	;NO, OUTPUT
	 JFCL			;IN CASE OUTPUT HAPPENED

	SKIPGE	B,-1(P)		;GET LINE NUMBER
	 JRST	 [MOVNS B
		  MOVNI A,5	;ONLY PUT OUT 5 CHARS
		  JRST NOCONV]	;WAS GIVEN TO US IN TOTO
	MOVNI	A,6		;PUT OUT TAB AFTER
	MOVE	C,[<ASCII /00000/>/2] ;TO MAKE 5
	EXCH	B,C
	PUSH	P,LNBAK		;RETURN ADDR
LNCONV:	IDIVI	C,=10
	IORI	D,"0"
	DPB	D,[POINT 7,(P),6]
	SKIPE	C		;THE RECURSIVE PRINTER
	PUSHJ	P,LNCONV
	HLL	C,(P)		;ONE CHAR, LEFT JUST
	LSHC	B,7
LNBAK:	POPJ	P,.+1
	LSH	B,1
	TRO	B,1
NOCONV:	AOS	C,OBP(CDB)	;MOVE OUT A WORD
	MOVEM	B,(C)
	ADDM	A,OCOWNT(CDB)	;UPDATE COUNT
	MOVEI	B,11
	CAME	A,[-5]
	 IDPB	 B,OBP(CDB)	;OUTPUT A TAB
NOTAB:	MOVE	LPSA,X33
	JRST	RESTR		;THAT'S IT

ENDCOM(LIN)
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
	  ,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
	  ,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
COMMENT ⊗Breakset ⊗

DSCR BREAKSET(TABLE #,"STRING",WAY);
CAL SAIL
⊗

HERE (BREAKSET)
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
	MOVE	LPSA,X33
	SUB	SP,X22
	SKIPLE	A,-2(P)		;TABLE #
	CAILE	A,=18
	ERR	<THERE ARE ONLY 18 BREAK TABLES>
	HLLZ	B,BRKMSK(A)	;BREAK MASK FOR THIS TABLE
	ADD	A,USER
	MOVE	C,[ANDCAM B,(D)]  ;USUAL CLEARING INSTR
	LDB	X,[POINT 4,-1(P),35] ;COMMAND
	TRZN	X,10		  ;LEFT OR RIGHT HALF OF TABLE?
	SKIPA	X,BKCOM(X)	  ;RIGHT HALF
	HLRZ	X,BKCOM(X)	  ;LEFT HALF
	JRST	(X)		  ;DISPATCH

BKCOM:	XWD	XCLUDE,PASLINS	;X,,P
	XWD	INCL,PENDCH	;I,,A
	XWD	ILLSET,RETCH	;-,,R
	XWD	ILLSET,SKIPCH	;-,,S
	XWD	BRKLIN,DSPSET	;L,,D
	XWD	ILLSET,ERMAN	;-,,E
	XWD	NOLINS,ILLSET	;N,,-
	XWD	OMIT,ILLSET	;O,,-

ILLSET:	ERR	<ILLEGAL COMMAND TO BREAKSET>,1
	JRST	RESTR

XCLUDE:	SKIPA	C,[IORM B,(D)]	;YES, SET ALL TO 1 TO INITIALIZE
OMIT:	MOVSS	B		;OMIT, PUT BIT IN RH
INCL:	MOVSI	D,-200
	HRRI	D,BRKTBL(USER)	;RELOCATABLE IOWD
BRKLUP:	XCT	C		;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
	AOBJN	D,BRKLUP
	MOVE	C,[IORM B,BRKTBL(D)]	;USUAL SETTING INSTR
	CAIN	X,XCLUDE	;BY EXCEPTION?
	MOVE	C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
	ADDI	C,(USER)	;RELOCATE IT
	HRRZ	A,1(SP)		;LENGTH OF STRING
	MOVE	X,2(SP)		;BYTE POINTER
	JRST	BRKL2
BRKL1:	ILDB	D,X		;GET A CHAR
	XCT	C		;DO RIGHT THING TO RIGHT BIT
BRKL2:	SOJGE	A,BRKL1
	JRST	RESTR

PASLINS: TDZA	B,B		;PASS LINE NOS. SINE COMMENT
NOLINS:	MOVEI	B,-1		;INFORM IN THAT IT SHOULD 
	MOVEM	B,LINTBL(A)	;  DELETE LINE NOS.
	JRST	RESTR

BRKLIN:	SKIPA	B,[-1]		;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN:	MOVSI	B,-1		;LH NEG SIGNALS ERMAN'S SCHEME
	MOVEM	B,LINTBL(A)
	JRST	RESTR

PENDCH:	SETOM	DSPTBL(A)	;APPEND TO END OF INPUT
	JRST	RESTR

SKIPCH:	TDZA	B,B		;CHAR NEVER APPEARS IN INPUT STRING
RETCH:	MOVEI	B,-1		;RETAIN FOR NEXT TIME
	MOVEM	B,DSPTBL(A)
	JRST	RESTR

DSPSET:	SETOM	PGNNFL(USER)	;WE'RE DISPLAYING PAGE/LINE NUMBERS ON DPY
	JRST	RESTR
COMMENT ⊗Setbreak 

  TBL IS AS IN BREAKSET
  BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
  OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
  MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
     I,X,O,N,R,A,P, or S.
This function is not attainable by the user unless he declares it.
⊗

DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
CAL SAIL
⊗

HERE (SETBREAK)
	HRRZ	TEMP,-3(SP)		;DO OMIT STRING, IF PRESENT
	JUMPE	TEMP,NO.O		;NULL STRING DOESN'T COUNT
	PUSH	P,-1(P)			;TABLE #
	PUSH	SP,-3(SP)		;OMIT CHARACTERS
	PUSH	SP,-3(SP)
	PUSH	P,["O"]			;OMIT!
	PUSHJ	P,BREAKSET		;DO THAT
NO.O:	HRRZS	-1(SP)			;COUNT OF # OF COMMANDS
BKSLUP:	SOSGE	-1(SP)		;DONE?
	 JRST	 BKSDUN			; YES
	PUSH	P,-1(P)			;TABLE #
	ILDB	TEMP,(SP)		;COMMAND
	PUSH	P,TEMP
	PUSH	SP,-5(SP)
	PUSH	SP,-5(SP)		;STRING TO USE IF NECESSARY
	PUSHJ	P,BREAKSET
	JRST	BKSLUP			;DO IT -- AGAIN

BKSDUN:	SUB	P,X22
	SUB	SP,[XWD 6,6]
	JRST	@2(P)

COMMENT ⊗Stdbrk ⊗

DSCR STDBRK(CHANNEL);
CAL SAIL
⊗

HERE (STDBRK)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)
	MOVEI	CDB,D-DMODE		;SO WE CAN USE SIMIO'S OPEN
	MOVEI	D,17			;DUMP MODE
	MOVE	D+1,['SYS   ']
	MOVEI	D+2,0			;NO HEADERS
	XCT	IOOPEN,SIMIO		;DO THE OPEN
	 ERR	 <DSK NOT AVAILABLE?>
	MOVEI	USER,D-FNAME		;SO WE CAN USE SIMIO'S LOOKUP
	MOVE	D,['BKTBL ']
	MOVE	D+1,['BKT   ']		;FUNNY NAME AND EXTENSION
	SETZB	D+2,D+3
	XCT	IOLOOKUP,SIMIO		;DO THE LOOKUP
	ERR	<STANDARD BREAK TABLE NOT AVAILABLE>
	MOVE	USER,GOGTAB
	MOVEI 	D,DSPTBL-1(USER)
	HRLI	D,-(=19+=19+=128)	;IOWD SIZE,LOC
	MOVEI	D+1,0			;TERMINATE COMMAND LIST
	XCT	IODIN,SIMIO		;DO THE INPUT
	SKIPA				;ALL WENT WELL
	ERR	<PROBLEM READING STANDARD BREAK TABLE>
	XCT	IORELEASE,SIMIO		;RELEASE FILE
	JRST	RESTR

ENDCOM(BRK)
COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<CLOSE ROUTINES>)
COMMENT ⊗Close, Closin, Closo
  CLOSE(CHAN)     

CLOSIN closes only the input side
CLOSO closes only the output side

⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗

HERE (CLOSIN) PUSHJ	P,SAVE		;CLOSE INPUT ONLY
	MOVEI	D,1
	JRST	CLSS

DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)	
	PUSHJ	P,SAVE		;CLOSE OUTPUT ONLY
	MOVEI	D,2
	JRST	CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE)				;CLOSE BOTH
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
	MOVEI	D,0
CLSS:	MOVE	CHNL,-1(P)
	MOVE	LPSA,X22
	CHKCHN	CHNL,<CLOSE>	;VERIFY OK CHANNEL
	SKIPN	CDB,@CDBLOC(USER) ;GET CDB
	 JRST	 RESTR		;NOT OPEN, DON'T CLOSE
	XCT	IOCLOSE,SIMIO	;CLOSE CHAN,SPEC
	SETZM	INAME(CDB)
	SETZM	ONAME(CDB)	;NO FILE NAMES OPEN
	JRST	RESTR		;RETURN

ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME>
	  ,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
	  ,<MTAPE, USETI, USETO, RENAME ROUTINES>)
COMMENT ⊗Mtape ⊗

DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗

.MTP:
HERE (MTAPE)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)		;CHANNEL NUMBER
	LOADI7	A,<MTAPE>
	PUSHJ	P,GETCHN
	LDB	C,[POINT 5,-1(P),35]	;PART OF COMMAND CHAR
	MOVE	A,OPTAB			;COMMAND BITS
	MOVE	B,OPTAB+1		;MORE
	TRZE	C,30			;COMPRESS TABLE
	ADDI	C,5
	LSH	C,2			;EACH COMMAND IS 4 BITS
	ROTC	A,(C)			;GET RIGHT COMMAND
	ANDI	B,17			;DO IF SYSTEM DOESN'T
	HRLI	B,(<MTAPE>)		;CREATE MTAPE OPERATION
	DPB	CHNL,[POINT 4,B,12]
	TRNE	B,-1			;IS THERE AN OPERATION?
	XCT	B			;YES, DO IT
	JRST	RESTR

OPTAB:	BYTE (4) 16,17,0,0,3,6,7,13,10	;A,B,E,F,R,S,T
	BYTE (4) 11,0,1			;U,W
COMMENT ⊗ Useti, Useto, Rename ⊗

DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗

HERE (USETI)
↑↑.USETI:
	SKIPA	LPSA,[XCT IOSETI,SIMIO]	;USETI
HERE (USETO)
↑↑.USETO:
	MOVE	LPSA,[XCT IOSETO,SIMIO] ;USETO
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)
	LOADI7	A,<USET>
	PUSHJ	P,GETCHN
	MOVE	A,-1(P)			;VALUE TO USETO
	MOVE	LPSA+1,[JRST .+2]	;BE ABLE TO GET BACK
	JRST	LPSA			;GO TO USETI/O
	MOVE	LPSA,X33
	JRST	RESTR

DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
CAL SAIL
⊗

HERE (RENAME)
↑↑.RENAME:
	PUSHJ	P,SAVE
	SETZM	@-1(P)
	MOVE	LPSA,X44
	LOADI7	A,<RENAME>
	MOVE	CHNL,-3(P)
	PUSHJ	P,GETCHN
	PUSHJ	P,FILNAM	;PARSE FILENAME SPEC
	 JRST	 BDSPC		;SPECIFICATION NO GOOD
	MOVE	TEMP,-2(P)
	ROT	TEMP,-=9
	MOVEM	TEMP,FNAME+2(USER)
	XCT	IORENAME,SIMIO	;DO THE RENAME
	 JRST	 RNERR		;NO GOOD
	JRST	RESTR
BDSPC:	HRRZ	TEMP,ERRTST(CDB)	;SEE IF
	TRNE	TEMP,10000		;WILLING TO HANDLE ERROR
	ERR	<RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT CODE
RNERR:	HRRZ	TEMP,FNAME+1(USER)	;RETURN HORSESHIT NUMBER
	HRROM	TEMP,@-1(P)		;TO THE USER
	JRST	RESTR

ENDCOM(MTP)
COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
COMMENT ⊗Usercon ⊗

DSCR USERCON(@INDEX,@SETGET,FLAG);
CAL SAIL
PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
 SETGET is used to communicate USER table values
 FLAG is "OPCODE" input to USERCON
RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
 On exit, SETGET contains old value of this entry.
 If FLAG is odd, the original SETGET value replaces this entry.
⊗


HERE(USERCON)
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 4,4]
	MOVE	A,-1(P)		;THE FLAG
GLOB <
	MOVEI	B,ENDREN
	JUMPL	A,[MOVEI USER,GLUSER
		   MOVEI B,ZAPEND ;USE GLOBAL TABLE
		   JRST .+1]
	SKIPL	C,-3(P)		;THE INDEX
	CAML	C,B
>;GLOB
NOGLOB <
	SKIPL	C,-3(P)		;THE INDEX
	CAIL	C,ENDREN	;CHECK BOUNDS
>;NOGLOB
	ERR	<USERCON INDEX OUT OF BOUNDS >,7,RESTR
	ADD	C,USER		;POINT AT CORRECT ENTRY
	MOVE	B,(C)		;GET OLD VALUE
	MOVE	D,@-2(P)	;(PERHAPS) NEW VALUE
	TRNE	A,1		;STORE NEW VALUE?
	MOVEM	D,(C)		;YES
	MOVEM	B,@-2(P)	;RETURN OLD VALUE
GLOB <
	MOVE	USER,GOGTAB	;RESET
>;GLOB
	JRST	RESTR
ENDCOM(USC)
COMMENT ⊗Ttyuuo functions ⊗

DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗

Comment ⊗
INTEGER PROCEDURE INCHRW;
 RETURN A CHAR FROM TTCALL 0,

INTEGER PROCEDURE INCHRS;
 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)

STRING PROCEDURE INCHWL;
 WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0, 
	STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INSTR(INTEGER BRCHAR);
 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)

STRING PROCEDURE INSTRL(INTEGER BRCHAR);
 WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)

STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0, 
  STR←INSTR(BRCHAR)


PROCEDURE OUTCHR(INTEGER CHAR);
 OUTPUT CHAR (TTCALL 1)

PROCEDURE OUTSTR(STRING STR);
 OUTPUT STR (TTCALL 3)


PROCEDURE CLRBUF;
 CLEARS INPUT BUFFER (TTCALL 11,)

TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
 TTYINL DOES A WAIT FOR LINE FIRST.
 FULL BREAKSET CAPABILITIES EXCEPT FOR 
 "R" MODE (AND OF COURSE, LINE NUM. STUFF)

	TITLE	TTYUUO
⊗

COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR
ENTINT	<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
	  ,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#

HERE (INCHRW)	TTCALL	A
	POPJ	P,

HERE (INCHRS)	TTCALL	2,A		;SKIP IF CHAR WAITING
	MOVNI	A,1		;ELSE RETURN -1
	POPJ	P,

HERE (OUTCHR)	TTYUUO	1,-1(P)		;OUTPUT THE PARAMETER
	SUB	P,X22		;REMOVE PARAMETER
	JRST	@2(P)

HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
	EXCH	A,-1(SP)		;LENGTH OF STRING
	HRRZS	A			; REALLY
	EXCH	B,(SP)			;PTR TO THE STRING
	PUSH	P,C			;NEED ANOTHER AC
	JUMPLE	A,OU.OUT		;DON'T DO ANYTHING
OSLOOP:	MOVE	C,A
	SUBI	A,14*5-1		;# CHARS/CHOMP
	SKIPLE	A			;LOTS LEFT??
	MOVEI	C,14*5-1		; YES,
	MOVE	LPSA,[POINT 7,SGACS(USER)];AS GOOD A PLACE AS ANY
	ILDB	TEMP,B
	SKIPE	TEMP			;NULL??
	IDPB	TEMP,LPSA		; NO
	SOJG	C,.-3
	MOVEI	TEMP,0			;A NULL FOR THE END
	IDPB	TEMP,LPSA
	TTCALL	3,SGACS(USER)		;RAISON D'ETRE
	JUMPG	A,OSLOOP
OU.OUT:	POP	SP,B
	POP	SP,A
	POP	P,C
	POPJ	P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
	HLRZ	TEMP,(SP)		;SIZE/POSITION FIELDS OF BP
	TRZ	TEMP,7777		;CLEAR SIZE FIELD
	OR	TEMP,-1(SP)		;POSITION, COUNT IN RH FOR DDTOUT
	TRNN	TEMP,7777		;IF NULL STRING, QUIT
	 JRST	 QUIT
	HRLM	TEMP,(SP)
	MOVE	TEMP,[SIXBIT /TTY/]	;DEVICE FOR TTYMES
	MOVEM	TEMP,-1(SP)
	MOVEI	TEMP,-1(SP)		;POINT AT SPEC
	CALLI	TEMP,400047		;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
	 JFCL				;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT:	SUB	SP,X22			;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
	POPJ	P,			;DONE

REDSTR:	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,=100
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,=100
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
	TTCALL	TEMP
FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,=100		;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	HRROM   A,-1(SP)	; TO STRING COUNT WORD
;;#GI#
	JRST	RESTR

HERE (INSTR) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X22	;# TO REMOVE

INS1:	TTCALL	TEMP		;NEXT CHAR
INS2:	CAMN	TEMP,B		;BREAK?
	 JRST	 FINSTR		; YES, ALL DONE
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
	AOJA	A,INS1		; GO BACK FOR MORE

HERE (INCHWL)	PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	LPSA,X11
	TTCALL	4,TEMP
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
INS3:	CAIE	TEMP,12
	CAIN	TEMP,175
	 JRST	 DNSTR
	CAIE	TEMP,15		;CR?
	TRNE	TEMP,600	;CONTROL BITS ON?
	 JRST	 DNSTR		;YES
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
	TTCALL	TEMP		;GET ANOTHER AND
	AOJA	A,INS3		;GO HANDLE IT
DNSTR:	MOVEM	TEMP,.SKIP.	;SET BREAK CHAR
	JRST	FINSTR
;;#GF#

HERE (INCHSL)	PUSHJ	P,SAVE
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
	PUSHJ	P,REDSTR
	SETOM	@-1(P)		;ASSUME FAILED
	TTCALL	5,TEMP		;ARE THERE CHARS?
	JRST	FINSTR		;NO
	SETZM	@-1(P)		;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
	JRST	INS3		;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#

HERE (INSTRL)	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	PUSHJ	P,REDSTR
	TTCALL	4,TEMP
	MOVE	B,-1(P)
	JRST	INS2

HERE (INSTRS)	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	PUSHJ	P,REDSTR
	SETOM	@-2(P)
	TTCALL	5,TEMP
	JRST	FINSTR
	SETZM	@-2(P)
	MOVE	B,-1(P)
	JRST	INS2

HERE (CLRBUF)	TTCALL	11,
	POPJ	P,

HERE (TTYINS) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
	MOVE	LPSA,X33
	SETOM	@-1(P)		;ASSUME NO CHARS
	TTCALL	5,D		;SEE IF LINES WAITING
	 JRST	FINS1		;NONE WAINTING
	JRST	TYIN1		;GO AHEAD

HERE (TTYINL)
	PUSHJ	P,SAVE
	TTCALL	4,D		;WAIT FOR A LINE
	JRST	TYIN

HERE (TTYIN)	PUSHJ	P,SAVE
	TTCALL	D		;GET A CHAR

TYIN:	PUSHJ	P,REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,X33		;PREPARE TO RETURN
TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	SKIPL	C,-2(P)		;TABLE #
	CAILE	C,=18
	ERR	<TTYIN: THERE ARE ONLY 18 BREAK TABLES>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	Q,BRKMSK(C)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	JRST	TTYN1
TTYN:	TTCALL	D		;1 CHAR
TTYN1:	TDNE	Q,@Y		;BREAK OR OMIT?
	JRST	TTYSPC		; YES, FIND OUT WHICH
TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
	AOJL	A,TTYN		;COUNT AND CONTINUE
	JRST	FINS1		;DONE
TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,Q
	JRST	TTYN		;OMIT
	MOVEM	D,@-1(P)
	MOVE	Y,-2(P)		;WHAT TO DO WITH IT
	ADD	Y,USER
	SKIPN	Y,DSPTBL(Y)
	JRST	FINS1		;DONE, NO SAVE
	JUMPL	Y,TTYAPP	;APPEND
	ERR	<CAN'T RETAIN BREAK CHAR FROM TTYIN>,1,FINS1
TTYAPP:	IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	FINS1

ENDCOM(TTY)
EXPO <
COMPIL(PTY)
ENDCOM(PTY)
>;EXPO
NOEXPO <
COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
	  ,<PTY ROUTINES>)
COMMENT ⊗Ptyuuo functions ⊗

	OPDEF	PTYUUO	[711B8]

DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);

END "PTYSPC"

⊗


HERE (PTYGET)
	SETOM	.SKIP.
	MOVEI	A,0
	PTYUUO	A
	SETZM	.SKIP.
	POPJ	P,

HERE (PTYREL)
	POP	P,(P)
	EXCH	A,(P)
	PTYUUO	1,A
	POP	P,A
	JRST	@2(P)

HERE (PTYGTL) PUSH	P,(P)	;ANOTHER COPY OF RETURN ADDRESS.
	PTYUUO	13,-2(P);POINT AT PTY LINE NUMBER
	MOVE	A,-1(P)	;RESULT.
	SUB	P,X33
	JRST	@3(P)	;AND RETURN.

HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
	SUB	P,X33
	JRST	@3(P)

HERE (PTIFRE)
	MOVE	TEMP,[PTYUUO 2,0]
	JRST	%PTY1

HERE (PTOCNT)
	SKIPA	TEMP,[PTYUUO 3,0]

HERE (PTCHRW)
	MOVE	TEMP,[PTYUUO 5,0]
%PTY1:	POP	P,(P)
	EXCH	0,(P)
	XCT	TEMP
	POP	P,0
	JRST	@2(P)

HERE (PTCHRS)
	POP	P,(P)
	EXCH	0,(P)
	PTYUUO	4,0
	MOVNI	A,1
	POP	P,0
	JRST	@2(P)

HERE (PTOCHS)
	SKIPA	TEMP,[PTYUUO 6,0]

HERE (PTOCHW)
	MOVE	TEMP,[PTYUUO 7,0]
	SETOM	.SKIP.
	POP	P,(P)
	EXCH	A,(P)
	EXCH	0,-1(P)
	XCT	TEMP
	SETZM	.SKIP.
	POP	P,A
	POP	P,0
	JRST	@3(P)

HERE (LODED)
	MOVEI	TEMP,0
	EXCH	TEMP,(P)
	PUSH	P,TEMP
	SKIPA	TEMP,[PTYUUO 15,-1(SP)]

HERE (PTOSTR)
	MOVE	TEMP,[PTYUUO  11,-1(SP)]
	PUSH	P,TEMP
	MOVE	USER,GOGTAB
	PUSHJ	P,INSET
	PUSH	SP,[1]
	PUSH	SP,[POINT 7,[0]]
	PUSHJ	P,CAT
	POP	P,TEMP
	POP	P,(P)
	POP	P,-1(SP)
	XCT	TEMP
	SUB	SP,X22
	JRST	@2(P)

HERE (BACKUP)
	TTYUUO	10,
	POPJ	P,

HERE (PTYALL)
	PUSHJ	P,SAVE
	MOVE	0,-1(P)	;LINE NUMBER
	PTYUUO	3,0
	JUMPE	A,[PUSH SP,[0]
		   PUSH SP,[0]
		   JRST ALLQ]
	MOVEI	A,=156
	ADDM	A,REMCHR(USER)
	SKIPL	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSHJ	P,INSET
	PUSH	SP,-1(P)	;PTY LINE NUMBER
	PUSH	SP,TOPBYTE(USER)	;AND BYTE POINTER.
	PTYUUO	10,-1(SP)	;AND ASK FOR ALL THAT IS THERE.
	MOVEI	B,0
	MOVE	C,(SP)		;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR:	MOVE	LPSA,C		;LAG BY ONE		#IN#
	ILDB	0,C		;GET CHAR
	JUMPE	0,ALLDUN
	AOJA	B,SOMMOR
ALLDUN:	CAILE	B,=150
	 ERR	 <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
	HRROM	B,-1(SP)	;SAVE AS RESULT.
	MOVEM	LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
	SUBI	B,=156		;-ESTIMATE
	ADDM	B,REMCHR(USER)	;AND UPDATE FREE COUTN.
ALLQ:	MOVE	LPSA,X22
	JRST	RESTR

%REDSTR:SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,=100
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,=100
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

%FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
	PTYUUO	5,CDB
%FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,=100		;NUMBER USED
	HRROM	A,-1(SP)	; AND TO STRING COUNT WORD
	JRST	RESTR

HERE (PTYSTR)
	PUSHJ	P,SAVE
	PUSHJ	P,%REDSTR
	MOVE	CDB,-2(P)
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X33	;# TO REMOVE

%INS1:	PTYUUO	5,CDB		;NEXT CHAR
%INS2:	CAMN	CHNL,B		;BREAK?
	 JRST	 %FINSTR		; YES, ALL DONE
	IDPB	CHNL,TOPBYTE(USER) ;PUT IT AWAY AND
	AOJA	A,%INS1		; GO BACK FOR MORE

	JRST	%INS2

HERE (PTYIN) PUSHJ	P,SAVE
	MOVE	CDB,-3(P)
	PTYUUO	5,CDB

%TYIN:	PUSHJ	P,%REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,[XWD 4,4]		;PREPARE TO RETURN
%TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	SKIPL	C,-2(P)		;TABLE #
	CAILE	C,=18
	ERR	<PTYIN: THERE ARE ONLY 18 BREAK TABLES>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	Q,BRKMSK(C)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
	ADD	Y,[XWD CHNL,BRKTBL] ;BRKTBL+RLC(USER)
	JRST	%TTYN1
%TTYN:	PTYUUO	5,CDB
%TTYN1:	TDNE	Q,@Y		;BREAK OR OMIT?
	JRST	%TTYSPC		; YES, FIND OUT WHICH
%TTYC:	IDPB	CHNL,TOPBYTE(USER)	;PUT IT AWAY
	AOJL	A,%TTYN		;COUNT AND CONTINUE
	JRST	%FINS1		;DONE
%TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,Q
	JRST	%TTYN		;OMIT
	MOVEM	CHNL,@-1(P)
	MOVE	Y,-2(P)		;WHAT TO DO WITH IT
	ADD	Y,USER
	SKIPN	Y,DSPTBL(Y)
	JRST	%FINS1		;DONE, NO SAVE
	JUMPL	Y,%TTYAPP	;APPEND
	ERR	<CAN'T RETAIN BREAK CHAR FROM PTYIN>,1,%FINS1
%TTYAPP:	IDPB	CHNL,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	%FINS1

ENDCOM(PTY)
>;NOEXPO
IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗
COMPIL(ARY,<LRCOP,ARCOP,LRMAK,ARMAK,ARYEL,BEXIT,STKUWD
ENTINT <ARRINFO,ARRBLT,ARRTRAN>>
  ,<SAVE,RESTR,CORGET,CORREL,X11,X22,X33,X44,GOGTAB,ARRRCL,RECQQ,LEAP,ALLFOR>
  ,<ARRAY ALLOCATION ROUTINES>)

COMMENT ⊗Array Stuff ⊗

;ARYDIR, ARRPDL, AND FRIENDS ARE NO MORE

DSCR LRCOP, ARCOP
⊗
HERE(LRCOP)
HERE(ARCOP)
;;#HO# 6-7-72 DCS ALLOW BOTH ADDRS TO BE RETURNED
	PUSH	P,B
	PUSH	P,C		;SOME WORK SPACE.
	PUSH	P,-3(P)		;ARRAY TO BE COPIED
	PUSHJ	P,..ARCOP	;COPY IT
	POP	P,C
	POP	P,B
	SUB	P,X22
	JRST	@2(P)		;DONE

↑↑..ARCOP:
;;#HO#
	HRRZ	A,-1(P)		;THE ARRAY TO BE COPIED.
	SKIPGE	-2(A)
	SUBI	A,1		;FOR STRING ARRAYS.
	HLRE	B,-1(A)		;NUMBER OF DIMENSIONS.
	MOVMS	B		;ABSOLUTE VALUE.
	IMUL	B,[-3]
	ADDI	A,-2(B)		;A NOW POINTS TO "CORGET" GUY.
	MOVN	C,-1(A)		;SIZE
	SUBI	C,3		;TO ACCOUNT FOR BOOKEEPING.
	PUSHJ	P,CORGET
	ERR	<NO ROOM FOR ARRAY>
	PUSH	P,B
	HRLI	B,(A)		;MAKE UP A BLT WORD.
	ADDI	C,(B)
	BLT	B,-1(C)		;COPY THE WHOLE ARRAY.
	POP	P,B		;BECAUSE BLT DESTROYS ITS.
	HRRZS	A		;SINCE THE ADDI ABOVE LEFT STUFF IN LEFT HALF.
	MOVNS	A
	ADDI	A,(B)		;A HAS NEW-OLD DIFFERENCE.
	ADDM	A,(B)		;THESE HAVE TO BE RELOCATED.
	ADD	A,-1(P)		;NEW ARRAY DESCRIPTOR.
	HRRM	A,-2(B)		;FOR STRING GARBAGE COLLECTOR.
	MOVE	C,-1(P)		;ARRAY THAT WAS COPIED.
	SKIPGE	-2(C)		;WAS IT A STRING ARRAY?
	SOS	-2(B)		;BACK IT UP ONCE.
	SUB	P,X22
	JRST	@2(P)		;ALL DONE.

DSCR LRMAK
⊗
HERE(LRMAK)
DSCR ARMAK
⊗

HERE (ARMAK)
BEGIN	ARMAK
	PUSHJ	P,SAVE
	HRRZ	A,-1(P)		;#DIMENSIONS
	MOVEI	B,-2(P)		;→BOUNDS(n)
	MOVEI	C,1

MAKLUP:	SOJL	A,SIZDUN	;DONE GETTING TOTAL SIZE
	MOVE	D,(B)		;UPPER BOUND
	ADDI	D,1		;PLUS ONE.
	SUB	D,-1(B)		;  -LOWER BOUND IS TOTAL SIZE
	SKIPG	D		;MUST BE POSITIVE
	 ERR	 <LOWER BOUND ≥ UPPER BOUND>
	IMUL	C,D		;COLLECT SIZE
	SUBI	B,2		;LOOK AT NEXT
	JRST	MAKLUP

SIZDUN:	; MOVEI C,SIZE DESIRED -- ALREADY THERE
	SKIPGE	-1(P)		;IF #DIMS POSITIVE, THEN NOT STRING ARRAY
	LSH	C,1		;MULTIPLY BY TWO FOR STRINGS.
	PUSH	P,C		;SAVE SIZE OF ARRAY ITSELF
	HRRZ	A,-2(P)		;#DIMENSIONS AGAIN
	IMULI	A,3		;SIZE OF ARRAY DESCRIPTOR TABLE
	ADDI	C,2(A)		;ADD TO SIZE OF AREA NEEDED
AGIN:	PUSH	P,C		;SAVE IT
	PUSHJ	P,CORGET		;ARRAY
	 ERR	 <NO ROOM FOR ARRAY>

GOTARR:	POP	P,C		;TOTAL SIZE AGAIN
	MOVE	D,B		;SAVE ADDRESS
	HRRZ	TEMP,B
	ADD	TEMP,C
	POP	P,C		;ARRAY SIZE
	PUSH	P,B		;SAVE →ARRAY BLOCK
	SETZM	(B)
	HRLS	B
	ADDI	B,1
	BLT	B,-1(TEMP)	;CLEAR ARRAY
	HRRZI	B,(D)		;GET ADDRESS BACK
	HRRZ	TEMP,-2(P)	;#DIMENSIONS AGAIN
	SKIPGE	-2(P)		;STRING ARRAY?
	 MOVNS	TEMP		; YES
	HRL	C,TEMP		;#DIMS, TOTAL SIZE (#DIMS NEG IF STRING)
	PUSH	P,C		;SAVE INFORMATION WORD


COMMENT ⊗
LET D→NEXT WORD INTO TABLE,  A=COUNT OF DIMENSIONS LEFT,
    C=ACCUMULATING TOTAL SIZES (AGAIN)
    B→CURRENT DESCRIPTIONS (IN STACK),  TEMP USED FOR MOVING THINGS
⊗

	ADDI	B,1		;LEAVE ROOM FOR ADDRESS WORD
	HRRZ	A,-3(P)		;#DIMS
	MOVE	LPSA,A		;PREPARE FOR SUBRT RETURN
	LSH	LPSA,1
	ADDI	LPSA,2
	HRLS	LPSA
	MOVEI	D,-4(P)		;→INFO
	;MOVE	D,[FIRST WORD]	;ALREADY THERE
	MOVEI	C,1		;MULTIPLY FACTOR
	MOVEI	X,0		;ACCUMULATE TOTAL DISPLACEMENT

STOLUP:	SOJL	A,STODUN
	MOVEW	(<1(B)>,<(D)>) ;UPPER BOUND
	ADDI	TEMP,1
	SUB	TEMP,-1(D)		;TOTAL SIZE
	MOVEM	C,2(B)		;AND MULTIPLY FACTOR
	IMUL	C,TEMP		;TEMP HAS SIZE THIS DIMENSION
	MOVEW	(<(B)>,<-1(D)>)	;STORE LOWER BOUND
	IMUL	TEMP,2(B)	;COLLECT TOTAL DISPLACEMENT
	ADD	X,TEMP		;IN X
	ADDI	B,3
	SUBI	D,2
	JRST	STOLUP		;UPDATE POINTERS AND LOOP


STODUN:	POP	P,(B)		;INFO WORD
	ADDI	B,1		;WILL POINT AT FIRST DATA WORD
	POP	P,TEMP	;→BLOCK HEAD
	HRRZM	B,-2(TEMP)	;STORE WHERE STRNGC CAN FIND IT
	SKIPGE	-1(B)		;IS IT A STRING ARRAY?
	HRROI	B,1(B)		;YES, POINT AT 2D WORD OF FIRST ELEMENT
	MOVEM	B,RACS+1(USER)	;RESULT
	JUMPGE	B,NSTG		;STRING ARRAY?
	 LSH	 X,1		; YES, DOUBLE DISPLACEMENT
NSTG:	SUB	B,X		;ARRAY ADDR - TOTAL DISPLACEMENT
	HLL	B,RACS+1(USER)	;-1 IF STRING, 0 OTHERWISE
	MOVEM	B,(TEMP)	;SAVE IN (0,0,0) WORD
	JRST	RESTR



BEND ARMAK


DSCR ARYEL
⊗

HERE(ARYEL)
BEGIN ARYEL
	HRRZ	B,-1(P)
	POP	P,-1(P)		;PUT POPJ ADDRESS BACK FOR CORREL.
	SKIPGE	-2(B)
	SUBI	B,1		;COMPUTE THE HEADER ADDRESS.
	HLRE	A,-1(B)
	MOVMS	A
	IMUL	A,[-3]
	ADDI	B,-2(A)
	HRRZS	B
	JRST	CORREL		;RELEASE IT.

BEND
COMMENT	⊗  bexit & stkuwd  ⊗
DSCR BEXIT
PARM -- XWD #LEVELS-1,LVI ADDRESS IN LPSA
DES -- RELEASES STROAGE FOR BLOCKS -- REPLACES THE OLD ARRREL
SID -- MANGLES ALL REGISTERS
⊗

HERE(BEXIT)
BEGIN BEXIT
BKCNT←5
BKPTR←6
TPTR←7
EN←10	;ALSO USED BY STKUWD
PDA←11	;THIS IS USED BY STKUWD, BUT SOME OF THE LVIDAC ROUTINES MUST SAVE IT
	;SINCE THEY ARE SOMETIMES USED BY STKUWD -- THIS IS CHEAPEST WAY

	PUSH	P,A			;SAVE A
	HLRE	BKCNT,LPSA		;SAVE COUNT
	HRRZ	BKPTR,LPSA		;POINT
	MOVE	TPTR,[POINT 4,EN,3]	;BYTE PTR FOR TYPE
NXTEN:	MOVE	EN,(BKPTR)		;PICK ONE UP
	LDB	A,TPTR			;PICK UP TYPE
	PUSHJ	P,@[ ↑↑LVIDAC:	DRYROT
				RARY	;1
				RARY	;2
				SLFRE	;3 -- SET OR LIST
				LAFRE	;LEAP ARRAY OF SETS OR LISTS
	
				FEVAR	;5 FOR EACH CONTROL VARIABLE
				KLIST	;6  
				CTEXTT	;7 CONTEXT
				DRYROT	;10
				DRYROT	;11
				DRYROT	;12
				DRYROT	;13
				DRYROT	;14
				DRYROT	;15
				DRYROT	;16
				BKE	;17 END OF BLOCK AREA
				](A)
	AOJA	BKPTR,NXTEN	;GET NEXT

DRYROT: ERR <DRYROT AT BEXIT>
	POPJ	P,
RARY:	SKIPN   C,@EN
	POPJ	P,
	EXCH	C,(P)		;CLEVER WAY TO FIX THE STACK FOR CALL TO
				;ARYEL
	PUSH	P,C
	SETZM	@EN		;SAY IT IS GONE
	JRST	ARYEL		;MAKE IT THE TRUTH
SLFRE:	SKIPN	A,@EN		;
	POPJ	P,
	SETZM	@EN		;ZERO OUT THE DESCRIPTOR
	PUSH	P,5		;SAVE IT
	PUSH	P,6
	MOVEI	5,0		;FOR RECLAIMER
	PUSHJ	P,RECQQ		;SINCE SET
	POP	P,6
	POP	P,5
	POPJ	P,
CTEXTT: SKIPN	A,@EN		;CONTEXT EMPTY?
	POPJ	P,		;YES
	PUSH	P,EN		;CONTEXT ADDRESS
	PUSHJ	P,ALLFOR	;FORGET EVERYTHING
	POPJ	P,

LAFRE:	SKIPN	A,@EN		;ARRAY PTR
	POPJ	P,		;NOBODY HOME
	PUSH	P,A
	SETZM	@EN
	PUSHJ	P,ARRRCL	;JRL'S MAGICAL SET ARRAY ZAPPER
	EXCH	A,(P)		;CLEVER TRICK AGAIN
	PUSH	P,A		;
	JRST	ARYEL		;GIVE UP THE SPACE
BKE:	SOJGE	BKCNT,GETNXT	;DO WE NEED TO DO MORE?
	MOVE	A,-1(P)
	SUB	P,[XWD 3,3]	;
	JRST	@1(P)		;NO
GETNXT:	MOVEI	BKPTR,@EN	;GET LINK
	SOJGE	BKPTR,CPOPJ	;WILL COMPENSATE FOR AOS
	ERR 	<DRYROT AT BEXIT -- WENT TOO FAR>
FEVAR:	SKIPN	A,@EN
CPOPJ:	POPJ	P,
	PUSH	P,PDA
	PUSH	P,BKCNT
	PUSH	P,BKPTR
	PUSH	P,TPTR
; NOW CALL LEAP TO RELEASE FOREACH
	MOVEI	5,46
	PUSHJ	P,LEAP
	POP	P,TPTR
	POP	P,BKPTR
	POP	P,BKCNT
	POP	P,PDA
	POPJ	P,
KLIST:	SKIPN	A,@EN
	POPJ	P,
	ERR	<UNTERMINATED PROCESS DEPENDS ON A BLOCK BEING EXITED 
MAY CONTINUE >,1
	POPJ	P,

BEND BEXIT

HERE (STKUWD)
BEGIN	STKUWD
DSCR STKUWD
DES THIS PROCEDURE UNWINDS THE STACK TO ESTABLISH A CORRECT DISPLAY AND
	LEXIC LEVEL.
PAR LPSA=XWD CORRECT LL,CORRECT DL
SID MANGLES YOUR ACS (EXCEPT F, P, SP -- WHICH ARE PROPERLY FIXED UP)
⊗

CDLSAV←5
LLFGR←6
SIN←7
EN←10
PDA←11

	MOVE	USER,GOGTAB		
	POP	P,STKURT(USER)		;REMEMBER RETURN ADDRESS
	HRRZM	LPSA,CDLSAV		;
	HLROM	LPSA,LLFGR		;SET UP PARAMETERS FOR USE 
	HLRZ	PDA,1(RF)		;PICK UP PROC DESC ADDRESS
PLOOP:	CAMN	PDA,CDLSAV		;IS THIS THE PARENT ???
	HRRZS	LLFGR			;USE THIS AS A FLAG
	HRRZ	SIN,PD.LLW(PDA)		;POINTER AT LVI INFO
NXTEN:	SKIPN	EN,(SIN)		;A ZERO SAYS
	JRST	EOPD			;WE ARE AT END OF LOC VAR INF
TPGET:	LDB	A,[POINT 4,EN,3]	;TYPE FIELD
	CAIN	A,17			;IGNORE END OOF BK ENTRIES
	AOJA	SIN,NXTEN
	JUMPL	LLFGR,DOIT		;IF NOT AT RIGHT DL, ZAP EM ALL
	LDB	B,[POINT =9,EN,=12]	;LL FIELD
	CAMG	B,LLFGR			;IF LEX LEV IS LOW ENOUGH
	AOJA	SIN,NXTEN		;LET HIM LIVE -- VERY INEFFICIENT CODE
DOIT:	PUSHJ	P,@LVIDAC(A)		;CALL APPROPRIATE ROUTINE
	AOJA	SIN,NXTEN
EOPD:	JUMPL	LLFGR,EOPD.1		;RETURN TEST
	MOVE 	USER,GOGTAB		;
	JRST	@STKURT(USER)
EOPD.1:	HRRZ	SIN,PD.DLW(PDA)		;NOW HAVE TO CLEAR OUT SET FORMALS
	HRRZ	B,PD.NPW(PDA)		;#ARITH +1
	MOVE	C,RF			;F REG
	SUBI	C,1(B)			;C← →→ 1 BEFORE 1'ST ARITH PARM
PARLP:	SOJLE	B,ADJSKS		;COUNT DOWN # ARGS
	AOS	C			;POINT AT NEXT
	MOVE	B,(SIN)			;TBITS
	TRNE	B,SET
	TDNE	B,[XWD REFRNC!SBSCRP,LPARRAY!ITEM!ITMVAR]
	AOJA	SIN,PARLP		;IF NOT VALUE SET, NO PROBLEMS
	MOVEI	EN,(C)			;EN←← PTR TO SET
;; BY JRL 8-31- 72 FOLLOWING INSTRUCTION WAS PUSHJ P,@LVIDAC+4
	PUSHJ	P,@LVIDAC+3		;CALL SET RELEASER
	AOJA	SIN,PARLP		;GO ON TO NEXT
ADJSKS:	HRRZ	RF,(RF)			;BACK A DYNAMIC LINK
	HLRZ	PDA,1(RF)		;NEW PDA
	MOVE	SP,2(RF)		;OLD OLD SP
	HLLZ	A,PD.DSW(PDA)		;EXTRA SS DISPL NEED
	HLR	A,A			;BOTH SIDES
	ADD	SP,A			;
	HRRZ	A,PD.DSW(PDA)		;ARITH STK DISPL
	ADD	A,RF			;+RF
	HRRZ	B,P			;WHERE WE ARE NOW
	SUB	B,A			;HOW FAR BACK TO GO
	HRL	B,B			;BOTH SIDES
	SUB	P,B			;TRIMMED BACK
	JRST	PLOOP			;

BEND STKUWD

COMMENT ⊗ array info & the like ⊗

DSCR INTEGER←ARRINFO(ARRAY,CODE);
CAL SAIL
⊗

HERE (ARRINFO)
BEGIN ARRINFO
	MOVE	A,-2(P)	;ARRAY ADDRESS
	SKIPGE	-2(A)	;STRING ARRAY?
	 SUBI	 A,1		; YES, BACK UP FOR IT
	SKIPGE	TEMP,-1(P)	;CONTROL PARAMETER
	 JRST	 [HLRE A,-1(A) ;WANTS NUMBER OF DIMENSIONS
		   JRST RSINFO]
	JUMPE	TEMP,[HRRZ A,-1(A) ;WANTS TOTAL SIZE
			JRST RSINFO]
; WANTS A BOUND
	ROT	TEMP,-1		;SAVE LOW ORDER BIT AS SIGN
	MOVNI	LPSA,3		;GET DISPLACEMENT INTO ARRAY TABLE
	IMULI	LPSA,(TEMP)
	SKIPGE	TEMP		;WANT UPPER OR LOWER BOUND
	SUBI	LPSA,4
	HRLI	A,LPSA
	MOVE	A,@A		;GET THE REQD BOUND
RSINFO:	
	SUB	P,X33
	JRST	@3(P)
BEND ARRINFO

DSCR ARRBLT(@DEST,@SOURCE,LENGTH);
CAL SAIL
⊗

HERE (ARRBLT) 
BEGIN ARRBLT
	HRRZ	TEMP,-3(P)
	HRL	TEMP,-2(P)
	SOS	LPSA,-1(P)
	ADDI	LPSA,(TEMP)
	BLT	TEMP,(LPSA)
	SUB	P,X44
	JRST	@4(P)
BEND  ARRBLT

DSCR ARRTRAN(DEST ARRAY,SOURCE ARRAY);
CAL SAIL
⊗

HERE (ARRTRAN)
BEGIN ARRTRAN
	HRRZ	TEMP,-2(P)		;DEST ARRAY ADDR
	HRRZ	LPSA,-1(P)		;SOURCE ARRAY ADDR
	SKIPL	-2(TEMP)		;STRING ARRAY?
	 JRST	 NSTR			; NO
	SUBI	TEMP,1
	SUBI	LPSA,1

NSTR:	HRL	TEMP,LPSA		;BLT WORD
	HRRZ	LPSA,-1(LPSA)		;SOURCE SIZE
	HRRZ	USER,-1(TEMP)
	CAMLE	LPSA,USER
	 HRRZ	 LPSA,USER
	ADDI	LPSA,-1(TEMP)		;TERMINATION WORD
	BLT	TEMP,(LPSA)
	SUB	P,X33
	JRST	@3(P)
BEND ARRTRAN

ENDCOM(ARY)

IFE ALWAYS, <
COMPIL(DM1,<RECQQ,ARRRCL,LEAP,ALLFOR>,,<DUMMY LEAP BEXIT TARGETS>)
↑↑RECQQ:
↑↑ARRRCL:
↑↑LEAP: 
↑↑ALLFOR:
	ERR <DRYROT-LIBRARY>
ENDCOM(DUM)
COMPIL(DM2,<SPRPDA,RESUME,TERMIN,SPROUT,DADDY,CURSCB>,,<DUMMY PROCESS VARIABLES>)
↑↑SPRPDA:
↑↑RESUME:
↑↑TERMIN:
↑↑SPROUT:
↑↑DADDY:
↑↑CURSCB:
	ERR <DRYROT-LIBRARY>
ENDCOM(DM2)
>;IFE ALWAYS

COMMENT ⊗ the procedure item routines
⊗

COMPIL(PIT,<PITCOP,PITBND,APPLY,PITDTM>,<GINFTB,INFTB,DATM,GDATM>
	,<PROCEDURE ITEM ROUTINES>)
BEGIN PITS
PDA ← 4
NA ← 5
L ← 6
ARG ← 7
GLOB <
GBRK←←6000 
>;GLOB

DSCR PITBND,PITCOP
CAL
	PUSH P,DITM
	PUSH P,XXX
	PUSHJ P,PITBND	<OR PITCOP>

PARM DITM IS ITEM TO BE MADE INTO PROCEDURE ITEM
	FOR PITBND, XXX IS PDA OF PROC TO BE BOUND
	FOR PITCOP, XXX IS PROCEDURE ITEM NUMBER
DES PUTS INTO DITM'S DATUM: XWD STATIC LINK,PDA &SETS DITM'S TYPE TO PITTYP
SID MANGLE TEMP,LPSA,USER,B,C
⊗



HERE (PITBND)
	HRRZ	LPSA,-1(P)		;PICK UP PDA
	HRRZ	TEMP,PD.PPD(LPSA)	;PARENT'S PDA
	SKIPE	PD.PPD(TEMP)		;IF DADDY IS THE GLOBAL MAN (IE
	JRST	PUTDTM			;THE OUTER BLOCK -- INDICATED BY HIS
					;HAVING NO FATHER -- THEN DONT LOOK FOR
					;A STATIC LINK -- YOU WILL USE 0

	SKIPA	USER,RF			;
CTXTLP:	HRRZ	USER,(USER)		;GO UP A LINK
	HLRZ	B,1(USER)		;PDA AT THIS LEVEL.  NOTE WE
	CAME	TEMP,B			;FIRST LOOK AT THIS GUY
	JRST	CTXTLP			;NOT THE ONE
	HRL	LPSA,USER		;NOW LPSA IS SL,,PDA
	JRST	PUTDTM			;GO PUT IN THE DATUM

HERE(PITCOP)
	MOVE	B,-1(P)			;PICK UP ITEM NO INTO B
	PUSHJ	P,PITDGT		;GET DATUM
PUTDTM:	MOVE 	B,-2(P)			;TARGET
	MOVEI	USER,PITTYP		;SPECIAL CODE
GLOB <
	CAIL 	B,GBRK			;IS IT GLOBAL???
	JRST	[
		TERPRI	<DON'T BIND PROCEDURES TO GLOBAL ITEMS>
		CAI	B,
		ERR	<ITEM NUMBER>,6
		]
	>;GLOB

	HRRM	USER,@INFTB		;PUT IN NEW DATUM TYPE
	MOVE	C,B
	MOVEM	LPSA,@DATM		;SET DATUM
	SUB	P,[XWD 3,3]
	JRST	@3(P)			;RETURN

PITDGT:					;PROCEDURE TO GET PIT DATUM
GLOB <
	CAIL	B,GBRK			;
	SKIPA	LPSA,@GINFTB
	MOVE	LPSA,@INFTB
	HRRZ	LPSA,LPSA
>;GLOB
NOGLOB <
	HRRZ	LPSA,@INFTB
>;NOGLOB
	CAIE	LPSA,PITTYP		;IS IT A PROCEDURE ITEM???
	JRST	[ CAI B,
		ERR <NOT A PROCEDURE ITEM >,6]
	MOVE	C,B
GLOB <
	CAIL	C,GBRK
	ERR	<DRYROT AT PITDGT>
>;GLOB
	MOVE	LPSA,@DATM		;FETCH DATUM
	POPJ	P,

DSCR PITDTM
CAL 	PUSH	P,PIT NO
	PUSHJ	P,PITDTM
DES	SETS THE TOP OT THE STACK TO THE DATUM OF THE PROCEDURE ITEM
⊗

HERE(PITDTM)
	MOVE	B,-1(P)			;PICK UP ITEM NO
	PUSHJ	P,PITDGT		;GET ITS DATUM
	MOVEM	LPSA,-1(P)		;SET IT DOWN INTO THE STACK
	POPJ	P,

DSCR APPLY
CAL 
	PUSH	P,[xwd context,pda]
	PUSH	P,ARGLIS
	PUSHJ	P,APPLY
DES  
	APPLY is the interpretive caller. Essentially, it uses the items
in ARGLIS to build a procedure call on the procedure named by the pda.
If context=0, then the procedure is just called in the normal manner. 
If context is not zero, then APPLY will build a MSCP, using this value
as the static link, and will jrst to the instruction after the mscp.

⊗
HERE(APPLY)
	MOVE	PDA,-2(P)
	MOVE	NA,PD.NPW(PDA)		;NUMBER OF PARAMETERS
	TLNE	NA,-1			;BETTER BE NO STRINGS
	JRST	[
		PRINT	<ATTEMPT TO EVAL A PROCEDURE WITH STRING PARAMETERS>
CPITE:		PUSHJ	P,PITERR
		ERR <CANNOT CONTINUE>
		]
	MOVE	ARG,PD.DLW(PDA)		;POINT AT FIRST SET OF TBITS
	HLRE	L,-1(P)			;LEN OF ARG LIST
	MOVM	L,L			;MAKE IT POS -- JRL'S CROCK STRIKES
	CAIGE	L,-1(NA)		;DO WE HAVE ENOUGH?
	JRST	[
		PRINT	<NOT ENOUGH ACTUAL PARAMETERS SUPPLIED TO INTERP CALL>
		JRST	CPITE
		]
	HRRZ	L,-1(P)			;POINT AT PTR TO FIRST
	HRRZ	L,(L)			;PTR TO FIRST
PALP:	SOJLE	NA,ARGSON		;COUNT DOWN
	MOVE	L,(L)			;LOOK AT NEXT
	HLRZ	B,L			;ITEM NUMBER
GLOB <
	CAIL	B,GBRK			;
	SKIPA	A,@GINFTB		;GLOBAL TYPE
>;GLOB
	MOVE	A,@INFTB		;PICK UP TYPE
	MOVE	C,(ARG)			;TBITS OF ARG
	TLZN	C,VALUE			;BETTER BE VALUE
	JRST	[
		PRINT	<EVAL WITH NON-VALUE ITEMVAR FORMAL>
		JRST	CPITE
		]
	CAIN	C,ITMVAR		;IF SIMPLE ITEMVAR
	JRST	PSHIT			;JUST PUSH IT ON
	CAILE	A,ARRTYP		;IS IT AN ARRAY ITEM?
	JRST	[
		TRZN	C,LPARRAY	;YES, TEST THE FORMAL
		JRST	BFACT		;LOSE
		SUBI	A,ARRTYP	;SUBTRACT OFF THE ARRAY OFFSET
		JRST 	.+1
		]
	CAME	C,TBTBL(A)		;DO TYPE BITS AGREE???
	JRST	[			;LOSE
BFACT:
		PRINT <BAD FORMAL-ACTUAL TYPE MATCH FOR ARGUMENT >
		DECPNT	ARG
		TERPRI	< IN AN INTERPRETIVE CALL>
		PUSHJ	P,PITERR
		JRST	.+1

		]
PSHIT:	PUSH	P,B			;PUSH ON THE ITEM NUMBER
	AOJA	ARG,PALP		;LOOP BACK

ARGSON:	TLNN	PDA,-1			;WERE WE GIVEN A CONTEXT
	JRST 	CAL1			;NO
	PUSH	P,[CRET]		;PUSH	RETURN ADDRESS
	PUSH	P,RF
	HRRZ	ARG,PD.PPD(PDA)		;PARENTS PDA
	MOVS	B,PDA			;PDA,,STATIC LINK
	HLRZ	NA,1(B)			;PDA OF DADDY???
	CAME	NA,ARG			;????
	JRST	[

		PRINT	<CONTEXT WRONG OR CLOBBERED IN INTERP CALL>
		JRST	CPITE
		]
	PUSH	P,B			;STATIC LINK
	PUSH	P,SP			;
	HLRZ	ARG,PD.PPD(PDA)		;WORD AFTER MKSEMT
	JRST	(ARG)			;GO THERE
CAL1:	HRRZ	ARG,PD.(PDA)		;ENTRY ADDRESS
	PUSHJ	P,(ARG)			;CALL IT
CRET:	MOVE	PDA,-2(P)		;HERE ON RETURN
	MOVE	ARG,PD.PDB(PDA)		;PROC TBITS
	TRNN	ARG,ITEM!ITMVAR		;IF NOT ONE OF THESE
	MOVEI	A,0			;THEN RETURN 0
	SUB	P,[XWD 3,3]
	JRST	@3(P)			;RETURN


PITERR:	TERPRI 
	PRINT <PROCEDURE IS >
	TERPRI
	PUSHJ	P,PRPID
	ERR	< >,1
	POPJ	P,

PRPID:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	HRRZI	B,PD.ID1(PDA)
	MOVE	A,PD.ID2(PDA)
	SOJL	B,.+4
	ILDB	C,A
	TTCALL	1,C
	JRST	.-3
	POP	P,C
	POP	P,B
	POP	P,A
	POPJ	P,

COMMENT ⊗ TABLE OF TYPE BITS FOR ITEMS ⊗
TBTBL:	0				;0
	0				;1
	0				;2
	STRING!ITMVAR			;3
	FLOTNG!ITMVAR			;4
	INTEGR!ITMVAR			;5
	ITMVAR!SET			;6
	LSTBIT!ITMVAR!SET		;7
	0				;10

BEND PITS
ENDCOM(PIT)
BEND GOGOL
PATCH:	BLOCK	50