mirror of
https://github.com/PDP-10/its.git
synced 2026-03-04 10:44:38 +00:00
2133 lines
45 KiB
Plaintext
2133 lines
45 KiB
Plaintext
|
||
TITLE STRBUILD MUDDLE STRUCTURE BUILDER
|
||
|
||
.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG
|
||
.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC
|
||
.GLOBAL PGROW,TPGROW,MAINPR,%SLEEP,MSGTYP,PURTOP,PURBOT,STOSTR,RBLDM,CPOPJ,CPOPJ1,STBL
|
||
.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,PINIT,CKPUR,GCSET
|
||
.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,CPOPJ1,.LIST.
|
||
.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,SLEEPR,GCHK10,FPAG
|
||
.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,C1CONS
|
||
.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP
|
||
.GLOBAL TD.PUT,TD.GET,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2,CHKPGI,PURCLN
|
||
.GLOBAL CTIME,MTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX
|
||
.GLOBAL NOWLVL,CURPLN,PVSTOR,SPSTOR,MPOPJ,NGCS,RNUMSP,NUMSWP,SAGC,INQAGC
|
||
.GLOBAL GCTIM,GCCAUS,GCCALL,AAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT
|
||
; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
|
||
|
||
.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS
|
||
.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE
|
||
.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN
|
||
.GLOBAL AGC,ROOT,CIGTPR,IIGLOC
|
||
.GLOBAL P.TOP,P.CORE,PMAPB
|
||
.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1
|
||
.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM
|
||
|
||
; SHARED SYMBOLS WITH GC MODULE
|
||
|
||
.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL
|
||
.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX
|
||
.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP
|
||
.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB
|
||
.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG,PMIN,PURMIN
|
||
.GLOBAL GLBINC,GCHAIR,GCMONF,SQKIL,INBLOT
|
||
.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
|
||
.GLOBAL C%M20,C%M30,C%M40,C%M60
|
||
|
||
NOPAGS==1 ; NUMBER OF WINDOWS
|
||
EOFBIT==1000
|
||
PDLBUF=100
|
||
|
||
.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC)
|
||
|
||
GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR
|
||
STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT
|
||
STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT
|
||
|
||
|
||
RELOCATABLE
|
||
.INSRT MUDDLE >
|
||
SYSQ
|
||
IFE ITS,[
|
||
.INSRT STENEX >
|
||
]
|
||
IFN ITS, PGSZ==10.
|
||
IFE ITS, PGSZ==9.
|
||
|
||
|
||
; GC-READ TAKES ONE ARGUMENT WHICH MUST BE A "READB" CHANNEL
|
||
|
||
.GLOBAL CLOOKU,CINSER,MOBLIST,CATOM,EOFCND,IGLOC
|
||
|
||
MFUNCTION GCREAD,SUBR,[GC-READ]
|
||
|
||
ENTRY
|
||
|
||
CAML AB,C%M2 ; CHECK # OF ARGS
|
||
JRST TFA
|
||
CAMGE AB,C%M40
|
||
JRST TMA
|
||
|
||
GETYP A,(AB) ; MAKE SURE ARG IS A CHANNEL
|
||
CAIE A,TCHAN
|
||
JRST WTYP2 ; IT ISN'T COMPLAIN
|
||
MOVE B,1(AB) ; GET PTR TO CHANNEL
|
||
HRRZ C,-2(B) ; LOOK AT BITS IN CHANNEL
|
||
TRC C,C.OPN+C.READ+C.BIN
|
||
TRNE C,C.OPN+C.READ+C.BIN
|
||
JRST BADCHN
|
||
|
||
PUSH P,1(B) ; SAVE ITS CHANNEL #
|
||
IFN ITS,[
|
||
MOVE B,[-2,,C] ; SET UP AOBJN PTR TO READ IN DELIMITING
|
||
; CONSTANTS
|
||
MOVE A,(P) ; GET CHANNEL #
|
||
DOTCAL IOT,[A,B]
|
||
FATAL GCREAD-- IOT FAILED
|
||
JUMPL B,EOFGC ; IF BLOCK DIDN'T FINISH THEN EOF
|
||
]
|
||
IFE ITS,[
|
||
MOVE A,(P) ; GET CHANNEL
|
||
BIN
|
||
MOVE C,B ; TO C
|
||
BIN
|
||
MOVE D,B ; TO D
|
||
GTSTS ; SEE IF EOF
|
||
TLNE B,EOFBIT
|
||
JRST EOFGC
|
||
]
|
||
|
||
PUSH P,C ; SAVE AC'S
|
||
PUSH P,D
|
||
|
||
IFN ITS,[
|
||
MOVE B,[-3,,C] ; NEXT GROUP OF WORDS
|
||
DOTCAL IOT,[A,B]
|
||
FATAL GCREAD--GC IOT FAILED
|
||
]
|
||
IFE ITS,[
|
||
MOVE A,-2(P) ; GET CHANNEL
|
||
BIN
|
||
MOVE C,B
|
||
BIN
|
||
MOVE D,B
|
||
BIN
|
||
MOVE E,B
|
||
]
|
||
MOVEI 0,0 ; DO PRELIMINARY TESTS
|
||
IOR 0,A ; IOR ALL WORDS IN
|
||
IOR 0,B
|
||
IOR 0,C
|
||
IOR 0,(P)
|
||
IOR 0,-1(P)
|
||
TLNE 0,-1 ; SKIP IF NO BITS IN LEFT HALF
|
||
JRST ERDGC
|
||
|
||
MOVEM D,NNPRI
|
||
MOVEM E,NNSAT
|
||
MOVE D,C ; GET START OF NEWTYPE TABLE
|
||
SUB D,-1(P) ; CREATE AOBJN POINTER
|
||
HRLZS D
|
||
ADDI D,(C)
|
||
MOVEM D,TYPTAB ; SAVE IT
|
||
MOVE A,(P) ; GET LENGTH OF WORD
|
||
SUBI A,CONADJ ; SUBTRACT FOR CONSTANTS
|
||
|
||
ADD A,GCSTOP
|
||
CAMG A,FRETOP ; SEE IF GC IS NESESSARY
|
||
JRST RDGC1
|
||
MOVE C,(P)
|
||
ADDM C,GETNUM ; MOVE IN REQUEST
|
||
MOVE C,[0,,1] ; ARGS TO GC
|
||
PUSHJ P,INQAGC ; GC
|
||
RDGC1: MOVE C,GCSTOP ; GET CURRENT TOP OF THE WORLD
|
||
MOVEM C,OGCSTP ; SAVE IT
|
||
ADD C,(P) ; CALCULATE NEW GCSTOP
|
||
ADDI C,2 ; SUBTRACT FOR CONSTANTS
|
||
MOVEM C,GCSTOP
|
||
SUB C,OGCSTP
|
||
SUBI C,2 ; SUBSTRACT TO GET RID OF D.W'S
|
||
MOVNS C ; SET UP AOBJN PTR FOR READIN
|
||
IFN ITS,[
|
||
HRLZS C
|
||
MOVE A,-2(P) ; GET CHANNEL #
|
||
ADD C,OGCSTP
|
||
DOTCAL IOT,[A,C]
|
||
FATAL GCREAD-- IOT FAILED
|
||
]
|
||
IFE ITS,[
|
||
MOVE A,-2(P) ; CHANNEL TO A
|
||
MOVE B,OGCSTP ; SET UP BYTE POINTER
|
||
HRLI B,444400
|
||
SIN ; IN IT COMES
|
||
]
|
||
|
||
MOVE C,(P) ; GET LENGHT OF OBJECT
|
||
ADDI A,5
|
||
MOVE B,1(AB) ; GET CHANNEL
|
||
ADDM C,ACCESS(B)
|
||
MOVE D,GCSTOP ; SET UP TO LOOK LIKE UVECTOR OF LOSES
|
||
ADDI C,2 ; ADD 2 FOR DOPE WORDS
|
||
HRLM C,-1(D)
|
||
MOVSI A,.VECT.
|
||
SETZM -2(D)
|
||
IORM A,-2(D) ; MARK VECTOR BIT
|
||
PUSH TP,$TRDTB ; HOLD ON IN CASE OF GC
|
||
MOVEI A,-2(D)
|
||
MOVN C,(P)
|
||
ADD A,C
|
||
HRL A,C
|
||
PUSH TP,A
|
||
|
||
MOVE D,-1(P) ; SET UP BOTTOM OF ATOM TABLE
|
||
SUBI D,1
|
||
MOVEM D,ABOTN
|
||
MOVE C,GCSTOP ; START AT TOP OF WORLD
|
||
SUBI C,3 ; POINT TO FIRST ATOM
|
||
|
||
; LOOP TO FIX UP THE ATOMS
|
||
|
||
AFXLP: HRRZ 0,1(TB)
|
||
ADD 0,ABOTN
|
||
CAMG C,0 ; SEE IF WE ARE DONE
|
||
JRST SWEEIN
|
||
HRRZ 0,1(TB)
|
||
SUB C,0
|
||
PUSHJ P,ATFXU ; FIX IT UP
|
||
HLRZ A,(C) ; GET LENGTH
|
||
TRZ A,400000 ; TURN OFF MARK BIT
|
||
SUBI C,(A) ; POINT TO PRECEDING ATOM
|
||
HRRZS C ; CLEAR OFF NEGATIVE
|
||
JRST AFXLP
|
||
|
||
; FIXUP ROUTINE FOR ATOMS (C==> D.W.)
|
||
|
||
ATFXU: PUSH P,C ; SAVE PTR TO D.W.
|
||
ADD C,1(TB)
|
||
MOVE A,C
|
||
HLRZ B,(A) ; GET LENGTH AND MARKING
|
||
TRZE B,400000 ; TURN OF MARK BIT AND SKIP IF WAS ALREADY MARKED
|
||
JRST ATFXU1
|
||
MOVEI D,-3(B) ; FULL WORDS OF STRING IN PNAME
|
||
IMULI D,5 ; CALCULATE # OF CHARACTERS
|
||
MOVE 0,-2(A) ; GET LAST WORD OF STRING
|
||
SUBI A,-1(B) ; LET A POINT TO OBLIST SLOAT
|
||
MOVE B,A ; GET COPY OF A
|
||
MOVE A,0
|
||
SUBI A,1
|
||
ANDCM 0,A
|
||
JFFO 0,.+1
|
||
HRREI 0,-34.(A)
|
||
IDIVI 0,7 ; # OF CHARS IN LAST WORD
|
||
ADD D,0
|
||
ADD D,$TCHSTR ; MAKE IT LOOK LIKE A STRINGS TYPE-WORD
|
||
PUSH P,D ; SAVE IT
|
||
MOVE C,(B) ; GET OBLIST SLOT PTR
|
||
ATFXU9: HRRZS B ; RELATAVIZE POINTER
|
||
HRRZ 0,1(TB)
|
||
SUB B,0
|
||
PUSH P,B
|
||
JUMPE C,ATFXU6 ; NO OBLIST. CREATE ATOM
|
||
CAMN C,C%M1 ; SEE IF ROOT ATOM
|
||
JRST RTFX
|
||
ADD C,ABOTN ; POINT TO ATOM
|
||
PUSHJ P,ATFXU
|
||
PUSH TP,$TATOM
|
||
PUSH TP,B
|
||
MOVE A,$TATOM ; SET UP TO SEE IF OBLIST EXITS
|
||
MOVE C,$TATOM
|
||
MOVE D,IMQUOTE OBLIST
|
||
PUSHJ P,CIGTPR
|
||
JRST ATFXU8 ; NO OBLIST. CREATE ONE
|
||
SUB TP,C%22 ; GET RID OF SAVED ATOM
|
||
RTCON: PUSH TP,$TOBLS
|
||
PUSH TP,B
|
||
MOVE C,B ; SET UP FOR LOOKUP
|
||
MOVE A,-1(P) ; SET UP PTR TO PNAME
|
||
MOVE B,(P)
|
||
ADD B,[440700,,1] ; ADJUST TO MAKE IT LOOK LIKE A BYTE-POINTER
|
||
HRRZ 0,1(TB)
|
||
ADD B,0
|
||
PUSHJ P,CLOOKU
|
||
JRST ATFXU4 ; NOT ON IT SO INSERT
|
||
ATFXU3: SUB P,C%22 ; DONE
|
||
SUB TP,C%22 ; POP OFF OBLIST
|
||
ATFXU7: MOVE C,(P) ; RESTORE PTR TO D.W.
|
||
ADD C,1(TB)
|
||
MOVEM B,-1(C) ; MOVE IN RELATAVIZE ADDRESS
|
||
MOVSI D,400000
|
||
IORM D,(C) ; TURN OFF MARK BIT
|
||
MOVE 0,3(B) ; SEE IF MUST BE LOCR
|
||
TRNE 0,1 ; SKIP IF MUST MAKE IT IMPURE
|
||
PUSHJ P,IIGLOC
|
||
POP P,C
|
||
ADD C,1(TB)
|
||
POPJ P, ; EXIT
|
||
ATFXU1: POP P,C ; RESTORE PTR TO D.W.
|
||
ADD C,1(TB)
|
||
MOVE B,-1(C) ; GET ATOM
|
||
POPJ P,
|
||
|
||
; ROUTINE TO INSERT AN ATOM
|
||
|
||
ATFXU4: MOVE C,(TP) ; GET OBLIST PTR
|
||
MOVE B,(P) ; SET UP STRING PTR TO PNAME
|
||
ADD B,[440700,,1]
|
||
HRRZ 0,1(TB)
|
||
ADD B,0
|
||
MOVE A,-1(P) ; GET TYPE WORD
|
||
PUSHJ P,CINSER ; INSERT IT
|
||
JRST ATFXU3
|
||
|
||
; THIS ROUTINE CREATS THE ATOM SO THAT ITS NOT ON ANY OBLIST
|
||
|
||
ATFXU6: MOVE B,(P) ; POINT TO PNAME
|
||
ADD B,[440700,,1] ; MAKE IT LOOK LIKE A BYTE POINTER
|
||
HRRZ 0,1(TB)
|
||
ADD B,0
|
||
MOVE A,-1(P)
|
||
PUSHJ P,CATOM
|
||
SUB P,C%22 ; CLEAN OFF STACK
|
||
JRST ATFXU7
|
||
|
||
; THIS ROUTINE CREATES AND OBLIST
|
||
|
||
ATFXU8: MCALL 1,MOBLIST
|
||
PUSH TP,$TOBLS
|
||
PUSH TP,B ; SAVE OBLIST PTR
|
||
JRST ATFXU4 ; JUMP TO INSERT THE OBLIST
|
||
|
||
; HERE TO INSERT AN ATOM INTO THE ROOT OBLIST
|
||
|
||
RTFX: MOVE B,ROOT+1 ; GET ROOT OBLIST
|
||
JRST RTCON
|
||
|
||
; THIS ROUTINE SWEEPS THRU THE NEW CORE IMAGE AND UPDATES ALL THE POINTERS.
|
||
|
||
SWEEIN:
|
||
; ROUTINE TO FIX UP TYPE-TABLE FOR GC-READ. THIS ROUTINE FIXES UP THE TYPE TABLE SO THAT
|
||
; THE TYPES ATOM I.D. IS REPLACED BY ITS TYPE-NUMBER IN THE NEW MUDDLE AND IF ITS A
|
||
; TEMPLATE, THE SLOT FOR THE PRIMTYPE-ATOM IS REPLACED BY THE SAT OF THE TEMPLATE
|
||
|
||
HRRZ E,1(TB) ; SET UP TYPE TABLE
|
||
ADD E,TYPTAB
|
||
JUMPGE E,VUP ; SKIP OVER IF DONE
|
||
TYPUP1: PUSH P,C%0 ; PUSH SLOT FOR POSSIBLE TEMPLATE ATOM
|
||
HLRZ A,1(E) ; GET POSSIBLE ATOM SLOT
|
||
JUMPE A,TYPUP2 ; JUMP IF NOT A TEMPLATE
|
||
ADD A,ABOTN ; GET ATOM
|
||
ADD A,1(TB)
|
||
MOVE A,-1(A)
|
||
MOVE B,TYPVEC+1 ; GET TYPE VECTOR SLOT FOR LOOP TO SEE IF ITS THERE
|
||
TYPUP3: CAMN A,1(B) ; SKIP IF NOT EQUAL
|
||
JRST TYPUP4 ; FOUND ONE
|
||
ADD B,C%22 ; TO NEXT
|
||
JUMPL B,TYPUP3
|
||
JRST ERTYP1 ; ERROR NONE EXISTS
|
||
TYPUP4: HRRZ C,(B) ; GET SAT SLOT
|
||
CAIG C,NUMSAT ; MAKE SURE TYPE IS A TEMPLATE
|
||
JRST ERTYP2 ; IF NOT COMPLAIN
|
||
HRLM C,1(E) ; SMASH IN NEW SAT
|
||
MOVE B,1(B) ; GET ATOM OF PRIMTYPE
|
||
MOVEM B,(P) ; PUSH ONTO STACK
|
||
TYPUP2: MOVEI D,0 ; INITIALIZE TYPE COUNT FOR LOOKUP LOOP
|
||
MOVE B,TYPVEC+1 ; GET PTR FOR LOOP
|
||
HRRZ A,1(E) ; GET TYPE'S ATOM ID
|
||
ADD A,ABOTN ; GET ATOM
|
||
ADD A,1(TB)
|
||
MOVE A,-1(A)
|
||
TYPUP5: CAMN A,1(B) ; SKIP IF NOT EQUAL
|
||
JRST TYPUP6 ; FOUND ONE
|
||
ADDI D,1 ; INCREMENT TYPE-COUNT
|
||
ADD B,C%22 ; POINT TO NEXT
|
||
JUMPL B,TYPUP5
|
||
HRRM D,1(E) ; CLOBBER IN TYPE-NUMBER
|
||
PUSH TP,$TATOM ; PUSH ARGS FOR NEWTYPE
|
||
PUSH TP,A
|
||
PUSH TP,$TATOM
|
||
POP P,B ; GET BACK POSSIBLE PRIMTYPE ATOM
|
||
JUMPE B,TYPUP7 ; JUMP IF NOT A TEMPLATE
|
||
PUSH TP,B ; PUSH ON PRIMTYPE
|
||
TYPUP9: SUB E,1(TB)
|
||
PUSH P,E ; SAVE RELATAVIZED PTR TO TYPE-TABLE
|
||
MCALL 2,NEWTYPE
|
||
POP P,E ; RESTORE RELATAVIZED PTR
|
||
ADD E,1(TB) ; FIX IT UP
|
||
TYPUP0: ADD E,C%22 ; INCREMENT E
|
||
JUMPL E,TYPUP1
|
||
JRST VUP
|
||
TYPUP7: HRRZ B,(E) ; FIND PRIMTYPE FROM SAT
|
||
MOVE A,@STBL(B)
|
||
PUSH TP,A
|
||
JRST TYPUP9
|
||
TYPUP6: HRRM D,1(E) ; CLOBBER IN TYPE #
|
||
JRST TYPUP0
|
||
|
||
ERTYP1: ERRUUO EQUOTE CANT-FIND-TEMPLATE
|
||
|
||
ERTYP2: ERRUUO EQUOTE TEMPLATE-TYPE-NAME-NOT-OF-TYPE-TEMPLATE
|
||
|
||
VUP: HRRZ E,1(TB) ; FIX UP SOME POINTERS
|
||
MOVEM E,OGCSTP
|
||
ADDM E,ABOTN
|
||
ADDM E,TYPTAB
|
||
|
||
|
||
; ROUTINE TO SWEEP THRU THE READ-IN IMAGE LOOKING FOR UVECTORS AND TEMPLATES.
|
||
; WHILE SWEEPING IT FIXES UP THE DOPE WORDS APPROPRIATELY.
|
||
|
||
HRRZ A,TYPTAB ; GET TO TOP OF WORLD
|
||
SUBI A,2 ; GET TO FIRST TYPE WORD OR DOPE-WORD OF FIRST OBJECT
|
||
VUP1: CAMG A,OGCSTP ; SKIP IF NOT DONE
|
||
JRST VUP3
|
||
HLRZ B,(A) ; GET TYPE SLOT
|
||
TRNE B,.VECT. ; SKIP IF NOT A VECTOR
|
||
JRST VUP2
|
||
SUBI A,2 ; SKIP OVER PAIR
|
||
JRST VUP1
|
||
VUP2: TRNE B,400000 ; SKIP IF UVECTOR
|
||
JRST VUP4
|
||
ANDI B,TYPMSK ; GET RID OF MONITORS
|
||
CAMG B,NNPRI ; SKIP IF NEWTYPE
|
||
JRST VUP5
|
||
PUSHJ P,GETNTP ; GET THE NEW TYPE #
|
||
PUTYP B,(A) ; SMASH IT IT
|
||
VUP5: HLRZ B,1(A) ; SKIP OVER VECTOR
|
||
TRZ B,400000 ; GET RID OF POSSIBLE MARK BIT
|
||
SUBI A,(B)
|
||
JRST VUP1 ; LOOP
|
||
VUP4: ANDI B,TYPMSK ; FLUSH MONITORS
|
||
CAMG B,NNSAT ; SKIP IF TEMPLATE
|
||
JRST VUP5
|
||
PUSHJ P,GETSAT ; CONVERT TO NEW SAT
|
||
ADDI B,.VECT. ; MAJIC TO TURN ON BIT
|
||
PUTYP B,(A)
|
||
JRST VUP5
|
||
|
||
|
||
VUP3: PUSH P,GCSBOT ; SAVE CURRENT GCSBOT
|
||
MOVE A,OGCSTP ; SET UP NEW GCSBOT
|
||
MOVEM A,GCSBOT
|
||
PUSH P,GCSTOP
|
||
HRRZ A,TYPTAB ; SET UP NEW GCSTOP
|
||
MOVEM A,GCSTOP
|
||
SETOM GCDFLG
|
||
MOVE A,[PUSHJ P,RDFIX] ; INS FOR GCHACK
|
||
MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS
|
||
PUSHJ P,GCHK10
|
||
SETZM GCDFLG
|
||
POP P,GCSTOP ; RESTORE GCSTOP
|
||
MOVE A,1(TB) ; GET A POINTER TO RETURNING VALUES
|
||
MOVE B,A
|
||
HLRE C,B
|
||
SUB B,C
|
||
SETZM (B)
|
||
SETZM 1(B)
|
||
POP P,GCSBOT ; RESTORE GCSBOT
|
||
MOVE B,1(A) ; GET PTR TO OBJECTS
|
||
MOVE A,(A)
|
||
JRST FINIS ; EXIT
|
||
|
||
; ERROR FOR INCORRECT GCREAD FILE
|
||
|
||
ERDGC: ERRUUO EQUOTE BAD-GC-READ-FILE
|
||
|
||
; ROUTINE CALLED BY GCHACK TO UPDATE PTRS IN THE NEW CORE IMAGE
|
||
|
||
RDFIX: PUSH P,C ; SAVE C
|
||
PUSH P,B ; SAVE PTR
|
||
EXCH B,C
|
||
TLNE C,UBIT ; SKIP IF NOT UVECTOR
|
||
JRST ELEFX ; DON'T HACK TYPES IN UVECTOR
|
||
CAIN B,TTYPEC
|
||
JRST TYPCFX
|
||
CAIN B,TTYPEW
|
||
JRST TYPWFX
|
||
CAML B,NNPRI
|
||
JRST TYPGFX
|
||
ELEFX: EXCH B,A ; EXCHANGE FOR SAT
|
||
PUSHJ P,SAT
|
||
EXCH B,A ; REFIX
|
||
CAIE B,SLOCR ; REL GLOC'S ARE STORED AS ATOMS
|
||
CAIN B,SATOM
|
||
JRST ATFX
|
||
CAIN B,SCHSTR
|
||
JRST STFX
|
||
CAIN B,S1WORD ; SEE IF PRIMTYPE WOR
|
||
JRST RDLSTF ; LEAVE IF IS
|
||
STFXX: MOVE 0,GCSBOT ; ADJUSTMENT
|
||
SUBI 0,FPAG+5
|
||
SKIPE 1(C) ; DON'T CHANGE A PTR TO NIL
|
||
ADDM 0,1(C) ; FIX UP
|
||
RDLSTF: TLNN C,.LIST. ; SEE IF PAIR
|
||
JRST RDL1 ; EXIT
|
||
MOVE 0,GCSBOT ; FIX UP
|
||
SUBI 0,FPAG+5
|
||
HRRZ B,(C) ; SEE IF POINTS TO NIL
|
||
SKIPN B
|
||
JRST RDL1
|
||
MOVE B,C ; GET ARG FOR RLISTQ
|
||
PUSHJ P,RLISTQ
|
||
JRST RDL1
|
||
ADDM 0,(C)
|
||
RDL1: POP P,B ; RESTORE B
|
||
POP P,C
|
||
POPJ P,
|
||
|
||
; ROUTINE TO FIX UP PNAMES
|
||
|
||
STFX: TLZN D,STATM
|
||
JRST STFXX
|
||
HLLM D,1(C) ; PUT BACK WITH BIT OFF
|
||
ADD D,ABOTN
|
||
ANDI D,-1
|
||
HLRE 0,-1(D) ; LENGTH OF ATOM
|
||
MOVNS 0
|
||
SUBI 0,3 ; VAL & OBLIST
|
||
IMULI 0,5 ; TO CHARS (SORT OF)
|
||
HRRZ D,-1(D)
|
||
ADDI D,2
|
||
PUSH P,A
|
||
PUSH P,B
|
||
LDB A,[360600,,1(C)] ; GET BYTE POS
|
||
IDIVI A,7 ; TO CHAR POS
|
||
SKIPE A
|
||
SUBI A,5
|
||
HRRZ B,(C) ; STRING LENGTH
|
||
SUB B,A ; TO WORD BOUNDARY STRING
|
||
SUBI 0,(B)
|
||
IDIVI 0,5
|
||
ADD D,0
|
||
POP P,B
|
||
POP P,A
|
||
HRRM D,1(C)
|
||
JRST RDLSTF
|
||
|
||
; ROUTINE TO FIX UP POINTERS TO ATOMS
|
||
|
||
ATFX: SKIPGE D
|
||
JRST RDLSTF
|
||
ADD D,ABOTN
|
||
MOVE 0,-1(D) ; GET PTR TO ATOM
|
||
CAIE B,SLOCR ; IF REL LOCATIVE, MORE HAIR
|
||
JRST ATFXAT
|
||
MOVE B,0
|
||
PUSH P,E
|
||
PUSH P,D
|
||
PUSH P,C
|
||
PUSH P,B
|
||
PUSH P,A
|
||
PUSHJ P,IGLOC
|
||
SUB B,GLOTOP+1
|
||
MOVE 0,B
|
||
POP P,A
|
||
POP P,B
|
||
POP P,C
|
||
POP P,D
|
||
POP P,E
|
||
ATFXAT: MOVEM 0,1(C) ; SMASH IT IN
|
||
JRST RDLSTF ; EXIT
|
||
|
||
TYPCFX: HRRZ B,1(C) ; GET TYPE
|
||
PUSHJ P,GETNEW ; GET TYPE IN THIS CORE IMAGE
|
||
HRRM B,1(C) ; CLOBBER IT IN
|
||
JRST RDLSTF ; CONTINUE FIXUP
|
||
|
||
TYPWFX: HLRZ B,1(C) ; GET TYPE
|
||
PUSHJ P,GETNEW ; GET TYPE IN THIS CORE IMAGE
|
||
HRLM B,1(C) ; SMASH IT IN
|
||
JRST ELEFX
|
||
|
||
TYPGFX: PUSH P,D
|
||
PUSHJ P,GETNTP ; GET TYPE IN THIS CORE IMAGE
|
||
POP P,D
|
||
PUTYP B,(C)
|
||
JRST ELEFX
|
||
|
||
; HERE TO HANDLE AN EOF IN GC-READ. IT USES OPTIONAL SECOND ARG IF SUPPLIED AS
|
||
; EOF HANDLER ELSE USES CHANNELS.
|
||
|
||
EOFGC: MOVE B,1(AB) ; GET CHANNEL INTO B
|
||
CAML AB,C%M20 ; [-2,,0] ; SKIP IF EOF ROUTINE IS SUPPLIED
|
||
JRST MYCLOS ; USE CHANNELS
|
||
PUSH TP,2(AB)
|
||
PUSH TP,3(AB)
|
||
JRST CLOSIT
|
||
MYCLOS: PUSH TP,EOFCND-1(B)
|
||
PUSH TP,EOFCND(B)
|
||
CLOSIT: PUSH TP,$TCHAN
|
||
PUSH TP,B
|
||
MCALL 1,FCLOSE ; CLOSE CHANNEL
|
||
MCALL 1,EVAL ; EVAL HIS EOF HANDLER
|
||
JRST FINIS
|
||
|
||
; ROUTINE TO SUPPLY THE TYPE NUMBER FOR A NEWTYPE
|
||
|
||
GETNEW: CAMG B,NNPRI ;NEWTYPE
|
||
POPJ P,
|
||
GETNTP: MOVE D,TYPTAB ; GET AOBJN POINTER TO TYPE-TABLE
|
||
GETNT1: HLRZ E,(D) ; GET TYPE #
|
||
CAIN E,(B) ; SKIP IF NOT EQUAL TO GOAL
|
||
JRST GOTTYP ; FOUND IT
|
||
ADD D,C%22 ; POINT TO NEXT
|
||
JUMPL D,GETNT1
|
||
SKIPA ; KEEP TYPE SAME
|
||
GOTTYP: HRRZ B,1(D) ; GET NEW TYPE #
|
||
POPJ P,
|
||
|
||
; ROUTINE TO SUPPLY THE SAT TO A TEMPLATE HACKER
|
||
|
||
GETSAT: MOVE D,TYPTAB ; GET AOBJN PTR TO TYPE TABLE
|
||
GETSA1: HRRZ E,(D) ; GET OBJECT
|
||
CAIN E,(B) ; SKIP IF NOT EQUAL TO GOAL
|
||
JRST GOTSAT ; FOUND IT
|
||
ADD D,C%22
|
||
JUMPL D,GETSA1
|
||
FATAL GC-DUMP -- TYPE FIXUP FAILURE
|
||
GOTSAT: HLRZ B,1(D) ; GET NEW SAT
|
||
POPJ P,
|
||
|
||
|
||
; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER
|
||
RLISTQ: PUSH P,A
|
||
GETYP A,(B) ; GET TYPE
|
||
PUSHJ P,SAT ; GET SAT
|
||
CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE
|
||
SKIPL MKTBS(A)
|
||
AOS -1(P) ; SKIP IF NOT DEFFERED
|
||
POP P,A
|
||
POPJ P, ; EXIT
|
||
|
||
|
||
.GLOBAL FLIST
|
||
|
||
MFUNCTION BLOATSTAT,SUBR,[BLOAT-STAT]
|
||
|
||
ENTRY
|
||
|
||
JUMPGE AB,GETUVC ; SEE IF THERE IS AN ARGUMENT
|
||
GETYP A,(AB)
|
||
CAIE A,TUVEC ; SEE IF THE ARGUMENT IS A UVECTOR
|
||
JRST WTYP1 ; IF NOT COMPLAIN
|
||
HLRE 0,1(AB)
|
||
MOVNS 0
|
||
CAIE 0,STATNO+STATGC ; SEE IF UVECTOR IS RIGHT LENGTH
|
||
JRST WTYP1
|
||
CAMGE AB,C%M20 ; [-2,,0] ; SEE IF THERE ARE TOO MANY ARGUMENTS
|
||
JRST TMA
|
||
MOVE A,(AB) ; GET THE UVECTOR
|
||
MOVE B,1(AB)
|
||
JRST SETUV ; CONTINUE
|
||
GETUVC: MOVEI A,STATNO+STATGC ; CREATE A UVECTOR
|
||
PUSHJ P,IBLOCK
|
||
SETUV: PUSH P,A ; SAVE UVECTOR
|
||
PUSH P,B
|
||
MOVE 0,NOWFRE ; COMPUTE FREE STORAGE USED SINCE LAST BLOAT-STAT
|
||
SUB 0,RFRETP
|
||
ADD 0,GCSTOP
|
||
MOVEM 0,CURFRE
|
||
PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS
|
||
HLRE 0,TP ; COMPUTE STACK SPACE USED UP
|
||
ADD 0,NOWTP
|
||
SUBI 0,PDLBUF
|
||
MOVEM 0,CURTP
|
||
MOVE B,IMQUOTE THIS-PROCESS
|
||
PUSHJ P,ILOC
|
||
HRRZS B
|
||
MOVE PVP,PVSTOR+1
|
||
HRRZ C,TPBASE+1(PVP) ; CALCULATE # OF ATOM SLOTS
|
||
MOVE 0,B
|
||
HRRZ D,SPBASE+1(PVP) ; COMPUTE CURRENT # OF BINDINGS
|
||
SUB 0,D
|
||
IDIVI 0,6
|
||
MOVEM 0,CURLVL
|
||
SUB B,C ; TOTAL WORDS ATOM STORAGE
|
||
IDIVI B,6 ; COMPUTE # OF SLOTS
|
||
MOVEM B,NOWLVL
|
||
HRRZ A,GLOBASE+1 ; COMPUTE TOTAL # OF GLOBAL SLOTS
|
||
HLRE 0,GLOBASE+1
|
||
SUB A,0 ; POINT TO DOPE WORD
|
||
HLRZ B,1(A)
|
||
ASH B,-2 ; # OF GVAL SLOTS
|
||
MOVEM B,NOWGVL
|
||
HRRZ A,GLOTOP+1 ; COMPUTE # OF GVAL SLOTS IN USE
|
||
HRRZ 0,GLOBSP+1
|
||
SUB A,0
|
||
ASH A,-2 ; NEGATIVE # OF SLOTS USED
|
||
MOVEM A,CURGVL
|
||
HRRZ A,TYPBOT+1 ; GET LENGTH OF TYPE VECTOR
|
||
HLRE 0,TYPBOT+1
|
||
SUB A,0
|
||
HLRZ B,1(A) ; # OF WORDS IN TYPE-VECTOR
|
||
IDIVI B,2 ; CONVERT TO # OF TYPES
|
||
MOVEM B,NOWTYP
|
||
HLRE 0,TYPVEC+1 ; LENGTH OF VISABLE TYPE-VECTOR
|
||
MOVNS 0
|
||
IDIVI 0,2 ; GET # OF TYPES
|
||
MOVEM 0,CURTYP
|
||
MOVE 0,CODTOP ; GET LENGTH OF STATIONARY IMPURE STORAGE
|
||
MOVEM 0,NOWSTO
|
||
SETZB B,D ; ZERO OUT MAXIMUM
|
||
HRRZ C,FLIST
|
||
LOOPC: HLRZ 0,(C) ; GET BLK LENGTH
|
||
ADD D,0 ; ADD # OF WORDS IN BLOCK
|
||
CAMGE B,0 ; SEE IF NEW MAXIMUM
|
||
MOVE B,0
|
||
HRRZ C,(C) ; POINT TO NEXT BLOCK
|
||
JUMPN C,LOOPC ; REPEAT
|
||
MOVEM D,CURSTO
|
||
MOVEM B,CURMAX
|
||
HLRE 0,P ; GET AMOUNT OF ROOM LEFT ON P
|
||
ADD 0,NOWP
|
||
SUBI 0,PDLBUF
|
||
MOVEM 0,CURP
|
||
MOVSI C,BSTGC ; SET UP BLT FOR GC FIGURES
|
||
HRRZ B,(P) ; RESTORE B
|
||
HRR C,B
|
||
BLT C,(B)STATGC-1
|
||
HRLI C,BSTAT ; MODIFY BLT FOR STATS
|
||
HRRI C,STATGC(B)
|
||
BLT C,(B)STATGC+STATNO-1
|
||
MOVEI 0,TFIX+.VECT.
|
||
HRLM 0,(B)STATNO+STATGC ; MOVE IN UTYPE
|
||
POP P,B
|
||
POP P,A ; RESTORE TYPE-WORD
|
||
JRST FINIS
|
||
|
||
GCRSET: SETZM GCNO ; CALL FROM INIT, ZAP ALL 1ST
|
||
MOVE 0,[GCNO,,GCNO+1]
|
||
BLT 0,GCCALL
|
||
JRST GCSET
|
||
|
||
|
||
|
||
|
||
.GLOBAL PGFIND,PGGIVE,PGTAKE,PGINT
|
||
|
||
; USER GARBAGE COLLECTOR INTERFACE
|
||
.GLOBAL ILVAL
|
||
|
||
MFUNCTION GC,SUBR
|
||
ENTRY
|
||
|
||
JUMPGE AB,GC1
|
||
CAMGE AB,C%M60 ; [-6,,0]
|
||
JRST TMA
|
||
PUSHJ P,GETFIX ; GET FREEE MIN IF GIVEN
|
||
SKIPE A ; SKIP FOR 0 ARGUMENT
|
||
MOVEM A,FREMIN
|
||
GC1: PUSHJ P,COMPRM ; GET CURRENT USED CORE
|
||
PUSH P,A
|
||
CAML AB,C%M40 ; [-4,,0] ; SEE IF 3RD ARG
|
||
JRST GC5
|
||
GETYP A,4(AB) ; MAKE SURE A FIX
|
||
CAIE A,TFIX
|
||
JRST WTYP ; ARG WRONG TYPE
|
||
MOVE A,5(AB)
|
||
MOVEM A,RNUMSP
|
||
MOVEM A,NUMSWP
|
||
GC5: CAML AB,C%M20 ; [-2,,0] ; SEE IF SECOND ARG
|
||
JRST GC3
|
||
GETYP A,2(AB) ; SEE IF NONFALSE
|
||
CAIE A,TFALSE ; SKIP IF FALSE
|
||
JRST HAIRGC ; CAUSE A HAIRY GC
|
||
GC3: MOVSI A,TATOM ; CHECK TO SEE IF INTERRUPT FLAG IS ON
|
||
MOVE B,IMQUOTE AGC-FLAG
|
||
PUSHJ P,ILVAL
|
||
CAMN A,$TUNBOUND ; SKIP IF NOT UNBOUND
|
||
JRST GC2
|
||
SKIPE GCHPN ; SKIP IF GCHAPPEN IS 0
|
||
JRST FALRTN ; JUMP TO RETURN FALSE
|
||
GC2: MOVE C,[9.,,0]
|
||
PUSHJ P,AGC ; COLLECT THAT TRASH
|
||
PUSHJ P,COMPRM ; HOW MUCH ROOM NOW?
|
||
POP P,B ; RETURN AMOUNT
|
||
SUB B,A
|
||
MOVSI A,TFIX
|
||
JRST FINIS
|
||
HAIRGC: MOVE B,3(AB)
|
||
CAIN A,TFIX ; IF FIX THEN CLOBBER NGCS
|
||
MOVEM B,NGCS
|
||
MOVEI A,1 ; FORCE VALUE FLUSHING PHASE TO OCCUR
|
||
MOVEM A,GCHAIR
|
||
JRST GC2 ; HAIRY GC OCCORS NO MATTER WHAT
|
||
FALRTN: MOVE A,$TFALSE
|
||
MOVEI B,0 ; RETURN A FALSE-- FOR GC WHICH DIDN'T OCCOR
|
||
JRST FINIS
|
||
|
||
|
||
COMPRM: MOVE A,GCSTOP ; USED SPACE
|
||
SUB A,GCSBOT
|
||
POPJ P,
|
||
|
||
|
||
MFUNCTION GCDMON,SUBR,[GC-MON]
|
||
|
||
ENTRY
|
||
|
||
MOVEI E,GCMONF
|
||
|
||
FLGSET: MOVE C,(E) ; GET CURRENT VALUE
|
||
JUMPGE AB,RETFLG ; RET CURRENT
|
||
CAMGE AB,C%M20 ; [-3,,]
|
||
JRST TMA
|
||
GETYP 0,(AB)
|
||
SETZM (E)
|
||
CAIN 0,TFALSE
|
||
SETOM (E)
|
||
SKIPL E
|
||
SETCMM (E)
|
||
|
||
RETFLG: SKIPL E
|
||
SETCMM C
|
||
JUMPL C,NOFLG
|
||
MOVSI A,TATOM
|
||
MOVE B,IMQUOTE T
|
||
JRST FINIS
|
||
|
||
NOFLG: MOVEI B,0
|
||
MOVSI A,TFALSE
|
||
JRST FINIS
|
||
|
||
.GLOBAL EVATYP,APLTYP,PRNTYP
|
||
|
||
MFUNCTION BLOAT,SUBR
|
||
ENTRY
|
||
|
||
PUSHJ P,SQKIL
|
||
MOVEI C,0 ; FLAG TO SAY WHETHER NEED A GC
|
||
MOVSI E,-NBLO ; AOBJN TO BLOATER TABLE
|
||
|
||
BLOAT2: JUMPGE AB,BLOAT1 ; ALL DONE?
|
||
PUSHJ P,NXTFIX ; GET NEXT BLOAT PARAM
|
||
SKIPE A
|
||
PUSHJ P,@BLOATER(E) ; DISPATCH
|
||
AOBJN E,BLOAT2 ; COUNT PARAMS SET
|
||
|
||
JUMPL AB,TMA ; ANY LEFT...ERROR
|
||
BLOAT1: JUMPE C,BLOATD ; DONE, NO GC NEEDED
|
||
MOVE C,E ; MOVE IN INDICATOR
|
||
HRLI C,1 ; INDICATE THAT IT COMES FROM BLOAT
|
||
SETOM INBLOT
|
||
PUSHJ P,AGC ; DO ONE
|
||
SKIPE A,TPBINC ; SMASH POINNTERS
|
||
MOVE PVP,PVSTOR+1
|
||
ADDM A,TPBASE+1(PVP)
|
||
SKIPE A,GLBINC ; GLOBAL SP
|
||
ADDM A,GLOBASE+1
|
||
SKIPE A,TYPINC
|
||
ADDM A,TYPBOT+1
|
||
SETZM TPBINC ; RESET PARAMS
|
||
SETZM GLBINC
|
||
SETZM TYPINC
|
||
|
||
BLOATD: SKIPN A,GETNUM ; SKIP IF FREE STORAGE REQUEST IN EFFECT
|
||
JRST BLTFN
|
||
ADD A,FRETOP ; ADD FRETOP
|
||
ADDI A,1777 ; ONE BLOCK FOR MARK PDL AND ROUND
|
||
ANDCMI A,1777 ; TO PAGE BOUNDRY
|
||
CAML A,PURBOT ; SKIP IF POSSIBLE TO WIN
|
||
JRST BLFAGC
|
||
ASH A,-10. ; TO PAGES
|
||
PUSHJ P,P.CORE ; GRET THE CORE
|
||
JRST BLFAGC ; LOSE LOSE LOSE
|
||
MOVE A,FRETOP ; CALCULATE NEW PARAMETERS
|
||
MOVEM A,RFRETP
|
||
MOVEM A,CORTOP
|
||
MOVE B,GCSTOP
|
||
SETZM 1(B)
|
||
HRLI B,1(B)
|
||
HRRI B,2(B)
|
||
BLT B,-1(A) ; ZERO CORE
|
||
BLTFN: SETZM GETNUM
|
||
MOVE B,FRETOP
|
||
SUB B,GCSTOP
|
||
MOVSI A,TFIX ; RETURN CORE FOUND
|
||
JRST FINIS
|
||
BLFAGC: MOVN A,FREMIN
|
||
ADDM A,GETNUM ; FIX UP SO BLOATS CORRECTLY
|
||
MOVE C,C%11 ; INDICATOR FOR AGC
|
||
PUSHJ P,AGC ; GARBAGE COLLECT
|
||
JRST BLTFN ; EXIT
|
||
|
||
; TABLE OF BLOAT ROUTINES
|
||
|
||
BLOATER:
|
||
MAINB
|
||
TPBLO
|
||
LOBLO
|
||
GLBLO
|
||
TYBLO
|
||
STBLO
|
||
PBLO
|
||
SFREM
|
||
SLVL
|
||
SGVL
|
||
STYP
|
||
SSTO
|
||
PUMIN
|
||
PMUNG
|
||
TPMUNG
|
||
NBLO==.-BLOATER
|
||
|
||
; BLOAT MAIN STORAGE AREA
|
||
|
||
MAINB: SETZM GETNUM
|
||
MOVE D,FRETOP ; COMPUTE CURRENT ROOM
|
||
SUB D,PARTOP
|
||
CAMGE A,D ; NEED MORE?
|
||
POPJ P, ; NO, LEAVE
|
||
SUB A,D
|
||
MOVEM A,GETNUM ; SAVE
|
||
POPJ P,
|
||
|
||
; BLOAT TP STACK (AT TOP)
|
||
|
||
TPBLO: HLRE D,TP ; GET -SIZE
|
||
MOVNS B,D
|
||
ADDI D,1(TP) ; POINT TO DOPE (ALMOST)
|
||
CAME D,TPGROW ; BLOWN?
|
||
ADDI D,PDLBUF ; POINT TO REAL DOPE WORD
|
||
SUB A,B ; SKIP IF GROWTH NEEDED
|
||
JUMPLE A,CPOPJ
|
||
ADDI A,63.
|
||
ASH A,-6 ; CONVERT TO 64 WD BLOCKS
|
||
CAILE A,377
|
||
JRST OUTRNG
|
||
DPB A,[111100,,-1(D)] ; SMASH SPECS IN
|
||
AOJA C,CPOPJ
|
||
|
||
; BLOAT TOP LEVEL LOCALS
|
||
|
||
LOBLO: HLRE D,TP ; GET -SIZE
|
||
MOVNS B,D
|
||
ADDI D,1(TP) ; POINT TO DOPE (ALMOST)
|
||
CAME D,TPGROW ; BLOWN?
|
||
ADDI D,PDLBUF ; POINT TO REAL DOPE WORD
|
||
CAMG A,B ; SKIP IF GROWTH NEEDED
|
||
IMULI A,6 ; 6 WORDS PER BINDING
|
||
MOVE PVP,PVSTOR+1
|
||
HRRZ 0,TPBASE+1(PVP)
|
||
HRRZ B,SPBASE+1(PVP) ; ROOM AVAIL TO E
|
||
SUB B,0
|
||
SUBI A,(B) ; HOW MUCH MORE?
|
||
JUMPLE A,CPOPJ ; NONE NEEDED
|
||
MOVEI B,TPBINC
|
||
PUSHJ P,NUMADJ
|
||
DPB A,[1100,,-1(D)] ; SMASH
|
||
AOJA C,CPOPJ
|
||
|
||
; GLOBAL SLOT GROWER
|
||
|
||
GLBLO: ASH A,2 ; 4 WORDS PER VAR
|
||
MOVE D,GLOBASE+1 ; CURRENT LIMITS
|
||
HRRZ B,GLOBSP+1
|
||
SUBI B,(D)
|
||
SUBI A,(B) ; NEW AMOUNT NEEDED
|
||
JUMPLE A,CPOPJ
|
||
MOVEI B,GLBINC ; WHERE TO KEEP UPDATE
|
||
PUSHJ P,NUMADJ ; FIX NUMBER
|
||
HLRE 0,D
|
||
SUB D,0 ; POINT TO DOPE
|
||
DPB A,[1100,,(D)] ; AND SMASH
|
||
AOJA C,CPOPJ
|
||
|
||
; HERE TO GROW TYPE VECTOR (AND FRIENDS)
|
||
|
||
TYBLO: ASH A,1 ; TWO WORD PER TYPE
|
||
HRRZ B,TYPVEC+1 ; FIND CURRENT ROOM
|
||
MOVE D,TYPBOT+1
|
||
SUBI B,(D)
|
||
SUBI A,(B) ; EXTRA NEEDED TO A
|
||
JUMPLE A,CPOPJ ; NONE NEEDED, LEAVE
|
||
MOVEI B,TYPINC ; WHERE TO STASH SPEC
|
||
PUSHJ P,NUMADJ ; FIX NUMBER
|
||
HLRE 0,D ; POINT TO DOPE
|
||
SUB D,0
|
||
DPB A,[1100,,(D)]
|
||
SKIPE D,EVATYP+1 ; GROW AUX TYPE VECS IF NEEDED
|
||
PUSHJ P,SGROW1
|
||
SKIPE D,APLTYP+1
|
||
PUSHJ P,SGROW1
|
||
SKIPE D,PRNTYP+1
|
||
PUSHJ P,SGROW1
|
||
AOJA C,CPOPJ
|
||
|
||
; HERE TO CREATE STORAGE SPACE
|
||
|
||
STBLO: MOVE D,GCSBOT ; HOW MUCH NOW HERE
|
||
SUB D,CODTOP
|
||
SUBI A,(D) ; MORE NEEDED?
|
||
JUMPLE A,CPOPJ
|
||
MOVEM A,PARNEW ; FORCE PAIR SPACE TO MOVE ON OUT
|
||
AOJA C,CPOPJ
|
||
|
||
; BLOAT P STACK
|
||
|
||
PBLO: HLRE D,P
|
||
MOVNS B,D
|
||
SUBI D,5 ; FUDGE FOR THIS CALL
|
||
SUBI A,(D)
|
||
JUMPLE A,CPOPJ
|
||
ADDI B,1(P) ; POINT TO DOPE
|
||
CAME B,PGROW ; BLOWN?
|
||
ADDI B,PDLBUF ; NOPE, POIN TO REAL D.W.
|
||
ADDI A,63.
|
||
ASH A,-6 ; TO 64 WRD BLOCKS
|
||
CAILE A,377 ; IN RANGE?
|
||
JRST OUTRNG
|
||
DPB A,[111100,,-1(B)]
|
||
AOJA C,CPOPJ
|
||
|
||
; SET FREMIN
|
||
|
||
SFREM: SKIPE A ; DON'T ZERO EMPTY PARAMETER
|
||
MOVEM A,FREMIN
|
||
POPJ P,
|
||
|
||
; SET LVAL INCREMENT
|
||
|
||
SLVL: IMULI A,6 ; CALCULATE AMOUNT TO GROW B
|
||
MOVEI B,LVLINC
|
||
PUSHJ P,NUMADJ
|
||
MOVEM A,LVLINC
|
||
POPJ P,
|
||
|
||
; SET GVAL INCREMENT
|
||
|
||
SGVL: IMULI A,4. ; # OF SLOTS
|
||
MOVEI B,GVLINC
|
||
PUSHJ P,NUMADJ
|
||
MOVEM A,GVLINC
|
||
POPJ P,
|
||
|
||
; SET TYPE INCREMENT
|
||
|
||
STYP: IMULI A,2 ; CALCULATE NUMBER OF GROW BLOCKS NEEDED
|
||
MOVEI B,TYPIC
|
||
PUSHJ P,NUMADJ
|
||
MOVEM A,TYPIC
|
||
POPJ P,
|
||
|
||
; SET STORAGE INCREMENT
|
||
|
||
SSTO: IDIVI A,2000 ; # OF BLOCKS
|
||
CAIE B,0 ; REMAINDER?
|
||
ADDI A,1
|
||
IMULI A,2000 ; CONVERT BACK TO WORDS
|
||
MOVEM A,STORIC
|
||
POPJ P,
|
||
; HERE FOR MINIMUM PURE SPACE
|
||
|
||
PUMIN: ADDI A,1777
|
||
ANDCMI A,1777 ; TO PAGE BOUNDRY
|
||
MOVEM A,PURMIN
|
||
POPJ P,
|
||
|
||
; HERE TO ADJUST PSTACK PARAMETERS IN GC
|
||
|
||
PMUNG: ADDI A,777 ; TO NEAREST 1000 WORD BOUNDRY
|
||
ANDCMI A,777
|
||
MOVEM A,PGOOD ; PGOOD
|
||
ASH A,2 ; PMAX IS 4*PGOOD
|
||
MOVEM A,PMAX
|
||
ASH A,-4 ; PMIN IS .25*PGOOD
|
||
MOVEM A,PMIN
|
||
|
||
; HERE TO ADJUST GC TPSTACK PARAMS
|
||
|
||
TPMUNG: ADDI A,777
|
||
ANDCMI A,777 ; TO NEAREST 1000 WORD BOUNDRY
|
||
MOVEM A,TPGOOD
|
||
ASH A,2 ; TPMAX= 4*TPGOOD
|
||
MOVEM A,TPMAX
|
||
ASH A,-4 ; TPMIN= .25*TPGOOD
|
||
MOVEM A,TPMIN
|
||
|
||
|
||
; GET NEXT (FIX) ARG
|
||
|
||
NXTFIX: PUSHJ P,GETFIX
|
||
ADD AB,C%22
|
||
POPJ P,
|
||
|
||
; ROUTINE TO GET POS FIXED ARG
|
||
|
||
GETFIX: GETYP A,(AB)
|
||
CAIE A,TFIX
|
||
JRST WRONGT
|
||
SKIPGE A,1(AB)
|
||
JRST BADNUM
|
||
POPJ P,
|
||
|
||
|
||
; GET NUMBERS FIXED UP FOR GROWTH FIELDS
|
||
|
||
NUMADJ: ADDI A,77 ; ROUND UP
|
||
ANDCMI A,77 ; KILL CRAP
|
||
MOVE 0,A
|
||
MOVNS A ; COMPUTE ADD FACTOR FOR SPEC. POINTER UPDATE
|
||
HRLI A,-1(A)
|
||
MOVEM A,(B) ; AND STASH IT
|
||
MOVE A,0
|
||
ASH A,-6 ; TO 64 WD BLOCKS
|
||
CAILE A,377 ; CHECK FIT
|
||
JRST OUTRNG
|
||
POPJ P,
|
||
|
||
; DO SYMPATHETIC GROWTHS
|
||
|
||
SGROW1: HLRE 0,D
|
||
SUB D,0
|
||
DPB A,[111100,,(D)]
|
||
POPJ P,
|
||
|
||
;FUNCTION TO CONSTRUCT A LIST
|
||
|
||
MFUNCTION CONS,SUBR
|
||
|
||
ENTRY 2
|
||
GETYP A,2(AB) ;GET TYPE OF 2ND ARG
|
||
CAIE A,TLIST ;LIST?
|
||
JRST WTYP2 ;NO , COMPLAIN
|
||
MOVE C,(AB) ; GET THING TO CONS IN
|
||
MOVE D,1(AB)
|
||
HRRZ E,3(AB) ; AND LIST
|
||
PUSHJ P,ICONS ; INTERNAL CONS
|
||
JRST FINIS
|
||
|
||
; COMPILER CALL TO CONS
|
||
|
||
C1CONS: PUSHJ P,ICELL2
|
||
JRST ICONS2
|
||
ICONS4: HRRI C,(E)
|
||
ICONS3: MOVEM C,(B) ; AND STORE
|
||
MOVEM D,1(B)
|
||
TLPOPJ: MOVSI A,TLIST
|
||
POPJ P,
|
||
|
||
; INTERNAL CONS--ICONS; C,D VALUE, E CDR
|
||
|
||
; RELATIVIZE RETURN ADDRESS HERE--MUST BE DIFFERENT FROM ICONS, SINCE
|
||
; ICONS IS CALLED FROM INTERPRETER ENTRIES WHICH ARE THEMSELVES PUSHJ'ED
|
||
; TO: DOING SUBM M,(P) ANYWHERE IN ICONS IS FATAL IF A GC OCCURS.
|
||
|
||
CICONS: SUBM M,(P)
|
||
PUSHJ P,ICONS
|
||
JRST MPOPJ
|
||
|
||
; INTERNAL CONS TO NIL--INCONS
|
||
|
||
INCONS: MOVEI E,0
|
||
|
||
ICONS: GETYP A,C ; CHECK TYPE OF VAL
|
||
PUSHJ P,NWORDT ; # OF WORDS
|
||
SOJN A,ICONS1 ; JUMP IF DEFERMENT NEEDED
|
||
PUSHJ P,ICELL2 ; NO DEFER, GET 2 WORDS FROM PAIR SPACE
|
||
JRST ICNS2A ; NO CORE, GO GC (SPECIAL PLACE, NOTICE)
|
||
JRST ICONS4
|
||
|
||
; HERE IF CONSING DEFERRED
|
||
|
||
ICONS1: MOVEI A,4 ; NEED 4 WORDS
|
||
PUSHJ P,ICELL ; GO GET 'EM
|
||
JRST ICNS2A ; NOT THERE, GC (SAME PLACE AS FOR ICONS)
|
||
HRLI E,TDEFER ; CDR AND DEFER
|
||
MOVEM E,(B) ; STORE
|
||
MOVEI E,2(B) ; POINT E TO VAL CELL
|
||
HRRZM E,1(B)
|
||
MOVEM C,(E) ; STORE VALUE
|
||
MOVEM D,1(E)
|
||
JRST TLPOPJ
|
||
|
||
|
||
|
||
; HERE TO GC ON A CONS
|
||
|
||
; HERE FROM C1CONS
|
||
ICONS2: SUBM M,(P)
|
||
PUSHJ P,ICONSG
|
||
SUBM M,(P)
|
||
JRST C1CONS
|
||
|
||
; HERE FROM ICONS (THUS CICONS, INDIRECTLY), ICONS1
|
||
ICNS2A: PUSHJ P,ICONSG
|
||
JRST ICONS
|
||
|
||
; REALLY DO GC
|
||
ICONSG: PUSH TP,C ; SAVE VAL
|
||
PUSH TP,D
|
||
PUSH TP,$TLIST
|
||
PUSH TP,E ; SAVE VITAL STUFF
|
||
ADDM A,GETNUM ; AMOUNT NEEDED
|
||
MOVE C,[3,,1] ; INDICATOR FOR AGC
|
||
PUSHJ P,INQAGC ; ATTEMPT TO WIN
|
||
MOVE D,-2(TP) ; RESTORE VOLATILE STUFF
|
||
MOVE C,-3(TP)
|
||
MOVE E,(TP)
|
||
SUB TP,C%44 ; [4,,4]
|
||
POPJ P, ; BACK TO DRAWING BOARD
|
||
|
||
; SUBROUTINE TO ALLOCATE WORDS IN PAIR SPACE. CALLS AGC IF NEEDED
|
||
|
||
CELL2: MOVEI A,2 ; USUAL CASE
|
||
CELL: PUSHJ P,ICELL ; INTERNAL
|
||
JRST .+2 ; LOSER
|
||
POPJ P,
|
||
|
||
ADDM A,GETNUM ; AMOUNT REQUIRED
|
||
PUSH P,A ; PREVENT AGC DESTRUCTION
|
||
MOVE C,[3,,1] ; INDICATOR FOR AGC
|
||
PUSHJ P,INQAGC
|
||
POP P,A
|
||
JRST CELL ; AND TRY AGAIN
|
||
|
||
; INTERNAL CELL GETTER, SKIPS IF ROO EXISTS, ELSE DOESN'T
|
||
|
||
ICELL2: MOVEI A,2 ; MOST LIKELY CAE
|
||
ICELL: SKIPE B,RCL
|
||
JRST ICELRC ;SEE IF WE CAN RE-USE A RECYCLE CELL
|
||
MOVE B,PARTOP ; GET TOP OF PAIRS
|
||
ADDI B,(A) ; BUMP
|
||
CAMLE B,FRETOP ; SKIP IF OK.
|
||
JRST VECTRY ; LOSE
|
||
EXCH B,PARTOP ; SETUP NEW PARTOP AND RETURN POINTER
|
||
ADDM A,USEFRE
|
||
JRST CPOPJ1 ; SKIP RETURN
|
||
|
||
; TRY RECYCLING USING A VECTOR FROM RCLV
|
||
|
||
VECTRY: SKIPN B,RCLV ; SKIP IF VECTOR EXISTS
|
||
POPJ P,
|
||
PUSH P,C
|
||
PUSH P,A
|
||
MOVEI C,RCLV
|
||
VECTR1: HLRZ A,(B) ; GET LENGTH
|
||
SUB A,(P)
|
||
JUMPL A,NXTVEC ; DOESN'T SATISFY TRY AGAIN
|
||
CAIN A,1 ; MAKE SURE NOT LEFT WITH A SINGLE SLOT
|
||
JRST NXTVEC
|
||
JUMPN A,SOML ; SOME ARE LEFT
|
||
HRRZ A,(B)
|
||
HRRM A,(C)
|
||
HLRZ A,(B)
|
||
SETZM (B)
|
||
SETZM -1(B) ; CLEAR DOPE WORDS
|
||
SUBI B,-1(A)
|
||
POP P,A ; CLEAR STACK
|
||
POP P,C
|
||
JRST CPOPJ1
|
||
SOML: HRLM A,(B) ; SMASH AMOUNT LEFT
|
||
SUBI B,-1(A) ; GET TO BEGINNING
|
||
SUB B,(P)
|
||
POP P,A
|
||
POP P,C
|
||
JRST CPOPJ1
|
||
NXTVEC: MOVEI C,(B)
|
||
HRRZ B,(B) ; GET NEXT
|
||
JUMPN B,VECTR1
|
||
POP P,A
|
||
POP P,C
|
||
POPJ P,
|
||
|
||
ICELRC: CAIE A,2
|
||
JRST ICELL+2 ;IF HE DOESNT WANT TWO, USE OLD METHOD
|
||
PUSH P,A
|
||
MOVE A,(B)
|
||
HRRZM A,RCL
|
||
POP P,A
|
||
SETZM (B) ;GIVE HIM A CLEAN RECYCLED CELL
|
||
SETZM 1(B)
|
||
JRST CPOPJ1 ;THAT IT
|
||
|
||
|
||
;FUNCTION TO BUILD A LIST OF MANY ELEMENTS
|
||
|
||
IMFUNCTION LIST,SUBR
|
||
ENTRY
|
||
|
||
PUSH P,$TLIST
|
||
LIST12: HLRE A,AB ;GET -NUM OF ARGS
|
||
PUSH TP,$TAB
|
||
PUSH TP,AB
|
||
MOVNS A ;MAKE IT +
|
||
JUMPE A,LISTN ;JUMP IF 0
|
||
SKIPE RCL ;SEE IF WE WANT TO DO ONE AT A TIME
|
||
JRST LST12R ;TO GET RECYCLED CELLS
|
||
PUSHJ P,CELL ;GET NUMBER OF CELLS
|
||
PUSH TP,(P) ;SAVE IT
|
||
PUSH TP,B
|
||
SUB P,C%11
|
||
LSH A,-1 ;NUMBER OF REAL LIST ELEMENTS
|
||
|
||
CHAINL: ADDI B,2 ;LOOP TO CHAIN ELEMENTS
|
||
HRRZM B,-2(B) ;CHAIN LAST ONE TO NEXT ONE
|
||
SOJG A,.-2 ;LOOP TIL ALL DONE
|
||
CLEARM B,-2(B) ;SET THE LAST CDR TO NIL
|
||
|
||
; NOW LOBEER THE DATA IN TO THE LIST
|
||
|
||
MOVE D,AB ; COPY OF ARG POINTER
|
||
MOVE B,(TP) ;RESTORE LIS POINTER
|
||
LISTLP: GETYP A,(D) ;GET TYPE
|
||
PUSHJ P,NWORDT ;GET NUMBER OF WORDS
|
||
SOJN A,LDEFER ;NEED TO DEFER POINTER
|
||
GETYP A,(D) ;NOW CLOBBER ELEMENTS
|
||
HRLM A,(B)
|
||
MOVE A,1(D) ;AND VALUE..
|
||
MOVEM A,1(B)
|
||
LISTL2: HRRZ B,(B) ;REST B
|
||
ADD D,C%22 ;STEP ARGS
|
||
JUMPL D,LISTLP
|
||
|
||
POP TP,B
|
||
POP TP,A
|
||
SUB TP,C%22 ; CLEANUP STACK
|
||
JRST FINIS
|
||
|
||
|
||
LST12R: ASH A,-1 ;ONE AT A TIME TO GET RECYCLED CELLS
|
||
JUMPE A,LISTN
|
||
PUSH P,A ;SAVE COUNT ON STACK
|
||
SETZM E
|
||
SETZB C,D
|
||
PUSHJ P,ICONS
|
||
MOVE E,B ;LOOP AND CHAIN TOGETHER
|
||
SOSLE (P)
|
||
JRST .-4
|
||
PUSH TP,-1(P) ;PUSH ON THE TYPE WE WANT
|
||
PUSH TP,B
|
||
SUB P,C%22 ;CLEAN UP AFTER OURSELVES
|
||
JRST LISTLP-2 ;AND REJOIN MAIN STREAM
|
||
|
||
|
||
; MAKE A DEFERRED POINTER
|
||
|
||
LDEFER: PUSH TP,$TLIST ;SAVE CURRENT POINTER
|
||
PUSH TP,B
|
||
MOVEM D,1(TB) ; SAVE ARG HACKER
|
||
PUSHJ P,CELL2
|
||
MOVE D,1(TB)
|
||
GETYPF A,(D) ;GET FULL DATA
|
||
MOVE C,1(D)
|
||
MOVEM A,(B)
|
||
MOVEM C,1(B)
|
||
MOVE C,(TP) ;RESTORE LIST POINTER
|
||
MOVEM B,1(C) ;AND MAKE THIS BE THE VALUE
|
||
MOVSI A,TDEFER
|
||
HLLM A,(C) ;AND STORE IT
|
||
MOVE B,C
|
||
SUB TP,C%22
|
||
JRST LISTL2
|
||
|
||
LISTN: MOVEI B,0
|
||
POP P,A
|
||
JRST FINIS
|
||
|
||
; BUILD A FORM
|
||
|
||
IMFUNCTION FORM,SUBR
|
||
|
||
ENTRY
|
||
|
||
PUSH P,$TFORM
|
||
JRST LIST12
|
||
|
||
; COMPILERS CALLS TO FORM AND LIST A/ COUNT ELEMENTS ON STACK
|
||
|
||
IILIST: SUBM M,(P)
|
||
PUSHJ P,IILST
|
||
MOVSI A,TLIST
|
||
JRST MPOPJ
|
||
|
||
IIFORM: SUBM M,(P)
|
||
PUSHJ P,IILST
|
||
MOVSI A,TFORM
|
||
JRST MPOPJ
|
||
|
||
IILST: JUMPE A,IILST0 ; NIL WHATSIT
|
||
PUSH P,A
|
||
MOVEI E,0
|
||
IILST1: POP TP,D
|
||
POP TP,C
|
||
PUSHJ P,ICONS ; CONS 'EM UP
|
||
MOVEI E,(B)
|
||
SOSE (P) ; COUNT
|
||
JRST IILST1
|
||
|
||
SUB P,C%11
|
||
POPJ P,
|
||
|
||
IILST0: MOVEI B,0
|
||
POPJ P,
|
||
|
||
;FUNCTION TO BUILD AN IMPLICIT LIST
|
||
|
||
MFUNCTION ILIST,SUBR
|
||
ENTRY
|
||
PUSH P,$TLIST
|
||
ILIST2: JUMPGE AB,TFA ;NEED AT LEAST ONE ARG
|
||
CAMGE AB,C%M40 ; [-4,,0] ; NO MORE THAN TWO ARGS
|
||
JRST TMA
|
||
PUSHJ P,GETFIX ; GET POS FIX #
|
||
JUMPE A,LISTN ;EMPTY LIST ?
|
||
CAML AB,C%M20 ; [-2,,0] ;ONLY ONE ARG?
|
||
JRST LOSEL ;YES
|
||
PUSH P,A ;SAVE THE CURRENT VALUE OF LENGTH FOR LOOP ITERATION
|
||
ILIST0: PUSH TP,2(AB)
|
||
PUSH TP,(AB)3
|
||
MCALL 1,EVAL
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
SOSLE (P)
|
||
JRST ILIST0
|
||
POP P,C
|
||
ILIST1: MOVE C,(AB)+1 ;REGOBBLE LENGTH
|
||
ACALL C,LIST
|
||
ILIST3: POP P,A ; GET FINAL TYPE
|
||
JRST FINIS
|
||
|
||
|
||
LOSEL: PUSH P,A ; SAVE COUNT
|
||
MOVEI E,0
|
||
|
||
LOSEL1: SETZB C,D ; TLOSE,,0
|
||
PUSHJ P,ICONS
|
||
MOVEI E,(B)
|
||
SOSLE (P)
|
||
JRST LOSEL1
|
||
|
||
SUB P,C%11
|
||
JRST ILIST3
|
||
|
||
; IMPLICIT FORM
|
||
|
||
MFUNCTION IFORM,SUBR
|
||
|
||
ENTRY
|
||
PUSH P,$TFORM
|
||
JRST ILIST2
|
||
|
||
; IVECTOR AND IUVECTOR--GET VECTOR AND UVECTOR OF COMPUTED VALUES
|
||
|
||
MFUNCTION VECTOR,SUBR,[IVECTOR]
|
||
|
||
MOVEI C,1
|
||
JRST VECTO3
|
||
|
||
MFUNCTION UVECTOR,SUBR,[IUVECTOR]
|
||
|
||
MOVEI C,0
|
||
VECTO3: ENTRY
|
||
JUMPGE AB,TFA ; AT LEAST ONE ARG
|
||
CAMGE AB,C%M40 ; [-4,,0] ; NOT MORE THAN 2
|
||
JRST TMA
|
||
PUSHJ P,GETFIX ; GET A POS FIXED NUMBER
|
||
LSH A,(C) ; A-> NUMBER OF WORDS
|
||
PUSH P,C ; SAVE FOR LATER
|
||
PUSHJ P,IBLOCK ; GET BLOCK (TURN ON BIT APPROPRIATELY)
|
||
POP P,C
|
||
HLRE A,B ; START TO
|
||
SUBM B,A ; FIND DOPE WORD
|
||
MOVSI D,.VECT. ; FOR GCHACK
|
||
IORM D,(A)
|
||
JUMPE C,VECTO4
|
||
MOVSI D,400000 ; GET NOT UNIFORM BIT
|
||
IORM D,(A) ; INTO DOPE WORD
|
||
SKIPA A,$TVEC ; GET TYPE
|
||
VECTO4: MOVSI A,TUVEC
|
||
CAML AB,C%M20 ; [-2,,0] ; SKIP IF ARGS NEED TO BE HACKED
|
||
JRST FINIS
|
||
JUMPGE B,FINIS ; DON'T EVAL FOR EMPTY CASE
|
||
|
||
PUSH TP,A ; SAVE THE VECTOR
|
||
PUSH TP,B
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
|
||
JUMPE C,UINIT
|
||
JUMPGE B,FINIS ; EMPTY VECTOR, LEAVE
|
||
INLP: PUSHJ P,IEVAL ; EVAL EXPR
|
||
MOVEM A,(C)
|
||
MOVEM B,1(C)
|
||
ADD C,C%22 ; BUMP VECTOR
|
||
MOVEM C,(TP)
|
||
JUMPL C,INLP ; IF MORE DO IT
|
||
|
||
GETVEC: MOVE A,-3(TP)
|
||
MOVE B,-2(TP)
|
||
SUB TP,C%44 ; [4,,4]
|
||
JRST FINIS
|
||
|
||
; HERE TO FILL UP A UVECTOR
|
||
|
||
UINIT: PUSHJ P,IEVAL ; HACK THE 1ST VALUE
|
||
GETYP A,A ; GET TYPE
|
||
PUSH P,A ; SAVE TYPE
|
||
PUSHJ P,NWORDT ; SEE IF IT CAN BE UNIFORMED
|
||
SOJN A,CANTUN ; COMPLAIN
|
||
STJOIN: MOVE C,(TP) ; RESTORE POINTER
|
||
ADD C,1(AB) ; POINT TO DOPE WORD
|
||
MOVE A,(P) ; GET TYPE
|
||
HRLZM A,(C) ; STORE IN D.W.
|
||
MOVSI D,.VECT. ; FOR GCHACK
|
||
IORM D,(C)
|
||
MOVE C,(TP) ; GET BACK VECTOR
|
||
SKIPE 1(AB)
|
||
JRST UINLP1 ; START FILLING UV
|
||
JRST GETVE1
|
||
|
||
UINLP: MOVEM C,(TP) ; SAVE PNTR
|
||
PUSHJ P,IEVAL ; EVAL THE EXPR
|
||
GETYP A,A ; GET EVALED TYPE
|
||
CAIE A,@(P) ; WINNER?
|
||
JRST WRNGSU ; SERVICE ERROR FOR UVECTOR,STORAGE
|
||
UINLP1: MOVEM B,(C) ; STORE
|
||
AOBJN C,UINLP
|
||
GETVE1: SUB P,C%11
|
||
JRST GETVEC ; AND RETURN VECTOR
|
||
|
||
IEVAL: PUSH TP,2(AB)
|
||
PUSH TP,3(AB)
|
||
MCALL 1,EVAL
|
||
MOVE C,(TP)
|
||
POPJ P,
|
||
|
||
; ISTORAGE -- GET STORAGE OF COMPUTED VALUES
|
||
|
||
MFUNCTION ISTORAGE,SUBR
|
||
ENTRY
|
||
JUMPGE AB,TFA
|
||
CAMGE AB,C%M40 ; [-4,,0] ; AT LEAST ONE ARG
|
||
JRST TMA
|
||
PUSHJ P,GETFIX ; POSITIVE COUNT FIRST ARG
|
||
PUSHJ P,CAFRE ; GET CORE
|
||
MOVN B,1(AB) ; -COUNT
|
||
HRL A,B ; PUT IN LHW (A)
|
||
MOVM B,B ; +COUNT
|
||
HRLI B,2(B) ; LENGTH + 2
|
||
ADDI B,(A) ; MAKE POINTER TO DOPE WORDS
|
||
HLLZM B,1(B) ; PUT TOTAL LENGTH IN 2ND DOPE
|
||
HRRM A,1(B) ; PUT ADDRESS IN RHW (STORE DOES THIS TOO).
|
||
MOVE B,A
|
||
MOVSI A,TSTORAGE
|
||
CAML AB,C%M20 ; [-2,,0] ; SECOND ARG TO EVAL?
|
||
JRST FINIS ; IF NOT, RETURN EMPTY
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSHJ P,IEVAL ; EVALUATE FOR FIRST VALUE
|
||
GETYP A,A
|
||
PUSH P,A ; FOR COMPARISON LATER
|
||
PUSHJ P,SAT
|
||
CAIN A,S1WORD
|
||
JRST STJOIN ;TREAT LIKE A UVECTOR
|
||
; IF NOT 1-WORD TYPES, CANNOT STORE, SO COMPLAIN
|
||
PUSHJ P,FREESV ; FREE STORAGE VECTOR
|
||
ERRUUO EQUOTE DATA-CANT-GO-IN-STORAGE
|
||
|
||
; FOR STORAGE, MUST FREE THE CORE ELSE IT IS LOST (NO GC)
|
||
FREESV: MOVE A,1(AB) ; GET COUNT
|
||
ADDI A,2 ; FOR DOPE
|
||
HRRZ B,(TP) ; GET ADDRESS
|
||
PUSHJ P,CAFRET ; FREE THE CORE
|
||
POPJ P,
|
||
|
||
|
||
; INTERNAL VECTOR ALLOCATOR. A/SIZE OF VECTOR (NOT INCLUDING DOPE WORDS)
|
||
|
||
IBLOK1: ASH A,1 ; TIMES 2
|
||
GIBLOK: TLOA A,400000 ; FUNNY BIT
|
||
IBLOCK: TLZ A,400000 ; NO BIT ON
|
||
TLO A,.VECT. ; TURN ON BIT FOR GCHACK
|
||
ADDI A,2 ; COMPENSATE FOR DOPE WORDS
|
||
IBLOK2: SKIPE B,RCLV ; ANY TO RECYCLE?
|
||
JRST RCLVEC
|
||
NORCL: MOVE B,GCSTOP ; POINT TO BOTTOM OF SPACE
|
||
PUSH P,B ; SAVE TO BUILD PTR
|
||
ADDI B,(A) ; ADD NEEDED AMOUNT
|
||
CAML B,FRETOP ; SKIP IF NO GC NEEDED
|
||
JRST IVECT1
|
||
MOVEM B,GCSTOP ; WIN, GET POINTER TO BLOCK AND UPDATE VECBOT
|
||
ADDM A,USEFRE
|
||
HRRZS USEFRE
|
||
HRLZM A,-1(B) ; STORE LENGTH IN DOPE WORD
|
||
HLLZM A,-2(B) ; AND BIT
|
||
HRRM B,-1(B) ; SMASH IN RELOCATION
|
||
SOS -1(B)
|
||
POP P,B ; RESTORE PTR TO BOTTOM OF VECTOR
|
||
HRROS B ; POINT TO START OF VECTOR
|
||
TLC B,-3(A) ; SETUP COUNT
|
||
HRRI A,TVEC
|
||
SKIPL A
|
||
HRRI A,TUVEC
|
||
MOVSI A,(A)
|
||
POPJ P,
|
||
|
||
; HERE TO DO A GC ON A VECTOR ALLOCATION
|
||
|
||
IVECT1: PUSH P,0
|
||
PUSH P,A ; SAVE DESIRED LENGTH
|
||
HRRZ 0,A
|
||
ADDM 0,GETNUM ; AND STORE AS DESIRED AMOUNT
|
||
MOVE C,[4,,1] ; GET INDICATOR FOR AGC
|
||
PUSHJ P,INQAGC
|
||
POP P,A
|
||
POP P,0
|
||
POP P,B
|
||
JRST IBLOK2
|
||
|
||
|
||
; INTERNAL EVECTOR (CALLED FROM READ) A/ #OF THINGS
|
||
; ITEMS ON TOP OF STACK
|
||
|
||
IEVECT: ASH A,1 ; TO NUMBER OF WORDS
|
||
PUSH P,A
|
||
PUSHJ P,IBLOCK ; GET VECTOR
|
||
HLRE D,B ; FIND DW
|
||
SUBM B,D ; A POINTS TO DW
|
||
MOVSI 0,400000+.VECT.
|
||
MOVEM 0,(D) ; CLOBBER NON UNIF BIT
|
||
POP P,A ; RESTORE COUNT
|
||
JUMPE A,IVEC1 ; 0 LNTH, DONE
|
||
MOVEI C,(TP) ; BUILD BLT
|
||
SUBI C,(A)-1 ; C POINTS TO 1ST ITEM ON STACK
|
||
MOVSI C,(C)
|
||
HRRI C,(B) ; B/ SOURCE,,DEST
|
||
BLT C,-1(D) ; XFER THE DATA
|
||
HRLI A,(A)
|
||
SUB TP,A ; FLUSH STACKAGE
|
||
IVEC1: MOVSI A,TVEC
|
||
POPJ P,
|
||
|
||
|
||
; COMPILERS CALL
|
||
|
||
CIVEC: SUBM M,(P)
|
||
PUSHJ P,IEVECT
|
||
JRST MPOPJ
|
||
|
||
|
||
; INTERNAL CALL TO EUVECTOR
|
||
|
||
IEUVEC: PUSH P,A ; SAVE LENGTH
|
||
PUSHJ P,IBLOCK
|
||
MOVE A,(P)
|
||
JUMPE A,IEUVE1 ; EMPTY, LEAVE
|
||
ASH A,1 ; NOW FIND STACK POSITION
|
||
MOVEI C,(TP) ; POINT TO TOP
|
||
MOVE D,B ; COPY VEC POINTER
|
||
SUBI C,-1(A) ; POINT TO 1ST DATUM
|
||
GETYP A,(C) ; CHECK IT
|
||
PUSHJ P,NWORDT
|
||
SOJN A,CANTUN ; WONT FIT
|
||
GETYP E,(C)
|
||
|
||
IEUVE2: GETYP 0,(C) ; TYPE OF EL
|
||
CAIE 0,(E) ; MATCH?
|
||
JRST WRNGUT
|
||
MOVE 0,1(C)
|
||
MOVEM 0,(D) ; CLOBBER
|
||
ADDI C,2
|
||
AOBJN D,IEUVE2 ; LOOP
|
||
TRO E,.VECT.
|
||
HRLZM E,(D) ; STORE UTYPE
|
||
IEUVE1: POP P,A ; GET COUNY
|
||
ASH A,1 ; MUST FLUSH 2 TIMES # OF ELEMENTS
|
||
HRLI A,(A)
|
||
SUB TP,A ; CLEAN UP STACK
|
||
MOVSI A,TUVEC
|
||
POPJ P,
|
||
|
||
; COMPILER'S CALL
|
||
|
||
CIUVEC: SUBM M,(P)
|
||
PUSHJ P,IEUVEC
|
||
JRST MPOPJ
|
||
|
||
IMFUNCTION EVECTOR,SUBR,[VECTOR]
|
||
ENTRY
|
||
HLRE A,AB
|
||
MOVNS A
|
||
PUSH P,A ;SAVE NUMBER OF WORDS
|
||
PUSHJ P,IBLOCK ; GET WORDS
|
||
MOVEI D,-1(B) ; SETUP FOR BLT AND DOPE CLOBBER
|
||
JUMPGE B,FINISV ;DONT COPY A ZERO LENGTH VECTOR
|
||
|
||
HRLI C,(AB) ;START BUILDING BLT POINTER
|
||
HRRI C,(B) ;TO ADDRESS
|
||
ADDI D,@(P) ;SET D TO FINAL ADDRESS
|
||
BLT C,(D)
|
||
FINISV: MOVSI 0,400000+.VECT.
|
||
MOVEM 0,1(D) ; MARK AS GENERAL
|
||
SUB P,C%11
|
||
MOVSI A,TVEC
|
||
JRST FINIS
|
||
|
||
|
||
|
||
;EXPLICIT VECTORS FOR THE UNIFORM CSE
|
||
|
||
IMFUNCTION EUVECTOR,SUBR,[UVECTOR]
|
||
|
||
ENTRY
|
||
HLRE A,AB ;-NUM OF ARGS
|
||
MOVNS A
|
||
ASH A,-1 ;NEED HALF AS MANY WORDS
|
||
PUSH P,A
|
||
JUMPGE AB,EUV1 ; DONT CHECK FOR EMPTY
|
||
GETYP A,(AB) ;GET FIRST ARG
|
||
PUSHJ P,NWORDT ;SEE IF NEEDS EXTRA WORDS
|
||
SOJN A,CANTUN
|
||
EUV1: POP P,A
|
||
PUSHJ P,IBLOCK ; GET VECT
|
||
JUMPGE B,FINISU
|
||
|
||
GETYP C,(AB) ;GET THE FIRST TYPE
|
||
MOVE D,AB ;COPY THE ARG POINTER
|
||
MOVE E,B ;COPY OF RESULT
|
||
|
||
EUVLP: GETYP 0,(D) ;GET A TYPE
|
||
CAIE 0,(C) ;SAME?
|
||
JRST WRNGUT ;NO , LOSE
|
||
MOVE 0,1(D) ;GET GOODIE
|
||
MOVEM 0,(E) ;CLOBBER
|
||
ADD D,C%22 ;BUMP ARGS POINTER
|
||
AOBJN E,EUVLP
|
||
|
||
TRO C,.VECT.
|
||
HRLM C,(E) ;CLOBBER UNIFORM TYPE IN
|
||
FINISU: MOVSI A,TUVEC
|
||
JRST FINIS
|
||
|
||
WRNGSU: GETYP A,-1(TP)
|
||
CAIE A,TSTORAGE
|
||
JRST WRNGUT ;IF UVECTOR
|
||
PUSHJ P,FREESV ;FREE STORAGE VECTOR
|
||
ERRUUO EQUOTE TYPES-DIFFER-IN-STORAGE-OBJECT
|
||
|
||
WRNGUT: ERRUUO EQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR
|
||
|
||
CANTUN: ERRUUO EQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR
|
||
|
||
BADNUM: ERRUUO EQUOTE NEGATIVE-ARGUMENT
|
||
; FUNCTION TO GROW A VECTOR
|
||
REPEAT 0,[
|
||
MFUNCTION GROW,SUBR
|
||
|
||
ENTRY 3
|
||
|
||
MOVEI D,0 ;STACK HACKING FLAG
|
||
GETYP A,(AB) ;FIRST TYPE
|
||
PUSHJ P,SAT ;GET STORAGE TYPE
|
||
GETYP B,2(AB) ;2ND ARG
|
||
CAIE A,STPSTK ;IS IT ASTACK
|
||
CAIN A,SPSTK
|
||
AOJA D,GRSTCK ;YES, WIN
|
||
CAIE A,SNWORD ;UNIFORM VECTOR
|
||
CAIN A,S2NWORD ;OR GENERAL
|
||
GRSTCK: CAIE B,TFIX ;IS 2ND FIXED
|
||
JRST WTYP2 ;COMPLAIN
|
||
GETYP B,4(AB)
|
||
CAIE B,TFIX ;3RD ARG
|
||
JRST WTYP3 ;LOSE
|
||
|
||
MOVEI E,1 ;UNIFORM/GENERAL FLAG
|
||
CAIE A,SNWORD ;SKIP IF UNIFORM
|
||
CAIN A,SPSTK ;DONT SKIP IF UNIFORM PDL
|
||
MOVEI E,0
|
||
|
||
HRRZ B,1(AB) ;POINT TO START
|
||
HLRE A,1(AB) ;GET -LENGTH
|
||
SUB B,A ;POINT TO DOPE WORD
|
||
SKIPE D ;SKIP IF NOT STACK
|
||
ADDI B,PDLBUF ;FUDGE FOR PDL
|
||
HLLZS (B) ;ZERO OUT GROWTH SPECS
|
||
SKIPN A,3(AB) ;ANY TOP GROWTH?
|
||
JRST GROW1 ;NO, LOOK FOR BOTTOM GROWTH
|
||
ASH A,(E) ;MULT BY 2 IF GENERAL
|
||
ADDI A,77 ;ROUND TO NEAREST BLOCK
|
||
ANDCMI A,77 ;CLEAR LOW ORDER BITS
|
||
ASH A,9-6 ;DIVIDE BY 100 AND SHIFT TO POSTION
|
||
TRZE A,400000 ;CONVERT TO SIGN MAGNITUDE
|
||
MOVNS A
|
||
TLNE A,-1 ;SKIP IF NOT TOO BIG
|
||
JRST GTOBIG ;ERROR
|
||
GROW1: SKIPN C,5(AB) ;CHECK LOW GROWTH
|
||
JRST GROW4 ;NONE, SKIP
|
||
ASH C,(E) ;GENRAL FUDGE
|
||
ADDI C,77 ;ROUND
|
||
ANDCMI C,77 ;FUDGE FOR VALUE RETURN
|
||
PUSH P,C ;AND SAVE
|
||
ASH C,-6 ;DIVIDE BY 100
|
||
TRZE C,400 ;CONVERT TO SIGN MAGNITUDE
|
||
MOVNS C
|
||
TDNE C,[-1,,777000] ;CHECK FOR OVERFLOW
|
||
JRST GTOBIG
|
||
GROW2: HLRZ E,1(B) ;GET TOTAL LENGTH OF VECTOR
|
||
MOVNI E,-1(E)
|
||
HRLI E,(E) ;TO BOTH HALVES
|
||
ADDI E,1(B) ;POINTS TO TOP
|
||
SKIPE D ;STACK?
|
||
ADD E,[PDLBUF,,0] ;YES, FUDGE LENGTH
|
||
SKIPL D,(P) ;SHRINKAGE?
|
||
JRST GROW3 ;NO, CONTINUE
|
||
MOVNS D ;PLUSIFY
|
||
HRLI D,(D) ;TO BOTH HALVES
|
||
ADD E,D ;POINT TO NEW LOW ADDR
|
||
GROW3: IORI A,(C) ;OR TOGETHER
|
||
HRRM A,(B) ;DEPOSIT INTO DOPEWORD
|
||
PUSH TP,(AB) ;PUSH TYPE
|
||
PUSH TP,E ;AND VALUE
|
||
SKIPE A ;DON'T GC FOR NOTHING
|
||
MOVE C,[2,,0] ; GET INDICATOR FOR AGC
|
||
PUSHJ P,AGC
|
||
JUMPL A,GROFUL
|
||
POP P,C ;RESTORE GROWTH
|
||
HRLI C,(C)
|
||
POP TP,B ;GET VECTOR POINTER
|
||
SUB B,C ;POINT TO NEW TOP
|
||
POP TP,A
|
||
JRST FINIS
|
||
|
||
GROFUL: SUB P,C%11 ; CLEAN UP STACK
|
||
SUB TP,C%22
|
||
PUSHJ P,FULLOS
|
||
JRST GROW
|
||
|
||
GTOBIG: ERRUUO EQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH
|
||
GROW4: PUSH P,[0] ;0 BOTTOM GROWTH
|
||
JRST GROW2
|
||
]
|
||
FULLOS: ERRUUO EQUOTE NO-STORAGE
|
||
|
||
|
||
; SUBROUTINE TO BUILD CHARACTER STRING GOODIES
|
||
|
||
MFUNCTION BYTES,SUBR
|
||
|
||
ENTRY
|
||
MOVEI D,1
|
||
JUMPGE AB,TFA
|
||
GETYP 0,(AB)
|
||
CAIE 0,TFIX
|
||
JRST WTYP1
|
||
MOVE E,1(AB)
|
||
ADD AB,C%22
|
||
JRST STRNG1
|
||
|
||
IMFUNCTION STRING,SUBR
|
||
|
||
ENTRY
|
||
|
||
MOVEI D,0
|
||
MOVEI E,7
|
||
STRNG1: MOVE B,AB ;COPY ARG POINTER
|
||
MOVEI C,0 ;INITIALIZE COUNTER
|
||
PUSH TP,$TAB ;SAVE A COPY
|
||
PUSH TP,B
|
||
HLRE A,B ; GET # OF ARGS
|
||
MOVNS A
|
||
ASH A,-1 ; 1/2 FOR # OF ARGS
|
||
PUSHJ P,IISTRN
|
||
JRST FINIS
|
||
|
||
IISTRN: PUSH P,E
|
||
JUMPL E,OUTRNG
|
||
CAILE E,36.
|
||
JRST OUTRNG
|
||
SKIPN E,A ; SKIP IF ARGS EXIST
|
||
JRST MAKSTR ; ALL DONE
|
||
|
||
STRIN2: GETYP 0,(B) ;GET TYPE CODE
|
||
CAMN 0,SING(D) ; SINGLE CHARACTER OR FIX?
|
||
AOJA C,STRIN1
|
||
CAME 0,MULTI(D) ; OR STRING OR BYTE-STRING
|
||
JRST WRONGT ;NEITHER
|
||
HRRZ 0,(B) ; GET CHAR COUNT
|
||
ADD C,0 ; AND BUMP
|
||
|
||
STRIN1: ADD B,C%22
|
||
SOJG A,STRIN2
|
||
|
||
; NOW GET THE NECESSARY VECTOR
|
||
|
||
MAKSTR: HRL C,MULTI(D) ; FINAL TYPE,, CHAR COUNT
|
||
PUSH P,C ; SAVE CHAR COUNT
|
||
PUSH P,E ; SAVE ARG COUNT
|
||
MOVEI D,36.
|
||
IDIV D,-2(P) ; A==> BYTES PER WORD
|
||
MOVEI A,(C) ; LNTH+4 TO A
|
||
ADDI A,-1(D)
|
||
IDIVI A,(D)
|
||
LSH E,12.
|
||
MOVE D,-2(P)
|
||
DPB D,[060600,,E]
|
||
HRLM E,-2(P) ; SAVE REMAINDER
|
||
PUSHJ P,IBLOCK
|
||
|
||
POP P,A
|
||
JUMPGE B,DONEC ; 0 LENGTH, NO STRING
|
||
HRLI B,440000 ;CONVERT B TO A BYTE POINTER
|
||
HRRZ 0,-1(P) ; BYTE SIZE
|
||
DPB 0,[300600,,B]
|
||
MOVE C,(TP) ; POINT TO ARGS AGAIN
|
||
|
||
NXTRG1: GETYP D,(C) ;GET AN ARG
|
||
CAIN D,TFIX
|
||
JRST .+3
|
||
CAIE D,TCHRS
|
||
JRST TRYSTR
|
||
MOVE D,1(C) ; GET IT
|
||
IDPB D,B ;AND DEPOSIT IT
|
||
JRST NXTARG
|
||
|
||
TRYSTR: MOVE E,1(C) ;GET BYTER
|
||
HRRZ 0,(C) ;AND COUNT
|
||
NXTCHR: SOJL 0,NXTARG ; IF RUNOUT, GET NEXT ARG
|
||
ILDB D,E ;AND GET NEXT
|
||
IDPB D,B ; AND DEPOSIT SAME
|
||
JRST NXTCHR
|
||
|
||
NXTARG: ADD C,C%22 ;BUMP ARG POINTER
|
||
SOJG A,NXTRG1
|
||
ADDI B,1
|
||
|
||
DONEC: MOVSI C,TCHRS+.VECT.
|
||
TLO B,400000
|
||
HLLM C,(B) ;AND CLOBBER AWAY
|
||
HLRZ C,1(B) ;GET LENGTH BACK
|
||
POP P,A
|
||
SUBI B,-1(C)
|
||
HLL B,(P) ;MAKE A BYTE POINTER
|
||
SUB P,C%11
|
||
POPJ P,
|
||
|
||
SING: TCHRS
|
||
TFIX
|
||
|
||
MULTI: TCHSTR
|
||
TBYTE
|
||
|
||
|
||
; COMPILER'S CALL TO MAKE A STRING
|
||
|
||
CISTNG: TDZA D,D
|
||
|
||
; COMPILERS CALL TO MAKE A BYTE STRING
|
||
|
||
CBYTES: MOVEI D,1
|
||
SUBM M,(P)
|
||
MOVEI C,0 ; INIT CHAR COUNTER
|
||
MOVEI B,(A) ; SET UP STACK POINTER
|
||
ASH B,1 ; * 2 FOR NO. OF SLOTS
|
||
HRLI B,(B)
|
||
SUBM TP,B ; B POINTS TO ARGS
|
||
PUSH P,D
|
||
MOVEI E,7
|
||
JUMPE D,CBYST
|
||
GETYP 0,1(B) ; CHECK BYTE SIZE
|
||
CAIE 0,TFIX
|
||
JRST WRONGT
|
||
MOVE E,2(B)
|
||
ADD B,C%22
|
||
SUBI A,1
|
||
CBYST: ADD B,C%11
|
||
PUSH TP,$TTP
|
||
PUSH TP,B
|
||
PUSHJ P,IISTRN ; MAKE IT HAPPEN
|
||
MOVE TP,(TP) ; FLUSH ARGS
|
||
SUB TP,C%11
|
||
POP P,D
|
||
JUMPE D,MPOPJ
|
||
SUB TP,C%22
|
||
JRST MPOPJ
|
||
|
||
;BUILD IMPLICT STRING
|
||
|
||
MFUNCTION IBYTES,SUBR
|
||
|
||
ENTRY
|
||
|
||
CAML AB,C%M20 ; [-3,,] ; AT LEAST 2
|
||
JRST TFA
|
||
CAMGE AB,C%M60 ; [-7,,] ; NO MORE THAN 3
|
||
JRST TMA
|
||
PUSHJ P,GETFIX ; GET BYTE SIZE
|
||
JUMPL A,OUTRNG
|
||
CAILE A,36.
|
||
JRST OUTRNG
|
||
PUSH P,[TFIX]
|
||
PUSH P,A
|
||
PUSH P,$TBYTE
|
||
ADD AB,C%22
|
||
MOVEM AB,ABSAV(TB)
|
||
JRST ISTR1
|
||
|
||
MFUNCTION ISTRING,SUBR
|
||
|
||
ENTRY
|
||
JUMPGE AB,TFA ; TOO FEW ARGS
|
||
CAMGE AB,C%M40 ; [-4,,0] ; VERIFY NOT TOO MANY ARGS
|
||
JRST TMA
|
||
PUSH P,[TCHRS]
|
||
PUSH P,[7]
|
||
PUSH P,$TCHSTR
|
||
ISTR1: PUSHJ P,GETFIX
|
||
MOVEI C,36.
|
||
IDIV C,-1(P)
|
||
ADDI A,-1(C)
|
||
IDIVI A,(C) ; # OF WORDS NEEDED TO A
|
||
ASH D,12.
|
||
MOVE C,-1(P) ; GET BYTE SIZE
|
||
DPB C,[060600,,D]
|
||
PUSH P,D
|
||
PUSHJ P,IBLOCK
|
||
HLRE C,B ; -LENGTH TO C
|
||
SUBM B,C ; LOCN OF DOPE WORD TO C
|
||
HRLI D,TCHRS+.VECT. ; CLOBBER ITS TYPE
|
||
HLLM D,(C)
|
||
MOVE A,-1(P)
|
||
HRR A,1(AB) ; SETUP TYPE'S RH
|
||
SUBI B,1
|
||
HRL B,(P) ; AND BYTE POINTER
|
||
SUB P,C%33
|
||
SKIPE (AB)+1 ; SKIP IF NO CHARACTERS TO DEPOSIT
|
||
CAML AB,C%M20 ; [-2,,0] ; SKIP IF 2 ARGS GIVEN
|
||
JRST FINIS
|
||
PUSH TP,A ;SAVE OUR STRING
|
||
PUSH TP,B
|
||
PUSH TP,A ;SAVE A TEMPORARY CLOBBER POINTER
|
||
PUSH TP,B
|
||
PUSH P,(AB)1 ;SAVE COUNT
|
||
PUSH TP,(AB)+2
|
||
PUSH TP,(AB)+3
|
||
CLOBST: PUSH TP,-1(TP)
|
||
PUSH TP,-1(TP)
|
||
MCALL 1,EVAL
|
||
GETYP C,A ; CHECK IT
|
||
CAME C,-1(P) ; MUST BE A CHARACTER
|
||
JRST WTYP2
|
||
IDPB B,-2(TP) ;CLOBBER
|
||
SOSLE (P) ;FINISHED?
|
||
JRST CLOBST ;NO
|
||
SUB P,C%22
|
||
SUB TP,C%66
|
||
MOVE A,(TP)+1
|
||
MOVE B,(TP)+2
|
||
JRST FINIS
|
||
|
||
|
||
; HERE TO CHECK TO SEE WHETHER PURE RSUBR'S ARE MAPPED BELOW FRETOP AND
|
||
; PUNT SOME IF THERE ARE.
|
||
|
||
INQAGC: PUSH P,C
|
||
PUSH P,B
|
||
PUSH P,A
|
||
PUSH P,E
|
||
PUSHJ P,SQKIL
|
||
JSP E,CKPUR ; CHECK FOR PURE RSUBR
|
||
POP P,E
|
||
MOVE A,PURTOP
|
||
SUB A,CURPLN
|
||
MOVE B,RFRETP ; GET REAL FRETOP
|
||
CAIL B,(A)
|
||
MOVE B,A ; TOP OF WORLD
|
||
MOVE A,GCSTOP
|
||
ADD A,GETNUM
|
||
ADDI A,1777 ; PAGE BOUNDARY
|
||
ANDCMI A,1777
|
||
CAIL A,(B) ; SEE WHETHER THERE IS ROOM
|
||
JRST GOTOGC
|
||
PUSHJ P,CLEANT
|
||
POP P,A
|
||
POP P,B
|
||
POP P,C
|
||
POPJ P,
|
||
GOTOGC: POP P,A
|
||
POP P,B
|
||
POP P,C ; RESTORE CAUSE INDICATOR
|
||
MOVE A,P.TOP
|
||
PUSHJ P,CLEANT ; CLEAN UP
|
||
SKIPL PLODR ; IF IN PLOAD DON'T INTERRUPT
|
||
JRST INTAGC ; GO CAUSE GARBAGE COLLECT
|
||
JRST SAGC
|
||
|
||
CLEANT: PUSH P,C
|
||
PUSH P,A
|
||
SUB A,P.TOP
|
||
ASH A,-PGSZ
|
||
JUMPE A,CLNT1
|
||
PUSHJ P,GETPAG ; GET THOSE PAGES
|
||
FATAL CAN'T GET PAGES NEEDED
|
||
MOVE A,(P)
|
||
ASH A,-10. ; TO PAGES
|
||
PUSHJ P,P.CORE
|
||
PUSHJ P,SLEEPR
|
||
CLNT1: PUSHJ P,RBLDM
|
||
POP P,A
|
||
POP P,C
|
||
POPJ P,
|
||
|
||
; RCLVEC DISTASTEFUL VECTOR RECYCLER
|
||
|
||
; Arrive here with B pointing to first recycler, A desired length
|
||
|
||
RCLVEC: PUSH P,D ; Save registers
|
||
PUSH P,C
|
||
PUSH P,E
|
||
MOVEI D,RCLV ; Point to previous recycle for splice
|
||
RCLV1: HLRZ C,(B) ; Get size of this block
|
||
CAIL C,(A) ; Skip if too small
|
||
JRST FOUND1
|
||
|
||
RCLV2: MOVEI D,(B) ; Save previous pointer
|
||
HRRZ B,(B) ; Point to next block
|
||
JUMPN B,RCLV1 ; Jump if more blocks
|
||
|
||
POP P,E
|
||
POP P,C
|
||
POP P,D
|
||
JRST NORCL ; Go to normal allocator
|
||
|
||
|
||
FOUND1: CAIN C,1(A) ; Exactly 1 greater?
|
||
JRST RCLV2 ; Cant use this guy
|
||
|
||
HRLM A,(B) ; Smash in new count
|
||
TLO A,.VECT. ; make vector bit be on
|
||
HLLM A,-1(B)
|
||
CAIE C,(A) ; Exactly right length?
|
||
JRST FOUND2 ; No, do hair
|
||
|
||
HRRZ C,(B) ; Point to next block
|
||
HRRM C,(D) ; Smash previous pointer
|
||
HRRM B,(B)
|
||
SUBI B,-1(A) ; Point to top of block
|
||
JRST FOUND3
|
||
|
||
FOUND2: SUBI C,(A) ; Amount of left over to C
|
||
HRRZ E,(B) ; Point to next block
|
||
HRRM B,(B)
|
||
SUBI B,(A) ; Point to dope words of guy to put back
|
||
MOVSM C,(B) ; Smash in count
|
||
MOVSI C,.VECT. ; Get vector bit
|
||
MOVEM C,-1(B) ; Make sure it is a vector
|
||
HRRM B,(D) ; Splice him in
|
||
HRRM E,(B) ; And the next guy also
|
||
ADDI B,1 ; Point to start of vector
|
||
|
||
FOUND3: HRROI B,(B) ; Make an AOBJN pointer
|
||
TLC B,-3(A)
|
||
HRRI A,TVEC
|
||
SKIPGE A
|
||
HRRI A,TUVEC
|
||
MOVSI A,(A)
|
||
POP P,E
|
||
POP P,C
|
||
POP P,D
|
||
POPJ P,
|
||
|
||
END
|
||
|