--- /dev/null
+
+TITLE INITIALIZATION FOR MUDDLE
+
+RELOCATABLE
+
+LAST==1 ;POSSIBLE CHECKS DONE LATER
+
+.INSRT MUDDLE >
+
+.LIFL <TVLNT-TVLOC>
+.LOP .VALUE
+.ELDC
+
+
+.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AGC,ICR,SWAP,OBLNT,MSGTYP
+.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,VECBOT,VECTOP,TPBASE
+.GLOBAL LISTEN,ROOT,TBINIT,TOPLEV,INTOBL,ERROBL,TTYOPE
+.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,TYI,TYO
+
+SETUP: MOVE P,GCPDL ;GET A PUSH DOWN STACK
+ MOVE TVP,[-TVLNT,,TVBASE] ;GET INITIAL TRANSFER VECTOR
+ PUSHJ P,TTYOPE ;OPEN THE TTY
+ 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
+ MOVE B,PARBOT ;CHECK FOR ANY PAIRS
+ CAME B,PARTOP ;ANY LOAD/ASSEMBLE TIME PAIRS?
+ JRST PAIRCH ;YES CHECK THEM
+ ADDI A,1 ;BUMP UP
+ MOVEM A,PARBOT ;UPDATE PARBOT AND TOP
+ MOVEM A,PARTOP
+SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR
+ 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
+ HRLI TB,1
+ SUB TP,[1,,1] ;POP ONCE
+
+; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
+
+ PUSH P,[3] ;COUNT INITIAL OBLISTS
+
+MAKEOB: MCALL 0,MOBLIST ;GOBBLE AN OBLIST
+ PUSH TP,$TOBLS ;AND SAVE THEM
+ PUSH TP,B
+ SOS A,(P) ;COUNT DOWN
+ MOVEM B,@OBTBL(A) ;STORE
+ JUMPN A,MAKEOB
+
+ MOVE C,TVP ;MAKE 2 COPIES OF XFER VECTOR POINTER
+ MOVE D,TVP
+
+;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
+\f
+;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
+
+TVEXAU: HLRE B,C ;GET -LENGTH
+ SUBI C,(B) ;POIT TO DOPE WORD
+ ANDI C,-1 ;NO LH
+ HLRZ A,1(C) ;INTIAL LENGTH TO A
+ MOVEI E,(C) ;COPY OF POINTER TO DOPW WD
+ SUBI E,(D) ;AMOUNT LEFT OVER TO E
+ HRLZM E,1(C) ;CLOBBER INTO DOPE WORD FOR GARBAGE
+ MOVSI E,(E) ;PREPARE TO UPDATE TVP
+ ADD TVP,E ;NOW POINTS TO THE RIGHT AMOUNT
+ HLRE B,D ;-AMOUNT LEFT TO B
+ ADD B,A ;AMOUNT OF GOOD STUFF
+ HRLZM B,1(D) ;STORE IT IN GODD DOPE WORD
+ MOVSI E,400000 ;CLOBBER TO GENERAL IN BOTH CASES
+ MOVEM E,(C)
+ MOVEM E,(D)
+
+
+; FIX UP TYPE VECTOR
+
+ MOVE A,TYPVEC+1(TVP) ;GET POINTER
+ MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS
+ MOVSI B,TATOM ;SET TYPE TO ATOM
+
+TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM
+ MOVE C,@1(A) ;GET ATOM
+ MOVEM C,1(A)
+ ADD A,[2,,2] ;BUMP
+ JUMPL A,TYPLP
+\f
+;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
+
+;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
+
+ IRP A,,[[PRINT,TCHSTR],[OUTPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
+ IRP B,C,[A]
+ PUSH TP,$!C
+ PUSH TP,CHQUOTE B
+ .ISTOP
+ TERMIN
+ TERMIN
+
+ MCALL 4,FOPEN ;OPEN THE OUT PUT CHANNEL
+ MOVEM B,TTOCHN+1(TVP) ;SAVE IT
+
+;ASSIGN AS GLOBAL VALUE
+
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE OUTCHAN
+ PUSH TP,A
+ PUSH TP,B
+ MOVE A,[PUSHJ P,TYO] ;MORE WINNING INS
+ MOVEM A,IOINS(B) ;CLOBBER
+ MCALL 2,SETG
+
+;SETUP A CALL TO OPEN THE TTY CHANNEL
+
+ IRP A,,[[READ,TCHSTR],[INPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
+ IRP B,C,[A]
+ PUSH TP,$!C
+ PUSH TP,CHQUOTE B
+ .ISTOP
+ TERMIN
+ TERMIN
+
+ MCALL 4,FOPEN ;OPEN INPUTCHANNEL
+ MOVEM B,TTICHN+1(TVP) ;SAVE IT
+ PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE
+ PUSH TP,MQUOTE INCHAN
+ PUSH TP,A
+ PUSH TP,B
+ MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR
+ MOVE A,[PUSHJ P,TYI]
+ MOVEM A,IOIN2(C) ;MORE OF A WINNER
+ MOVE A,[PUSHJ P,TYO]
+ MOVEM A,ECHO(C) ;ECHO INS
+ MCALL 2,SETG
+
+;GENERATE AN INITIAL PROCESS AND SWAP IT IN
+
+ PUSHJ P,ICR ;CREATE IT
+ 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]
+ PUSH TP,[0]
+ PUSH TP,SP
+ PUSH TP,P
+ MOVE C,TP ;COPY TP
+ ADD C,[3,,3] ;FUDGE
+ PUSH TP,C ;TPSAV PUSHED
+ PUSH TP,PP
+ PUSH TP,[TOPLEV]
+ HRRI TB,(TP) ;SETUP TB
+ HRLI TB,2
+ ADD TB,[1,,1]
+ MOVEM TB,TBINIT+1(PVP)
+
+; CREATE LIST OF ROOT AND NEW OBLIST
+
+ MCALL 0,MOBLIST ;MAKE OBLIST
+ PUSH TP,A ;SAVE RESULTS
+ PUSH TP,B
+ PUSH TP,ROOT(TVP)
+ PUSH TP,ROOT+1(TVP)
+ MCALL 2,LIST ;MAKE LIST
+ MOVEM A,ROOT(TVP)
+ MOVEM B,ROOT+1(TVP)
+ PUSH TP,$TATOM ;ASSIGN TO GLOBAL VALUE
+ PUSH TP,MQUOTE OBLIST
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 2,SETG
+
+
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE QUITTER
+ MCALL 1,LIST
+ PUSH TP,$TCHAN ;SET UP CNTL-G INT
+ PUSH TP,TTICHN+1(TVP)
+ PUSH TP,$TFORM
+ PUSH TP,B
+ MCALL 2,ONCHAR ;TURN ON INTERRUPT
+ MOVEI A,SETUP ;POINT TO START
+ MOVEM A,CODTOP
+ ADDI A,1
+ SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO
+ MOVEM A,PARNEW
+ PUSH P,[14.,,14.] ;PUSH A SMALL PRGRM ONTO P
+ MOVEI A,1(P) ;POINT TO ITS START
+ PUSH P,[JRST AGC] ;GO TO AGC
+ PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P
+ PUSH P,[SUB B,-13.(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,SPSTO+1(PVP)] ;SP
+ PUSH P,[MOVEM B,SPSAV(TB)]
+ PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO
+ PUSH P,[MOVEM B,PCSAV(TB)]
+ PUSH P,[MOVSI B,(.VALUE )]
+ PUSH P,[HRRI B,C]
+ PUSH P,[JRST B] ;GO DO VALRET
+ PUSH P,[A] ;RETURN ADDRESS FOR AGC
+ PUSH P,A ;SAVE A
+ MOVE A,[JRST -11.(P)] ;WHEER TO START
+ SUB P,[1,,1] ;REMOVE LOSSAGE
+ MOVE 0,[JUMPA START]
+ MOVE B,[.VALUE C] ;SETUP VALRET
+ MOVE C,[ASCII \\170/\e9\]
+ MOVE D,[ASCII \B!\eQî\]
+ MOVE E,[ASCIZ \\16*\] ;TERMINATE
+ JRST @1(P) ;GO DO IT
+\f
+; 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
+ HLRE E,B ;-LENGHT
+ SUBM B,E ;E POINTS TO DOPE WORDS
+ ADDI E,1 ;POINT TO 2ND
+ HRRM E,(D) ;INTO PE CELL
+ HRLI B,350700 ;MAKE POINT BYTER
+ MOVEM B,1(D) ;AND STORE IT
+ ANDI A,-1 ;CLEAR LH OF A
+ JUMPE A,SETLP ;JUMP IF NO REF
+ MOVE E,(P) ;GET OFFSET
+ LSH E,1
+ 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 E,-1(A) ;CLOBBER
+ MOVEI B,TVP
+ DPB B,[220400,,-1(A)] ;CLOBBER INDEX FIELD
+CHACK1: ADDI E,1
+ HRRM E,(A) ;STORE INTO REFERENCE
+ JRST SETLP
+\f
+; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
+; ALREADY THERE
+
+ATOMHK: PUSH TP,$TVEC ;SAVE TV POINTERS
+ PUSH TP,C
+ PUSH TP,$TVEC
+ PUSH TP,D
+ MOVE B,1(C) ;GET THE ATOM
+ PUSH TP,$TATOM ;AND SAVE
+ PUSH TP,B
+ HRRZ A,(B) ;GET OBLIST SPEC FROM ATOM
+ LSH A,1
+ ADDI A,1(TB) ;POINT TO ITS HOME
+ PUSH TP,$TOBLS
+ PUSH TP,(A) ;AND SAV IT
+
+ ADD B,[2,,2] ;POINT TO ATOM'S PNAME
+ MOVEI A,0 ;FOR HASHING
+ XOR A,(B)
+ AOBJN B,.-1
+ MOVMS A ;FORCE POSITIVE RESULT
+ IDIV A,OBLNT
+ HRLS B ;REMAINDER IN B IS BUCKET
+ ADDB B,(TP) ;UPDATE POINTER
+
+ SKIPN C,(B) ;GOBBLE BUCKET CONTENTS
+ JRST USEATM ;NONE, LEAVE AND USE THIS ATOM
+OBLOO3: MOVE E,-2(TP) ;RE-GOBBLE ATOM
+ ADD E,[2,,2] ;POINT TO PNAME
+ SKIPN D,1(C) ;CHECK LIST ELEMNT
+ JRST NXTBCK ;0, CHECK NEXT IN THIS BUCKET
+ ADD D,[2,,2] ;POINT TO PNAME
+OBLOO2: MOVE A,(D) ;GET A WORD
+ CAME A,(E) ;COMPARE
+ JRST NXTBCK ;THEY DIFFER, TRY NEX
+OBLOOP: AOBJP E,CHCKD ;COULD BE A MATCH, GO CHECK
+ AOBJN D,OBLOO2 ;HAVEN'T LOST YET
+
+NXTBCK: HRRZ C,(C) ;CDR THE LIST
+ JUMPN C,OBLOO3 ;IF NOT NIL, KEEP TRYING
+
+;HERE IF THIS ATOM MUST BE PUT ON OBLIST
+
+USEATM: MOVE B,(TP) ;POINTER TO BUCKET
+ HRRZ C,(B) ;POINTER TO LIST IN THIS BUCKET
+ PUSH TP,$TATOM ;GENERATE CALL TO CONS
+ PUSH TP,-3(TP)
+ PUSH TP,$TLIST
+ PUSH TP,C
+ MCALL 2,CONS ;CONS IT UP
+ MOVE C,(TP) ;REGOBBLE BUCKET POINTER
+ HRRZM B,(C) ;CLOBBER
+ MOVE B,-2(TP) ;POINT TO ATOM
+ PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER
+ MOVE C,-6(TP) ;RESET POINTERS
+ MOVE D,-4(TP)
+ SUB TP,[8,,8]
+ 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)
+ MOVE A,(P) ;GET CURRENT OFFSET
+ LSH A,1
+ ADDI A,1
+ ANDI B,-1 ;CHECKFOR REAL REF
+ JUMPE B,SETLP
+ HRRM A,(B) ;CLOBBER CODE
+ JRST SETLP
+
+\f
+; A POSSIBLE MATCH ARRIVES HERE
+
+CHCKD: AOBJN D,NXTBCK ;SIZES DIFFER, JUMP
+ MOVE D,1(C) ;THEY MATCH!, GET EXISTING ATOM
+ HLRZ A,(D) ;GET TYPE OF IT
+ CAIE A,TUNBOU ;UNBOUND?
+ JRST A1VAL ;YES, CONTINUE
+ MOVE B,-2(TP) ;GET NEW ATOM
+ MOVE A,(B) ;MOVE VALUE
+ MOVEM A,(D)
+ MOVE A,1(B)
+ MOVEM A,1(D)
+ MOVE B,D ;EXISTING ATOM TO B
+ PUSHJ P,VALMAK ;MAKE A VALUE
+
+;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
+
+OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP
+ MOVE C,TVP ;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
+ CAMGE C,D ;HAVE WE HIT END
+ 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
+ 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,[8,,8]
+ JRST SETLP1 ;AND GO ON
+
+A1VAL: MOVE B,-2(TP) ;GET NEW ATOM POINTER
+ 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
+
+\f
+;MAKE A VALUE IN SLOT ON GLOBAL SP
+
+VALMAK: HLRZ A,(B) ;TYPE OF VALUE
+ CAIN A,TUNBOU ;VALUE?
+ POPJ P, ;NO, ALL DONE
+ MOVE A,GLOBSP+1(TVP) ;GET POINTER TO GLOBAL SP
+ SUB A,[4,,4] ;ALLOCATE SPACE
+ CAMG A,GLOBAS+1(TVP) ;CHECK FOR OVERFLOW
+ JRST SPOVFL
+ MOVEM A,GLOBSP+1(TVP) ;STORE IT BACK
+ MOVE C,(B) ;GET TYPE CELL
+ HLLZM C,2(A) ;INTO TYPE CELL
+ MOVE C,1(B) ;GET VALUE
+ MOVEM C,3(A) ;INTO VALUE SLOT
+ MOVSI C,TATOM ;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,
+
+SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
+/]
+ JRST TYPIT
+
+
+OBTBL: INTOBL+1(TVP)
+ ERROBL+1(TVP)
+ ROOT+1(TVP)
+
+END SETUP
+
+
+\f\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff