github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-28 12:57:56 +00:00
Code Issues Releases Wiki Activity
Files
b99988823f194cbb3390fe0051204cde63dd767f
PDP-10.its/src/lisp/_fasl.defs

1214 lines
33 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; -*-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
Reference in New Issue View Git Blame Copy Permalink