--- /dev/null
+TITLE SAVE AND RESTORE STATE OF A MUDDLE
+
+RELOCATABLE
+
+.INSRT DSK:MUDDLE >
+
+SYSQ
+
+UNTAST==0
+IFE ITS,[
+IF1,[
+.INSRT STENEX >
+EXPUNGE SAVE
+]
+]
+.GLOBAL MOPEN,MIOT,MCLOSE,MUDSTR,SWAP,STRTO6,GCPDL,RGPRS,ADDNUL,GCSTOP,PHIBOT
+.GLOBAL CHNL0,CHNL1,REOPN,AGC,SWAPIN,MASK1,MASK2,IPCBLS,DEMFLG,FSTART,CKVRS
+.GLOBAL P.CORE,P.TOP,SGSNAM,%RUNAM,%RSNAM,%RJNAM,INTINT,CLOSAL,TTYOPE,PURBOT,CHKPGI
+.GLOBAL NOTTY,PURCLN,6TOCHS,DISXTR,IDVAL1,N.CHNS,PMAPB,PURTOP,HITOP,FRETOP,FREMIN
+.GLOBAL SQKIL,SFRK,GETJS,IJFNS,IJFNS1,MULTSG,MULTI,NOMULT
+
+FME==1000,,-1
+FLS==1000,,
+MFORK==400000
+
+MFUNCTION FSAVE,SUBR
+
+ ENTRY
+
+ JRST SAVE1
+
+MFUNCTION SAVE,SUBR
+
+ ENTRY
+SAVE1: PUSHJ P,SQKIL
+IFE ITS,[
+ SKIPE MULTSG
+ PUSHJ P,NOMULT
+]
+ PUSH P,.
+ PUSH P,[0] ; GC OR NOT?
+IFE ITS,[
+ MOVE B,[400600,,]
+ MOVE C,[440000,,100000]
+]
+ PUSHJ P,GTFNM ; GET THE FILE NAME ONTO P
+ JRST .+2
+ JRST SAVEON
+ JUMPGE AB,TMA ; TOO MUCH STRING
+ GETYP 0,(AB) ; WHAT IS ARG
+ CAMGE AB,[-3,,0] ; NOT TOO MANY
+ JRST TMA
+ CAIN 0,TFALSE
+IFN ITS, SETOM -6(P) ; GC FLAG
+IFE ITS, SETOM (P)
+SAVEON:
+IFN ITS,[
+ MOVSI A,7 ; IMAGE BLOCK OUT
+ MOVEM A,-4(P) ; DIRECTION
+ PUSH P,A
+ PUSH P,-4(P) ; DEVICE
+ PUSH P,[SIXBIT /_MUDS_/]
+ PUSH P,[SIXBIT />/]
+ PUSH P,-4(P) ; SNAME
+ MOVEI A,-4(P) ; POINT TO BLOCK
+ PUSHJ P,MOPEN ; ATTEMPT TO OPEN
+ JRST CANTOP
+ SUB P,[5,,5] ; FLUSH OPEN BLOCK
+ PUSH P,-6(P) ; GC FLAG TO TOP OF STACK (-4 --> -6 TAA)
+]
+ EXCH A,(P) ; CHAN TO STACK GC TO A
+ JUMPL A,NOGC
+ PUSH TP,$TFIX ; CAUSE HAIRY GC TO OCCUR
+ PUSH TP,[0]
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE T
+ MCALL 2,GC
+NOGC: PUSHJ P,PURCLN
+
+; NOW GET VERSION OF MUDDLE FOR COMPARISON
+
+ MOVE A,MUDSTR+2 ; GET #
+ MOVEI B,177 ; CHANGE ALL RUBOUT CHARACTERS
+ MOVEI C,40 ; ----- TO SPACES
+ PUSHJ P,HACKV
+
+ PUSHJ P,WRDOUT
+ MOVE A,P.TOP ; GET TOP OF CORD
+ PUSHJ P,WRDOUT
+ MOVEI A,0 ; WRITE ZERO IF FAST
+IFN ITS, SKIPE -8(P) ; -6 --> -8 TAA
+IFE ITS, SKIPE -1(P)
+ PUSHJ P,WRDOUT
+ MOVE A,VECTOP ; CORE REQUIREMENTS FOR THIS SAVED MUDDLE
+ PUSHJ P,WRDOUT
+
+IFN ITS,[
+ SETZB A,B ; FIRST, ALL INTS OFF
+ .SETM2 A,
+
+; IF FAST SAVE JUMP OFF HERE
+
+ SKIPE -6(P)
+ JRST FSAVE1
+
+]
+
+IFE ITS,[
+ MOVEI A,400000 ; FOR THIS PROCESS
+ DIR ; TURN OFF INT SYSTEM
+
+; IF FAST, LEAVE HERE
+
+ SKIPE -1(P)
+ JRST FSAVE1
+
+; NOW DUMP OUT GC SPACE
+
+]
+IFN ITS,[
+
+DMPDN2: SETZB A,B ; SET UP RENAME WHILE OPEN ETC.
+ MOVE E,-1(P)
+ MOVE D,-2(P)
+ LDB C,[270400,,0] ; GET CHANNEL
+ .FDELE A ; RENAME IT
+ FATAL SAVE RENAME FAILED
+ XOR 0,[<.IOT A>#<.CLOSE>] ; CHANGE TO A CLOSE
+ XCT 0
+
+ MOVE A,MASK1 ; TURN INTS BACK ON
+ MOVE B,MASK2
+ .SETM2 A,
+]
+
+IFE ITS,[
+
+DMPDN2: MOVE A,0
+ CLOSF
+ FATAL CANT CLOSE SAVE FILE
+ CIS ; CLEAR IT SYSTEM
+ MOVEI A,400000
+ EIR ; AND RE-ENABLE
+]
+
+SDONE: MOVE A,$TCHSTR
+ MOVE B,CHQUOTE SAVED
+ JRST FINIS
+
+; SCAN FOR MANY OCCURENCES OF THE SAME THING
+
+
+; HERE TO WRITE OUT FAST SAVE FILE
+
+FSAVE1:
+IFN UNTAST,[
+ PUSHJ P,PUCHK
+]
+ MOVE A,PARTOP ; DONT WRITE OUT "HOLE"
+ ADDI A,1777
+ ANDCMI A,1777
+ MOVEI E,(A)
+ PUSHJ P,WRDOUT
+ MOVE 0,(P) ; CHANNEL TO 0
+IFN ITS,[
+ ASH 0,23. ; TO AC FIELS
+ IOR 0,[.IOT A]
+ MOVEI A,5 ; START AT WORD 5
+]
+IFE ITS,[
+ MOVE A,[-<P-E>,,E]
+ PUSH P,(A)
+ AOBJN A,.-1
+ MOVE A,0
+ MOVE B,P ; WRITE OUT P FOR WIINAGE
+ BOUT
+ MOVE B,[444400,,20]
+ MOVNI C,20-6
+ SOUT ; MAKE PAGE BOUNDARIES WIN
+ MOVEI A,20 ; START AT 20
+]
+ MOVEI B,(E) ; PARTOP TO B
+ PUSHJ P,FOUT ; WRITE OUT UP TO PAIR TOP
+ PUSHJ P,PUROUT
+ SUB P,[1,,1] ; CLEAN OFF STACK
+ JRST DMPDN2
+
+IFN ITS,[
+FOUT: MOVEI D,(A) ; SAVE START
+ SUB A,B ; COMPUTE LH OF IOT PNTR
+ MOVSI A,(A)
+ SKIPL A ; IF + MEANS GROSS CORE SIZE
+ MOVSI A,400000 ; USE BIGGEST
+ HRRI A,(D)
+ XCT 0 ; ZAP, OUT IT GOES
+ CAMGE A,B ; SKIP IF ALL WENT
+ JRST FOUT ; DO THE REST
+ POPJ P, ; GO CLOSE FILE
+]
+IFE ITS,[
+FOUT: MOVEI C,(A)
+ SUBI C,(B) ; # OF BYTES TP C
+ MOVEI B,(A) ; START TO B
+ HRLI B,444400
+ MOVE A,0
+ SOUT ; WRITE IT OUT
+ POPJ P,
+]
+
+
+; HERE TO ATTEMPT TO RESTORE A SAVED STATE
+
+MFUNCTION RESTORE,SUBR
+
+ ENTRY
+ PUSHJ P,SQKIL
+IFE ITS,[
+ MOVE B,[100600,,]
+ MOVE C,[440000,,240000]
+]
+ PUSHJ P,GTFNM
+ JRST TMA
+IFN ITS,[
+ MOVSI A,6 ; READ/IMAGE/BLOCK
+ MOVEM A,-4(P)
+ MOVEI A,-4(P)
+ PUSHJ P,MOPEN ; OPEN THE LOSER
+ JRST FNF
+ SUB P,[6,,6] ; REMOVE OPEN BLOCK
+
+ PUSH P,A ; SAVE CHANNEL
+ PUSHJ P,SGSNAM ; SAVE SNAME IN SYSTEM
+]
+IFE ITS, PUSH P,A ; SAVE JFN
+ PUSHJ P,CKVRS ; CHECK THE VERSION NUMBER
+
+IFN ITS, MCALL 0,IPCOFF ; CLOSE ALL IPC CHANS
+ PUSHJ P,CLOSAL ; CLOSE CHANNELS
+IFN ITS,[
+ SETZB A,B ; KILL ALL POSSIBLE INTERRUPTION
+ .SETM2 A,
+ DOTCAL UNLOCK,[[1000,,-1]]
+ .VALUE ; UNLOCK LOCKS
+]
+IFE ITS,[
+ MOVEI A,400000 ; DISABLE INTS
+ DIR ; INTS OFF
+
+ HLRZ A,IJFNS ; CLOSE AGC
+ CLOSF
+ JFCL
+ HRRZ A,IJFNS ; CLOSE INTERPRETER
+ CLOSF
+ JFCL
+ HLRZ A,IJFNS1 ; CLOSE SGC
+ CLOSF
+ JFCL
+
+ HRRZ A,IJFNS1
+ CLOSF
+ JFCL
+
+ SETZM IJFNS
+ SETZM IJFNS1
+]
+ PUSHJ P,PURCLN ; DONT KEEP PURE SHAREDNESS
+
+ POP P,E
+IFE ITS,[
+ SKIPLE A,SFRK ; IF WE HAVE AN INFERIOR, KILL IT
+ KFORK
+]
+ MOVE A,E
+FSTART: MOVE P,GCPDL
+ PUSH P,A
+IFN ITS,[
+ MOVE 0,[1-PHIBOT,,1]
+ DOTCAL CORBLK,[[FLS],[FME],0]
+ FATAL CANT FLUSH PURE PAGES
+]
+ PUSHJ P,WRDIN ; GET P.TOP
+ ASH A,-10.
+ MOVE E,A
+ PUSHJ P,WRDIN ; READ A WORD (VECTOP) OR 0==>FAST I.E. MAP RESTORE
+ JUMPE A,FASTR
+
+IFE ITS,[
+FASTR1: MOVEI A,P-1
+ MOVEI B,P-1-E
+ POP P,(A)
+ SUBI A,1
+ SOJG B,.-2
+]
+
+IFN ITS,[
+FASTR1:
+]
+IFN ITS, MOVEM E,NOTTY ; SAVE TTY FLAG
+IFE ITS,[
+ MOVEM E,DEMFLG
+ PUSHJ P,GETJS
+ HRRZS IJFNS
+ SETZM IJFNS1
+]
+ PUSHJ P,PURCLN ; IN CASE RESTORED THING HAD PURE STUFF
+ PUSHJ P,INTINT ; USE NEW INTRRRUPTS
+
+IFN ITS,[
+ .SUSET [.RSNAM,,A]
+ PUSH P,A
+]
+
+; NOW CYCLE THROUGH CHANNELS
+ MOVE C,[-N.CHNS*2,,CHNL1] ; POINT TO REAL CHANNELS SLOTS
+ PUSH TP,$TVEC
+ PUSH TP,C
+ PUSH P,[N.CHNS]
+
+CHNLP: HRRZ A,(C) ; SEE IF NEW VALUE
+ JUMPN A,NXTCHN
+ SKIPN B,1(C) ; GET CHANNEL
+ JRST NXTCHN
+ PUSHJ P,REOPN
+ PUSHJ P,CHNLOS
+ MOVE C,(TP) ; GET POINTER
+NXTCHN: ADD C,[2,,2] ; AND BUMP
+ MOVEM C,(TP)
+ SOSE (P)
+ JRST CHNLP
+
+ SKIPN C,CHNL0+1 ; ANY PSUEDO CHANNELS
+ JRST RDONE ; NO, JUST GO AWAY
+ MOVSI A,TLIST ; YES, REOPEN THEM
+ MOVEM A,(TP)-1
+CHNLP1: MOVEM C,(TP) ; SAVE POINTER
+ SKIPE B,(C)+1 ; GET CHANNEL
+ PUSHJ P,REOPN
+ PUSHJ P,CHNLO1
+ MOVE C,(TP) ; GOBBLE POINTER
+ HRRZ C,(C) ; REST LIST OF PSUEDO CHANNELS
+ JUMPN C,CHNLP1
+
+RDONE: MOVE A,VECTOP
+ CAMN A,P.TOP
+ JRST NOCOR
+ SETZM (A)
+ HRLS A
+ ADDI A,1 ; SET UP BLT POINTER
+ MOVE B,P.TOP
+ BLT A,-1(B) ; TO THE TOP OF THE WORLD
+NOCOR: SUB TP,[2,,2]
+ SUB P,[1,,1]
+ PUSHJ P,TTYOPE
+IFN ITS,[
+ PUSHJ P,IPCBLS ;BLESS ALL THE IPC CHANNELS
+ PUSHJ P,SGSNAM ; GET SNAME
+ SKIPN A
+ MOVE A,(P) ; GET OLD SNAME
+ SUB P,[1,,1]
+ PUSHJ P,6TOCHS ; TO STRING
+]
+IFE ITS,[
+ PUSHJ P,SGSNMQ ; SKIPS IF SNAME IS NON-NIL
+ PUSHJ P,%RSNAM ; ELSE GETS "REAL" SNAME
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,SNAME
+ SETOM SFRK
+]
+ PUSHJ P,%RUNAM
+ PUSHJ P,%RJNAM
+ MOVE A,$TCHSTR
+ MOVE B,CHQUOTE RESTORED
+ JRST FINIS
+
+IFE ITS,[
+;SKIPS IF THERE IS AN SNAME, RETURNING IT
+SGSNMQ: MOVE B,IMQUOTE SNM
+ PUSHJ P,IDVAL1
+ GETYP 0,A
+ CAIE 0,TCHSTR
+ JRST CPOPJ
+ HRRZ 0,A
+ JUMPE CPOPJ
+ JRST CPOPJ1
+]
+
+FASTR:
+IFN ITS,[
+ PUSHJ P,WRDIN
+ ADDI A,1777
+ ANDCMI A,1777 ; ROUND AND TO PAGE BOUNDRY
+ ASH A,-10. ; TO PAGES
+ MOVNS A
+ MOVSI A,(A) ; TO PAGE AOBJN
+ MOVE C,A ; COPY OF POINTER
+ MOVE 0,NOTTY ; SAVE NOTTY FLAG AROUND
+ MOVE D,(P) ; CHANNEL
+ DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,D,C]
+ FATAL CORBLK ON RESTORE LOSSAGE
+ PUSHJ P,PURIN ; GET PURIFIED STRUCTURE
+ MOVSI A,(D) ; GET CHANNLEL BACK
+ ASH A,5
+ MOVEI B,E ; WHERE TO STRAT IN FILE
+ IOR A,[.ACCESS B]
+ XCT A ; ACCESS TO RIGHT ACS
+ XOR A,[<.IOT B>#<.ACCESS B>]
+ MOVE B,[D-P-1,,E]
+ XCT A ; GET ACS
+ MOVE E,0 ; NO TTY FLAG BACK
+ XOR A,[<.IOT B>#<.CLOSE>]
+ XCT A
+ MOVE A,GCSTOP ; GET CORE AND FOOL P.CORE
+ ADDI A,1777
+ ANDCMI A,1777
+ EXCH A,P.TOP ; GET P.TOP
+ ASH A,-10. ; TO PAGES
+ PUSHJ P,P.CORE
+ PUSHJ P,NOCORE
+ JRST FASTR1
+]
+
+IFE ITS,[
+FASTR: POP P,A ; JFN TO A
+ BIN ; CORE TOP TO B
+ MOVE E,B ; SAVE
+ BIN ; PARTOP
+ MOVE D,B
+ BIN ; SAVED P
+ MOVE P,B
+ MOVE 0,DEMFLG ; SAVE DEMFLG FLAG AROUND
+ HRL E,C ; SAVE VECTOP
+ MOVSI A,(A) ; JFN TO LH
+ MOVSI B,400000 ; FOR ME
+ MOVSI C,120400 ; FLAGS
+ ASH D,-9. ; PAGES TO D
+ PMAP
+ ADDI A,1
+ ADDI B,1
+ SOJG D,.-3
+
+ PUSHJ P,PURIN
+
+ HLRZS A
+ CLOSF
+ JFCL
+ MOVE E,0 ; DEMFLG TO E
+ JRST FASTR1
+]
+
+; HERE TO GROCK FILE NAME FROM ARGS
+
+GTFNM:
+IFN ITS,[
+ PUSH P,[0] ; DIRECTION
+ PUSH TP,$TPDL
+ PUSH TP,P
+ IRP A,,[DSK,MUDDLE,SAVE]
+ PUSH P,[SIXBIT /A/]
+ TERMIN
+ PUSHJ P,SGSNAM ; GET SNAME
+ PUSH P,A ; SAVE SNAME
+ JUMPGE AB,GTFNM1
+ PUSHJ P,RGPRS ; PARSE THESE ARGS
+ JRST .+2
+GTFNM1: AOS -5(P) ; SKIP RETURN
+ MOVE A,(P) ; GET SNAME
+ .SUSET [.SSNAM,,A]
+ MOVE A,-5(P) ; GET RET ADDR
+ SUB TP,[2,,2]
+ JRST (A)
+
+; HERE TO OUTPUT 1 WORD
+
+WRDOUT: PUSH P,B
+ PUSH P,A
+ HRROI B,(P) ; POINT AT C(A)
+ MOVE A,-3(P) ; CHANNEL
+ PUSHJ P,MIOT ;WRITE IT
+POPJB: POP P,A
+ POP P,B
+ POPJ P,
+
+; HERE TO READ 1 WORD
+WRDIN==WRDOUT
+]
+IFE ITS,[
+ PUSH P,C
+ PUSH P,B
+ MOVE B,IMQUOTE SNM
+ PUSHJ P,IDVAL1
+ GETYP 0,A
+ CAIN 0,TUNBOU
+ JRST GTFNM0
+ TRNN A,-1 ;ANY LENGTH?
+ PUSHJ P,%RSNAM ;IF <SNAME> IS "", GET REAL ONE
+ PUSHJ P,ADDNUL
+ SKIPA
+GTFNM0: MOVEI B,0
+ PUSH P,[377777,,377777]
+ PUSH P,[-1,,[ASCIZ /DSK/]]
+ PUSH P,B
+ PUSH P,[-1,,[ASCIZ /MUDDLE/]]
+ PUSH P,[-1,,[ASCIZ /SAVE/]]
+ PUSH P,[0]
+ PUSH P,[0]
+ PUSH P,[77] ; USE AN OBSCURE JFN IF POSSIBLE
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ PUSHJ P,ADDNUL
+ MOVEI A,-10(P)
+ GTJFN
+ JRST FNF
+ SUB P,[9.,,9.]
+ POP P,B
+ OPENF
+ JRST FNF
+ ADD AB,[2,,2]
+ SKIPL AB
+CPOPJ1: AOS (P)
+CPOPJ: POPJ P,
+
+WRDIN: PUSH P,B
+ MOVE A,-2(P) ; JFN TO A
+ BIN
+ MOVE A,B
+ POP P,B
+ POPJ P,
+
+WRDOUT: PUSH P,B
+ MOVE B,-2(P)
+ EXCH A,B
+ BOUT
+ EXCH A,B
+ POP P,B
+ POPJ P,
+]
+
+
+;REPLACE ALL OCCURANCES OF CHARACTER (B) TO CHARACTER (C) IN A
+HACKV: PUSH P,D
+ PUSH P,E
+ MOVE D,[440700,,A]
+ MOVEI E,5
+HACKV1: ILDB 0,D
+ CAIN 0,(B) ; MATCH ?
+ DPB C,D ; YES, CLOBBER
+ SOJG E,HACKV1
+ POP P,E
+ POP P,D
+ POPJ P,
+
+
+CANTOP: ERRUUO EQUOTE CANT-OPEN-OUTPUT-FILE
+
+FNF: ERRUUO EQUOTE FILE-NOT-FOUND
+
+BADVRS: ERRUUO EQUOTE MUDDLE-VERSIONS-DIFFER
+
+
+CHNLO1: MOVE C,(TP)
+ SETZM 1(C)
+ JRST CHNLO2
+
+CHNLOS: MOVE C,(TP)
+ SETZM (C)-1
+CHNLO2: MOVEI B,[ASCIZ /
+CHANNEL-NOT-RESTORED
+/]
+ JRST MSGTYP"
+
+
+NOCORE: PUSH P,A
+ PUSH P,B
+ MOVEI B,[ASCIZ /
+WAIT, CORE NOT YET HERE
+/]
+ PUSHJ P,MSGTYP"
+ MOVE A,-1(P) ; RESTORE BLOCKS NEEDED
+ MOVEI B,1
+ .SLEEP B,
+ PUSHJ P,P.CORE
+ JRST .-4
+ MOVEI B,[ASCIZ /
+CORE ARRIVED
+/]
+ PUSHJ P,MSGTYP
+ POP P,B
+ POP P,A
+ POPJ P,
+
+IFN UNTAST,[
+PUCHK: MOVEI E,HIBOT ; COMPUTE REAL START OF INTERPRETER
+ ASH E,-10. ; TO PAGES
+ MOVE A,PURTOP ; GET START TO POSSIBLE AREA CONTAINING P.S.
+ ASH A,-10. ; TO PAGES
+PURCH1: PUSHJ P,CHKPGI ; SEE IF PAGE IS PURIFIED
+ JFCL
+ ADDI A,1 ; INCREMENT PAGE COUNTER
+ CAMG A,E ; SKIP IF DONE
+ JRST PURCH1
+ POPJ P,
+]
+
+; THESE ROUTINES ARE USED BY SAVE AND RESTORE TO GET PAGES OF PURE STRUCTURE
+; INTO A SAVE FILE.
+
+PUROUT: MOVEI E,HIBOT ; COMPUTE REAL START OF INTERPRETER
+ ASH E,-10. ; TO PAGES
+ MOVE A,PURTOP ; GET START TO POSSIBLE AREA CONTAINING P.S.
+ ASH A,-10. ; TO PAGES
+PUROU2: PUSHJ P,CHKPGI ; SEE IF PAGE IS PURIFIED
+ JRST INCPUT
+ PUSH P,A ; SAVE A
+ ASH A,10. ; TO WORDS
+ HRLI A,-2000 ; MAKE UP AOBJN PTR FOR IOT
+ MOVE B,-2(P) ; RESTORE CHN #
+IFN ITS,[
+ DOTCAL IOT,[B,A]
+ FATAL SAVE--IOT FAILED
+]
+IFE ITS,[
+ PUSH P,C ; SAVE C
+ MOVE B,A ; SET UP BYTE POINTER
+ MOVE A,0 ; CHANNEL TO A
+ HRLI B,444400 ; SET UP BYTE POINTER
+ MOVNI C,2000
+ SOUT ; OUT IT GOES
+ POP P,C
+]
+
+ POP P,A ; RESTORE PAGE #
+INCPUT: ADDI A,1 ; INCREMENT PAGE COUNTER
+ CAMG A,E ; SKIP IF DONE
+ JRST PUROU2
+ POPJ P,
+
+
+IFN UNTAST,[
+
+CHKPGJ: TDZA 0,0
+]
+CHKPGI:
+IFN UNTAST,[
+ MOVEI 0,1
+]
+ PUSH P,A ; SAVE IT
+ IDIVI A,16. ; FIND ENTRY IN PMAP TABLE
+ MOVE C,PMAPB(A) ; GET WORD CONTAINING ENTRY
+ HRLZI D,400000 ; SET UP TEST WORD
+ IMULI B,2
+ MOVNS B
+ LSH D,(B) ; GET TO CHECK PAIR
+ LSH D,-1 ; TO BIT INDICATING SAVE
+ TDON C,D ; SKIP IF PAGE CONTAINS P.S
+ JRST PUROU1
+ POP P,A
+ AOS (P) ; SKIP ITS A WINNER
+IFN UNTAST,[
+ JUMPN 0,.+4
+ LSH D,1
+ TDNN C,D
+ AOS (P)
+] POPJ P, ; EXIT
+PUROU1:
+IFN UNTAST,[
+ JUMPE 0,CHKPG2
+IFN ITS,[
+ PUSH P,A
+ DOTCAL CORTYP,[A,[2000,,A],[2000,,0]]
+ FATAL DOTCAL FAILURE
+ SKIPN A
+ MOVEI 0,0
+ POP P,A
+ JUMPGE 0,CHKPG2
+]
+IFE ITS,[
+ PUSH P,A
+ PUSH P,B
+ LSH A,1
+ HRLI A,400000
+ RPACS
+ MOVE 0,B
+ POP P,B
+ POP P,A
+ TLC 0,150400
+ TRNE 0,150400
+ JRST CHKPG2
+]
+ LSH D,1
+ TDO C,D
+ MOVEM C,PMAPB(A)
+ AOS -1(P)
+CHKPG2:]
+ POP P,A
+ POPJ P,
+
+
+; ROUTINE TO READ IN PURE STRUCTURE PAGES
+
+IFN ITS,[
+PURIN: PUSH P,D ; SAVE CHANNEL #
+ MOVEI E,HIBOT ; COMPUTE REAL START OF INTERPRETER
+ ASH E,-10. ; TO PAGES
+ MOVE A,PURTOP ; GET START TO POSSIBLE AREA CONTAINING P.S.
+ ASH A,-10. ; TO WORDS
+PURIN1:
+IFN UNTAST, PUSHJ P,CHKPGJ ; SEE IF PURE PAGE EXISTS
+IFE UNTAST, PUSHJ P,CHKPGI ; SEE IF PURE PAGE EXISTS
+ JRST NXPGPN
+IFN UNTAST,[
+ SKIPA D,[200000]
+ MOVEI D,[104000]
+ MOVSI 0,(D)
+]
+ PUSH P,A ; SAVE A
+ MOVE D,-1(P) ; RESTORE CHANNEL #
+ HRLI A,-1 ; SET UP AOBJN POINTER FOR DOTCAL
+IFN UNTAST,[
+ DOTCAL CORBLK,[0,[1000,,-1],A,D]
+]
+IFE UNTAST,[
+ DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,D]
+]
+ FATAL SAVE--CORBLK FAILED
+ POP P,A ; RESTORE A
+NXPGPN: ADDI A,1
+ CAMG A,E ; SKIP IF DONE
+ JRST PURIN1
+ POP P,D ; RESTORE CHANNEL
+ POPJ P,
+]
+IFE ITS,[
+PURIN: PUSH P,A ; SAVE CHANNEL
+ MOVEI E,HIBOT ; TOP OF SCAN
+ ASH E,-10.
+ MOVE A,PURBOT ; BOTTOM OF SCAN
+ ASH A,-10. ; TO PAGES
+PURIN1: PUSHJ P,CHKPGI ; SEE IF PAGE IS NEEDED
+ JRST NXTPGN
+ SKIPA C,[120000]
+ MOVEI C,120400
+ PUSH P,A
+ MOVE B,A ; COPY TO B
+ ASH B,1 ; FOR TEXEX PAGES
+ HRLI B,MFORK ; SET UP ARGS TO PMAP
+ MOVSI C,(C)
+ MOVE A,-1(P) ; GET FILE POINTER
+ PMAP ; IN IT COMES
+ ADDI B,1 ; INCREMENT B
+ ADDI A,1 ; AND A
+ PMAP ; SECOND HALF OF ITS PAGE
+ ADDI A,1
+ MOVEM A,-1(P) ; SAVE FILE PAGE
+ POP P,A
+NXTPGN: ADDI A,1
+ CAMG A,E ; SKIP IF DONE
+ JRST PURIN1
+ POP P,A ; RESTOR CHANNEL
+ POPJ P, ;EXIT
+]
+CKVRS: PUSH P,-1(P)
+ PUSHJ P,WRDIN ; READ MUDDLE VERSION
+ MOVEI B,40 ; CHANGE ALL SPACES
+ MOVEI C,177 ; ----- TO RUBOUT CHARACTERS
+ PUSHJ P,HACKV
+ CAME A,MUDSTR+2 ; AGREE ?
+ JRST BADVRS
+ SUB P,[1,,1] ; POP OFF CHANNEL #
+ POPJ P,
+
+
+END
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff