;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** STANDARD AC, UUO, AND MACRO DEFINITIONS *
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


;;; THIS FILE CONTAINS:
;;;	STANDARD SYMBOLIC ACCUMULATOR DEFINITIONS.
;;;	UUO DEFINITIONS:
;;;		ERROR CALLS AND STRING TYPEOUT.
;;;		COMPILED CODE TO INTERPRETER INTERFACES.
;;;		VARIOUS UUOS USEFUL FROM DDT.
;;;	.GLOBAL DECLARATIONS.
;;;	.FORMAT DECLARATIONS.
;;;	TYPE BIT DEFINITIONS FOR USE WITH SEGMENT TABLE
;;;	MACROS FOR CONDITIONALIZING SINGLE LINES OF CODE.
;;;	GENERAL MACRO DEFINITIONS [THAT ANY LOSER MIGHT WANT].
;;;	SYMBOL BLOCK-STRUCTURE DEFINITIONS
;;;	SYMBOLIC NAMES RELATED TO ARRAYS.
;;;	SYMBOLIC NAMES RELATED TO FILES.

;;; THE DEFINITIONS FOR MACLISP CONTAINED HEREIN
;;; ARE RELATIVELY STABLE. THIS FILE MAY BE .INSRT'D BY MIDAS
;;; FILES ASSEMBLED IN .FASL MODE TO DEFINE THESE THINGS.
;;; THE .GLOBAL DECLARATIONS IN PARTICULAR ARE FOR THE
;;; BENEFIT OF THESE .FASL FILES.
;;; IT IS A GOOD IDEA FOR .FASL FILES TO USE THE FASEND MACRO
;;; IN PLACE OF THE USUAL END STATEMENT.

;;; SYMBOLS FOR COMPILED CODE

IFNDEF ITS, ITS==:1
IFNDEF TOPS10, TOPS10==:0
IFNDEF TOPS20, TOPS20==:0
IFNDEF SAIL, SAIL==:0
IFNDEF TENEX, TENEX==:0
IFNDEF CMU, CMU==:0

IFNDEF D10, D10==:TOPS10\SAIL\CMU
IFNDEF D20, D20==:TOPS20\TENEX

IFNDEF PAGING, PAGING==:ITS\D20

IFNDEF BIGNUM, BIGNUM==:1
IFNDEF JOBQIO, JOBQIO==:1
IFNDEF SFA, SFA==:1



SUBTTL	ACCUMULATOR USAGE

NIL=:0		;ATOM HEADER FOR NIL
A=:1		;ARG 1; VALUE; MARKED FROM BY GC
B=:2		;ARG 2; MARKED FROM BY GC
C=:3		;ARG 3; MARKED FROM BY GC
AR1=:4		;ARG 4; MARKED FROM BY GC
AR2A=:5		;ARG 5; MARKED FROM BY GC
NACS==:5 ;NUMBER OF ACS MARKED FROM BY GC - NO OTHER ACS MARKED
T=:6		;-<NO. OF ARGS> FOR LSUBR CALL; ALSO USED FOR JSP T,
TT=:7		;TEMP; OFTEN USED FOR ARGS TO INTERNAL ROUTINES
D=:10		;SOMEWHAT LESS TEMPORARY THAN TT
R=:11		;DITTO; SOMETIMES USED FOR JSP R,
F=:12		;SOMEWHAT LESS TEMPORARY THAN D AND R
FREEAC=:13	;UNUSED BY LISP, EXCEPT SAVED-USED-RESTORED BY GC
P=:14		;SUBROUTINE AND SYSTEM PDL POINTER ("REGULAR PDL")
FLP=:15		;FLONUM PDL POINTER ("FLOPDL")
FXP=:16		;FIXNUM PDL POINTER ("FIXPDL")
SP=:17		;LAMBDA-BINDINGS PDL POINTER ("SPECIAL PDL")
;;; PDL POINTERS ARE ALWAYS KEPT IN ACS. PDL POINTERS ARE NOT
;;; MARKED FROM, BUT PDL DATA ON REGULAR AND SPECIAL PDLS ARE
;;; PROTECTED FROM GARBAGE COLLECTION.
;;; FLP IS NOT USED BY LISP, EXCEPT AT LDATFL AND ERRIOJ,
;;; BUT PRIMARILY BY COMPILED NUMERICAL CODE.
;;; DO NOT DO RANDOM PUSH/POPS ON SP - USE BIND AND UNBIND ROUTINES.

SUBTTL	DEFINITIONS OF UUO'S

;;; NOTE: LERR < LER3 < ERINT < SERINT  -- SEE ERRFRAME.

LERR=:1_33	;LISP ERROR; AC FIELD=0 => MSG IS SIXBIT, ELSE S-EXP
ACALL=:2_33	;KLUDGY FAST UUO FOR NCALLS TO ARRAYS
AJCALL=:3_33	;AJCALL:ACALL :: JCALL:CALL
LER3=:4_33	;EPRINT, THEN LERR
ERINT=:5_33	;A CORRECTABLE ERROR
PP=:6_33		;SEXP TYPE OUT FROM DDT
STRT=:7_33	;STRING TYPEOUT (sixbit format - stops on unquoted "!")
SERINT=:10_33	;LIKE ERINT, BUT S-EXPRESSION MESSAGE.
TP=:11_33	;PRINTS ST ENTRY FOR A GIVEN LOCATION
IOJRST=:12_33	;JRST TO ADR AFTER PUTTING I/O ERROR MSG IN C
STRT7=:13_33	;STRING TYPEOUT (ascii format - stops on 0 byte)
UUOMAX==:13	;NO OF ERROR-TYPE UUO'S


CALL=:14_33	;BASIC CALL FROM COMPILED CODE TO INTERFACE TO INTERPRETER
JCALL=:CALL+1_33 ;4.1 BIT ON MEANS JRST TO FUNCTION RATHER THAN PUSHJ
CALLF=:CALL+2_33 ;4.2 BIT ON MEANS NEVER CONVERT UUO INTO PUSHJ [OR JRST]
JCALLF=:CALL+3_33
NCALL=:20_33	;4.5 BIT MEANS NUMBER FUNCTION CALL
NJCALL=:NCALL+1_33
NCALLF=:NCALL+2_33
NJCALF=:NCALL+3_33
NUUOCLS==:NJCALF_-33-CALL_-33

;;; SPECIAL INTERPRETATION OF STRT AC FIELD:
;;;	AC FIELD      OUTPUT TO
;;;	  0		OUTFILES IF ^R SET; TTY IF ^W SET
;;;	 17		MSGFILES
;;;	  X		FILE(S) IN ACCUMULATOR X

;;; ERINT AND SERINT ARE DECODED BY THEIR ACCUMULATOR FIELDS.
;;; HERE ARE SOME SYMBOLS FOR REFERENCING THEM.

NERINT==0
IRPS X,,[UDF,UBV,WTA,UGT,WNA,GCL,FAC,IOL]
	%!X=:ERINT .IRPCNT,
	%%!X=:SERINT .IRPCNT,
	DEFINE X CRUFT
		%!X [SIXBIT CRUFT]
	TERMIN
	NERINT==NERINT+1
TERMIN

;;; SHORT FORM	ATOM		WHAT IS IT?
;;; 
;;; 0)  UDF	UNDEF-FNCTN	UNDEFINED FUNCTION (FUNCTION IN A)
;;; 1)  UBV	UNBND-VRBL	UNBOUND VARIABLE BEING EVAL'ED (ATOM IN A)
;;; 2)  WTA	WRNG-TYPE-ARGS	WRONG TYPE OF ARGUMENTS FOR A FUNCTION (ARG IN A)
;;; 3)  UGT	UNSEEN-GO-TAG	GO TO A TAG THAT'S NOT THERE (TAG IN A)
;;; 4)  WNA	WRNG-NO-ARGS	WRONG NUMBER OF ARGS TO A FUNCTION (FORM IN A)
;;; 5)  GCL	GC-LOSSAGE	GC LOST (A = NAME OF SPACE: LIST...)
;;; 6)  FAC	FAIL-ACT	RANDOM LOSSAGE (ARG IS UP TO CALLER)
;;; 7)  IOL	IO-LOSSAGE	;I/O LOSSAGE

