mirror of
https://github.com/PDP-10/its.git
synced 2026-02-17 21:27:17 +00:00
Added support for LISP interpreter and runtime (autoloaded files only).
This commit is contained in:
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
b6a6e0d429
commit
e9619de352
661
src/l/ulap.145
Normal file
661
src/l/ulap.145
Normal file
@@ -0,0 +1,661 @@
|
||||
;;; -*-MIDAS-*-
|
||||
;;; **************************************************************
|
||||
;;; ***** MACLISP ****** UTAPE, LAP, AND AGGLOMERATED SUBRS ******
|
||||
;;; **************************************************************
|
||||
;;; ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
|
||||
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
|
||||
;;; **************************************************************
|
||||
|
||||
|
||||
|
||||
PGBOT [UIO]
|
||||
|
||||
|
||||
|
||||
SUBTTL OLD I/O FUNCTIONS IN TERMS OF NEW I/O PRIMITIVES
|
||||
|
||||
;;; (DEFUN UREAD FEXPR (FILENAME)
|
||||
;;; (UCLOSE)
|
||||
;;; ((LAMBDA (FILE)
|
||||
;;; (EOFFN UREAD
|
||||
;;; (FUNCTION
|
||||
;;; (LAMBDA (EOFFILE EOFVAL)
|
||||
;;; (UCLOSE)
|
||||
;;; EOFVAL)))
|
||||
;;; (INPUSH (SETQ UREAD FILE))
|
||||
;;; (DEFAULTF FILE))
|
||||
;;; (OPEN (*UGREAT FILENAME) 'IN)))
|
||||
|
||||
UREAD: PUSH P,A ;FEXPR
|
||||
PUSHJ P,UCLOSE
|
||||
POP P,A
|
||||
PUSHJ P,UGREAT
|
||||
PUSH P,[UREAD2]
|
||||
PUSH P,A
|
||||
MOVNI T,1
|
||||
JRST $EOPEN
|
||||
UREAD2: MOVEM A,VUREAD
|
||||
PUSH P,[UREAD1]
|
||||
PUSH P,A
|
||||
PUSH P,[QUREOF]
|
||||
MOVNI T,2
|
||||
JRST EOFFN
|
||||
UREAD1: HRRZ A,VUREAD
|
||||
PUSHJ P,INPUSH
|
||||
PUSHJ P,DEFAULTF
|
||||
HRRZ A,VUREAD
|
||||
JRST TRUENAME ;RETURN TRUENAME OF FILE TO USER
|
||||
|
||||
UREOF: PUSH P,B ;+INTERNAL-UREAD-EOFFN - SUBR 2
|
||||
PUSHJ P,UCLOSE
|
||||
JRST POPAJ
|
||||
|
||||
|
||||
;;; (DEFUN UCLOSE FEXPR (X)
|
||||
;;; (COND (UREAD
|
||||
;;; ((LAMBDA (OUREAD)
|
||||
;;; (AND (EQ OUREAD INFILE) (INPUSH -1))
|
||||
;;; (SETQ UREAD NIL)
|
||||
;;; (CLOSE OUREAD))
|
||||
;;; UREAD))
|
||||
;;; (T NIL)))
|
||||
|
||||
UCLOSE: SKIPN A,VUREAD ;FEXPR
|
||||
POPJ P,
|
||||
CAMN A,VINFILE
|
||||
PUSHJ P,INPOP ;SAVES A
|
||||
SETZM VUREAD
|
||||
JRST $CLOSE
|
||||
|
||||
|
||||
;;; (DEFUN UWRITE FEXPR (DEVDIR)
|
||||
;;; (OR DEVDIR (SETQ DEVDIR (CAR (DEFAULTF NIL))))
|
||||
;;; (*UWRITE (CONS DEVDIR
|
||||
;;; (COND ((STATUS FEATURE DEC10)
|
||||
;;; (CONS (STATUS JNAME) '(OUT)))
|
||||
;;; ((STATUS FEATURE DEC20)
|
||||
;;; '(MACLISP OUTPUT))
|
||||
;;; ((STATUS FEATURE ITS)
|
||||
;;; '(.LISP. OUTPUT))))
|
||||
;;; 'OUT
|
||||
;;; (LIST DEVDIR)))
|
||||
;;;
|
||||
;;; (DEFUN UAPPEND FEXPR (FILENAME)
|
||||
;;; (SETQ FILENAME (*UGREAT FILENAME))
|
||||
;;; (*UWRITE FILENAME 'APPEND FILENAME))
|
||||
;;;
|
||||
;;; (DEFUN *UWRITE (NAME MODE NEWDEFAULT) ;INTERNAL ROUTINE
|
||||
;;; (COND (UWRITE
|
||||
;;; (SETQ OUTFILES (DELQ UWRITE OUTFILES))
|
||||
;;; (CLOSE UWRITE)
|
||||
;;; (SETQ UWRITE NIL)))
|
||||
;;; ((LAMBDA (FILE)
|
||||
;;; (SETQ OUTFILES
|
||||
;;; (CONS (SETQ UWRITE FILE)
|
||||
;;; OUTFILES))
|
||||
;;; (CAR (DEFAULTF NEWDEFAULT)))
|
||||
;;; (OPEN NAME MODE)))
|
||||
|
||||
UAPPEND: PUSHJ P,UGREAT ;FEXPR
|
||||
MOVEI C,(A)
|
||||
MOVEI B,QAPPEND
|
||||
JRST UWRT1
|
||||
|
||||
UWRITE: JUMPN A,UWRT0 ;FEXPR
|
||||
PUSHJ P,DEFAULTF
|
||||
HLRZ A,(A)
|
||||
UWRT0: PUSHJ P,NCONS
|
||||
IFN ITS+D20,[
|
||||
MOVEI C,(A)
|
||||
HLRZ A,(C)
|
||||
MOVEI B,QLSPOUT
|
||||
PUSHJ P,CONS
|
||||
] ;END OF IFN ITS+D20
|
||||
IFN D10,[
|
||||
PUSH P,A
|
||||
PUSHJ P,SJNAME
|
||||
MOVEI B,Q$OUT
|
||||
PUSHJ P,CONS
|
||||
POP P,C
|
||||
HLRZ B,(C)
|
||||
PUSHJ P,XCONS
|
||||
] ;END OF IFN D10
|
||||
MOVEI B,Q$OUT
|
||||
UWRT1: PUSH P,C ;*UWRITE BEGINS HERE
|
||||
PUSH P,[UWRT2]
|
||||
PUSH P,A
|
||||
PUSH P,B
|
||||
SKIPE VUWRITE
|
||||
PUSHJ P,UFILE5
|
||||
MOVNI T,2
|
||||
JRST $OPEN
|
||||
UWRT2: MOVEM A,VUWRITE
|
||||
HRRZ B,VOUTFILES
|
||||
PUSHJ P,CONS
|
||||
MOVEM A,VOUTFILES
|
||||
POP P,A
|
||||
PUSHJ P,DEFAULTF
|
||||
JRST $CAR
|
||||
|
||||
|
||||
;;; (DEFUN UFILE FEXPR (SHORTNAME)
|
||||
;;; (COND ((NULL UWRITE)
|
||||
;;; (ERROR 'NO/ UWRITE/ FILE
|
||||
;;; (CONS 'UFILE SHORTNAME)
|
||||
;;; 'IO-LOSSAGE))
|
||||
;;; (T (PROG2 NIL
|
||||
;;; (DEFAULTF (RENAMEF UWRITE (*UGREAT SHORTNAME)))
|
||||
;;; (SETQ OUTFILES (DELQ UWRITE OUTFILES))
|
||||
;;; (SETQ UWRITE NIL)
|
||||
;;; (OR OUTFILES (SETQ ^R NIL))))))
|
||||
|
||||
UFILE0: MOVEI B,QUFILE
|
||||
PUSHJ P,XCONS
|
||||
IOL [NO UWRITE FILE!]
|
||||
|
||||
UFILE: SKIPN VUWRITE ;FEXPR
|
||||
JRST UFILE0
|
||||
PUSHJ P,UGREAT
|
||||
MOVEI B,(A)
|
||||
SETZ A,
|
||||
EXCH A,VUWRITE
|
||||
PUSH P,A
|
||||
PUSH P,B
|
||||
HRRZ B,VOUTFILES
|
||||
PUSHJ P,.DELQ
|
||||
MOVEM A,VOUTFILES
|
||||
SKIPN VOUTFILES
|
||||
SETZM TAPWRT
|
||||
POP P,B
|
||||
POP P,A
|
||||
PUSHJ P,$RENAME ;CLOSES THE FILE AS WELL AS RENAMES IT
|
||||
PUSHJ P,DEFAULTF
|
||||
POPJ P,
|
||||
|
||||
UFILE5: HRRZ A,VUWRITE
|
||||
HRRZ B,VOUTFILES
|
||||
PUSHJ P,.DELQ
|
||||
MOVEM A,VOUTFILES
|
||||
HRRZ A,VUWRITE
|
||||
PUSHJ P,$CLOSE
|
||||
SETZM VUWRITE
|
||||
SKIPN VOUTFILES
|
||||
SETZM TAPWRT
|
||||
POPJ P,
|
||||
|
||||
|
||||
;;; (DEFUN CRUNIT FEXPR (DEVDIR)
|
||||
;;; (CAR (DEFAULTF (AND DEVDIR (LIST DEVDIR)))))
|
||||
|
||||
SCRUNIT: SETZ A,
|
||||
CRUNIT: SKIPE A ;FEXPR
|
||||
PUSHJ P,NCONS
|
||||
PUSHJ P,DEFAULTF
|
||||
JRST $CAR
|
||||
|
||||
|
||||
;;; (DEFUN *UGREAT (NAME) ;INTERNAL ROUTINE
|
||||
;;; (MERGEF NAME
|
||||
;;; (COND ((STATUS FEATURE ITS) '(* . >))
|
||||
;;; ('(* . LSP)))))
|
||||
|
||||
|
||||
|
||||
UGREAT: PUSH P,[6BTNML]
|
||||
UGRT1: PUSHJ P,FIL6BT
|
||||
IFN ITS+D10,[
|
||||
REPEAT 3, PUSH FXP,[SIXBIT \*\]
|
||||
IT$ PUSH FXP,[SIXBIT \>\]
|
||||
SA$ PUSH FXP,[SIXBIT \___\]
|
||||
SA% 10$ PUSH FXP,[SIXBIT \LSP\]
|
||||
10$ SETOM -2(FXP) ;FOR D10 DEFAULT PPN IS -1
|
||||
] ;END OF IFN ITS+D10
|
||||
IFN D20,[
|
||||
PUSHN FXP,L.F6BT
|
||||
MOVE T,[ASCII \LSP\]
|
||||
MOVEM T,-L.6EXT-L.6VRS+1(FXP)
|
||||
] ;END OF IFN D20
|
||||
JRST IMRGF
|
||||
|
||||
|
||||
;;; (DEFUN UPROBE FEXPR (FILENAME)
|
||||
;;; (SETQ FILENAME (MERGEF (*UGREAT FILENAME) NIL))
|
||||
;;; (PROBEF FILENAME))
|
||||
|
||||
UPROBE: PUSHJ P,UGRT1 ;FEXPR
|
||||
JRST PROBF0
|
||||
|
||||
|
||||
;;; (DEFUN UKILL FEXPR (FILENAME)
|
||||
;;; (DEFAULTF (DELETEF FILENAME))))
|
||||
|
||||
UKILL: PUSHJ P,$DELETEF
|
||||
JRST DEFAULTF
|
||||
|
||||
|
||||
|
||||
SUBTTL SYMBOL MANIPULATION AND SQUOZE FUNCTIONS
|
||||
|
||||
;;; (TTSR| <SYMBOL>) GETS THE ARRAY PROPERTY OF <SYMBOL>,
|
||||
;;; OR GIVES IT AN ARRAY PROPERTY WITH A DEAD SAR;
|
||||
;;; IT MARKS THE SAR AS BEING NEEDED BY COMPILED CODE,
|
||||
;;; AND THEN RETURNS THE ADDRESS OF THE TTSAR AS A FIXNUM.
|
||||
;;; THIS IS USED PRIMARILY BY LAP.
|
||||
|
||||
TTSR: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE (TTSR|)
|
||||
MOVEI C,(A) ;SAVES AR1,R,F - SEE FASLOAD
|
||||
PUSHJ P,ARGET
|
||||
JUMPN A,TTSR1
|
||||
JSP T,SACONS
|
||||
MOVEI T,ADEAD
|
||||
MOVEM T,ASAR(A)
|
||||
MOVE T,[TTDEAD]
|
||||
MOVEM T,TTSAR(A)
|
||||
MOVEI B,(A)
|
||||
MOVEI A,(C)
|
||||
MOVEI C,QARRAY
|
||||
PUSHJ P,PUTPROP
|
||||
TTSR1: MOVSI T,TTS.CN
|
||||
IORM T,TTSAR(A)
|
||||
MOVEI TT,1(A)
|
||||
POPJ P,
|
||||
|
||||
;;; BOTH ROUTINES ALWAYS RETURN THE LEFT-JUSTIFIED SQUOZE IN T
|
||||
;;; AND THE SIXBIT IN R
|
||||
;;; RSQUEEZE MAY LEAVE RIGHT-JUSTIFIED SQUOZE IN TT
|
||||
RSQUEEZE: ;CANONICAL SQUOZE CONVERSION
|
||||
IT% HRROS (P) ;FOR DEC-10, GIVES DEC-10 SQUOZE
|
||||
SQUEEZE: ;THIS ALWAYS GIVES LEFT-JUSTIFIED SQUOZE
|
||||
MOVEI AR1,6 ;CONVERT PNAME-ATOM TO SQUOZE AND SIXBIT
|
||||
MOVE AR2A,[440600,,SQ6BIT] ;RETURNS SQUOZE IN TT, SIXBIT IN R
|
||||
SETZM SQ6BIT ;CLEAR LOCS USED TO ACCUMULATE
|
||||
SETZM SQSQOZ ; SIXBIT AND SQUOZE
|
||||
HRROI R,SQZCHR
|
||||
PUSHJ P,PRINTA ;"PRINT" OUT CHARS OR PNAME
|
||||
IT% MOVE TT,SQSQOZ
|
||||
SKIPA T,SQSQOZ
|
||||
IMULI T,50
|
||||
SOJGE AR1,.-1 ; MULTIPLY ITS SQUOZE UP TO SIZE
|
||||
IT% MOVE R,(P)
|
||||
IT% TLNN R,1
|
||||
MOVE TT,T
|
||||
MOVE R,SQ6BIT
|
||||
POPJ P,
|
||||
|
||||
SQZCHR: TLNN AR2A,770000 ;IGNORE MORE THAN 6 CHARS
|
||||
POPJ P,
|
||||
SUBI A,40 ;CONVERT TO SIXBIT
|
||||
CAIL A,1 ;LOSSAGE IF NOT SIXBIT CHAR
|
||||
CAILE A,77 ; - ALSO, SPACE IS A LOSS
|
||||
MOVEI A,'. ;LOSING NON-SQUOZE CHAR
|
||||
IDPB A,AR2A ;DEPOSIT SIXBIT CHAR
|
||||
CAIL A,'A ;CHECK FOR LETTER
|
||||
CAILE A,'Z
|
||||
JRST SQNOTL
|
||||
SUBI A,'A-13 ;CONVERT TO SQUOZE VALUE
|
||||
SQOK: EXCH T,SQSQOZ
|
||||
IMULI T,50
|
||||
ADDI T,(A)
|
||||
EXCH T,SQSQOZ
|
||||
SOJA AR1,CPOPJ ;DECR COUNT AND RETURN TO PRINTA
|
||||
|
||||
SQNOTL: CAIL A,'0 ;CHECK FOR DIGIT
|
||||
CAILE A,'9
|
||||
JRST SQNOTD
|
||||
SUBI A,'0-1 ;CONVERT TO SQUOZE VALUE
|
||||
JRST SQOK
|
||||
|
||||
SQNOTD: CAIE A,'$ ;CHECK FOR $ OR %
|
||||
CAIN A,'%
|
||||
JRST SQ%$
|
||||
MOVEI A,'. ;ANY CHAR OTHER THAN A-Z, 0-9, $, OR %
|
||||
DPB A,AR2A ; DEFAULTS TO . (E.G. *FOOBAR -> .FOOBA)
|
||||
MOVEI A,45-42
|
||||
SQ%$: ADDI A,42 ;SQUOZE VALUE FOR $,%,.
|
||||
JRST SQOK
|
||||
|
||||
|
||||
UNSQOZ: LDB T,[004000,,D] ;HAIRY MESS TO CONVERT
|
||||
SETZM LD6BIT ; SQUOZE TO SIXBIT
|
||||
UNSQZ1: IDIVI T,50 ;(THIS IS SEPARATE ROUTINE SO
|
||||
JUMPE TT,UNSQZ2 ; LAP LOSERS CAN USE IT)
|
||||
CAIL TT,45 ;<1SQUOZE .>
|
||||
JRST UNSQZ3
|
||||
CAIL TT,13 ;<1SQUOZ A> IS 13
|
||||
ADDI TT,'A-13 ;CONVERT RANGE A - Z ,
|
||||
CAIGE TT,13 ;<1SQUOZ 1> IS 1
|
||||
ADDI TT,'0-1 ;CONVERT RANGE 0 - 9
|
||||
UNSQZ2: IOR TT,LD6BIT
|
||||
ROT TT,-6
|
||||
MOVEM TT,LD6BIT
|
||||
JUMPN T,UNSQZ1
|
||||
MOVE A,[440600,,LD6BIT] ;MAKE SIXBIT INTO AN ATOM
|
||||
JRST READ6C
|
||||
|
||||
UNSQZ3: SUBI TT,46-'$ ;[1SQUOZ $] IS 46, [1SQOZ .] IS 45
|
||||
CAIN TT,45-<46-'$> ;CONVERT RANGE $ - %
|
||||
MOVEI TT,'* ;BUT . IS EXCEPTIONAL
|
||||
JRST UNSQZ2
|
||||
|
||||
|
||||
|
||||
|
||||
PUTDDTSYM:
|
||||
MOVEI R,0 ;PUTDDTSYM| IS FOR LAP - OFFSETS VALUE BY LOAD OFFSET
|
||||
PUTDD0:
|
||||
IT$ JSP T,SIDDTP ;LOSE IF NO DDT TO GIVE SYMBOL TO
|
||||
IT% 20% SKIPN .JBSYM"
|
||||
JRST FALSE
|
||||
PUSH FXP,R
|
||||
PUSH P,B
|
||||
10$ SKIPL R ;SEE LDPUT1
|
||||
PUSHJ P,RSQUEEZE ;SQUEEZE ATOM'S PNAME DOWN TO SQUOZ CODE
|
||||
POP P,B
|
||||
PUSHJ P,GETDDG ;L-JUST SQUOZ IN T, CANONICAL-JUST IN TT
|
||||
JRST PUTDX ;DONT REDEFINE GLOBALSYMS
|
||||
IFE ITS,[
|
||||
PUSHJ P,GETDDJ
|
||||
JRST PUTDD4
|
||||
MOVEI F,(D)
|
||||
] ;END OF IFE ITS
|
||||
PUTDD2: JSP T,FXNV2 ;GET VALUE OF SECOND ARG
|
||||
POP FXP,R
|
||||
ADDI D,(R) ;ADD IN OFFSET
|
||||
IT$ .BREAK 12,[..SSYM,,TT]
|
||||
10$ MOVEM D,(F) ;NON-ITS LEAVES IN F A PTR TO SYMTAB
|
||||
JRST TRUE ; SLOT WHERE ENTRY IS TO BE MADE
|
||||
|
||||
IFE ITS,[
|
||||
PUTDD4: SOSGE SYMLO
|
||||
JRST FALSE
|
||||
MOVE F,R70+2
|
||||
SUBB F,.JBSYM"
|
||||
TLO TT,100000 ;LOCAL SYMBOL
|
||||
MOVEM TT,(F)
|
||||
AOJA F,PUTDD2
|
||||
] ;END OF IFE ITS
|
||||
|
||||
PUTDX: POPI FXP,1
|
||||
JRST FALSE
|
||||
|
||||
|
||||
SUBTTL LAPSETUP AND FASLAPSETUP
|
||||
|
||||
LAPSETUP:
|
||||
JUMPN A,LAPSMH ;ARG = NIL => SETUP SOME SYM PROPERTIES
|
||||
MOVEI T,LAPST2
|
||||
LAP5HAK:
|
||||
PUSH P,T ;APPLIES THE ROUTINE FOUND IN T
|
||||
; TO ALL THE GLOBALSYMS
|
||||
PUSH P,[441100,,LAP5P] ;ATOMIC SYMBOL PLACED IN A,
|
||||
; GLOBALSYM INDEX IN TT
|
||||
MOVSI F,-LLSYMS
|
||||
L5H1: ILDB TT,(P) ;HAFTA GET THE GLOBALSYM INDEX FROM
|
||||
; PERMUTATION TABLE
|
||||
CAIL TT,LGSYMS ;IF NOT A GLOBALSYM [BUT AN XTRASYM], SKIP IT
|
||||
JRST L5XIT
|
||||
CAIN TT,3 ;****NEVER CHANGE THE GLOBALSYM INDICES FOR:
|
||||
JRST L5SPBND ; SPECBIND 3
|
||||
CAIN TT,25 ; ERSETUP 25
|
||||
JRST L5ERSTP ; MAKUNBOUND 34
|
||||
CAIN TT,34 ; INHIBIT 47
|
||||
JRST L5MKUNBD ; 0*0PUSH 53
|
||||
CAIN TT,47 ; NILPROPS 54
|
||||
JRST L5INHIBI ;THOSE HAVE MORE THAN 6 CHARS IN THEIR PNAME
|
||||
CAIN TT,53 ;AND CANT BE RECONSTRUCTED BY UNSQOZ'ING FROM
|
||||
JRST L50.0P ;FROM THE LAPFIV TABLE
|
||||
CAIN TT,54
|
||||
JRST L5NILP
|
||||
MOVE D,LAPFIV(F)
|
||||
PUSHJ P,UNSQOZ
|
||||
L5H2: LDB TT,(P)
|
||||
PUSHJ P,@-1(P)
|
||||
L5XIT: AOBJN F,L5H1
|
||||
JRST POP2J
|
||||
|
||||
L5ERSTP:
|
||||
MOVEI A,[SIXBIT \ERSETUP \]
|
||||
JRST L5H3
|
||||
L5SPBND:
|
||||
MOVEI A,[SIXBIT \SPECBIND \]
|
||||
L5H3: HRLI A,440600
|
||||
PUSHJ P,READ6C
|
||||
JRST L5H2
|
||||
|
||||
L5MKUNBD:
|
||||
MOVEI A,[SIXBIT \MAKUNBOUND \]
|
||||
JRST L5H3
|
||||
L5INHIBIT:
|
||||
MOVEI A,[SIXBIT \INHIBIT \]
|
||||
JRST L5H3
|
||||
L50.0P: MOVEI A,[SIXBIT \0*0PUSH \]
|
||||
JRST L5H3
|
||||
L5NILP: MOVEI A,[SIXBIT \NILPROPS\]
|
||||
JRST L5H3
|
||||
|
||||
|
||||
LAPSMH: CAIE A,TRUTH ;(LAPSETUP| T 2) MEANS
|
||||
JRST LAPSM1 ; SET UP THE XCT HACK AREAS
|
||||
10$ JSP T,FXNV2 ; WITH 2 XCT PAGES
|
||||
10$ MOVE TT,D
|
||||
10$ JRST LDXHAK
|
||||
10% POPJ P, ;FOR NON TOPS-10, NO NEED TO DO ANY SETUP
|
||||
|
||||
LAPSM1: MOVEI T,(B) ;OTHERWISE, FIRST ARG IS ADDRESS
|
||||
MOVEI R,(A) ; TO HACK, SECOND NON-NIL =>
|
||||
MOVE TT,(R) ; TRY THE XCT-PAGE HAK
|
||||
PUSHJ P,PRCHAK ;TRY TO SMASH (SKIP ON FAILURE)
|
||||
JRST TRUE
|
||||
MOVEI A,(AR2A)
|
||||
MOVE B,VPURCLOBRL
|
||||
PUSHJ P,CONS
|
||||
MOVEM A,VPURCLOBRL
|
||||
JRST TRUE
|
||||
|
||||
LAPST2: MOVE TT,LSYMS(TT) ;GET ACTUAL VALUE FROM GLOBALSYM INDEX
|
||||
MOVEI C,QSYM
|
||||
LSYMPUT: ;EXPECTS SYMBOL IN A, "SYM" OR "GLOBALSYM"
|
||||
MOVEI B,(A) ; IN C, AND VALUE IN TT
|
||||
JSP T,FXCONS
|
||||
EXCH A,B
|
||||
JRST PUTPROP
|
||||
|
||||
FSLSTP:
|
||||
MOVEI T,FSLST2
|
||||
PUSHJ P,LAP5HAK
|
||||
MOVE TT,LDFNM2
|
||||
JRST FIX1
|
||||
|
||||
FSLST2: MOVEI C,(A) ;MAKE UP ATOMIC SYMBOLS AND GIVE THEM SYM PROPERTIES
|
||||
JSP T,FXCONS ; OF THE FORM (0 (NIL <N>))
|
||||
PUSHJ P,NCONS ; WHERE <N> IS THE INDEX OF THE SYMBOL
|
||||
SETZ B, ; (THESE ARE THE "GLOBALSYMS")
|
||||
PUSHJ P,XCONS
|
||||
PUSHJ P,NCONS
|
||||
MOVE B,CIN0
|
||||
PUSHJ P,XCONS
|
||||
MOVEI B,(A)
|
||||
MOVEI A,(C)
|
||||
MOVEI C,Q%GLOBALSYM
|
||||
JRST PUTPROP
|
||||
|
||||
|
||||
|
||||
R70 ;GLOBALSYM NUMBER -1
|
||||
LSYMS: GLBSYM A
|
||||
LGSYMS==.-LSYMS ;END OF GLOBALSYMS HACKED BY FASLAP
|
||||
XTRSYM A
|
||||
LLSYMS==.-LSYMS ;END OF ALL GLOBAL SYMBOLS
|
||||
|
||||
;;; SIXBIT FOR LAP SYMBOL NAMES; MUST MATCH IRP LIST OF GLBSYM
|
||||
ZZ==0
|
||||
LAPSIX: .BYTE 6
|
||||
SIXSYM [
|
||||
IRPC Q,,[A]
|
||||
'Q
|
||||
TERMIN
|
||||
0
|
||||
ZZ==ZZ+1
|
||||
] ;END OF SIXSYM ARGUMENT
|
||||
.BYTE
|
||||
IFN ZZ-LGSYMS, WARN [LAPSIX OUT OF PHASE]
|
||||
EXPUNGE ZZ
|
||||
|
||||
LAPFIV:
|
||||
GLBSYM [SQUOZE 0,A]
|
||||
XTRSYM [SQUOZE 0,A]
|
||||
|
||||
HAOLNG LOG2LL5,<LLSYMS-1> ;CROCK FOR BINARY SEARCH
|
||||
REPEAT <1_LOG2LL5>-LLSYMS, 377777,,777777
|
||||
|
||||
LAP5P: BLOCK <LLSYMS+3>/4 ;PERMUTATION, STORED 4/WD, TO GET GLOBALSYMINDEX FROM LAPFIV INDEX
|
||||
|
||||
|
||||
GETDDTSYM:
|
||||
PUSHJ P,RSQUEEZE
|
||||
PUSHJ P,GETDDG ;GET GLOBALSYM INDEX, AND NO-SKIP IF WIN
|
||||
JRST FIX1
|
||||
IFN ITS,[
|
||||
MOVE D,TT ;SAVE SQUOZE OVER CALL TO SIDDTP
|
||||
JSP T,SIDDTP ;LOSE IF NO DDT FROM WHICH TO GET SYMBOL
|
||||
JRST FALSE
|
||||
MOVE TT,D
|
||||
.BREAK 12,[..RSYM,,TT]
|
||||
JUMPE TT,FALSE
|
||||
MOVE TT,TT+1
|
||||
JRST FIX1
|
||||
] ;END OF IFN ITS
|
||||
IFE ITS,[
|
||||
PUSHJ P,GETDDJ
|
||||
JRST FALSE
|
||||
JRST FIX1
|
||||
|
||||
GETDDJ: SKIPA D,.JBSYM" ;SQUOZ IN TT - FIND SYMBOL IN JOB SYMBOL TABLE
|
||||
GETDD1: ADD D,R70+2 ; SKIP IF FOUND
|
||||
JUMPGE D,CPOPJ
|
||||
MOVE T,(D)
|
||||
TLZ T,540000
|
||||
TLZN T,200000 ;SYMBOL MUSTN'T BE KILLED
|
||||
CAME T,TT ;MUST BE THE ONE WE WANT
|
||||
JRST GETDD1
|
||||
MOVE TT,1(D)
|
||||
AOJA D,POPJ1
|
||||
] ;END OF IFE ITS
|
||||
|
||||
|
||||
GETDDG: MOVEI R,0 ;SQUOZ IN T, SEARCH "GLOBALSYM" TABLE,
|
||||
TLZ T,740000 ; SKIP IF LOSE, LEAVE VALUE IN TT IF WIN
|
||||
REPEAT LOG2LL5,[
|
||||
CAML T,LAPFIV+<1_<LOG2LL5-.RPCNT-1>>(R)
|
||||
ADDI R,1_<LOG2LL5-.RPCNT-1>
|
||||
] ;END OF REPEAT LOG2LL5
|
||||
CAME T,LAPFIV(R) ;IF DDTSYM REQUEST IS FOR A GLOBAL SYM
|
||||
JRST POPJ1 ;THEN FIND IT IN THE LAPFIV TABLE, AND GET ITS
|
||||
LSHC R,-2 ;GLOBALSYM INDEX FROM THE PERMUTATION TABLE
|
||||
LSH F,-42
|
||||
LDB TT,LDGET6(F) ;USE TABLE FROM FASLOAD
|
||||
MOVE TT,LSYMS(TT)
|
||||
POPJ P,
|
||||
|
||||
|
||||
LGTSPC: MOVEM TT,GAMNT
|
||||
ADD TT,@VBPORG ;INSURE THAT BPEND-BPORG > (TT)
|
||||
SUB TT,@VBPEND
|
||||
JUMPGE TT,GTSPC1 ;MUST RELOCATE, OR GET MORE CORE.
|
||||
MOVE A,VBPEND ;ALREADY OK
|
||||
MOVE TT,(A)
|
||||
POPJ P,
|
||||
|
||||
PAGEBPORG: MOVE A,VBPORG ;MAKE SURE BPORG IS ON PAGE BOUNDRY
|
||||
MOVE TT,(A) ;NUMERIC VALUE OF BPORG
|
||||
TRNN TT,PAGKSM
|
||||
POPJ P,
|
||||
ADDI TT,PAGSIZ-1
|
||||
ANDCMI TT,PAGKSM
|
||||
CAMGE TT,@VBPEND
|
||||
JRST PGBP4
|
||||
PUSH FXP,TT ;NEW VALUE FOR BPORG
|
||||
JSP T,SPECBIND
|
||||
0 VNORET
|
||||
AOS VNORET
|
||||
PUSH P,CUNBIND
|
||||
SUB TT,(A)
|
||||
PUSHJ P,LGTSPC
|
||||
JUMPE TT,[LERR [SIXBIT \NO CORE - PAGEBPORG!\]]
|
||||
POP FXP,TT
|
||||
PGBP4: JSP T,FIX1A
|
||||
MOVEM A,VBPORG ;GIVE BPORG NEW PAGIFIED VALUE
|
||||
POPJ P,
|
||||
|
||||
SUBTTL MAKUNBOUND AND PURIFY
|
||||
|
||||
;NEVER FLUSHES VALUE CELL
|
||||
MAKUBE: %WTA [SIXBIT \UNCHANGEABLE VALUE - MAKUNBOUND!\]
|
||||
MAKUNBOUND: ;SUBR 1 - FLUSH VALUE OF ATOMIC SYMBOL
|
||||
BAKPRO
|
||||
JSP D,SETCK ;MAKE SURE IT'S A SYMBOL
|
||||
JUMPE A,MAKUBE
|
||||
CAIN A,TRUTH
|
||||
JRST MAKUBE
|
||||
HLRZ T,(A)
|
||||
MOVE B,(T)
|
||||
IFE 0, NOPRO
|
||||
IFN 0,[
|
||||
TLNE B,300 ;CAN'T RECLAIM VALUE CELL IF PURE
|
||||
JRST MAKUN1 ; OR IF COMPILED CODE NEEDS IT
|
||||
TLZ B,-1
|
||||
CAIN B,SUNBOUND ;CAN'T RECLAIM SUNBOUND!!!
|
||||
POPJ P,
|
||||
CAIL B,BXVCSG+NXVCSG*SEGSIZ
|
||||
JRST MAKUN1 ;CAN'T RECLAIM CELL NOT IN VALUE CELL AREA
|
||||
EXCH B,FFVC ;SO RECLAIM THE VALUE CELL ALREADY
|
||||
XCTPRO
|
||||
MOVEM B,@FFVC
|
||||
MOVEI B,SUNBOUND ;USE SUNBOUND FOR A VALUE CELL
|
||||
HRRM B,(T)
|
||||
NOPRO
|
||||
POPJ P, ;THAT'S ALL
|
||||
] ;END IFN 0
|
||||
|
||||
MAKUN1: PUSH P,A ;MAKE SURE WE RETURN THE ARGUMENT
|
||||
PUSH P,CPOPAJ
|
||||
MOVEI B,QUNBOUND ;FALL INTO SET WITH "UNBOUND" VALUE
|
||||
JRST SET+1
|
||||
|
||||
|
||||
;;;; PURIFY
|
||||
|
||||
IFN USELESS,[
|
||||
|
||||
$PURIFY:
|
||||
IFN D10, POPJ P,
|
||||
IFN ITS+D20,[
|
||||
LOCKTOPOPJ
|
||||
SETZ AR1,
|
||||
JSP T,FXNV1 ;GET TWO MACHINE NUMBERS
|
||||
JSP T,FXNV2
|
||||
ANDCMI TT,1777 ;PAGIFY FIRST DOWNWARD
|
||||
IORI D,1777 ;PAGIFY SECOND UPWARD
|
||||
CAMLE TT,D
|
||||
LERR [SIXBIT \ARG 2 < ARG 1 - PURIFY!\]
|
||||
JUMPE C,FPURF3 ;NULL THIRD ARG MEANS DEPURE
|
||||
MOVE T,LDXLPL
|
||||
HRRZ T,LDXPSP(T) ;GET ADR OF POSSIBLY PURE PAGE
|
||||
CAIG TT,(T)
|
||||
CAIGE D,(T)
|
||||
SKIPA
|
||||
SETZM LDXLPC ;FOR PURE PAGE JUST FORCE FREE COUNT TO ZERO
|
||||
FPURF0: CAIE C,QBPORG
|
||||
JRST FPURF3
|
||||
PUSHJ P,FPURF7
|
||||
JRST FPURF2
|
||||
|
||||
FPURF3: JSP R,IP0
|
||||
POPJ P,
|
||||
|
||||
] ;END OF IFN ITS+D20
|
||||
] ;END OF IFN USELESS
|
||||
|
||||
|
||||
PGTOP UIO,[UTAPE, LAP, AND AGGLOMERATED SUBRS]
|
||||
|
||||
Reference in New Issue
Block a user