1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-24 11:22:36 +00:00
PDP-10.its/src/mudsys/mudits.131
Adam Sampson a81db26a7a Rename to ITS conventions.
MIDAS and Muddle source get version numbers (as in the 1973 Muddle
source); the build files don't.
2018-04-25 09:32:25 +01:00

570 lines
11 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

TITLE MUDITS -- ITS DEPENDANT MUDDLE CODE
RELOCATABLE
.INSRT MUDDLE >
.GLOBAL %SSNAM,%RSNAM,%KILLM,%LOGOU,%SLEEP,%VALRE,NOTTY,DEMFLG,MSGTYP
.GLOBAL %UNAM,%JNAM,%XUNA,%XJNA,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%GCJB1,%VALFI
.GLOBAL %GCJOB,%SHWND,%GETIP,%INFMP
.GLOBAL GCHN,WNDP,FRNP,FRONT,MESSAG,INITFL,6TOCHS,SGSNAM,MTYO,PGINT,WHOAMI
.GLOBAL %TOPLQ,IPCINI,IPCBLS,%HANG,CTIME,BFLOAT,GCRSET,%MPINT,%GBINT,%SAVIN
.GLOBAL %MPIN,%MPINX,%CLSMP,%CLSM1,%MPIN1,%IMSAV,%IMSV1,%PURIF,PSHGCF
.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%SAVRP,%RSTRP,%CWINF,%FDBUF,BUFGC,P.TOP,P.CORE
.GLOBAL PURBOT,SQUPNT,GETSQU,DIR,%LDRDO,%MPRDO,%IFMP2,SQBLK,SQDIR
.GLOBAL CERR1,CERR2,CERR3,COMPERR,CALER,CALER1,SQLOD,SQKIL,SLEEPR,GETBUF,KILBUF
GCHN==0
CWTP==1000,,4000
RDTP==1000,,200000
WRTP==1000,,100000
GCHI==1000,,GCHN
CRJB==1000,,400001
FME==1000,,-1
FLS==1000,,
%RSTRP:
%OPGFX:
%SAVRP: POPJ P,
SQLOD: MOVEI A,1 ; NUMBER OF PAGES OF BUFFER
PUSHJ P,GETBUF
HRRM B,SQUPNT
ASH B,-10. ; TO PAGES
.SUSET [.RSNAM,,A] ; OPEN FILE TO SQUOZE TABLE
.SUSET [.SSNAM,,SQDIR] ; SET SNAME
.OPEN GCHN,SQBLK
FATAL SQUOZE TABLE NON EXISTANT
.SUSET [.SSNAM,,A]
DOTCAL FILLEN,[[GCHI],[2000,,A]]
.LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS
MOVNS A
HRLM A,SQUPNT
MOVEI A,0
DOTCAL CORBLK,[[RDTP],[FME],B,[GCHI],A]
PUSHJ P,SLEEPR
.CLOSE GCHN,
MOVE A,B ; GET B
ASH A,10.
POPJ P,
SQKIL: PUSHJ P,KILBUF
HLLZS SQUPNT
POPJ P,
GETSQU: HRRZ 0,SQUPNT
JUMPN 0,ATSQ10
JRST SQLOD
ATSQ10: POPJ P,
CTIME: .SUSET [.RRUNT,,B] ; Get user's run time in 4.069 microsecond units
IDIVI B,400000
FSC C,233
FSC B,254
FADR B,C
FDVR B,[250000.00] ; Change to units of seconds
MOVSI A,TFLOAT
POPJ P,
; SET THE SNAME GLOBALLY
%SSNAM: .SUSET [.SSNAM,,A]
POPJ P,
; READ THE GLOBAL SNAME
%RSNAM: .SUSET [.RSNAM,,A]
POPJ P,
; KILL THE CURRENT JOB/LOGOUT
%LOGOU:
%KILLM: .LOGOUT 1,
POPJ P,
; PASS STRING TO SUPERIOR (MONITOR?)
%VALRE: .VALUE (A)
POPJ P,
; DO 'KILL'
%VALFI: .BREAK 16,(A)
POPJ P,
; GO TO SLEEP A WHILE
%SLEEP: .SLEEP A,
POPJ P,
; HANG FOREVER
%HANG: SKIP
.HANG
; READ JNAME
%RJNAM: .SUSET [.RJNAM,,%JNAM]
MOVE A,%JNAM
POPJ P,
; READ XJNAME
%RXJNA: .SUSET [.RXJNA,,%XJNA]
MOVE A,%XJNA
POPJ P,
; READ UNAME
%RUNAM: .SUSET [.RUNAM,,%UNAM]
MOVE A,%UNAM
POPJ P,
; READ XUNAME
%RXUNA: .SUSET [.RXUNA,,%XUNA]
MOVE A,%XUNA
POPJ P,
; HERE TO SEE IF WE ARE A TOP LEVEL JOB
%TOPLQ: PUSH P,A
.SUSET [.RSUPPR,,A] ; READ SUPERIOR
SKIPGE A ; SKIP IF IT EXISTS
AOS -1(P) ; CAUSE SKIP RET
POP P,A
POPJ P,
; ERRORS IN COMPILED CODE MAY END UP HERE
CERR1: MOVE A,EQUOTE NTH-BY-A-NEGATIVE-NUMBER
.SUSET [.RJPC,,B]
JRST CERR
CERR2: MOVE A,EQUOTE NTH-REST-PUT-OUT-OF-RANGE
.SUSET [.RJPC,,B]
JRST CERR
CERR3: MOVE A,EQUOTE UVECTOR-PUT-TYPE-VIOLATION
.SUSET [.RJPC,,B]
COMPERR:
MOVE A,EQUOTE ERROR-IN-COMPILED-CODE
.SUSET [.RJPC,,B]
CERR: PUSH TP,$TATOM
PUSH TP,A
PUSH TP,$TWORD
PUSH TP,B
MOVEI A,2
JRST CALER
; GET AN INFERIOR FOR THE GARBAGE COLLECTOR
%GCJB1:
%GCJOB: PUSH P,A
PUSH P,D
MOVEI 0,(SIXBIT /USR/)
MOVEI A,0 ; USE SAME UNAME
MOVSI B,(SIXBIT /AGC/) ; IDENTIFY
; ROUTINE TO SEE WHETHER MAPCHN IS ALREADY OPEN
.STATUS GCHN,D
ANDI D,77
MOVEM D,PSHGCF
POP P,D
SKIPN PSHGCF ; SKIP IF OPEN
JRST TRYOPN
.IOPUSH GCHN ; PUSH THE CHANNEL
MOVSI B,(SIXBIT /AGE/)
TRYOPN: HRLI 0,7 ; READ BLOCK OUTPUT
.OPEN GCHN,0 ; TRY IT
JRST .+2
JRST GCJB1 ; OK, GET A PAGE
HRLI 0,6
.OPEN GCHN,0 ; AND TRY AGAIN
AOJA B,TRYOPN ; TRY A NEW NAME
.UCLOSE GCHN, ; FLUSH JOB
.CLOSE GCHN, ; AND CHANNEL
AOJA B,TRYOPN
GCJB1: HRLI 0,6 ; REOPEN IN READ
.OPEN GCHN,0
FATAL CAN'T REOPEN INFERIOR IN READ
POP P,A ; RET PAGE TO MAP AS 1ST
MOVEI B,FRNP ; SET UP FRONTEIR
PUSHJ P,%GETIP ; GET IT THERE
PUSHJ P,%SHWND
POPJ P,
; HERE TO WAIT A WHILE FOR CORE
; HERE TO GET A PAGE FOR THE INFERIOR
%GETIP: DOTCAL CORBLK,[[WRTP],[GCHI],A,[CRJB]]
PUSHJ P,SLEEPR
POPJ P,
; HERE TO PURIFY A STRUCTURE
%PURIF: DOTCAL CORBLK,[[RDTP],[FME],A,[FME],A]
FATAL UNABLE TO PURIFY STRUCTURE
POPJ P,
; HERE TO SHARE WINDOW
%SHWND: DOTCAL CORBLK,[[WRTP],[FME],B,[GCHI],A]
FATAL CANT SHARE INFERIOR PAGE
POPJ P,
; HERE TO CAUSE INFERIOR TO HOLD ONTO PURE CORE BEING FLUSHED
%MPINT: PUSH P,B
MOVE B,A ; COPY PAGE POINTER
DOTCAL CORBLK,[[RDTP],[GCHI],A,[FME],B]
FATAL CANT CAUSE INFERIOR TO SHARE ME
POP P,B
POPJ P,
; HERE TO GET BACK WHAT INFERIOR NOW HAS
%GBINT: PUSH P,B
MOVE B,A
DOTCAL CORBLK,[[RDTP],[FME],A,[GCHI],B]
FATAL CANT GET STUFF BACK
POP P,B
POPJ P,
; HERE TO MAP FROM AN INFERIOR TO A NEW BLOCK IN CORE
%MPINX:
%MPIN1: PUSH P,B
EXCH A,B
DOTCAL CORBLK,[[WRTP],[FME],A,[CRJB]]
PUSHJ P,SLEEPR
POP P,A
; HERE TO MAP FROM THE INFERIOR TO THE CORE IMAGE
%MPIN: DOTCAL CORBLK,[[WRTP],[FME],A,[GCHI],B]
FATAL CANT GET INFERIOR CORE BACK
POPJ P,
; HERE TO PROTECT CORE IMAGE
%SAVIN: PUSH P,A
MOVEI 0,(SIXBIT /USR/)
MOVEI A,0 ; USE SAME UNAME
MOVSI B,(SIXBIT /AGD/) ; IDENTIFY
TRYOP1: HRLI 0,7 ; WRITE BLOCK OUTPUT
.OPEN GCHN,0 ; TRY IT
JRST .+2
JRST GCJB2 ; OK, GET A PAGE
HRLI 0,6 ; CHANGE TO READ OPEN
.OPEN GCHN,0 ; AND TRY AGAIN
AOJA B,TRYOP1 ; TRY A NEW NAME
.UCLOSE GCHN, ; FLUSH JOB
.CLOSE GCHN, ; AND CHANNEL
AOJA B,TRYOP1
GCJB2: MOVEM B,SAVNAM
POP P,A
%IMSAV: HRRZ 0,A ; SEE IF 0
CAIE 0,0
JRST IMSAV1
ADD A,[1,,1] ; TO NEXT PAGE
.ACCESS GCHN,[20] ; ACCESS IN INF
PUSH P,B
PUSH P,A
MOVEI A,0
PUSHJ P,%GETIP ; GET AROUND SYSTEM LOSSAGE CONCERNING THE FIRST PAGE
MOVE B,[-1760,,20] ; IOT INTO INFERIOR
.IOT GCHN,B
POP P,A
POP P,B
IMSAV1: MOVE M,A
DOTCAL CORBLK,[[WRTP],[GCHI],A,[FME],A]
FATAL UNABLE TO PROTECT CORE IMAGE
IMSAV2:
; MAKE CORE IMAGE READ ONLY
MOVE A,M ; RESTORE A
DOTCAL CORBLK,[[RDTP],[FME],A,[FME],A]
FATAL CORBLK FAILED
POPJ P,
; MAP A PAGE INTO AGD INFERIOR IN READ ONLY MODE
; PAGE NUMBER IS IN A
%MPRDO: DOTCAL CORBLK,[[RDTP],[GCHI],A,[FME],A]
FATAL CORBLK FAILED
POPJ P,
; HERE TO FIND A BUFFER PAGE FOR C/W HACK
%FDBUF: HRRZ A,PURBOT
SUB A,P.TOP ; CALCULATE ROOM FOR PROSPECTIVE BUFFER
CAIG A,2000 ; SEE IF ROOM
JRST FDBUF1
MOVE A,P.TOP ; START OF BUFFER
HRRM A,BUFGC
POPJ P,
FDBUF1: SETOM BUFGC ; INDICATE NO BUFFER FOUND
POPJ P,
; HERE TO SIMULATE COPY ON WRITE. THIS ROUTINE TAKES A SOURCE PAGE IN A
; AND A BUFFER PAGE IN B
%CWINF: PUSH P,A ; SAVE SOURCE ADDRESS
PUSH P,B ; SAVE BUFFER ADDRESS
ASH B,-10. ; TO PAGES
ASH A,-10.
DOTCAL CORBLK,[[RDTP],[FME],B,[FME],A]
FATAL COPY-WRITE CORBLK FAILED
DOTCAL CORBLK,[[WRTP],[FME],A,[CRJB]]
PUSHJ P,SLEEPR
HRLZ A,(P) ; GET START OF BUFFER
HRR A,-1(P) ; GET START OF SOURCE PAGE
EXCH B,-1(P) ; GET BEGINNING OF SOURCE PAGE
BLT A,1777(B)
MOVE B,-1(P)
DOTCAL CORBLK,[[FLS],[FME],B]
FATAL CANT FLUSH BUFFER
SUB P,[2,,2] ; CLEAN OFF STACK
POPJ P, ; EXIT
; HERE TO PROTECT MUDDLES PURE SPACE
%IMSV1: MOVE M,A
PUSHJ P,%MPINT
POPJ P,
; HERE TO CLOSE THE IMAGE SAVING INFERIOR WITHOUT KILLING IT
%CLSJB: .CLOSE GCHN,
POPJ P,
; HERE TO OPEN AGD INFERIOR IN ORDER TO RESTORE CORE-IMAGE
%IFMP1: .IOPUSH GCHN ; PUSH CURRENT CONTENTS OF CHANNEL
PUSH P,A ; SAVE AC'S
PUSH P,B
MOVEI 0,(SIXBIT /USR/)
MOVEI A,0
MOVE B,SAVNAM
HRLI 0,6
.OPEN GCHN,0
FATAL AGD INFERIOR LOST
POP P,A
POP P,B
POPJ P,
; HERE TO MAP IN A PURE PAGE FROM THE AGD INFERIOR
%LDRDO: DOTCAL CORBLK,[[RDTP],[FME],A,[GCHI],A]
FATAL CORBLK FAILED
POPJ P,
; HERE TO MAP IN FROM AGD INFERIOR AND KILL CORE IMAGE AS WELL
; A HAS SOURCE PAGES AND B DESTINATION PAGES
%IFMP2: PUSHJ P,%INFMP
.IOPOP GCHN
POPJ P,
;HERE TO KILL AN IMAGE SAVING INFERIOR
%KILJB: .IOPUSH GCHN
PUSH P,0
PUSH P,B
PUSH P,C
PUSH P,A
MOVEI 0,(SIXBIT /USR/)
MOVE B,SAVNAM
HRLI 0,6
MOVEI A,0
.OPEN GCHN,0
FATAL AGD INFERIOR LOST
CKPGU: HRRZ A,(P)
DOTCAL CORTYP,[A,,[2000,,B]]
FATAL CORBLK TO UNPURE PAGES FAILED
JUMPL B,PGW
DOTCAL CORBLK,[[WRTP],[FME],A,[GCHI],A]
FATAL CORBLK TO UNPURE PAGES FAILED
PGW: POP P,A
ADD A,[1,,1]
SKIPL A
JRST KILIT
PUSH P,A ; REPUSH A
JRST CKPGU
KILIT: .UCLOS GCHN,
.CLOSE GCHN,
POP P,C
POP P,B
POP P,0
.IOPOP GCHN
POPJ P,
; HERE TO MAP INFERIOR BACK AND KILL SAME
%INFMP: PUSHJ P,%MPIN ; MAP IN IMAGE
.UCLOSE GCHN,
.CLOSE GCHN,
SKIPE PSHGCF ; SKIP IF CHANNEL IS NOT PUSHED
JRST INFMPX
POPJ P,
INFMPX: .IOPOP GCHN ; HAVE MORE THAN ONE GC-INF OPEN IOPOP
SETZM PSHGCF
POPJ P,
; USED TO MAP INFERIOR CONTAINING CORE IMAGE BACK IN AND KILL SAVE
%CLSMP: PUSHJ P,%GBINT
%CLSM1: .UCLOSE GCHN,
.CLOSE GCHN,
POPJ P,
; HACK TO PRINT MESSAGE OF INTEREST TO USER
MESOUT: MOVSI A,(JFCL)
MOVEM A,MESSAG ; DO ONLY ONCE
MOVE A,P.TOP
ADDI A,1777 ; MAKE SURE ON PAGE BOUNDRY
ASH A,-10. ; TO PAGES
MOVE B,VECTOP ; GET VECTOR
ADDI B,1777 ; PAGE AND ROUND
ANDCMI B,1777
MOVEM B,P.TOP
PUSHJ P,P.CORE ; GET CORE
JFCL
SETZB SP,FRM ; HACK TO AVOID LOSSAGE WITH GARBAGE IN SP FIRST TIME
PUSHJ P,PGINT ; INITIALIZE PAGE MAP
PUSHJ P,GCRSET
PUSHJ P,%RSNAM ; GET SAVED SNAME
PUSH P,A ; SAVE IT
SKIPE NOTTY ; HAVE A TTY?
JRST RESNM ; NO, SKIP THIS STUFF
MOVE A,[SIXBIT /MUDSYS/]
PUSHJ P,%SSNAM
MOVEI A,(SIXBIT /DSK/)
SKIPN B,WHOAMI
MOVE B,[SIXBIT /MUDDLE/]
MOVE C,[SIXBIT /MESSAG/]
.OPEN 0,A
JRST RESNM
MESSI: .IOT 0,A ; READ A CHAR
JUMPL A,MESCLS ; DONE, QUIT
CAIE A,14 ; DONT TYPE FF
PUSHJ P,MTYO ; AND TYPE IT OUT
JRST MESSI ; UNTIL DONE
MESCLS: .CLOSE 0,
RESNM: POP P,A ; GET SAVED SNAME BACK
PUSHJ P,%SSNAM ; AND SET IT BACK
RESNM1: POPJ P,
MUDINT: MOVSI 0,(JFCL) ; CLOBBER MUDDLE INIT SWITCH
MOVEM 0,INITFL
PUSHJ P,%RSNAM ; GET SNAME
CAMN A,[-1] ; NO SNAME ?
MOVE A,[SIXBIT /MUDSUB/] ; FOR DEMONS AND THE LIKE
PUSHJ P,6TOCHS ; TO STRING
PUSH TP,$TATOM
PUSH TP,IMQUOTE SNM
PUSH TP,A
PUSH TP,B
MCALL 2,SETG
PUSHJ P,SGSNAM ; SET TO GLOBAL
MOVE E,A ; SAVE IN E
MOVEI A,(SIXBIT /DSK/)
MOVE C,[SIXBIT /INIT/]
SKIPN B,WHOAMI ; SKIP IF NOT A STRAIGHT MUDDLE
JRST STMUDL
.OPEN 0,A
SKIPA D,E
JRST MUDIN1
CAMN D,[SIXBIT /MUDSUB/]
POPJ P,
.SUSET [.SSNAM,,[SIXBIT /MUDSUB/]]
MUDIN2: .OPEN 0,A
POPJ P,
MUDIN1: .CLOSE 0,
PUSH TP,$TCHSTR ; ATTEMPT TO LOAD A MUDDLE INIT FILE
PUSH TP,CHQUOTE READ
MOVE A,B
PUSHJ P,6TOCHS
PUSH TP,A
PUSH TP,B
PUSH TP,$TCHSTR
PUSH TP,CHQUOTE INIT
PUSH TP,$TCHSTR
PUSH TP,CHQUOTE DSK
.SUSET [.RSNAM,,A] ; USE SNAME AROUND
PUSHJ P,6TOCHS
PUSH TP,A
PUSH TP,B
MCALL 5,FOPEN
GETYP 0,A
CAIE 0,TCHAN ; DID THE CHANNEL OPEN ?
POPJ P, ; NO, RETURN
PUSH TP,A
PUSH TP,B
MOVEI B,INITSTR ; TELL USER WHAT'S HAPPENING
SKIPE WHOAMI
JRST .+3
SKIPN NOTTY
PUSHJ P,MSGTYP
MCALL 1,MLOAD
POPJ P,
; BLOCK TO OPEN SQUOZE TABLE
SQDIR: SIXBIT /MUDSAV/
SQBLK: SIXBIT / &DSK/
SIXBIT /SQUOZE/
SIXBIT /TABLE/
STMUDL: MOVE B,[SIXBIT /MUDDLE/]
JRST MUDIN2
IPCINI: PUSHJ P,IPCBLS
INITSTR: ASCIZ /MUDDLE INIT/
IMPURE
SAVNAM: 0 ; SAVED AGD INFERIOR NAME
DEMFLG: 0
MESSAG: PUSHJ P,MESOUT ; MESSAGE SWITCH
INITFL: PUSHJ P,MUDINT ; MUDDLE INIT SWITCH
PURE
END