SUBTTL	TABLE OF GLOBAL SYMBOLS USED BY COMPILED FUNCTIONS

;;; THE RELATIVE POSITIONS OF THESE SYMBOLS GET BUILT INTO FASL FILES,
;;; SO BE VERY CAREFUL ABOUT DISTURBING THE ORDER OF EXISTING SYMBOLS!
;;; GLBSYM AND SIXSYM MUST ALWAYS HAVE CORRESPONDING ENTRIES.

DEFINE GLBSYM B
IRP A,,[.SET,.MAP,PRINTA,SPECBIND,UNBIND,IOGBND,.LCALL
.UDT,ARGLOC,INUM,ST,FXNV1,PDLNMK,PDLNKJ,FIX1A
FIX1,FLOAT1,IFIX,IFLOAT,FXCONS,FLCONS,ERSETUP,ERUNDO
GOBRK,CARCDR,.STORE,NPUSH,PA3,QUNBOUND,FLTSKP,FXNV2
FXNV3,FXNV4,FIX2,FLOAT2,AREGET]
	B
TERMIN
IRP A,,[%HUNK1,%HUNK2,INTREL,INHIBIT,NOQUIT,CHECKI,0PUSH,0.0PUSH,NILPROPS,VBIND
%CXR,%RPX,%CONS,%NCONS,%XCONS,%C2NS,%HUNK3,%HUNK4,%PDLC,%PDLXC,%PDLNC
PTNTRY,PTEXIT,SFCALI,UNWPUS]
	B
TERMIN
TERMIN

DEFINE SIXSYM B			;SIXBIT NAMES -- MUST MATCH GLBSYM
IRP A,,[*SET,*MAP,PRINTA,SPECBIND,UNBIND,IOGBND,*LCALL
*UDT,ARGLOC,INUM,NUMVAL,FXNV1,PDLNMK,PDLNKJ,FIX1A
FIX1,FLOAT1,IFIX,IFLOAT,FXCONS,FLCONS,ERSETUP,ERUNDO
GOBRK,CARCDR,*STORE,NPUSH,PA3,MAKUNBOUND,FLTSKP,FXNV2
FXNV3,FXNV4,FIX2,FLOAT2,AREGET]
	B
TERMIN
IRP A,,[%HUNK1,%HUNK2,INTREL,INHIBIT,NOQUIT,CHECKI,0PUSH,0*0PUSH,NILPROPS,VBIND
%CXR,%RPX,%CONS,%NCONS,%XCONS,%C2NS,%HUNK3,%HUNK4,%PDLC,%PDLXC,%PDLNC
PTNTRY,PTEXIT,SFCALI,UNWPUS]
	B
TERMIN
TERMIN

;;; ADDITIONAL SYMBOLS FOR LAP AND .FASL HACKERS.
;;; THE ORDER OF THESE IS NOT CRITICAL.

DEFINE XTRSYM B
IRP A,,[CPOPJ,CCPOPJ,POPAJ,POP1J,CINTREL,LWNACK,SIXMAK,SQUEEZE,MKFXAR,FWCONS
SACONS,CFIX1,1DIMF,2DIMF,SEGLOG,R70,ARGLOC,ARGNUM,TTSAR,Q..MIS,MAKVC,SUNBOUND
IN0,TYIMAN,READ6C,READ0A,GCMKL,DEDSAR,BRGEN,RINTERN,LPNF,PNBUF,ALFILE,ALCHAN
XFILEP,FIL6BT,6BTNML,SIXATM,CHNTB,%HNK4R,GRBPSG,HNKLOG,IAPPLY,ALHUNK,ARYSIZ
.REA3,IFORCE,XOFLOK,XIFLOK,GCST,FWNACK]
	B
TERMIN
IFN PAGING,[
    IRP A,,[FLSTBL]
    TERMIN
]	;END of IFN PAGING
IFN ITS,[
    IRP A,,[GETCOR,IOCINS,J.STADR,J.CRUFT]
	    B
    TERMIN
]	;END OF IFN ITS
IFN D10,[
    IRP A,,[PPNATM,CMUP]
	    B
    TERMIN
]		;END OF IFN D10
IFN D20,[
    IRP A,,[TENEXP]
	    B
    TERMIN
]		;END OF IFN D20
IFN BIGNUM,[
    IRP A,,[BNCONS,NVSKIP]
	    B
    TERMIN
]	;END OF IFN BIGNUM
IFN JOBQIO,[
IRP A,,[JOBTB,LOJOBA]
	B
TERMIN
]		;END OF IFN JOBQIO
IFN SFA,[
IRP A,,[AFOSP,XFOSP]
	B
TERMIN
]		;END IFN SFA
TERMIN

GLBSYM [.GLOBAL A]
XTRSYM [.GLOBAL A]

SUBTTL	SYMBOLS FOR NUMBER-OF-ARGS CHECKING, AND .FORMAT


;;; SYMBOLS TO BE USED WITH FWNACK AND LWNACK.
;;; ORDINARILY ONE WRITES
;;;		JSP TT,FWNACK
;;;		FAXXX,,QZZZZZ
;;; IN EACH SYMBOL, THE 3.1 BIT (THESE ARE LEFT-HALF SYMBOLS)
;;; MEANS FSUBR. THE 3.2 BIT MEANS 0 ARGS IS OKAY; 3.3, 1 ARG;
;;; 3.4, 2 ARGS; ... ; 4.8, 15. ARGS; 4.9, > 15. ARGS.

;;; ITEMS IN THIS IRP MUST HAVE FIRST FOUR CHARS UNIQUE!!!
;;; IF YOU ADD STUFF HERE, ALSO FIX UP FASEND.
.SEE FASEND

IRP X,,[02,1N,12,23,2N,0,1,2,4,01,012,01234,0234,3456,1234567
13456,234,345,234567,76543,45]
LA!X==0
IRPC Q,,[X]
IFSN Q,N, LA!X==LA!X+2_Q
.ALSO	ZZ==Q
.ELSE	LA!X==LA!X+<<777774_ZZ>&7777777>
TERMIN
FA!X==LA!X+1
TERMIN


;;; THE FOLLOWING FORMATS ARE HEREBY DECLARED ILLEGAL AS
;;; BEING REDUNDANT AND/OR GROSSLY CONFUSING.
;;; SEE THE MIDAS MANUAL FOR DETAILS.
;;;		,A
;;;		,A C
;;;		,A,
;;;		,A,C
;;;		A B C
;;;		A,
;;;		A,B
;;;		A,B C
;;;		A,B,
;;;		A,B,C

IRP X,,[14,15,16,17,25,30,34,35,36,37]
.FORMAT X,0
TERMIN

;;; FLAG BITS FOR SQUOZE SYMBOLS IN DDT

%SY==1,,537777
%SYHKL==:400000	;HALF KILLED
%SYKIL==:200000	;FULLY KILLED
%SYLCL==:100000	;LOCAL
%SYGBL==:40000	;GLOBAL

;;; A FEW RANDOMLY USEFUL DEFINITIONS TO KEEP THINGS SYMBOLIC
;;; BUT WATCH OUT!  DONT JUST RANDOMLY THINK YOU CAN CHANGE NASCII 
;;;	AND HAVE THINGS WIN, ESPECIALLY THE PACKING OF CHARS FOR 
;;;	PNAMES, AND THE SPECIAL OBARRAY ENTRIES FOR SCOS.

IFN SAIL, 	NASCII==:1000	;NUMBER OF ASCII CHARS
.ELSE 		NASCII==:200	;NUMBER OF ASCII CHARS
BYTSWD==:5	;NUMBER OF ASCII BYTES PER WORD


