perm filename DDD[LSP,BGB]1 blob
sn#001385 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: 1B0
04600 FOR @' I←1,=31{
04700 1B'I}
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,=32
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
04200
04300 MOVEI FF,0
04400 GCS1: ILDB C,B
04500 JUMPN C,GCS2
04600 DAPZ FF,(A)
04700 LAPZ FF,A
04800 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
00400 EDXX: 0
00500
00600 ED: MOVEI 10,EDXX
00700 JRST (10)
00800
00900 GRINDEF: PUSH P,A
01000 PUSHJ P,ED
01100 POP P,A
01200 JRST 2(10)
01300
01400 EXCISE: JRST TRUE
01500
01600 XLIST
01700 VAR
01800 LIT
01900 LIST
00100 SYSINI: DAC A,NAME+1
00200 SETZM NAME+3
00300 INIT 17
00400 SIXBIT /SYS/
00500 0
00600 JRST AIN.4+1
00700 LOOKUP NAME
00800 JRST AIN.7+1
00900 INPUT [IOWD 1,NAME+3 ;INPOT size of file
01000 0]
01100 HLRO A,NAME+3
01200 POPJ P,
01300
01400 NAME: SIXBIT /LISP/
01500 0
01600 0
01700 0
01800
01900 SYSINP: DAC A,LST
02000 INPUT LST
02100 STATZ 740000
02200 ERR1 AIN.8
02300 RELEASE
02400 POPJ P,
02500
02600 LST: 0
02700 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,
01600
01700 VAR
01800 LIT
02000 INTERN MEMQ,UNBOUN
02100 INTERN EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2
02200 INTERN NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS
02300 INTERN READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL,SOBST
02400 INTERN CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD
02500 INTERN GET,INTERN,REMOB,MAKNAM,GENSYM,FIX,LENGTH,READLIST,PATOM
02600 INTERN LAST,INC,OUTC,FIX1A,NUMVAL,REVERSE,MAPLIST,GC,GETL,PUTPROP
02700 INTERN ERR,MAPCAR,REMPROP,LIST,SETQ,ERRSET,REMOB,ARRAY,APPEND
02800 INTERN SPECBIND,SPECSTR,XCONS,ATOM,READCH,SET,NCONC,PRINC
02900 INTERN CONS,ACONS,CTY,FP7A1,TERPRI,LSPRET,PSAV1,BKTRC
03000 INTERN TYO,ITYO,IGSTRT,NOINFG,CHRTAB
03100 INTERN EVAL,OEVAL,.APPEND,INPOT,OUTPUT