mirror of
https://github.com/PDP-10/its.git
synced 2026-05-23 05:52:16 +00:00
366665e77a
Found from comparison with a TS MUD54 binary. The Muddle 56/106 source came from TOPS-20 originally, and it had been extracted with newline conversion but not ITS encoding. Most of these are cosmetic, but there are a couple of VALRET strings with embedded \rs -- including the one used to exit initialisation. So successful initialisation now finishes with a *, rather than opening a random location.
1366 lines
27 KiB
Plaintext
1366 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,[
|
||
FATINS==.FATAL"
|
||
SEVEC==104000,,204
|
||
.INSRT STENEX >
|
||
]
|
||
|
||
IMPURE
|
||
|
||
OBSIZE==151. ;DEFAULT OBLIST SIZE
|
||
|
||
.LIFG <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 A,[-<400-PHIBOT>,,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,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]
|
||
.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
|
||
|