SUBTTL	DEFINITIONS OF BIBOP TYPE BITS FOR USE IN THE SEGMENT TABLE

.SEE ST

LS==:400000		;4.9  1=LIST STRUCTURE, 0=ATOMIC
ST.LS==:400000
$FS==:200000		;4.8  FREE STORAGE (BIT 4.9 SHOULD BE ON ALSO)
ST.$FS==:200000
FX==:100000		;4.7  FIXNUM STORAGE
ST.FX==:100000
FL==:40000		;4.6  FLONUM STORAGE
ST.FL==:40000
BN==:20000		;4.5  BIGNUM HEADER STORAGE
ST.BGN==:20000
SY==:10000		;4.4  SYMBOL HEADER STORAGE
ST.SY==:10000
SA==:4000		;4.3  SAR STORAGE (BIT 3.8 SHOULD BE ON ALSO)
ST.SA==:4000
VC==:2000		;4.2  VALUE CELL STORAGE (BIT 4.9 SHOULD BE ON ALSO)
ST.VAC==:2000
$PDLNM==:1000		;4.1  NUMBER PDL AREA
			;     (ONE OF THE NUMBER TYPE BITS SHOULD BE ON ALSO)
ST.$PDLNM==:1000
			;3.9  400 RESERVED - AVOID USING (FORMERLY $FLP)
$XM==:200		;3.8  EXISTENT (RANDOM) AREA
ST.$XM==:200
$NXM==:100		;3.7  NONEXISTENT (RANDOM) AREA
ST.$NXM==:100
PUR==:40		;3.6  PURE SPACE
			;     (ONE OF BITS 4.8-4.5, 3.8, OR 3.4-3.2 ALSO ON)
ST.PUR==:40
HNK==:20		;3.5  HUNK OF ONE KIND OR ANOTHER (BIT 4.9 ON ALSO)
ST.HNK==:20
DB==:10			;3.4  DOUBLE-PRECISION FLONUMS
ST.DB==:10
CX==:4			;3.3  COMPLEX NUMBERS
ST.CX==:10
DX==:2			;3.2  DOUBLE-PRECISION COMPLEX NUMBERS
ST.DX==:2
			;3.1  1 UNUSED (USE THIS BEFORE BIT 3.9)

RN==:$XM+$NXM			;RANDOMNESS!
NUM==:FX+FL+BN+DB+CX+DX		;NUMBERNESS!

ST.==:1,,<ST.LS+ST.FX+ST.BGN+ST.SA+ST.$PDLNM+ST.$NXM+ST.HNK+ST.CX+1>

SUBTTL	ONE-LINE CONDITIONAL MACROS

;;; THESE HELP MAKE SOME CODE LESS MESSY TO READ.
;;; PREFACING A LINE OF CODE WITH ONE OF THESE SYMBOLS TELLS MIDAS
;;; TO ASSEMBLE THAT LINE ONLY UNDER THE SPECIFIED CONDITION.
;;; EXAMPLE:
;;;
;;;	FOO:	MOVE A,(P)
;;;	10$	PUSHJ P,10HACK		;THIS LINE IS FOR DEC-10 ONLY
;;;		MOVE A,-1(P)
;;;	Q%	PUSHJ P,OLDHAK		;THIS LINE IS FOR OLD I/O ONLY
;;;		POPJ P,

DEFINE 10$
IFN D10,TERMIN

DEFINE 10%
IFE D10,TERMIN

DEFINE IT$
IFN ITS,TERMIN

DEFINE IT%
IFE ITS,TERMIN

DEFINE 20$
IFN D20,TERMIN

DEFINE 20%
IFE D20,TERMIN

DEFINE 10X
IFN TENEX,TERMIN

DEFINE SA$
IFN SAIL, TERMIN

DEFINE SA%
IFE SAIL,TERMIN

DEFINE CMU$
IFN CMU,TERMIN

DEFINE CMU%
IFE CMU,TERMIN

DEFINE T10$
IFN TOPS10,TERMIN

DEFINE T10%
IFE TOPS10,TERMIN

DEFINE 20X
IFN TOPS20,TERMIN

;;; NEWRD IS FOOLISH NEW READER FLAG (HISTORICAL ARTIFACT -- FLUSH EVENTUALLY)

DEFINE NW$
IFN NEWRD,TERMIN

DEFINE NW%
IFE NEWRD,TERMIN

DEFINE BG$
IFN BIGNUM,TERMIN

DEFINE BG%
IFE BIGNUM,TERMIN

DEFINE DB$
IFN DBFLAG,TERMIN

DEFINE DB%
IFE DBFLAG,TERMIN

DEFINE CX$
IFN CXFLAG,TERMIN

DEFINE CX%
IFE CXFLAG,TERMIN

DEFINE DX$
IFN DXFLAG,TERMIN

DEFINE DX%
IFE DXFLAG,TERMIN

DEFINE HN$
IFN HNKLOG,TERMIN

DEFINE HN%
IFE HNKLOG,TERMIN

DEFINE KA
IFN KA10,TERMIN

DEFINE KAKI
IFN KA10+KI10,TERMIN

DEFINE KI
IFN KI10,TERMIN

DEFINE KIKL
IFN KI10+KL10,TERMIN

DEFINE KL
IFN KL10,TERMIN

DEFINE PG$
IFN PAGING,TERMIN

DEFINE PG%
IFE PAGING,TERMIN

DEFINE SFA$
IFN SFA,TERMIN

DEFINE SFA%
IFE SFA,TERMIN

DEFINE HS$
IFN HISEGMENT,TERMIN

DEFINE HS%
IFE HISEGMENT,TERMIN

DEFINE REL$
IFE D20\<D10*PAGING>,TERMIN

DEFINE REL%
IFN D20\<D10*PAGING>,TERMIN


SUBTTL	GENERAL MACROS

DEFINE CONC A,B			;HAIRY CONCATENATOR MACRO
A!B!TERMIN

DEFINE LOCKI			;LOCK OUT USER INTERRUPTS UNTIL UNLOCKI'D
	PUSH FXP,INHIBIT
	SETOM INHIBIT
TERMIN

DEFINE UNLOCKI			;RELEASE THE USER-INTERRUPT LOCK, AND CHECK TO SEE 
	PUSHJ P,INTREL		;IF ANY INTERRUPTS WERE STACKED UP WHILE IN LOCKED STATE
TERMIN

DEFINE LOCKTOPOPJ		;LOCK ALL THE ENSUING CODE UNTIL THE
	PUSH P,CINTREL		;EXITING POPJ P,
	LOCKI
TERMIN

DEFINE UNLKPOPJ			;UNLOCK, THEN POPJ P,
	JRST INTREL
TERMIN

				.SEE CHNINT
DEFINE .5LOCKI			;HALF-LOCK INHIBIT
	PUSH FXP,INHIBIT
	HRROS INHIBIT
TERMIN

DEFINE .5LKTOPOPJ
	PUSH P,CINTREL
	.5LOCKI
TERMIN

IRP PL,,[,FX]
DEFINE SOVE!PL AL/	;CALLED LIKE SOVE A B C
IRPS AC,,AL
	PUSH PL!P,AC
TERMIN
TERMIN
DEFINE RSTR!PL AL/	;CALLED LIKE RSTR C B A
IRPS AC,,AL
	POP PL!P,AC
TERMIN
TERMIN
TERMIN


DEFINE MACROLOOP COUNT,NAME,C		;FOR EXPANDING MANY MACROS
IFSN C,, .CRFOFF
REPEAT COUNT,[ CONC NAME,\.RPCNT
]
IFSN C,, .CRFON
TERMIN



;SKIP IF TYPE, USING TT AS TEMP, ACCORDING TO BIBOP TYPE BITS
DEFINE SKOTT /Z
	SKOTT% N,L,Z
TERMIN
;SKIP IF NOT TYPE, USING TT AS TEMP, ACCORDING TO BIBOP TYPE BITS
DEFINE SKOTTN /Z
	SKOTT% E,GE,Z
