perm filename DD.MAC[LSP,BGB] blob
sn#001398 filedate 1972-11-05 generic text, type T, neo UTF8
00100 SUBTTL GARBAGE COLLECTER --- PAGE 16
00200
00300 GC: PUSHJ P,AGC
00400 JRST FALSE
00500
00600 AGC: DAC R,RGC#
00700 GCPK1: PUSH P,PA3
00800 PUSH P,PA4
00900 PUSH P,UBDPTR ;special atom UNBOUND; not on OBLIST
01000 PUSH P,MKNAM3
01100 PUSH P,GCMKL ;i/o channel INPOT lists and arrays
01200 PUSH P,BIND3
01300 PUSH P,INITF
01400 GCPK2: PUSH P,[XWD 0,GCP6] ;this is a return address
01500
01600 ;save AC 0 thru 10 in (regPDL)+1 thru +11.
01700 lac s,orgPDL
01800 addi s,11
01900 dap s,.+2
02000 subi s,10
02100 blt s,x
02200 ;clear bit tables.
02300 lac a,orgHBT
02400 setzm (a)
02500 hrl a,a
02600 aos a
02700 lac endFBT
02800 dap .+1
02900 blt a,x
03000 setz ;indicate GC on CPU lights.
03100 ;report what is exhausted.
03200 SKIPN GCGAGV
03300 JRST GCP5A
03400 SKIPN F
03500 STRTIP [SIXBIT /←FREE STG EXHAUSTED←!/]
03600 SKIPN FF
03700 STRTIP [SIXBIT /←FULL WORD SPACE EXHAUSTED←!/]
03800 ;mark time of GC entry.
03900 GCP5A: MOVEI TT,1 ;bit for marking.
04000 MOVEI A,0
04100 CALLI A,STIME ;time
04200 MOVNS A
04300 ADDM A,GCTIM#
04400 ;Initialize HBT referances.
04500 lacn A,orgHWS
04600 ash A,-5
04700 add A,orgHBT
04800 aos A
04900 dap A,GCBTP1
05000 dap A,GCBTP2
05100 lac A,orgFBT
05200 dap A,C2GC
00100 ;get a node off the PDL.
00200 GCP3: LAC C,orgPDL ;start at the bottom of the PDL.
00300 GCP6B: LAC S,P
00400 HLL C,P
00500 MOVEI B,0
00600 GC1: CAMN C,S
00700 POPJ P,
00800 LAPZ A,(C)
00900
01000 ;Address Test for within LISP space.
01100 GCP: CAMG A,endFWS
01200 CAMGE A,orgHWS
01300 JRST GCEND
01400 CAMLE A,endHWS
01500 JRST GCMFWS
01600
01700 ;mark a LISP node of the halfword space.
01800 LAC F,(A)
01900 LSHC A,-5
02000 ROT B,5
02100 LAC AR1,GCBT(B)
02200 GCBTP2: TDOE AR1,X(A)
02300 JRST GCEND
02400 GCBTP1: DAC AR1,X(A)
02500 PUSH P,F
02600 LIPZ A,F
02700 JRST GCP
02800
02900 ;mark a full word.
03000 GCMFWS: LAC AR1,A
03100 SUB AR1,orgFWS
03200 IDIVI AR1,44
03300 MOVNS AR2A
03400 LSH AR2A,36
03500 ADD AR2A,C2GC
03600 DPB TT,AR2A
03700 GCEND: CAMN P,S
03800 AOJA C,GC1
03900 POP P,A
04000 HRRZS A
04100 JRST GCP
04200
04300 GCMKL: XWD 0,[XWD [XWD -NIOCH,CHTAB+FSTCH],0]
04400 C2GC: XWD 430100+AR1,X ;.=bottom of fws bit table
04500 GCBT: XWD 400000,0
04600 ZZ==1B1
04700 XLIST
04800 REPEAT ↑D31,<ZZ
04900 ZZ==ZZ/2>
05000 LIST
00100 GCP6: LAPZ R,SC2
00200 GCP6C: CAIL R,(SP) ;mark sp
00300 JRST GCP6A
00400 PUSH P,(R)
00500 LAPZ C,P
00600 PUSHJ P,GCP6B
00700 SUB P,[XWD 1,1]
00800 AOJA R,GCP6C
00900
01000 GCP6A: LAPZ R,GCMKL ;mark arrays
01100 GCP6D: JUMPE R,GCSWP
01200 LIPZ A,(R)
01300 LAC D,(A)
01400 GCP6E: PUSH P,(D)
01500 LAPZ C,P
01600 PUSH P,(D)
01700 MOVSS (P)
01800 PUSHJ P,GCP6B
01900 SUB P,[XWD 2,2]
02000 AOBJN D,GCP6E
02100 LAPZ R,(R)
02200 JRST GCP6D
02300
00100 GFSWPP:
00200 JUMPL S,3 ;0
00300 DAPZ F,(R) ;1 put R on Free List.
00400 LAPZ F,R ;2
00500 LSH S,1 ;3 next bit.
00600 AOBJN R,0 ;4 address next word.
00700 LAC S,(D) ;5 get more bits from HBT.
00800 HRLI R,-40 ;6 set bit counter.
00900 AOBJN D,0 ;7 increm HBT pointer.
01000 JRST X ;10 return from AC's.
01100 ;11 S word from HBT.
01200 ;12 D -wrdcnt,,HBT ptr.
01300 ;13 R -bitcnt,,HWS ptr.
01400 ;14 P
01500 ;15 F free storage list.
01600
01700 ;garbage collector sweep
01800
01900 GCSWP: MOVSI R,GFSWPP
02000 BLT R,10
02100 MOVEI F,NIL ;will become movei f,-1
02200 lacn D,sizHBT
02300 hrlz D,D
02400 lap D,orgHBT
02500
02600 lac R,orgHWS
02700 andi R,37
02800 dap R,GCBTL2
02900 subi R,↑D32
03000 hrlz R,R
03100 lap R,orgHWS
03200 LAC S,(D)
03300 GCBTL2: ROT S,X
03400 hrri 10,.+2
03500 AOBJN D,0
03600
03700 lacn A,sizFWS
03800 movss A
03900 lap A,orgFWS
04000 lac B,endHBT
04100 hrli B,100
04300
04400 MOVEI FF,0
04500 GCS1: ILDB C,B
04600 JUMPN C,GCS2
04700 DAPZ FF,(A)
04800 LAPZ FF,A
04900 GCS2: AOBJN A,GCS1
00100 SKIPN GCGAGV
00200 JRST GCSP1
00300 LAC B,F
00400 PUSHJ P,GCPNT
00500 STRTIP [SIXBIT / FREE STG,!/]
00600 LAC B,FF
00700 PUSHJ P,GCPNT
00800 STRTIP [SIXBIT / FULL WORDS AVAILABLE←!/]
00900 GCSP1: LAPZ S,orgPDL
01000 AOS S
01100 MOVSS s
01200 BLT S,NACS+3 ;reload ac's
01300 SUB P,[XWD GCPK2-GCPK1,GCPK2-GCPK1] ;restore p
01400 JUMPE F,[ERR2 [SIXBIT /NO FREE STG LEFT!/]]
01500 JUMPE FF,[ERR2 [SIXBIT /NO FW STG LEFT!/]]
01600 LAC R,RGC
01700 MOVEI A,0
01800 CALLI A,STIME ;time
01900 ADDM A,GCTIM
02000 POPJ P,
02100
00100 ;Garbage Collector Statistics.
00200
00300 GCGAG: EXCH A,GCGAGV#
00400 POPJ P,
00500
00600 GCTIME: LAC A,GCTIM
00700 JRST FIX1A
00800
00900 TIME: MOVEI A,0
01000 CALLI A,STIME
01100 JRST FIX1A
01200
01300 SPEAK: LAC A,CONSVAL#
01400 JRST FIX1A
01500
01600 GCPNT: MOVEI R,TTYO
01700 MOVEI A,0
01800 JUMPE B,PRINL1
01900 LAPZ B,(B)
02000 AOJA A,.-2
00100 SUBTTL GETSYM --- PAGE 17
00200
00300 R50MAK: PUSHJ P,PNAMUK
00400 PUSH C,[0]
00500 HRLI C,700
00600 HRRI C,(SP)
00700 MOVEI B,0
00800 MK3: ILDB A,C
00900 LDB A,R50FLD
01000 CAMGE B,[50*50*50*50*50]
01100 SKIPN A
01200 POPJ P,
01300 IMULI B,50
01400 ADD B,A
01500 JRST MK3
01600
01700 GETSYM: PUSHJ P,R50MAK
01800 TLO B,040000 ;04 for globals
01900 LAC C,JOBSYM
02000 MK7: CAMN B,(C)
02100 JRST MK10 ;found
02200 AOBJP C,.+2
02300 AOBJN C,MK7
02400 TLC B,140000 ;10 for locals
02500 TLNE B,100000
02600 JRST MK7-1
02700 JRST FALSE
02800
02900 MK10: LAC A,1(C) ;value
03000 JRST FIX1A
03100
03200 PUTSYM: PUSH P,B
03300 PUSHJ P,R50MAK
03400 LAC A,B
03500 TLO A,040000 ;make global
03600 SKIPL JOBSYM
03700 AOS JOBSYM ;increment initial symbol table pointer
03800 MOVN B,[XWD 2,2]
03900 ADDB B,JOBSYM
04000 DAC A,(B) ;name
04100 POP P,1(B) ;value
04200 JRST FALSE
04300
04400 PATCH: BLOCK 200
00100 SUBTTL ALVINE AND LOADER INTERFACES --- PAGE 18
00200
00300 ;interface to alvine
00310 EXTERN EDXX
00400
00500 ED: MOVEI 10,EDXX
00600 JRST (10)
02000
02100 GRINDEF: PUSH P,A
02200 PUSHJ P,ED
02300 POP P,A
02400 JRST 2(10)
02500
02600 EXCISE: JRST TRUE
03400
03500 XLIST
03600 VAR
03700 LIT
03800 LIST
03100 SYSINI: DAC A,NAME+1
03200 SETZM NAME+3
03300 INIT 17
03400 SIXBIT /SYS/
03500 0
03600 JRST AIN.4+1
03700 LOOKUP NAME
03800 JRST AIN.7+1
03900 INPUT [IOWD 1,NAME+3 ;INPOT size of file
04000 0]
04100 HLRO A,NAME+3
04200 POPJ P,
04300
04400 NAME: SIXBIT /LISP/
04500 0
04600 0
04700 0
04800
04900 SYSINP: DAC A,LST
05000 INPUT LST
05100 STATZ 740000
05200 ERR1 AIN.8
05300 RELEASE
05400 POPJ P,
05500
05600 LST: 0
05700 0
00100 ;Size argument taken from A, pointer returned in A.
00200 MORCOR: DAC 0,LISPAC
00300 LAC 0,[XWD 1,LISPAC+1]
00400 BLT 0,LISPAC+17
00500 LAC 3,A
00600 LAC 12,AC12
00700 LAC 16,AC16
00800 LAC 17,AC17
00900 PUSHJ 17,CORGET
01000 OUTSTR[ASCIZ/NO MORE CORE./]
01100 LAC A,2
01200 LAC 0,[XWD LISPAC+2,2]
01300 BLT 0,17
01400 LAC 0,LISPAC
01500 POPJ P,
00100 ;SAIL TO LISP.
00200 INTERN LISP
00300 EXTERN CORGET
00400 ;ACCUMULATOR-2 POINTER TO FIRST WORD OF SAIL MEMORY BLOCK.
00500 ;ACCUMULATOR-3 SIZE OF SAIL MEMORY BLOCK.
00600 LISP: DAC 0,AC0
00700 LAC 0,[XWD 1,AC1]
00800 BLT 0,AC17
00900 LAC 3,-1(17)
01000 PUSHJ 17,CORGET
01100 JFCL
01200 ;JSR ALLOCD ;Allocation dialogue.
01300 OUTSTR [ASCIZ/
01400 /]
01500
01600 ;Bottom, Size & Top of LISP memory space.
01700 lac B,2
01800 lac S,3
01900 lac T,B
02000 addi T,-1(S)
02100
02200 ;Take BPS off the bottom
02300 dac B,orgBPS
02400 add B,sizBPS
02500 dac B,endBPS
02600 sos endBPS
02700 sub S,sizBPS
02800
02900 ;Take SPD off the top.
03000 dac T,endSPD
03100 sub T,sizSPD
03200 dac T,orgSPD
03300 aos orgSPD
03400 sub S,sizSPD
03500
03600 ;Compute FWS size ← 400+S/16.
03700 lac A,S
03800 ash A,-4
03900 addb A,sizFWS
04000
04100 ;Compute FBT size.
04200 idivi A,44
04300 aos A
04400 dac A,sizFBT
04500
04600 ;Compute PDL size.
04700 lac A,S
04800 ash A,-6
04900 addm A,sizPDL
00100 ;Compute size of Halfword Bit Table and Half Word Space.
00200 sub S,sizFBT
00300 sub S,sizFWS
00400 sub S,sizPDL
00500 lac A,S
00600 idivi A,41
00700 aos A
00800 dac A,sizHBT
00900 sub S,A
01000 dac S,sizHWS
01100
01200 ;Take Half Word Space, HWS, off the bottom.
01300 lac T,endBPS
01400 movei B,1(T)
01500 dac B,orgHWS
01600 add B,sizHWS
01700 add T,sizHWS
01800 dac T,endHWS
01900
02000 ;allocate Full Word Space, FWS above HWS.
02100 dac B,orgFWS
02200 add B,sizFWS
02300 add T,sizFWS
02400 dac T,endFWS
02500
02600 ;allocate Halfword Bit Table, HBT above FWS.
02700 dac B,orgHBT
02800 add B,sizHBT
02900 add T,sizHBT
03000 dac T,endHBT
03100
03200 ;allocate Fullword Bit Table, FBT above HBT.
03300 dac B,orgFBT
03400 add B,sizFBT
03500 add T,sizFBT
03600 dac T,endFBT
03700
03800 ;allocate Push Down List, PDL above FBT.
03900 dac B,orgPDL
04000 add B,sizPDL
04100 add T,sizPDL
04200 dac T,endPDL
00100 ;Initialize the values of the BPORG & BPEND atoms.
00200 LAC A,orgBPS
00300 ADDM A,VBPORG ;value of BPORG.
00400 LAC A,endBPS
00500 ADDM A,VBPEND ;value of BPEND.
00600
00700 ;Setup Special PDL pointer.
00800 LACN A,SIZSPD
00900 hrlz A,A
01000 lap A,orgSPD
01100 sos A
01200 dac A,SC2
01300
01400 ;lowest word of PDL holds pointer to OBLIST.
01500 LAC B,orgPDL
01600 LAC A,orgHWS
01700 DAC A,(B)
01800
01900 ;setup regular PDL pointer.
02000 ADDI B,12
02100 DAP B,C2
02200 LACN C,SIZPDL
02300 ADDI C,20
02400 DIP C,C2
02500
02600 ;Fixup references to HWS.
02700 lac FF,orgHWS
02800 subi FF,OBLIST ;HWS displacement.
02900 MOVEI C,FOOLST
03000 REL5: LAC B,(C)
03100 LAPZ A,(B)
03200 ADD A,FF
03300 DAP A,(B)
03400 LIP B,B
03500 LAPZ A,(B)
03600 ADD A,FF
03700 DAP A,(B)
03800 CAIGE C,EFOLST-1
03900 AOJA C,REL5
00100 ;Blit prenatal FWS into its allocated space.
00200
00300 hrli A,BFWS ;from here.
00400 lap A,orgFWS ;to there.
00500 hrrzi B,EFWS-BFWS(A) ;new top+1.
00600 blt A,(B)
00700
00800 ;Move prenatal HWS into its allocated space.
00900
01000 movei F,OBLIST ;from here.
01100 lac T,orgHWS ;to there.
01200 lac B,orgHWS
01300 subi B,OBLIST ;HWS displacement.
01400 lac C,orgFWS
01500 subi C,BFWS ;FWS displacement.
01600
01700 ;Relocate CAR portion of a word.
01800 REL1: lipz A,(F)
01900 caig A,EFWS
02000 caige A,OBLIST
02100 jrst .+5 ; A too high or low.
02200 move D,B ; A ≥ OBLIST.
02300 cail A,BFWS
02400 lac D,C ; A ≥ BFWS.
02500 add A,D
02600 dip A,(T)
02700
02800 ;Relocate CDR portion of a word.
02900 lapz A,(F)
03000 caig A,EFWS
03100 caige A,OBLIST
03200 jrst .+5 ; A too high or low.
03300 move D,B ; A ≥ OBLIST.
03400 cail A,BFWS
03500 lac D,C ; A ≥ BFWS.
03600 add A,D
03700 dap A,(T)
03800
03900 ;advance From and To Pointers.
04000 aos F
04100 caige F,BFWS
04200 aoja T,REL1
04300
04400 setzb F,DDTIFG
04500 JSR IOBRST
04600 JRST START
04700 XLIST
04800 LIT
04900 VAR
05000 LIST
00100 ;The FOO list is for fixing up references to HWS.
00200
00300 I=0
00400 DEFINE GARP (A,B)
00500 <XWD FOO'A,FOO'B>
00600
00700 FOO 0
00800 FOOLST:
00900 XLIST
01000 REPEAT <FOOCNT/2>,<
01100 GARP (\I,\<I+1>)
01200 I=I+2>
01300 LIST
01400
01500 EFOLST:
01600
01700 DEFINE MKENT (A)<
01800 INTERNAL A>
01900
01950 MKENT <MEMQ,UNBOUN>
02000 MKENT <EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2>
02100 MKENT <NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS>
02200 MKENT <READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL,SOBST>
02300 MKENT <CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD>
02400 MKENT <GET,INTERN,REMOB,MAKNAM,GENSYM,FIX,LENGTH,READLIST,PATOM>
02500 MKENT <LAST,INC,OUTC,FIX1A,NUMVAL,REVERSE,MAPLIST,GC,GETL,PUTPROP>
02600 MKENT <ERR,MAPCAR,REMPROP,LIST,SETQ,ERRSET,REMOB,ARRAY,APPEND>
02700 MKENT <SPECBIND,SPECSTR,XCONS,ATOM,READCH,SET,NCONC,PRINC>
02800 MKENT <CONS,ACONS,CTY,FP7A1,TERPRI,LSPRET,PSAV1,BKTRC>
02900 MKENT <TYO,ITYO,IGSTRT,NOINFG,CHRTAB>
03000 MKENT <EVAL,OEVAL,.APPEND,INPOT,OUTPUT>
03100
03200 END