mirror of
https://github.com/PDP-10/its.git
synced 2026-01-25 03:37:00 +00:00
3122c71eb2
The PURIMP routine splits the page map into three parts: writable data at the bottom, a large gap in the middle (which the GC will manage later), and read-only code/data at the top. There's one CORBLK call for each of these. The final call, which gave pages BOT/2000 to 400 as the range, failed with %EROPG when it hit the first unmapped page after the end of the pure data. Experimentation shows that, at least with current ITS, this is how CORBLK normally behaves. Fix by calculating the final page from RHITOP rather than assuming 400.
1374 lines
27 KiB
Plaintext
1374 lines
27 KiB
Plaintext
TITLE INITIALIZATION FOR MUDDLE
|
||
|
||
RELOCATABLE
|
||
|
||
HTVLNT==3000 ; GUESS OF TVP LENGTH
|
||
|
||
LAST==1 ;POSSIBLE CHECKS DONE LATER
|
||
|
||
.INSRT MUDDLE >
|
||
|
||
SYSQ
|
||
XBLT==123000,,
|
||
GCHN==0
|
||
IFE ITS,[
|
||
EXPUNGE .FATAL
|
||
FATINS==.FATAL"
|
||
SEVEC==104000,,204
|
||
.INSRT STENEX >
|
||
]
|
||
|
||
IMPURE
|
||
|
||
OBSIZE==151. ;DEFAULT OBLIST SIZE
|
||
|
||
.LIFL <TVBASE+TVLNT-TVLOC>
|
||
.LOP .VALUE
|
||
.ELDC
|
||
|
||
.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
|
||
.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW
|
||
.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE
|
||
.GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER
|
||
.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR
|
||
.GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1
|
||
.GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR
|
||
.GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS
|
||
.GLOBAL HASHTB,ILOOKC
|
||
|
||
LPUR==.LPUR ; SET UP SO LPUR WORKS
|
||
|
||
; INIITAL AMOUNT OF AFREE SPACE
|
||
|
||
STOSTR:
|
||
LOC TVSTRT-1
|
||
ISTOST: TVSTRT-STOSTR,,0
|
||
|
||
BLOCK HTVLNT ; TVP
|
||
|
||
SETUP: MOVEI 0,0 ; ZERO ACS
|
||
MOVEI 17,1
|
||
BLT 17,17
|
||
|
||
IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT
|
||
MOVE P,GCPDL ;GET A PUSH DOWN STACK
|
||
IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL
|
||
MOVE 0,[TVBASE,,TVSTRT]
|
||
BLT 0,TVSTRT+HTVLNT-3 ; BLT OVER TVP
|
||
IFE ITS, PUSHJ P,TWENTY ; FIND OUT WHETHER IT IS TOPS20 OR NOT
|
||
PUSHJ P,TTYOPE ;OPEN THE TTY
|
||
AOS A,20 ; TOP OF LOW SEGG
|
||
HRRZM A,P.TOP
|
||
SOSN A ; IF NOTHING YET
|
||
IFN ITS, .SUSET [.RMEMT,,P.TOP]
|
||
IFE ITS, JRST 4,
|
||
MOVE A,P.TOP
|
||
SUB A,FRETOP ; SETUP FOR GETTING NEEDED CORE
|
||
SUBI A,3777
|
||
ASH A,-10. ; TO PAGES
|
||
HRLS A ; SET UP AOBJN
|
||
HRRZ 0,P.TOP
|
||
ASH 0,-10.
|
||
SUBI 0,1
|
||
HRR A,0
|
||
IFN ITS,[
|
||
.CALL HIGET ; GET THEM
|
||
FATAL INITM--CORE NOT AVAILABLE FOR INITIALIZATION
|
||
ASH A,10. ; TO WORDS
|
||
MOVEM A,P.TOP
|
||
SUBI A,2000 ; WHERE FRETOP IS
|
||
MOVEM A,FRETOP
|
||
|
||
]
|
||
IFE ITS,[
|
||
MOVE A,FRETOP
|
||
ADDI A,2000
|
||
MOVEM A,P.TOP
|
||
]
|
||
HRRE A,P.TOP ; CHECK TOP
|
||
TRNE A,377777 ; SKIP IF ALL LOW SEG
|
||
JUMPL A,PAGLOS ; COMPLAIN
|
||
MOVE A,HITOP ; FIND HI SEG TOP
|
||
ADDI A,1777
|
||
ANDCMI A,1777
|
||
MOVEM A,RHITOP ; SAVE IT
|
||
MOVEI A,200
|
||
SUBI A,PHIBOT
|
||
JUMPE A,HIBOK
|
||
MOVSI A,(A)
|
||
HRRI A,200
|
||
IFN ITS,[
|
||
.CALL GIVCOR
|
||
.VALUE
|
||
]
|
||
HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION.
|
||
/]
|
||
PUSHJ P,MSGTYP ;PRINT IT
|
||
MOVE A,CODTOP ;CHECK FOR A WINNING LOAD
|
||
CAML A,VECBOT ;IT BETTER BE LESS
|
||
JRST DEATH1 ;LOSE COMPLETELY
|
||
SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR
|
||
MOVEM PVP,PVSTOR+1
|
||
MOVEM PVP,PVSTOR+1-TVSTRT+TVBASE
|
||
MOVEI A,(PVP) ;SET UP A BLT
|
||
HRLI A,PVBASE ;FROM PROTOTYPE
|
||
BLT A,PVLNT*2-1(PVP) ;INITIALIZE
|
||
MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS
|
||
MOVEI TB,(TP) ;AND A BASE
|
||
IFN ITS, HRLI TB,1
|
||
IFE ITS, HRLI TB,400001 ; FOR MULTI SEG HACKING
|
||
SUB TP,[1,,1] ;POP ONCE
|
||
|
||
; FIRST BUILD MOBY HASH TABLE
|
||
|
||
MOVEI A,1023. ; TRY THIS OUT FOR SIZE
|
||
PUSHJ P,IBLOCK
|
||
MOVEM B,HASHTB+1-TVSTRT+TVBASE ; STORE IN TVP POINTER
|
||
HLRE A,B
|
||
SUB B,A
|
||
MOVEI A,TATOM+.VECT.
|
||
HRLM A,(B)
|
||
|
||
; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
|
||
|
||
PUSH P,[5] ;COUNT INITIAL OBLISTS
|
||
|
||
PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE
|
||
|
||
MAKEOB: SOS A,-1(P)
|
||
MOVE A,OBSZ(A)
|
||
MOVEM A,OBLNT
|
||
MCALL 0,MOBLIST ;GOBBLE AN OBLIST
|
||
PUSH TP,$TOBLS ;AND SAVE THEM
|
||
PUSH TP,B
|
||
MOVE A,(P)-1 ;COUNT DOWN
|
||
MOVEM B,@OBTBL(A) ;STORE
|
||
JUMPN A,MAKEOB
|
||
|
||
POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE
|
||
|
||
MOVE C,[-TVLNT+2,,TVBASE]
|
||
MOVE D,[-HTVLNT+2,,TVSTRT]
|
||
|
||
;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
|
||
;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
|
||
|
||
ILOOP: HLRZ A,(C) ;FIRST TYPE
|
||
JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED
|
||
CAIN A,TCHSTR ;CHARACTER STRING?
|
||
JRST CHACK ;YES, GO HACK IT
|
||
CAIN A,TATOM ;ATOM?
|
||
JRST ATOMHK ;YES, CHECK IT OUT
|
||
MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME)
|
||
MOVEM A,(D)
|
||
MOVE A,1(C)
|
||
MOVEM A,1(D)
|
||
SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR
|
||
ADD D,[2,,2] ;OUT COUNTER
|
||
SETLP1: ADD C,[2,,2] ;AND IN COUNTER
|
||
JUMPL C,ILOOP ;JUMP IF MORE TO DO
|
||
|
||
;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
|
||
|
||
TVEXAU: HLRE B,D ; LEFT HALF OF AOBJN
|
||
MOVNI TVP,HTVLNT-2 ; CALCULATE LENGTH OF TVP
|
||
SUB TVP,B ; GET -LENGTH OF TVP IN TVP
|
||
HRLS TVP
|
||
HRRI TVP,TVSTRT ; BUILD A TASTEFUL TVP POINTER
|
||
MOVNI C,TVLNT-HTVLNT+2(B) ; SMASH IN LENGTH INTO END DOPE WORDS
|
||
HRLM C,TVSTRT+HTVLNT-1
|
||
MOVSI E,400000
|
||
MOVEM E,TVSTRT+HTVLNT-2
|
||
HLRE C,TVP
|
||
MOVNI C,-2(C) ; CLOBBER LENGTH INTO REAL TVP
|
||
HLRE B,TVP
|
||
SUBM TVP,B
|
||
MOVEM E,(B)
|
||
HRLM C,1(B) ; PUT IN LENGTH
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM TVP,REALTV+1(PVP)
|
||
|
||
|
||
; FIX UP TYPE VECTOR
|
||
|
||
MOVE A,TYPVEC+1 ;GET POINTER
|
||
MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS
|
||
MOVSI B,TATOM ;SET TYPE TO ATOM
|
||
MOVEI D,400000 ; TYPE CODE HACKS
|
||
|
||
TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM
|
||
MOVE C,@1(A) ;GET ATOM
|
||
HLRE E,C ; FIND DOPE WORD
|
||
SUBM C,E
|
||
HRRM D,(E) ; STUFF INTO ATOM
|
||
MOVEM C,1(A)
|
||
ADDI D,1
|
||
ADD A,[2,,2] ;BUMP
|
||
JUMPL A,TYPLP
|
||
|
||
; CLOSE TTY CHANNELS
|
||
IFN ITS,[
|
||
|
||
.CLOSE 1,
|
||
.CLOSE 2,
|
||
]
|
||
|
||
;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
|
||
|
||
;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
|
||
|
||
IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]]
|
||
IRP B,C,[A]
|
||
PUSH TP,$!C
|
||
PUSH TP,CHQUOTE B
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL
|
||
MOVEM B,TTOCHN+1 ;SAVE IT
|
||
|
||
;ASSIGN AS GLOBAL VALUE
|
||
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE OUTCHAN
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS
|
||
MOVEM A,IOINS(B) ;CLOBBER
|
||
MCALL 2,SETG
|
||
|
||
;SETUP A CALL TO OPEN THE TTY CHANNEL
|
||
|
||
IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]]
|
||
IRP B,C,[A]
|
||
PUSH TP,$!C
|
||
PUSH TP,CHQUOTE B
|
||
.ISTOP
|
||
TERMIN
|
||
TERMIN
|
||
|
||
MCALL 2,FOPEN ;OPEN INPUTCHANNEL
|
||
MOVEM B,TTICHN+1 ;SAVE IT
|
||
PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE
|
||
PUSH TP,IMQUOTE INCHAN
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR
|
||
MOVE A,[PUSHJ P,MTYI]
|
||
MOVEM A,IOIN2(C) ;MORE OF A WINNER
|
||
MOVE A,[PUSHJ P,IMTYO]
|
||
MOVEM A,ECHO(C) ;ECHO INS
|
||
MCALL 2,SETG
|
||
MOVEI A,3 ;FIRST CHANNEL AFTER INIT HAPPENS
|
||
MOVEM A,FRSTCH
|
||
|
||
;GENERATE AN INITIAL PROCESS AND SWAP IT IN
|
||
|
||
MOVEI A,TPLNT ;STACK PARAMETERS
|
||
MOVEI B,PLNT
|
||
PUSHJ P,ICR ;CREATE IT
|
||
MOVE PVP,PVSTOR+1
|
||
MOVE 0,SPSTO+1(B)
|
||
MOVEM 0,SPSTOR+1
|
||
MOVE 0,REALTV+1(PVP)
|
||
MOVEM 0,REALTV+1(B) ; STUFF IN TRANSFER VECTOR POINTER
|
||
MOVEI 0,RUNING
|
||
MOVEM 0,PSTAT"+1(B)
|
||
MOVE D,B ;SET UP TO CALL SWAP
|
||
JSP C,SWAP ;AND SWAP IN
|
||
MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS
|
||
PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME
|
||
PUSH TP,[1,,0]
|
||
MOVEI A,-1(TP)
|
||
PUSH TP,A
|
||
PUSH TP,SPSTOR+1
|
||
PUSH TP,P
|
||
MOVE C,TP ;COPY TP
|
||
ADD C,[3,,3] ;FUDGE
|
||
PUSH TP,C ;TPSAV PUSHED
|
||
PUSH TP,[TOPLEV]
|
||
HRRI TB,(TP) ;SETUP TB
|
||
IFN ITS, HRLI TB,2
|
||
IFE ITS, HRLI TB,400002
|
||
ADD TB,[1,,1]
|
||
MOVE PVP,PVSTOR+1
|
||
MOVEM TB,TBINIT+1(PVP)
|
||
MOVSI A,TSUBR
|
||
MOVEM A,RESFUN(PVP)
|
||
MOVEI A,LISTEN"
|
||
MOVEM A,RESFUN+1(PVP)
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE THIS-PROCESS
|
||
PUSH TP,$TPVP
|
||
PUSH TP,PVP
|
||
MCALL 2,SETG
|
||
|
||
; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE
|
||
|
||
MOVEI A,IMQUOTE T
|
||
SUBI A,
|
||
TVTOFF==0
|
||
ADDSQU TVTOFF
|
||
|
||
MOVEM A,SQULOC-1
|
||
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE TVTOFF,,MUDDLE
|
||
PUSH TP,$TFIX
|
||
PUSH TP,A
|
||
MCALL 2,SETG
|
||
|
||
; HERE TO SETUP SQUOZE TABLE IN PURE CORE
|
||
|
||
PUSHJ P,SQSETU ; GO TO ROUTINE
|
||
|
||
PUSHJ P,DUMPGC
|
||
MOVEI A,400000 ; FENCE POST PURE SR VECTOR
|
||
HRRM A,PURVEC
|
||
MOVE A,TP
|
||
HLRE B,A
|
||
SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS
|
||
MOVEI B,12 ;GROWTH SPEC
|
||
IORM B,(A)
|
||
MOVE PVP,PVSTOR+1
|
||
MOVE 0,REALTV+1(PVP)
|
||
HLRE E,0
|
||
SUBI 0,-1(E)
|
||
HRRZM 0,CODTOP
|
||
IFE ITS, PUSHJ P,GETJS
|
||
PUSHJ P,AAGC ;DO IT
|
||
AOJL A,.-1
|
||
MOVE PVP,PVSTOR+1
|
||
MOVE A,TPBASE+1(PVP)
|
||
SUB A,[640.,,640.]
|
||
MOVEM A,TPBASE+1(PVP)
|
||
|
||
; CREATE LIST OF ROOT AND NEW OBLIST
|
||
|
||
MOVEI A,5
|
||
PUSH P,A
|
||
|
||
NAMOBL: PUSH TP,$TATOM
|
||
PUSH TP,@OBNAM-1(A) ; NAME
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE OBLIST
|
||
PUSH TP,$TOBLS
|
||
PUSH TP,@OBTBL1-1(A)
|
||
MCALL 3,PUT ; NAME IT
|
||
SOS A,(P)
|
||
PUSH TP,$TOBLS
|
||
PUSH TP,@OBTBL1(A)
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE OBLIST
|
||
PUSH TP,$TATOM
|
||
PUSH TP,@OBNAM(A)
|
||
MCALL 3,PUT
|
||
SKIPE A,(P)
|
||
JRST NAMOBL
|
||
SUB P,[1,,1]
|
||
|
||
;Define MUDDLE version number
|
||
MOVEI A,5
|
||
MOVEI B,0 ;Initialize result
|
||
MOVE C,[440700,,MUDSTR+2]
|
||
VERLP: ILDB D,C ;Get next charcter digit
|
||
CAIG D,"9 ;Non-digit ?
|
||
CAIGE D,"0
|
||
JRST VERDEF
|
||
SUBI D,"0 ;Convert to number
|
||
IMULI B,10.
|
||
ADD B,D ;Include number into result
|
||
SOJG A,VERLP ;Finished ?
|
||
VERDEF:
|
||
PUSH TP,$TATOM
|
||
PUSH TP,IMQUOTE MUDDLE
|
||
PUSH TP,$TFIX
|
||
PUSH TP,B
|
||
MCALL 2,SETG ;Make definition
|
||
OPIPC:
|
||
IFN ITS,[
|
||
PUSH TP,$TCHSTR
|
||
PUSH TP,CHQUOTE IPC
|
||
PUSH TP,$TATOM
|
||
PUSH TP,MQUOTE IPC-HANDLER
|
||
MCALL 1,GVAL
|
||
PUSH TP,A
|
||
PUSH TP,B
|
||
PUSH TP,$TFIX
|
||
PUSH TP,[1]
|
||
MCALL 3,ON
|
||
MCALL 0,IPCON
|
||
]
|
||
|
||
; Allocate inital template tables
|
||
|
||
MOVEI A,10
|
||
PUSHJ P,CAFRE1
|
||
MOVSI A,(B)
|
||
HRRI A,1(B)
|
||
SETZM (B)
|
||
BLT A,7(B)
|
||
ADD B,[10,,10] ; REST IT OFF
|
||
MOVEM B,TD.LNT+1
|
||
MOVEI A,10
|
||
PUSHJ P,CAFRE1
|
||
MOVEI 0,TUVEC ; SETUP UTYPE
|
||
HRLM 0,10(B)
|
||
MOVEM B,TD.GET+1
|
||
MOVSI A,(B)
|
||
HRRI A,1(B)
|
||
SETZM (B)
|
||
BLT A,7(B)
|
||
MOVEI A,10
|
||
PUSHJ P,CAFRE1
|
||
MOVEI 0,TUVEC ; SETUP UTYPE
|
||
HRLM 0,10(B)
|
||
MOVEM B,TD.PUT+1
|
||
MOVSI A,(B)
|
||
HRRI A,1(B)
|
||
SETZM (B)
|
||
BLT A,7(B)
|
||
MOVEI A,10
|
||
PUSHJ P,CAFRE1
|
||
MOVEI 0,TUVEC ; SETUP UTYPE
|
||
HRLM 0,10(B)
|
||
MOVEM B,TD.AGC+1
|
||
MOVSI A,(B)
|
||
HRRI A,1(B)
|
||
SETZM (B)
|
||
BLT A,7(B)
|
||
|
||
PTSTRT: MOVEI A,SETUP
|
||
ADDI A,1
|
||
SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO
|
||
MOVEM A,PARNEW
|
||
|
||
; PURIFY/IMPURIFY THE WORLD (PDL)
|
||
|
||
IFN ITS,[
|
||
PURIMP: MOVE A,FRETOP
|
||
SUBI A,1
|
||
LSH A,-12
|
||
MOVE B,A
|
||
MOVNI A,1(A)
|
||
HRLZ A,A
|
||
DOTCAL CORBLK,[[1000,,310000],[1000,,-1],A]
|
||
FATAL INITM -- CAN'T IMPURIFY LOW CORE
|
||
MOVEI A,PHIBOT
|
||
ADDI B,1
|
||
SUB A,B
|
||
MOVNS A
|
||
HRL B,A
|
||
DOTCAL CORBLK,[[1000,,0],[1000,,-1],B]
|
||
FATAL INITM -- CAN'T FLUSH MIDDLE CORE
|
||
MOVE B,RHITOP
|
||
SUBI B,1
|
||
ASH B,-10.
|
||
MOVEI A,PHIBOT
|
||
SUB A,B
|
||
SUBI A,1
|
||
HRLS A
|
||
HRRI A,PHIBOT
|
||
DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A]
|
||
FATAL INITM -- CAN'T PURIFY HIGH CORE
|
||
]
|
||
|
||
IFE ITS,[
|
||
MOVEI A,400000
|
||
MOVE B,[1,,START]
|
||
SEVEC
|
||
]
|
||
PUSH P,[15.,,15.] ;PUSH A SMALL PRGRM ONTO P
|
||
MOVEI A,1(P) ;POINT TO ITS START
|
||
PUSH P,[JRST AAGC] ;GO TO AGC
|
||
PUSH P,[MOVE PVP,PVSTOR+1]
|
||
PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P
|
||
PUSH P,[SUB B,-14.(P)] ;FUDGE TO POP OFF PROGRAM
|
||
PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME
|
||
PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP
|
||
PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT
|
||
PUSH P,[MOVE B,SPSTOR+1] ;SP
|
||
PUSH P,[MOVEM B,SPSAV(TB)]
|
||
PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO
|
||
PUSH P,[MOVEM B,PCSAV(TB)]
|
||
IFN ITS, PUSH P,[MOVSI B,(.VALUE )]
|
||
IFE ITS, PUSH P,[MOVSI B,(JRST)]
|
||
PUSH P,[HRRI B,C]
|
||
PUSH P,[JRST B] ;GO DO VALRET
|
||
PUSH P,[B]
|
||
PUSH P,A ; PUSH START ADDR
|
||
MOVE B,[JRST -12.(P)]
|
||
MOVE 0,[JUMPA START]
|
||
IFE ITS, MOVE C,[HALTF]
|
||
IFE ITS, SKIPE OPSYS
|
||
MOVE C,[ASCII \0/9\]
|
||
MOVE D,[ASCII \B/1Q\]
|
||
MOVE E,[ASCIZ \
|
||
*
|
||
\] ;TERMINATE
|
||
POPJ P, ; GO
|
||
|
||
; CHECK PAIR SPACE
|
||
|
||
PAIRCH: CAMG A,B
|
||
JRST SETTV ;O.K.
|
||
|
||
DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
|
||
/]
|
||
PUSHJ P,MSGTYP
|
||
.VALUE
|
||
|
||
;CHARACTER STRING HACKER
|
||
|
||
CHACK: MOVE A,(C) ;GET TYPE
|
||
HLLZM A,(D) ;STORE IN NEW HOME
|
||
MOVE B,1(C) ;GET POINTER
|
||
HLRZ E,B ;-LENGHT
|
||
HRRM E,(D)
|
||
PUSH P,E+1 ; IDIVI WILL CLOBBER
|
||
ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS
|
||
IDIVI E,5 ; E/ WORDS LONG
|
||
PUSHJ P,EBPUR ; MAKE A PURIFIED COPY
|
||
POP P,E+1
|
||
HRLI B,010700 ;MAKE POINT BYTER
|
||
SUBI B,1
|
||
MOVEM B,1(D) ;AND STORE IT
|
||
ANDI A,-1 ;CLEAR LH OF A
|
||
JUMPE A,SETLP ;JUMP IF NO REF
|
||
HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
|
||
CAIE B,$TCHSTR ;SKIP IF IT DOES
|
||
JRST CHACK1 ;NO, JUST DO CHQUOTE PART
|
||
HRRM D,-1(A) ;CLOBBER
|
||
CHACK1: MOVEI E,1(D)
|
||
HRRM E,(A) ;STORE INTO REFERENCE
|
||
MOVEI E,0
|
||
DPB E,[220400,,(A)]
|
||
JRST SETLP
|
||
|
||
; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT
|
||
|
||
EBPUR: PUSH P,E
|
||
PUSH P,A
|
||
ADD E,HITOP ; GET NEW TOP
|
||
CAMG E,RHITOP ; SKIP IF TOO BIG
|
||
JRST EBPUR1
|
||
|
||
; CODE TO GROW HI SEG
|
||
|
||
MOVEI A,2000
|
||
ADDB A,RHITOP ; NEW TOP
|
||
TLNE A,777776
|
||
JRST HIFUL
|
||
IFN ITS,[
|
||
ASH A,-10. ; NUM OF BLOCKS
|
||
SUBI A,1 ; BLOCK TO GET
|
||
.CALL HIGET
|
||
.VALUE
|
||
]
|
||
|
||
EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT
|
||
EXCH E,HITOP
|
||
HRLI E,(B)
|
||
MOVEI B,(E)
|
||
BLT E,(A)
|
||
POP P,A
|
||
POP P,E
|
||
POPJ P,
|
||
|
||
GIVCOR: SETZ
|
||
SIXBIT /CORBLK/
|
||
1000,,0
|
||
1000,,-1
|
||
SETZ A
|
||
|
||
HIGET: SETZ
|
||
SIXBIT /CORBLK/
|
||
1000,,100000
|
||
1000,,-1
|
||
A
|
||
401000,,400001
|
||
|
||
|
||
; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
|
||
; ALREADY THERE
|
||
|
||
ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST
|
||
PUSH TP,[0] ; FILLED IN LATER
|
||
PUSH TP,$TVEC ;SAVE TV POINTERS
|
||
PUSH TP,C
|
||
PUSH TP,$TVEC
|
||
PUSH TP,D
|
||
MOVE C,1(C) ;GET THE ATOM
|
||
PUSH TP,$TATOM ;AND SAVE
|
||
PUSH TP,C
|
||
PUSH TP,$TATOM
|
||
PUSH TP,[0]
|
||
HRRZ B,(C) ;GET OBLIST SPEC FROM ATOM
|
||
LSH B,1
|
||
ADDI B,1(TB) ;POINT TO ITS HOME
|
||
HRRM B,-9(TP)
|
||
MOVE B,(B)
|
||
MOVEM B,-10(TP) ; CLOBBER
|
||
|
||
SETZM 2(C) ; FLUSH CURRENT OBLIST SPEC
|
||
MOVEI E,0
|
||
MOVE D,C
|
||
PUSH P,[LOOKCR]
|
||
ADD D,[3,,3]
|
||
JUMPGE D,.+4
|
||
PUSH P,(D)
|
||
ADDI E,1
|
||
AOBJN D,.-2
|
||
PUSH P,E
|
||
MOVSI A,TOBLS
|
||
JRST ILOOKC
|
||
LOOKCR:
|
||
MOVEM B,(TP)
|
||
JUMPN B,CHCKD
|
||
|
||
;HERE IF THIS ATOM MUST BE PUT ON OBLIST
|
||
|
||
USEATM: MOVE B,-2(TP) ; GET ATOM
|
||
HLRZ E,(B) ; SEE IF PURE OR NOT
|
||
TRNN E,400000 ; SKIP IF IMPURE
|
||
JRST PURATM
|
||
PUSH TP,$TATOM
|
||
PUSH TP,B
|
||
PUSH TP,$TOBLS
|
||
PUSH TP,-13(TP)
|
||
MCALL 2,INSERT
|
||
|
||
PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER
|
||
PURAT2: MOVE C,-6(TP) ;RESET POINTERS
|
||
MOVE D,-4(TP)
|
||
SUB TP,[12,,12]
|
||
MOVE B,(C) ;MOVE THE ENTRY
|
||
HLLZM B,(D) ;DON'T WANT REF POINTER STORED
|
||
MOVE A,1(C) ;AND MOVE ATOM
|
||
MOVEM A,1(D)
|
||
MOVEI A,1(D)
|
||
ANDI B,-1 ;CHECK FOR REAL REF
|
||
JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP
|
||
HRRM A,(B) ;CLOBBER CODE
|
||
MOVEI A,0
|
||
DPB A,[220400,,(B)] ; CLOBBER TVP PORTION
|
||
JRST SETLP
|
||
|
||
|
||
; HERE TO MAKE A PURE ATOM
|
||
|
||
PURATM: HRRZ B,-2(TP) ; POINT TO IT
|
||
HLRE E,-2(TP) ; - LNTH
|
||
MOVNS E
|
||
ADDI E,2
|
||
PUSHJ P,EBPUR ; PURE COPY
|
||
HRRM B,-2(TP) ; AND STORE BACK
|
||
MOVE B,-2(TP)
|
||
JUMPE 0,PURAT0
|
||
HRRZ D,0
|
||
HLRE E,0
|
||
SUBM D,E
|
||
HLRZ 0,2(D)
|
||
JUMPE 0,PURAT8
|
||
CAIG 0,HIBOT
|
||
FATAL INITM--PURE IMPURE LOSSAGE
|
||
JRST PURAT8
|
||
|
||
PURAT0: HRRZ E,(C)
|
||
MOVE D,-2(TP) ; GET ATOM BACK
|
||
HRRZ 0,(D) ; GET OBLIST CODE
|
||
JUMPE E,PURAT9
|
||
PURAT7: HLRZ D,1(E)
|
||
MOVEI D,-2(D)
|
||
SUBM E,D
|
||
HLRZ D,2(D)
|
||
CAILE D,HIBOT ; IF NEXT PURE & I AM ROOT
|
||
JUMPE 0,PURAT8 ; TAKES ADVANTAGE OF SYSTEM=0
|
||
JUMPE D,PURAT8
|
||
MOVE E,D
|
||
JRST PURAT7
|
||
|
||
PURAT8: HLRZ D,1(E)
|
||
SUBI D,2
|
||
SUBM E,D
|
||
HLRE C,B
|
||
SUBM B,C
|
||
HLRZ E,2(D)
|
||
HRLM E,2(B)
|
||
HRLM C,2(D)
|
||
JRST PURAT6
|
||
|
||
PURAT9: HLRE A,-2(TP)
|
||
SUBM B,A
|
||
HRRZM A,(C)
|
||
|
||
PURAT6: MOVE B,-10(TP) ; GET BUCKET BACK
|
||
MOVE C,-2(TP)
|
||
HRRZ 0,-9(TP)
|
||
HRRM 0,2(C) ; STORE OBLIST IN ATOM
|
||
PURAT1: HRRZ C,(B) ; GET CONTENTS
|
||
JUMPE C,HICONS ; AT END, OK
|
||
CAIL C,HIBOT ; SKIP IF IMPURE
|
||
JRST HICONS ; CONS IT ON
|
||
MOVEI B,(C)
|
||
JRST PURAT1
|
||
|
||
HICONS: HRLI C,TATOM
|
||
PUSH P,C
|
||
PUSH P,-2(TP)
|
||
PUSH P,B
|
||
MOVEI B,-2(P)
|
||
MOVEI E,2
|
||
PUSHJ P,EBPUR ; MAKE PURE LIST CELL
|
||
|
||
MOVE C,(P)
|
||
SUB P,[3,,3]
|
||
HRRM B,(C) ; STORE IT
|
||
MOVE B,1(B) ; ATOM BACK
|
||
MOVE C,-6(TP) ; GET TVP SLOT
|
||
HRRM B,1(C) ; AND STORE
|
||
HLRZ 0,(B) ; TYPE OF VAL
|
||
MOVE C,B
|
||
CAIN 0,TUNBOU ; NOT UNBOUND?
|
||
JRST PURAT3 ; UNBOUND, NO VAL
|
||
MOVEI E,2 ; COUNT AGAIN
|
||
PUSHJ P,EBPUR ; VALUE CELL
|
||
MOVE C,-2(TP) ; ATOM BACK
|
||
HLLZS (B) ; CLEAR LH
|
||
MOVSI 0,TLOCI
|
||
MOVEM B,1(C)
|
||
SKIPA
|
||
PURAT3: MOVEI 0,0
|
||
HRRZ A,(C) ; GET OBLIST CODE
|
||
MOVE A,OBTBL2(A)
|
||
HRRM A,2(C) ; STORE OBLIST SLOT
|
||
MOVEM 0,(C)
|
||
JRST PURAT2
|
||
|
||
; A POSSIBLE MATCH ARRIVES HERE
|
||
|
||
CHCKD: MOVE D,(TP) ;THEY MATCH!, GET EXISTING ATOM
|
||
MOVEI A,(D) ;GET TYPE OF IT
|
||
MOVE B,-2(TP) ;GET NEW ATOM
|
||
HLRZ 0,(B)
|
||
TRZ A,377777 ; SAVE ONLY 400000 BIT
|
||
TRZ 0,377777
|
||
CAIN 0,(A) ; SKIP IF WIN
|
||
JRST IM.PUR
|
||
MOVSI 0,400000
|
||
ANDCAM 0,(B)
|
||
ANDCAM 0,(D)
|
||
HLRZ A,(D)
|
||
JUMPN A,A1VAL
|
||
MOVE A,(B) ;MOVE VALUE
|
||
MOVEM A,(D)
|
||
MOVE A,1(B)
|
||
MOVEM A,1(D)
|
||
MOVE B,D ;EXISTING ATOM TO B
|
||
MOVEI 0,(B)
|
||
CAIL 0,HIBOT
|
||
JRST .+3
|
||
PUSHJ P,VALMAK ;MAKE A VALUE
|
||
JRST .+2
|
||
PUSHJ P,PVALM
|
||
|
||
;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
|
||
|
||
OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP
|
||
MOVE C,[-TVLNT,,TVSTRT] ;AND A COPY OF TVP
|
||
MOVEI A,0 ;INITIALIZE COUNTER
|
||
ALOOP: CAMN B,1(C) ;IS THIS IT?
|
||
JRST AFOUND
|
||
ADD C,[2,,2] ;BUMP COUNTER
|
||
CAMG C,D
|
||
AOJA A,ALOOP ;NO, KEEP LOOKING
|
||
|
||
MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
|
||
/]
|
||
TYPIT: PUSHJ P,MSGTYP
|
||
.VALUE
|
||
|
||
AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET
|
||
ADDI A,1
|
||
ADDI A,TVSTRT
|
||
MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM
|
||
HRRZ B,(C) ;POINT TO REFERENCE
|
||
SKIPE B ;ANY THERE?
|
||
HRRM A,(B) ;YES, CLOBBER AWAY
|
||
SUB TP,[12,,12]
|
||
MOVEI A,0
|
||
DPB A,[220400,,(B)] ; KILL TVP POINTER
|
||
JRST SETLP1 ;AND GO ON
|
||
|
||
A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE
|
||
MOVE B,D ;NOW PUT EXISTING ATOM IN B
|
||
CAIN C,TUNBOU ;UNBOUND?
|
||
JRST OFFIND ;YES, WINNER
|
||
|
||
MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
|
||
/]
|
||
JRST TYPIT
|
||
|
||
|
||
IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE
|
||
/]
|
||
JRST TYPIT
|
||
|
||
PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT
|
||
/]
|
||
JRST TYPIT
|
||
|
||
HIFUL: MOVEI B,[ASCIZ /LOSSAGE--HI SEG FULL
|
||
/]
|
||
JRST TYPIT
|
||
|
||
|
||
;MAKE A VALUE IN SLOT ON GLOBAL SP
|
||
|
||
VALMAK: HLRZ A,(B) ;TYPE OF VALUE
|
||
CAIE A,400000+TUNBOU
|
||
CAIN A,TUNBOU ;VALUE?
|
||
JRST VALMA1
|
||
MOVE A,GLOBSP+1 ;GET POINTER TO GLOBAL SP
|
||
SUB A,[4,,4] ;ALLOCATE SPACE
|
||
CAMG A,GLOBAS+1 ;CHECK FOR OVERFLOW
|
||
JRST SPOVFL
|
||
MOVEM A,GLOBSP+1 ;STORE IT BACK
|
||
MOVE C,(B) ;GET TYPE CELL
|
||
TLZ C,400000
|
||
HLLZM C,2(A) ;INTO TYPE CELL
|
||
MOVE C,1(B) ;GET VALUE
|
||
MOVEM C,3(A) ;INTO VALUE SLOT
|
||
MOVSI C,TGATOM ;GET TATOM,,0
|
||
MOVEM C,(A)
|
||
MOVEM B,1(A) ;AND POINTER TO ATOM
|
||
MOVSI C,TLOCI ;NOW CLOBBER THE ATOM
|
||
MOVEM C,(B) ;INTO TYPE CELL
|
||
ADD A,[2,,2] ;POINT TO VALUE
|
||
MOVEM A,1(B)
|
||
POPJ P,
|
||
|
||
VALMA1: SETZM (B)
|
||
POPJ P,
|
||
|
||
SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
|
||
/]
|
||
JRST TYPIT
|
||
|
||
|
||
PVALM: HLRZ 0,(B)
|
||
CAIE 0,400000+TUNBOU
|
||
CAIN 0,TUNBOU
|
||
JRST VALMA1
|
||
MOVEI E,2
|
||
PUSH P,B
|
||
PUSHJ P,EBPUR
|
||
POP P,C
|
||
MOVEM B,1(C)
|
||
MOVSI 0,TLOCI
|
||
MOVEM 0,(C)
|
||
MOVE B,C
|
||
POPJ P,
|
||
;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER
|
||
|
||
VECTGO DUMMY1
|
||
|
||
IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW
|
||
ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER
|
||
IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR
|
||
MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS
|
||
CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ
|
||
CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN
|
||
CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG
|
||
C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR
|
||
OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY
|
||
CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO
|
||
CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT
|
||
CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C
|
||
CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL
|
||
CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS
|
||
CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1
|
||
CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT
|
||
GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF
|
||
CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ
|
||
TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG
|
||
NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,VECBOT]
|
||
.GLOBAL A
|
||
ADDSQU A
|
||
TERMIN
|
||
IFE ITS,[
|
||
IRP A,,[NTTYPE,CLRSTR]
|
||
.GLOBAL A
|
||
ADDSQU A
|
||
TERMIN
|
||
]
|
||
|
||
VECRET
|
||
|
||
; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
|
||
|
||
SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL]
|
||
MOVEI 0,1
|
||
SQ2: MOVE B,(A)
|
||
CAMG B,2(A)
|
||
JRST SQ1
|
||
MOVEI 0,0
|
||
EXCH B,2(A)
|
||
MOVEM B,(A)
|
||
MOVE B,1(A)
|
||
EXCH B,3(A)
|
||
MOVEM B,1(A)
|
||
SQ1: ADD A,[2,,2]
|
||
JUMPL A,SQ2
|
||
JUMPE 0,SQSETU
|
||
IFE ITS,[
|
||
STSQU: MOVE B,[440700,,SQBLK]
|
||
PUSHJ P,MNGNAM
|
||
HRROI B,SQBLK
|
||
MOVSI A,600001
|
||
GTJFN
|
||
FATAL CANT MAKE FIXUP FILE
|
||
MOVEI E,(A)
|
||
MOVE B,[440000,,100000]
|
||
OPENF
|
||
FATAL CANT OPEN FIXUP FILE
|
||
MOVE B,[444400,,SQUTBL]
|
||
MOVNI C,SQULOC-SQUTBL
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
MOVE A,[SQUTBL-SQULOC,,SQUTBL]
|
||
MOVEM A,SQUPNT"
|
||
]
|
||
IFN ITS,[
|
||
.GLOBAL CSIXBT
|
||
STSQU: MOVE C,MUDSTR+2 ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
|
||
PUSHJ P,CSIXBT
|
||
HRRI C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
|
||
MOVSS C
|
||
MOVEM C,SQBLK+2 ; STORE IN APPROPRIATE BLOCKS
|
||
MOVEM C,SQWBLK+2
|
||
.SUSET [.SSNAM,,SQDIR]
|
||
.OPEN GCHN,SQWBLK ; OPEN FILE
|
||
FATAL CAN'T CREATE SQUOZE FILE
|
||
MOVE A,[SQUTBL-SQULOC,,SQUTBL]
|
||
MOVEM A,SQUPNT"
|
||
.IOT GCHN,A
|
||
.CLOSE GCHN ; CLOSE THE CHANNEL
|
||
]
|
||
POPJ P,
|
||
|
||
RHITOP: 0
|
||
|
||
OBSZ: 151.
|
||
13.
|
||
151.
|
||
151.
|
||
317.
|
||
|
||
OBTBL2: ROOT+1
|
||
ERROBL+1
|
||
INTOBL+1
|
||
MUDOBL+1
|
||
INITIAL+1
|
||
|
||
OBTBL: INITIAL+1-TVSTRT+TVBASE
|
||
MUDOBL+1-TVSTRT+TVBASE
|
||
INTOBL+1-TVSTRT+TVBASE
|
||
ERROBL+1-TVSTRT+TVBASE
|
||
ROOT+1-TVSTRT+TVBASE
|
||
OBNAM: MQUOTE INITIAL
|
||
IMQUOTE MUDDLE
|
||
MQUOTE INTERRUPTS
|
||
MQUOTE ERRORS
|
||
MQUOTE ROOT
|
||
|
||
OBTBL1: INITIAL+1
|
||
MUDOBL+1
|
||
INTOBL+1
|
||
ERROBL+1
|
||
ROOT+1
|
||
|
||
|
||
IFN ITS,[
|
||
SQWBLK: SIXBIT / 'DSK/
|
||
SIXBIT /SQUOZE/
|
||
SIXBIT /TABLE/
|
||
]
|
||
IFE ITS,[
|
||
MNGNAM: MOVE A,[440700,,MUDSTR+2] ; FOR NAME HACKING
|
||
ILDB 0,A ; SEE IF IT IS A VERSION
|
||
CAIN 0,177
|
||
POPJ P,
|
||
MOVE A,B
|
||
ILDB 0,A
|
||
CAIN 0,"X ; LOOK FOR X'S
|
||
JRST .+3
|
||
MOVE B,A
|
||
JRST .-4
|
||
|
||
MOVE A,[440700,,MUDSTR+2]
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
ILDB 0,A
|
||
IDPB 0,B
|
||
POPJ P,
|
||
]
|
||
|
||
IFN ITS,[
|
||
.GLOBAL VCREATE,MUDSTR
|
||
|
||
DEBUG: MOVE E,[440600,,[SIXBIT /EXPERIMENTAL/]]
|
||
MOVEI 0,12.
|
||
JRST STUFF
|
||
|
||
VCREATE: .SUSET [.SSNAM,,[SIXBIT /MUDSYS/]]
|
||
.OPEN 0,OP%
|
||
.VALUE
|
||
MOVEI 0,0 ; SET 0 TO DO THE .RCHST
|
||
.RCHST 0
|
||
.CLOSE 0
|
||
.FDELE DB%
|
||
.VALUE
|
||
MOVE E,[440600,,B]
|
||
MOVEI 0,6
|
||
STUFF: MOVE D,[440700,,MUDSTR+2]
|
||
STUFF1: ILDB A,E ; GET A CHAR
|
||
CAIN A,0 ;SUPRESS SPACES
|
||
MOVEI A,137 ;RUBOUT'S DON'T TYPE OUT
|
||
ADDI A,40 ; TO ASCII
|
||
IDPB A,D ; STORE
|
||
SOJN 0,STUFF1
|
||
SETZM 34
|
||
SETZM 35
|
||
SETZM 36
|
||
.VALUE
|
||
|
||
OP%: 1,,(SIXBIT /DSK/)
|
||
SIXBIT /MUD%/
|
||
SIXBIT />/
|
||
|
||
DB%: (SIXBIT /DSK/)
|
||
SIXBIT /MUD%/
|
||
SIXBIT /</
|
||
0
|
||
0
|
||
]
|
||
|
||
|
||
.GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
|
||
.GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
|
||
|
||
; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
|
||
|
||
DUMPGC:
|
||
IFN ITS,[
|
||
.SUSET [.SSNAM,,GCDIR] ; SET SNAME
|
||
MOVE C,MUDSTR+2 ; CREATE SECOND NAMES
|
||
PUSHJ P,CSIXBT
|
||
HRRI C,(SIXBIT /MUD/)
|
||
MOVS A,C ; MUDxx IS SECOND NAME
|
||
MOVEM A,GCLDBK+2
|
||
MOVEM A,SGCLBK+2
|
||
MOVEM A,ILDBLK+2
|
||
MOVEM A,GCDBLK+2 ; SMASH IN SECOND NAMES
|
||
MOVEM A,SGCDBK+2
|
||
MOVEM A,INTDBK+2
|
||
.OPEN 0,GCDBLK ; OPEN GC FILE
|
||
FATAL CANT CREATE AGC FILE
|
||
MOVNI A,LENGC ; CALCULATE IOT POINTER
|
||
ASH A,10.
|
||
HRLZS A
|
||
HRRI A,REALGC
|
||
.IOT 0,A ; SEND IT OUT
|
||
.CLOSE 0, ; CLOSE THE CHANNEL
|
||
.OPEN 0,SGCDBK ; OPEN GC FILE
|
||
FATAL CANT CREATE AGC FILE
|
||
MOVNI A,SLENGC ; CALCULATE IOT POINTER
|
||
ASH A,10.
|
||
HRLZS A
|
||
HRRI A,REALGC+RLENGC
|
||
.IOT 0,A ; SEND IT OUT
|
||
.CLOSE 0, ; CLOSE THE CHANNEL
|
||
|
||
|
||
; ROUTINE TO DUMP THE INTERPRETER
|
||
|
||
.SUSET [.SSNAM,,INTDIR]
|
||
.OPEN 0,ILDBLK ; OPEN FILE TO INTERPRETER BLOCK
|
||
FATAL CANT FIXUP INTERPRETER
|
||
HLRE B,TP ; MAKE SURE BIG ENOUGJ
|
||
MOVNS B ; SEE IF WE WIN
|
||
CAIGE B,400 ; SKIP IF WINNING
|
||
FATAL NO ROOM FOR PAGE MAP
|
||
MOVSI A,-400
|
||
HRRI A,1(TP)
|
||
.ACCES 0,[1]
|
||
.IOT 0,A ; GET IN PAGE MAP
|
||
.CLOSE 0,
|
||
.OPEN 0,INTDBK
|
||
FATAL CANT FIXUP INTERPRETER
|
||
MOVEI A,1 ; INITIALIZE FILE PAGE COUNT
|
||
MOVEI B,0 ; CORE PAGE COUNT
|
||
MOVEI E,1(TP)
|
||
LOPFND: HRRZ 0,(E)
|
||
JUMPE 0,NOPAG ; IF 0 FORGET IT
|
||
ADDI A,1 ; AOS FILE MAP
|
||
NOPAG: ADDI B,1 ; AOS PAGE MAP
|
||
CAIE B,PAGEGC ; SKIP IF DONE
|
||
AOJA E,LOPFND
|
||
ASH A,10. ; TO WORDS
|
||
.ACCES 0,A
|
||
MOVNI B,LENGC
|
||
ASH B,10. ; TO WORDS
|
||
HRLZS B ; SWAP
|
||
HRRI B,AGCLD
|
||
.IOT 0,B
|
||
.CLOSE 0,
|
||
POPJ P, ; DONE
|
||
|
||
GCDBLK: SIXBIT / 'DSK/
|
||
SIXBIT /AGC/
|
||
SIXBIT /MUD /
|
||
|
||
SGCDBK: SIXBIT / 'DSK/
|
||
SIXBIT /SGC/
|
||
SIXBIT /MUD /
|
||
|
||
INTDBK: 100007,,(SIXBIT /DSK/)
|
||
SIXBIT /TS/
|
||
SIXBIT /MUD/
|
||
|
||
]
|
||
IFE ITS,[
|
||
MOVE B,[440700,,GCLDBK]
|
||
PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
|
||
HRROI B,GCLDBK
|
||
MOVSI A,600001
|
||
GTJFN
|
||
FATAL CANT WRITE OUT GC
|
||
MOVEI E,(A)
|
||
MOVE B,[440000,,100000]
|
||
OPENF
|
||
FATAL CANT OPEN GC FILE
|
||
MOVNI C,LENGC
|
||
ASH C,10.
|
||
MOVE B,[444400,,REALGC]
|
||
MOVEI A,(E)
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
MOVEI D,LENGC+LENGC
|
||
MOVNI A,1
|
||
MOVEI B,REALGC
|
||
ASH B,-9.
|
||
HRLI B,400000
|
||
|
||
PMAP
|
||
ADDI B,1
|
||
SOJG D,.-2
|
||
|
||
MOVE B,[440700,,SGCLBK]
|
||
PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
|
||
HRROI B,SGCLBK
|
||
MOVSI A,600001
|
||
GTJFN
|
||
FATAL CANT WRITE OUT GC
|
||
MOVEI E,(A)
|
||
MOVE B,[440000,,100000]
|
||
OPENF
|
||
FATAL CANT OPEN GC FILE
|
||
MOVNI C,SLENGC
|
||
ASH C,10.
|
||
MOVE B,[444400,,REALGC+RLENGC]
|
||
MOVEI A,(E)
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
MOVEI D,SLENGC+SLENGC
|
||
MOVNI A,1
|
||
MOVEI B,REALGC+RLENGC
|
||
ASH B,-9.
|
||
HRLI B,400000
|
||
|
||
PMAP
|
||
ADDI B,1
|
||
SOJG D,.-2
|
||
|
||
MOVE B,[440700,,SECBLK]
|
||
PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
|
||
HRROI B,SECBLK
|
||
MOVSI A,600001
|
||
GTJFN
|
||
FATAL CANT WRITE OUT GC
|
||
MOVEI E,(A)
|
||
MOVE B,[440000,,100000]
|
||
OPENF
|
||
FATAL CANT OPEN GC FILE
|
||
MOVNI C,SECLEN
|
||
ASH C,10.
|
||
MOVE B,[444400,,REALGC+RLENGC+RSLENG]
|
||
MOVEI A,(E)
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
|
||
; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
|
||
|
||
.GLOBAL %FXUPS,%FXEND
|
||
|
||
MOVEI A,%FXUPS
|
||
|
||
%DBG1: HLRZ D,(A)
|
||
HRRZ A,(A)
|
||
LDB 0,[331100,,(A)] ; GET INS
|
||
MOVEI C,%TBL
|
||
HRRZ B,(C)
|
||
CAME B,0
|
||
AOJA C,.-2
|
||
CAIN B,<<(XBLT)>_<-9.>>
|
||
HLLZS (A)
|
||
LDB B,[331100,,(C)]
|
||
DPB B,[331100,,(A)]
|
||
MOVE A,D
|
||
JUMPN A,%DBG1
|
||
%DBG2:
|
||
MOVE B,[440700,,DECBLK]
|
||
PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
|
||
HRROI B,DECBLK
|
||
MOVSI A,600001
|
||
GTJFN
|
||
FATAL CANT WRITE OUT GC
|
||
MOVEI E,(A)
|
||
MOVE B,[440000,,100000]
|
||
OPENF
|
||
FATAL CANT OPEN GC FILE
|
||
MOVNI C,SECLEN
|
||
ASH C,10.
|
||
MOVE B,[444400,,REALGC+RLENGC+RSLENG]
|
||
MOVEI A,(E)
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
MOVEI D,SECLEN+SECLEN
|
||
MOVNI A,1
|
||
MOVEI B,REALGC+RLENGC
|
||
ASH B,-9.
|
||
HRLI B,400000
|
||
|
||
PMAP
|
||
ADDI B,1
|
||
SOJG D,.-2
|
||
|
||
MOVE B,[440700,,ILDBLK]
|
||
SKIPE OPSYS
|
||
MOVE B,[440700,,TILDBL]
|
||
PUSHJ P,MNGNAM
|
||
MOVSI C,-1000
|
||
MOVSI A,400000
|
||
RPA: RPACS
|
||
TLNE B,10000
|
||
TLNN B,400 ; SKIP IF NOT PRIVATE
|
||
SKIPA
|
||
MOVES (C)
|
||
ADDI C,777
|
||
ADDI A,1
|
||
AOBJN C,RPA
|
||
|
||
MOVNI A,1
|
||
CLOSF
|
||
FATAL CANT CLOSE STUFF
|
||
HRROI B,ILDBLK
|
||
MOVSI A,100001
|
||
GTJFN ; GET A JFN
|
||
FATAL GARBAGE COLLECTOR IS MISSING
|
||
HRRZS E,A ; SAVE JFN
|
||
MOVE B,[440000,,300000]
|
||
OPENF
|
||
FATAL CANT OPEN GC FILE
|
||
MOVEI A,(E) ; FIND OUT LENGTH OF MAP
|
||
BIN ; GET LENGTH WORD
|
||
HLRZ 0,B
|
||
CAIE 0,1776 ; TOPS20 SSAVE FILE FORMAT
|
||
CAIN 0,1000 ; TENEX SSAVE FILE FORMAT
|
||
JRST .+2
|
||
FATAL NOT AN SSAVE FILE
|
||
MOVEI A,(B) ; ISOLATE SIZE OF MAP
|
||
HLRE B,TP ; MUST BE SPACE FOR CRUFT
|
||
MOVNS B
|
||
CAIGE B,(A) ; ROOM?
|
||
FATAL NO ROOM FOR PAGE MAP (GULP)
|
||
MOVN C,A
|
||
MOVEI A,(E) ; READY TO READ IN MAP
|
||
MOVEI B,1(TP) ; ONTO TP STACK
|
||
HRLI B,444400
|
||
SIN ; SNARF IT IN
|
||
|
||
MOVEI A,1(TP) ; POINT TO MAP
|
||
CAIE 0,1000
|
||
JRST RPA1 ; GO TO THE TOPS20 CODE
|
||
LDB 0,[221100,,(A)] ; GET FORK PAGE
|
||
CAIE 0,PAGEGC+PAGEGC ; GOT IT?
|
||
AOJA A,.-2
|
||
JRST RPA2
|
||
|
||
RPA1: ADDI A,1 ; POINT TO PROCESS PAGE NUMBER
|
||
LDB 0,[331100,,(A)] ; REPEAT COUNT IN 0
|
||
LDB B,[3300,,(A)] ; FIRST PAGE NUMBER IN B
|
||
ADD 0,B ; LARGEST PAGE NUMBER
|
||
CAIL 0,PAGEGC+PAGEGC
|
||
CAILE B,PAGEGC+PAGEGC
|
||
AOJA A,RPA1 ; NEXT PAIR OF WORDS PLEASE
|
||
SUBI A,1 ; POINT TO FILE PAGE NUMBER
|
||
SUBI B,PAGEGC+PAGEGC
|
||
MOVN B,B
|
||
ADDM B,(A) ; SET UP THE PAGE
|
||
|
||
RPA2: HRRZ B,(A) ; GET PAGE
|
||
MOVEI A,(E) ; GET JFN
|
||
ASH B,9.
|
||
SFPTR
|
||
FATAL ACCESS OF FILE FAILED
|
||
MOVEI A,(E)
|
||
MOVE B,[444400,,AGCLD]
|
||
MOVNI C,LENGC
|
||
ASH C,10.
|
||
SOUT
|
||
MOVEI A,(E)
|
||
CLOSF
|
||
JFCL
|
||
POPJ P,
|
||
|
||
; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
|
||
|
||
TWENTY: HRROI A,C ; RESULTS KEPT HERE
|
||
HRLOI B,600015
|
||
MOVEI C,0 ; CLEAN C UP
|
||
DEVST
|
||
JFCL
|
||
MOVEI A,1 ; TENEX HAS OPSYS = 1
|
||
CAME C,[ASCII/NUL/] ; TOPS20 GIVES "NUL"
|
||
MOVEM A,OPSYS ; TENEX GIVES "NIL"
|
||
POPJ P,
|
||
%TBL: IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
|
||
S!A <<(A)>_<-9.>>
|
||
TERMIN
|
||
|
||
GCLDBK: ASCIZ /MDLXXX.AGC/
|
||
SGCLBK: ASCIZ /MDLXXX.SGC/
|
||
SECBLK: ASCIZ /MDLXXX.SEC/
|
||
ILDBLK: ASCIZ /MDLXXX.EXE/
|
||
TILDBL: ASCIZ /MDLXXX.SAV/
|
||
DECBLK: ASCIZ /MDLXXX.DEC/
|
||
]
|
||
|
||
|
||
|
||
END SETUP
|
||
|