TERMIN

DEFINE SKOTT% N,L,X,TYP
IFN TT-<X>,	HRRZ TT,X
	LSH TT,-SEGLOG
IFN <TYP>-LS,[
	MOVE TT,ST(TT)
	TLN!N TT,<TYP>
]
.ELSE	SKIP!L TT,ST(TT)
TERMIN


;; STRING HACKERS, ASSUMING ENCODINGS IN HUNKS
STWIWO==1	;STRING-WORD-INDEX, WORD-OFFSET         -  A RH QUANTITIY
STLNWO==1	;STRING-LENGTH, WORD-OFFSET 	        -  A LH QUANTITIY
DEFINE STRWDNO AC,IX
	HRRZ AC,STWIWO(IX)
	SKIPGE AC,(AC)
TERMIN
DEFINE STRLEN AC,IX
	HLRZ AC,STLNWO(IX)
	MOVE AC,(AC)
TERMIN



DEFINE %			;THIS IS GOOD FOR LIST STRUCTURE
,,.+1!TERMIN


DEFINE INFORM R,S,T,U,V,W,X,Y,Z,$,%
PRINTX 	R!S!T!U!V!W!X!Y!Z!$!%

TERMIN

DEFINE WARN R,S,T,U,V,W,X,Y,Z,$,%
WARN1 [R!S!T!U!V!W!X!Y!Z!$!%]
TERMIN

DEFINE WARN1 CRUFT
IFL 40-.LENGTH CRUFT,[ .ERR ######
PRINTX 	###### CRUFT

]
.ELSE .ERR ###### CRUFT
TERMIN

;;; USEFUL MACRO FOR .FASL FILES.  CAUSES LOADING TO PRINT MESSAGE.

