mirror of
https://github.com/PDP-10/its.git
synced 2026-03-02 09:56:20 +00:00
a7399d0f9a
Looking at the backup dates for files in <mdl.int>, mdl106.exe is from 20th January 1981, whereas some of the source files are from a couple of years later. Revert to the last version prior to 20th January 1981 -- in every case, this was the earliest revision that was kept in <mdl.int>. This undoes the changes that we'd previously made to these files, many of which are no longer necessary now that we're using MIDAS 73.
2132 lines
45 KiB
Plaintext
2132 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
|
||
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
|
||
HRLI A,-1(B) ; SMASH IN RELOCATION
|
||
HLRM A,-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
|
||
|