DEFINE VERPRT NAME,VRS=[???]
IFN .FNAM2-SIXBIT /MID/,[
%%%==.fnam2
.SXEVAL	  ((LAMBDA (X)
	     (COND ((STATUS NOFEATURE NOLDMSG)
		    (TERPRI MSGFILES)
		    (TYO #73  MSGFILES)
		    (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/  ) MSGFILES)
		    (PRINC X MSGFILES)
		    (TYO #40  MSGFILES)))
	      (PUTPROP (QUOTE NAME) X (QUOTE VERSION)))
	   (MAKNAM (DELQ #40
			 (QUOTE (#<<<%%%&<770000,,0>>_-36>+40>
				 #<<<%%%&<7700,,0>>_-30>+40>
				 #<<<%%%&<77,,0>>_-22>+40>
				 #<<<%%%&770000>_-14>+40>
				 #<<<%%%&7700>_-6>+40>
				 #<<%%%&77>+40> )))))
]
.ELSE [
.SXEVAL    (COND ((STATUS NOFEATURE NOLDMSG)
		  (TERPRI MSGFILES)
		  (TYO #73  MSGFILES)
		  (PRINC (QUOTE L/o/a/d/i/n/g/ NAME/ VRS/ ) MSGFILES)))
.SXEVAL	   (DEFPROP NAME VRS VERSION)
]
TERMIN

;; Silent VERPRT, which doesn't print the message, just does the DEFPROP
;; of the version property

DEFINE SVERPRT NAME,VRS=[???]
IFN .FNAM2-SIXBIT /MID/,[
%%%==.fnam2
.SXEVAL    (PUTPROP (QUOTE NAME)
		    (MAKNAM (DELQ #40
				  (QUOTE (#<<<%%%&<770000,,0>>_-36>+40>
					  #<<<%%%&<7700,,0>>_-30>+40>
					  #<<<%%%&<77,,0>>_-22>+40>
					  #<<<%%%&770000>_-14>+40>
					  #<<<%%%&7700>_-6>+40>
					  #<<%%%&77>+40> ))))
		    (QUOTE VERSION))
]
.ELSE [
.SXEVAL	  (DEFPROP NAME VRS VERSION)
]
TERMIN

;MACRO TO HANDLE UNWIND-PROTECT
;	UNWINDPROTECT CODE,CONTINUATION-CODE
;CAUSES CONTINUATION TO BE INVOKED AFTER CODE IS EXECUTED
;THE STATE OF THE PDLS MUST BE THE SAME BEFORE AND AFTER CODE EXECUTES.
;  CODE SHOULD BE THOUGHT OF AS A FUNCTION CALL.
; CODE IS THE CODE TO BE INVOKED AND PROTECTED.
; CONT IS THE "CONTINUATION" TO BE RUN WHEN UNWINDING THE STACK, OR AFTER
;    CODE IS RUN
DEFINE UNWINDPROTECT CODE,CONT,\LABEL
	JSP TT,PTNTRY		   ;SETUP AN UNWIND PROTECT
	JRST LABEL
	CONT
	POPJ P,
LABEL:
	CODE
;ASSUMPTION IS THAT FOLLOWING JSP CLOBBERS THE WORLD
	JSP TT,PTEXIT		   ;RUN CONTINUATION, PRESERVES A
TERMIN

;;; HERE COME THE RANDOM "RPG" MACROS FOR IN-LINING  THE PDL-FIXUP CODE

DEFINE PFIXPDL AC
	HRRZ AC,P
	MOVE P,C2
	SUBI AC,(P)
	HRLS AC
	ADD P,AC
TERMIN

DEFINE FXPFIXPDL AC
	HRRZ AC,FXP
	MOVE FXP,FXC2
	SUBI AC,(FXP)
	HRLS AC
	ADD FXP,AC
TERMIN

DEFINE FLPFIXPDL AC
	HRRZ AC,FLP
	MOVE FLP,FLC2
	SUBI AC,(FLP)
	HRLS AC
	ADD FLP,AC
TERMIN

DEFINE SPFIXPDL AC
	HRRZ AC,SP
	MOVE SP,SC2
	SUBI AC,(SP)
	HRLS AC
	ADD SP,AC
TERMIN




IF1,[

;;; FEATURE SO THAT HAIRY SUMS OF BITS MAY BE WRITTEN NICELY.
;;;	BITMAC FOO,FOO.
;;; CAUSES THE FORM
;;;	FOO<A+B+C>
;;; TO EXPAND INTO THE FORM
;;;	FOO.A+FOO.B+FOO.C

NBITMACS==0

DEFINE BITMAC XX,YY,ZZ=[1,,525252]
DEFINE XX<BITS>
IRPS J,K,[BITS]
YY!!J!K!TERMIN TERMIN
BITMA1 XX,YY,[ZZ]\NBITMACS
NBITMACS==NBITMACS+1
TERMIN

DEFINE BITMA1 XX,YY,ZZ,NN
DEFINE BTMC!NN
EXPUNGE XX,YY
XX==ZZ
YY==ZZ
IFSN [ZZ], IFGE <.TYPE ZZ>, EXPUNGE ZZ
TERMIN
TERMIN

IRP FOO,,[%TB,%TI,%TJ,%TX,%TO,%TS,%TC,%TG,%TT,%PI,%PJ]
IFDEF FOO, SV$!FOO==FOO		.SEE BITMAC
.ELSE SV$!FOO==1,,525252
EXPUNGE FOO
TERMIN

BITMAC AS,AS.			;LH ASARS
BITMAC TTS,TTS.,[1,,725252]	;LH TTSARS
BITMAC FBT,FBT.			;LH F.MODE WORD IN FILE ARRAYS
BITMAC RS.,RS.			;FOR READER SYNTAX BITS
BITMAC RS%,RS%,525252		;READER SYNTAX BITS, LH SHIFTED INTO RH
BITMAC IB,IB.,[525252,,525252]	;WORD 1 INTERRUPT BITS
BITMAC %TB,%TB,SV$%TB		;LH .TTY USER VARIABLE
BITMAC %TI,%TI,SV$%TI		;LH TTY IOCHNM BITS (SOME PER-IOT)
BITMAC %TJ,%TJ,SV$%TJ
BITMAC %TX,%TX,SV$%TX		;RH TTY CHARACTER BITS
BITMAC %TO,%TO,SV$%TO		;LH TTYOPT VARIABLE
BITMAC %TS,%TS,SV$%TS		;LH TTYSTS VARIABLE
BITMAC %TC,%TC,SV$%TC		;LH TTYCOM VARIABLE
BITMAC %TG,%TG,SV$%TG		;6-BIT BYTE TTYST1,TTYST2 GROUPS
BITMAC %TT,%TT,SV$%TT		;LH TTYTYP VARIABLE
BITMAC %PI,%PI,SV$%PI		;FULL WORD .PIRQC VARIABLE
BITMAC %PJ,%PJ,SV$%PJ		;LH .PIRQC VARIABLE
]		;END OF IF1



;;; MACRO FOR .FASL LOSERS WHO .INSRT THIS FILE TO USE
;;; IN PLACE OF THE "END" PSEUDO.  THIS GENERATES AN "END"
;;; AFTER PERFORMING SOME CLEANUP.  MANY SYMBOLS ARE EXPUNGED
;;; SO THAT .FASL FILES WILL NOT SPEND INFINITE TIME TRYING TO
;;; PASS THEM TO DDT.

DEFINE FASEND
IF2,[
EXPUNGE  NIL A B C AR1 AR2A NACS T TT D R F FREEAC P FLP FXP SP
EXPUNGE  LERR ACALL AJCALL LER3 ERINT PP STRT SERINT TP IOJRST UUOMAX
EXPUNGE  CALL JCALL CALLF JCALLF NCALL NJCALL NCALLF NJCALF NUUOCLS
EXPUNGE  NERINT NASCII
EXPUNGE  %UDF %UBV %WTA %UGT %WNA %GCL %FAC %IOL
EXPUNGE  %%UDF %%UBV %%WTA %%UGT %%WNA %%GCL %%FAC %%IOL
EXPUNGE  ASAR TTSAR
EXPUNGE  AS.SFA AS.JOB AS.FIL AS.RDT AS.OBA AS.SX AS.FX AS.FL AS.DB AS.CX
EXPUNGE  AS.DX AS.GCP
EXPUNGE  TTS.CL TTS.IM TTS.BN TTS.TY TTS.IO TTS.CN TTS.GC
EXPUNGE  TTSDIM TTS.1D TTS.2D TTS.3D TTS.4D TTS.5D
EXPUNGE  FI.EOF FO.EOF FI.BBC FI.BBF TI.BFN FT.CNS F.GC
EXPUNGE  F.MODE FBT.CM FBT.SA FBT.CP FBT.LN FBT.AP FBT.CC FBT.ND
EXPUNGE  F.CHAN F.JFN F.FLEN F.FPOS F.DEV F.SNM F.PPN F.FN1 F.FN2
EXPUNGE  F.RDEV F.RSNM F.RFN1 F.RFN2
EXPUNGE  F.DIR F.FNM F.EXT F.VRS
EXPUNGE  L.6DEV L.6DIR L.6FNM L.6EXT L.6VRS L.D6BT L.N6BT L.F6BT
EXPUNGE  LOPOFA
EXPUNGE  TI.ST1 TI.ST2 TI.ST3 TI.ST4 TI.ST5 TI.ST6 ATO.LC
EXPUNGE  AT.CHS AT.LNN AT.PGN FO.LNL FO.PGL FO.RPL LONBFA
EXPUNGE  FB.BFL FB.BVC FB.BYT FB.IBP FB.BP FB.CNT FB.HED FB.NBF
EXPUNGE  FB.BWS FB.ROF FB.BUF
EXPUNGE  J.INTF J.LFNM J.GC J.INTB J.STAD J.UIND LOJOBA J.SYMS J.CRUF
EXPUNGE  SR.CAL SFCALI SR.WOM SR.UDL SR.FML SR.FUN SR.PNA SR.FUS SR.LEN
EXPUNGE  SO.OPN SO.CLO SO.REN SO.DEL SO.TRP SO.PR1 SO.TYI SO.UNT SO.TIP
EXPUNGE  SO.IN SO.EOF SO.TYO SO.OUT SO.FOU SO.RED SO.RDL SO.PRT SO.PRC
EXPUNGE  SO.MOD SO.POS
EXPUNGE  ST.LS ST.$FS ST.FX ST.FL ST.BGN ST.SY ST.SA ST.VAC ST.$PDLNM
EXPUNGE  ST.$XM ST.$NXM ST.PUR ST.HNK ST.DB ST.CX ST.DX ST.

IRP X,,[02,1N,12,23,2N,0,1,2,4,01,012,01234,0234,3456,1234567
13456,234,345,234567,76543,45]
EXPUNGE  LA!X FA!X
TERMIN
MACROLOOP NBITMACS,BTMC,*
]		;END OF IF2
END 
TERMIN


SUBTTL SYMBOL BLOCK-STRUCTURE DEFINITIONS


;;; FORMAT OF SYMBOL HEADER FOR BIBOP:
;;; THE MAIN HEADER OF A SYMBOL IS A SINGLE WORD IN SYMBOL SPACE.
;;; THE RIGHT HALF CONTAINS THE PROPERTY LIST, AND THE LEFT HALF
;;; POINTS TO THE REST OF THE HEADER, WHICH IS IN THE IS2 OR SY2 AREA.
;;; SINCE THE REST OF THE HEADER (ALSO CALLED A "SYMBOL BLOCK") MUST
;;; LIE ON AN EVEN WORD BOUNDARY, THE LOW BIT OF THE LEFT HALF OF
;;; THE MAIN HEADER IS NORMALLY ZERO. THIS BIT IS USED BY THE
;;; GARBAGE COLLECTOR FOR MARKING PURPOSES, AND THEN RESET TO ZERO.
;;; THE SYMBOL BLOCK IS 2 WORDS LONG:
;;;		<VARIOUS BITS>,,<POINTER TO VALUE CELL>
;;;		<ARGS PROPERTY>,,<PNAME LIST>
;;; THE "VARIOUS BITS" ARE:
;;;	4.9-3.9	ONES (FOR NO PARTICULARLY GOOD REASON)
;;;	3.9	ZERO (RESERVED FOR SPECIAL VALUE CELL/LAP HACK)
;;;	3.8	1 => SYMBOL BLOCK MAY BE PURE (SEE GCMARK)
;;;	3.7	ONE IFF COMPILED CODE NEEDS THE SYMBOL
;;;	3.6	ONE IFF COMPILED CODE REFERENCES BY OTHER THAN CALL UUO
;;;		(IMPLIES 3.7 WHICH *MUST* ALSO BE ON)
;;;	3.5-3.1	ZERO (SO CAN INDIRECT THROUGH THE WORD TO GET VALUE)
;;; THE ARGS PROPERTY IS IN THE SAME FORMAT FASLOAD USES,
;;; TWO NINE-BIT BYTES DECODED AS FOLLOWS:
;;;		0 => NIL
;;;		777 => 777 (EFFECTIVELY INFINITY)
;;;		N => N-1, N NOT 0 OR 777
;;; THUS 000006 = (NIL . 5), 004005 = (3 . 4), AND 002777 = (1 . 777)
SYMVC==0		;BITS,,VC
SYMARGS==1		;ARGS PROP,,PNAME
SYMPNAME==1

SY.ONE==:777000		;ONES (NO GOOD REASON!!)
SY.LAP==:400
SY.PUR==:200
SY.CCN==:100
SY.OTC==:040
SY.ZER==:037

SY.==:1,,<SY.ONE+SY.PUR+SY.OTC>

SUBTTL	FORMAT OF ARRAYS

;;; ARRAYS ARE POINTED TO BY A TWO-WORD SAR (SPECIAL ARRAY CELL).
;;; SARS RESIDE IN A SPECIAL SPACE CALLED SAR SPACE.
ASAR==:0	;SAR POINTER POINTS TO ASAR (CODE DEPENDS ON THIS)
TTSAR==:1	;TTSAR COMES JUST AFTER IT
;;; THE FIRST WORD OF THE SAR, CALLED THE ASAR, POINTS TO THE ARRAY
;;; HEADER; PUSHJ'ING INDIRECTLY THOUGH IT GETS TO THE ARRAY
;;; SUBSCRIPT EVALUATION CODE. THE LEFT HALF, EXCLUDING THE
;;; INDIRECT AND INDEX BITS, CONTAINS VARIOUS BITS DESCRIBING
;;; THE TYPE OF THE ARRAY:


AS.SFA==:200000		;SFA ARRAY 
AS.JOB==:100000		;JOB ARRAY 
AS.FIL==:40000		;FILE ARRAY 
AS.RDT==:20000		;READTABLE
AS.OBA==:10000		;OBARRAY
AS.DX==:4000		;DUPLEX		;THESE ARE
AS.CX==:2000		;COMPLEX	; THE ACCESS
AS.DB==:1000		;DOUBLE		; METHODS -
AS.SX==:400		;S-EXPRESSION	; EXACTLY ONE
AS.FX==:200		;FIXNUM		; SHOULD BE SET
AS.FL==:100		;FLONUM		; IN EACH ASAR
AS.GCP==:40		;GC SHOULD USE AOBJN PTR TO MARK ARRAY

;;; THE SECOND WORD, CALLED THE TTSAR, POINTS TO THE ARRAY DATA
;;; AND IS INDEXED BY ACCUMULATOR TT. ITS LEFT HALF, EXCLUDING
;;; AGAIN THE INDIRECT AND INDEX BITS, CONTAIN MORE INFORMATION
;;; ABOUT THE ARRAY:

TTS.CL==:40000		;CLOSED FILE
TTS.BM==:20000		;TOPS-10  I/O BUFFER HAS BEEN MOVED
TTS.IM==:2000		;1 => IMAGE		;BOTH 0
TTS.BN==:1000		;1 => BINARY (FIXNUM)	; => ASCII
TTS.TY==:400		;0 => DSK-TYPE, 1 => TTY
TTS.IO==:200		;0 => IN, 1 => OUT
TTS.CN==:100		;COMPILED CODE NEEDS THIS SAR
TTS.GC==:40		;USED AS MARK BIT BY GC
TTSDIM==:410300	;BYTE POINTER FOR # OF DIMENSIONS (1-5)
TTS.1D==:100000		;DEFINITIONS
TTS.2D==:200000		; FOR SPECIFYING
TTS.3D==:300000		; NUMBER OF
TTS.4D==:400000		; ARRAY
TTS.5D==:500000		; DIMENSIONS

;;; S-EXPRESSION ARRAYS HAVE THE FOLLOWING FORM:
;;;		-<# WDS FOR GC MARK>,,<1ST WD OF DATA TO MARK>
;;;	HEADER:	JSP TT,<N>DIMS	;ASAR POINTS HERE; N=# OF DIMS
;;;		<ADDRESS OF SAR>	;LH USED BY FLASH
;;;		<DIMENSION 1>
;;;		   ...
;;;		<DIMENSION N>
;;;	DATA:	<ENTRY 0>,,<ENTRY 1>	;TTSAR POINTS HERE
;;;		   ...			;DATA PACKED 2/WD
;;;		<ENTRY X-1>,,<ENTRY X>
;;;
;;; THE FORMAT OF A NUMBER ARRAY IS AS FOLLOWS:
;;;		<GC AOBJN PTR>	;PROBABLY MEANINGLESS
;;;	HEADER:	PUSH P,CFIX1	;CFLOAT1 FOR A FLONUM ARRAY
;;;		JSP TT,<N>DIMF	;N=# OF DIMS
;;;		<ADDRESS OF SAR>	;LH USED BY FLASH
;;;		<DIMENSION 1>
;;;		   ...
;;;		<DIMENSION N>
;;;	DATA:	<ENTRY 0>	;TTSAR POINTS HERE
;;;		<ENTRY 1>	;FULL-WORD DATA 1/WD
;;;		   ...
;;;		<ENTRY X>

;;; THE AOBJN POINTER AT THE TOP OF EACH ARRAY IS MEANINGFUL ONLY
;;; IF THE AS.GCP BIT IS 1 IN THE ARRAY'S ASAR; IT INDICATES
;;; WHAT ENTRIES IN THE ARRAY GC SHOULD MARK. FOR S-EXPRESSION
;;; ARRAYS, THIS IS GENERALLY THE ENTIRE ARRAY; FOR OBARRAYS,
;;; IT INCLUDES THE BUCKETS BUT NOT THE SCO TABLE. FOR
;;; READTABLES, WHICH ARE OTHERWISE FIXNUM ARRAYS, UNDER NEWRD
;;; THE GC AOBJN POINTER INDICATES THAT THE LIST OF CHARACTER
;;; MACRO FUNCTIONS SHOULD BE MARKED.
;;; NOTE THAT IF SUCH AN AOBJN POINTER IS OF THE FORM <-N>,,<DATA>,
;;; THEN 2*N ENTRIES ARE MARKED; THE LEFT HALF IS THE NUMBER
;;; OF WORDS TO BE MARKED, WITH TWO ENTRIES PER WORD.
;;; CORRESPONDS TO ARRAY TYPE BITS IN ASAR'S.

SUBTTL	FORMAT OF FILE ARRAYS

;;; FILE ARRAYS ARE ARRAYS WHICH HAVE THE AS.FIL BIT SET
;;; IN THE ASAR AND SOME EXTRA BITS IN THE TTSAR DESCRIBING
;;; THE TYPE OF ARRAY.
;;; A FILE ARRAY CONTAINS A NUMBER OF VARIABLES RELATED TO
;;; THE FILE, AND POSSIBLY A BUFFER FOR DATA.
;;; THE PREFIX OF EACH NAME OF A FILE ARRAY COMPONENT INDICATES THE
;;; TYPES OF FILE ARRAYS TO WHICH IT IS APPLICABLE.  THUS TI.ST1
;;; IS ONLY FOR TTY INPUT FILE ARRAYS.

;;; NOTE: COMPONENTS MARKED (RELOC) MUST HAVE THEIR RIGHT
;;; HALVES RELOCATED WHEN THE ARRAY IS MOVED.
.SEE GT3D

;;; THE FOLLOWING ARE INDICES INTO THE FILE ARRAY'S DATA AREA
;;; (I.E. THEY ARE USED TO INDEX THROUGH THE TTSAR).

	FI.EOF==:0	;EOF FUNCTION
	FO.EOP==:0	;END OF PAGE FUNCTION
	FJ.INT==:0	;INTERRUPT FUNCTION FOR USR DEVICE

	FI.BBC==:1	;BUFFERED BACK CHARS FOR ASCII FILES
			;  LEFT HALF: SINGLE CHAR (3.8=1 IF ANY,
			;	SO CAN DISTINGUISH ^@ FROM NONE)
			;  RIGHT HALF: LIST OF CHARS FOLLOWING THE ONE
			;	IN THE LEFT HALF
			.SEE $DEVICE

	FI.BBF==:2	;LIST OF BUFFERED BACK FORMS (NOT IMPLEMENTED)

	TI.BFN==:3	;BUFFER-FORWARD (PRESCAN) FUNCTION FOR READ

	FT.CNS==:4	;ASSOCIATED TTY FILE FOR OTHER DIRECTION
			.SEE STTYCONS

;;; SLOTS 5, 6, AND 7 ARE RESERVED FOR EXPANSION.

F.GC==:10	;NUMBER OF SLOTS GC SHOULD EXAMINE

	F.MODE==:10	;MODE BITS
FBT.CM==:400000		;4.9	0=BUFFERED, 1=CHARMODE
FBT.SA==:200000		;4.8	SAIL CHARACTER SET (OUTPUT ONLY)
FBT.CP==:100000		;4.7	CURSORPOS WILL SUCCEED (?)
			;	ON ITS, REFLECTS %TOMVU (CAN MOVE UP)
				.SEE OPNTO1
FBT.LN==:40000		;4.6	HANDLE TTY IN LINE MODE
SA$     FBT.AP==:20000	;4.5	OPENED IN APPEND MODE
SA% 10% FBT.AP==:20000	;4.5	OPENED IN APPEND MODE
SA% 10$ FBT.AP==:0	;4.5	NOT YET HACKED FOR VANILLA TOPS-10
FBT.EC==:10000		;4.4	OUTPUT TTY IN ECHO AREA (ITS ONLY)
FBT.SE==:2000		;4.2	TTY CAN SELECTIVELY ERASE
FBT.FU==:1000		;4.1	TTY SHOULD READ/PRINT FULL 12.-BIT
			;	CHARACTERS (FIXNUM MODE)
FBT.ND==:400		;3.9	DON'T MEREGEF WITH DEFAULTF (NEVER LEFT ON
			;	IN OPTIONS WORD)
IT% FBT.CA==:0		;THIS SHOULD WORK CORRECTLY
IT$ FBT.CA==:40		;3.6	CLA DEVICE (ITS ONLY)
FBT.SC==:20		;3.5	SCROLL MODE
			;THE RIGHT HALF IS USED TO INDEX VARIOUS TABLES.
			;1.4-1.3 0=ASCII, 1=FIXNUM, 2=IMAGE
			;1.2	0=DSK, 1=TTY
			;1.1	0=INPUT, 1=OUTPUT

	F.CHAN==:11	;I/O CHANNEL NUMBER
			;FOR ALL IMPLEMENTATIONS, THIS IS THE INDEX INTO
			.SEE CHNTB	; THE CHANNEL TABLE.
			;FOR THE ITS AND D10 IMPLEMENTATIONS, IT IS
			; ALSO THE I/O CHANNEL NUMBER.

	F.JFN==:12	;THE JOB-FILE NUMBER FOR THIS FILE

	F.FLEN==:13	;THE LENGTH OF THE FILE, OR -1 IF RANDOM ACCESS IS IMPOSSIBLE.
			; MAY NOT BE UP-TO-DATE ON AN OUTPUT FILE, BUT FILEPOS
			.SEE FPOS5	; UPDATES IT FIRST IN THIS CASE.

	F.FPOS==:14	;FILE POSITION
			;FOR SINGLE MODE FILES, THIS IS THE ACTUAL FILE POSITION.
			;FOR BLOCK MODE, THIS IS THAT OF THE BEGINNING OF
	.SEE FB.BUF	; THE BUFFER IN THE FILE ARRAY, AND ONE
	.SEE FB.B	; MUST LOOK AT FB.BVC AND FB.CNT
	.SEE FB.CNT	; (OR WHATEVER) TO CALCULATE THE EXACT FILEPOS.
			;THE POSITION IS MEASURED IN CHARACTERS FOR ASCII FILES,
			; AND WORDS FOR FIXNUM FILES.
			;THIS VALUE MAY BE GARBAGE IF F.FLEN IS NEGATIVE.

;;; SLOTS 15-17 ARE RESERVED.

IFN ITS+D10,[
;;; FROM F.DEV TO F.RFN2 ARE USED BY JOB ARRAYS ALSO.
;;; MUST HAVE (F.DEV, F.SNM/F.PPN, F.FN1, F.FN2) IN THAT ORDER.
;;; DITTO FOR (F.RDEV, F.RSNM/F.RPPN, F.RFN1, F.RFN2).
L.6DEV==:1		;LENGTH OF DEVICE NAME IN "SIXBIT" FORM
L.6DIR==:1		;LENGTH OF DIRECTORY NAME
L.6FNM==:1		;LENGTH OF FILE NAME
L.6EXT==:1		;LENGTH OF EXTENSION (TYPE)
L.6VRS==:0		;LENGTH OF VERSION (GENERATION)
]		;END OF IFN ITS+D10
IFN D20,[
;;; FOR D20, "SIXBIT" FORM IS REALLY AN ASCIZ STRING.
L.6DEV==:8		;LENGTH OF DEVICE NAME IN "SIXBIT" FORM
L.6DIR==:8		;LENGTH OF DIRECTORY NAME
L.6FNM==:8		;LENGTH OF FILE NAME
L.6EXT==:8		;LENGTH OF EXTENSION (TYPE)
L.6VRS==:2		;LENGTH OF VERSION (GENERATION)
]	;END OF IFN D20

L.D6BT==:L.6DEV+L.6DIR		;LENGTH OF DEVICE/DIRECTORY "SIXBIT" FORM
L.N6BT==:L.6FNM+L.6EXT+L.6VRS	;LENGTH OF FILE NAMES IN "SIXBIT" FORM
L.F6BT==:L.D6BT+L.N6BT		;LENGTH OF TOTAL FILE SPEC IN "SIXBIT" FORM

;;; THESE ARE THE NAME WHICH WERE GIVEN TO OPEN.
	F.DEV==:20		;DEVICE NAME
IFE D20,[
  IT$	F.SNM==:F.DEV+L.6DEV	;SYSTEM NAME (SNAME)
  10$	F.PPN==:F.DEV+L.6DEV	;PROJECT-PROGRAMMER NUMBER
	F.FN1==:F.DEV+L.D6BT	;FILE NAME 1
	F.FN2==:F.FN1+L.6FNM	;FILE NAME 2 (D10: EXTENSION)
;;; THESE ARE THE NAMES RETURNED BY THE TRUENAME FUNCTION.
	F.RDEV==:F.DEV+L.F6BT		;"REAL" DEVICE NAME
   IT$	F.RSNM==:F.RDEV+L.6DEV		;"REAL" SYSTEM NAME
   10$	F.RPPN==:F.RDEV+L.6DEV		;"REAL" PPN
	F.RFN1==:F.RDEV+L.D6BT		;"REAL" FILE NAME 1
	F.RFN2==:F.RFN1+L.6FNM		;"REAL" FILE NAME 2
]	;END OF IFE D20
IFN D20,[
	F.DIR==:F.DEV+L.6DEV	;DIRECTORY
	F.FNM==:F.DIR+L.6DIR	;FILE NAME
	F.EXT==:F.FNM+L.6FNM	;EXTENSION
	F.VRS==:F.EXT+L.6EXT	;VERSION
;;; THE "REAL" FILE NAMES ARE NOT STORED, BUT FETCHED BY JSYS EACH TIME.
;	F.RDEV	
;	F.RDIR
;	F.RFNM
;	F.REXT
;	F.RVRS
]		;END OF IFN D20


LOPOFA==:70	.SEE ALFILE	;LENGTH OF PLAIN OLD FILE ARRAY

IFL LOPOFA-<F.DEV+L.F6BT>, WARN [DEFINITION OF LOPOFA IS TOO SMALL]

IFN ITS+D20+SAIL,[
;;; FOR ITS, THESE ARE TTYST1 AND TTYST2 FOR GIVING TO TTYSET.
;;; FOR D20, THESE ARE THE CCOC WORDS FOR GIVING TO SFCOC.
;;; FOR SAIL, THESE ARE THE ACTIVATION WORDS FOR SETACT.
	TI.ST1==:LOPOFA+0	;TTY STATUS WORD 1
	TI.ST2==:LOPOFA+1	;TTY STATUS WORD 2
IT%	TI.ST3==:LOPOFA+2	;TTY STATUS WORD 3
IT%	TI.ST4==:LOPOFA+3	;TTY STATUS WORD 4
	TI.ST5==:LOPOFA+4	;TTY CHARACTERISTICS (TTYOPT) WORD
IT% 	TI.ST6==:LOPOFA+5	;TTY MODE WORD
]		;END OF ITS+D20+SAIL

	ATO.LC==:LOPOFA+6	;LAST CHARACTER FLAG FOR ASCII OUTPUT:
				;ZERO: NORMAL STATE.
				;POSITIVE: LAST CHARACTER OUTPUT WAS A SLASH,
				; SO THE AUTOMATIC TERPRI SHOULD BE INHIBITED.
				;NEGATIVE: LAST CHARACTER OUTPUT WAS A <CR>,
				; SO IT MAY BE NECESSSARY TO SUPPLY A <LF>.

	AT.CHS==:LOPOFA+7	;CHARPOS

	AT.LNN==:LOPOFA+10	;LINENUM

	AT.PGN==:LOPOFA+11	;PAGENUM

	FO.LNL==:LOPOFA+12	;LINE LENGTH
				;NORMALLY INITIALIZED TO 1 LESS THAN THE ACTUAL WIDTH
 				; OF THE DEVICE TO ALLOW FOR SLASH OVERRUN.
				.SEE STERPRI	;MAY BE NEGATIVE, IN WHICH CASE THE
						; MAGNITUDE IS THE ACTUAL VALUE.

	FO.PGL==:LOPOFA+13	;PAGE LENGTH

	FO.RPL==:LOPOFA+14	;"REAL" PAGEL FOR TTYS

;;; SLOTS 15-17 ARE RESERVED FOR EXPANSION.

LONBFA==:LOPOFA+20	;LENGTH OF NON-BUFFERED FILE ARRAY

;;; EVERYTHING AFTER THIS IS ONLY FOR FILES WITH BUFFERS

	FB.BYT==:LONBFA+0	;NUMBER OF DATA BYTES PER WORD

	FB.BFL==:LONBFA+1	;LENGTH OF BUFFER IN BYTES

	FB.BVC==:LONBFA+2	;# VALID CHAARS IN BUFFER (ONLY INPUT FILES)

IFN ITS+D20,[
	FB.IBP==:LONBFA+3	;INITIAL BUFFER BYTE POINTER (RELOC)
	FB.BP==:LONBFA+4	;CURRENT BUFFER BYTE POINTER (RELOC)
	FB.CNT==:LONBFA+5	;COUNT OF REMAINING BYTES IN BUFFER
]		;END OF ITS+D20
IFN D10,[
	FB.HED==:LONBFA+3	;ADDRESS OF 3-WORD BUFFER RING HEADER
	FB.NBF==:LONBFA+4	;NUMBER OF BUFFERS
	FB.BWS==:LONBFA+5	;SIZE OF BUFFER IN WORDS (NOT COUNTING BUFFER HEADER)
SA$	FB.ROF==:LONBFA+6	;(NEGATIVE) RECORD OFFSET IN BYTES, I.E. FILEPOS
				; OF THE PHYSICAL BEGINNING OF THE FILE
]		;END OF IFN D10

	FB.BUF==:LONBFA+10	;BEGINNING OF BUFFER
				;FOR ITS AND D20, THE DATA BUFFER BEGINS HERE.
				;FOR D10, THE BUFFER RING STRUCTURE BEGINS HERE.
				;FOR TTY INPUT FILES, THE "BUFFER" IS AN ARRAY
				; OF INTERRUPT FUNCTIONS FOR EACH ASCII CHARACTER.

SUBTTL	FORMAT OF JOB ARRAYS

IFN ITS,[

;;; JOB ARRAYS ARE ARRAYS WHICH HAVE THE AS.JOB BIT SET
;;; IN THE ASAR.  THE TTS.CL BIT IS RELEVANT HERE ALSO,
;;; INDICATING A CLOSED JOB ARRAY.
;;; THE ARRAY CONTAINS VARIOUS DATA ASSOCIATED WITH THE JOB.

;;; NOTE: COMPONENTS MARKED (RELOC) MUST HAVE THEIR RIGHT
;;; HALVES RELOCATED WHEN THE ARRAY IS MOVED.

;;; THE FOLLOWING ARE INDICES INTO THE FILE ARRAY'S DATA AREA
;;; (I.E. THEY ARE USED TO INDEX THROUGH THE TTSAR).

	J.INTF==:0	;INTERRUPT FUNCTION (NEEDED BY INT SYSTEM)
	J.CINT==:1	;CHANNEL INTERRUPT FUNCTION
	J.LFNM==:2	;LOAD FILE NAMELIST?
	J.CRUFT==:3	;RANDOM CRUFT (USUALLY PROPERTY LIST)

J.GC==:4	;NUMBER OF SLOTS GC SHOULD EXAMINE

;SLOTS 3-12 RESERVED

;;; F.DEV THROUGH F.RFN2 (12 TO 21) APPLY TO JOB ARRAYS ALSO.

	J.INTB==:LOPOFA+0	;INTERRUPT BIT, OR ZERO FOR FOREIGN JOB
	J.STAD==:LOPOFA+1	;START ADDRESS
	J.UIND==:LOPOFA+2

LOJOBA==:FB.BUF

	J.SYMS==:FB.BUF	;START OF SYMBOL TABLE, IF ANY

]		;END OF IFN ITS

IFE SFA, SFCALI==-1
IFN SFA,[
SUBTTL FORMAT OF SFA OBJECTS

;;; AN SFA OBJECT HAS THE AS.SFA BIT SET IN THE ASAR.   TTS.CL IS IGNORED.

;;; THE FOLLOWING ARE INDICIES INTO THE SFA ARRAY AND ARE UNMARKED FROM:
SR.CAL==:0	;THE LISP CALL UUO XCT'ED TO INVOKE THE SFA FUNCTION
SFCALI==:SR.CAL	;FOR COMPILED CODE
SR.WOM==:1	;WHICH-OPERATIONS MASK:  ENCODED MASK OF THE OPERATIONS THAT
		; THE SFA CAN PERFORM.  USED FOR QUICK TESTING IN CERTAIN
		; DISPATCH CASES.  BITS AS FOLLOWS:
SR.UDL==:2	;USER DATA LENGTH

;;; ***NOTE:  THE HALVNESS OF THE BITS MUST NOT CHANGE ***
;LH BITS
  SO.OPN==:400000	;OPEN
  SO.CLO==:200000	;CLOSE
  SO.REN==:100000	;RENAMEF
  SO.DEL==:040000	;DELETEF
  SO.TRP==:020000	;TERPRI
  SO.PR1==:010000	;PRIN1
  SO.TYI==:004000	;TYI
  SO.UNT==:002000	;UNTYI
  SO.TIP==:001000	;TYIPEEK
  SO.IN==:000400	;IN
  SO.EOF==:000200	;EOFFN
  SO.TYO==:000100	;TYO
  SO.PRO==:000040	;PRINT-OBJECT
  SO.FOU==:000020	;FORCE-OUTPUT
  SO.RED==:000010	;READ
  SO.RDL==:000004	;READLINE
  SO.PRT==:000002	;PRINT
  SO.PRC==:000001	;PRINC
;RH BITS
  SO.MOD==:400000	;FILEMODE
  SO.POS==:200000	;FILEPOS
  SO.ICL==:100000	;CLEAR-INPUT
  SO.OCL==:040000	;CLEAR-OUTPUT
  SO.OUT==:020000	;OUT
  SO.CUR==:010000	;CURSORPOS
  SO.RUB==:004000	;RUBOUT


SR.FML==:3	;FIRST MARKED LOCATION

SR.FUN==:3	;RH IS SFA FUNCTION
SR.CNS==:3	;LH IS ASSOCIATE FOR BI-DIRECTIONALITY (TTYCONS)
SR.PNA==:4	;RH IS PRINTNAME
SR.PLI==:4	;LH IS GENERAL PLIST
SR.FUS==:5	;LH IS FIRST USER SLOT

SR.LEN==:5	;NUMBER OF WORDS NEEDED BY THE SYSTEM
]		;END IFN SFA


;;; Size of hunks
IFDEF SEGLOG,	 HNKLOG==SEGLOG-1
IFNDEF SEGLOG,	 HNKLOG==11