; -*-MIDAS-*- .SYMTAB 10000. TITLE DECUUO -- DEC UUO emulator for ITS VERSION==.FNAM2 ; For information on how to use DECUUO, read .info.;decuuo order. ; If you care about the revision history, see MC:DECSYS;DECUUO HISTOR subttl Conditional Assembly ; MACRO's to clean up the source define TWO ifn TWOSW!termin define NOTWO ife TWOSW!termin ifndef TWOSW,TWOSW==-1 ;separate code into pure and impure pages QQUOTE==^^ ;quote character for unmapping TV keyboard input CTRL==^B META==^C ;character interpreted as META bit CTLMTA==^F ;AC assignments M=1 ;used for display A=2 ;don't change these without changing the drawing program B=3 C=4 D=5 E=6 P=7 T=10 ;don't use these AC's in the UUO handler TT=11 ; "" LOWAC==M ;lowest AC used by UUO handler HIGHAC==P ;highest AC used by UUO handler subttl Macros and Storage Area Definitions NOTWO,[DEFINE STORAGE (A) TERMIN ] TWO,[ DEFINE STORAGE (NAM) IFE LCPURE-LCCURR,LCPURE==. IFE LCIMPU-LCCURR,LCIMPU==. .==LC!NAM LCCURR==. TERMIN ];TWO TVBUF==700000 ;PDP-11 TV BUFFER IN OUR MAP TVPAGS==10 ;10 PAGES OF TV BUFFER IMPURE==TVBUF+*2000 ;ORIGIN OF IMPURE AREA PURE==740000 ;ORIGIN OF PURE AREA AVAILP==/2000 ;PAGES AVAILABLE FOR CLIENT LOC IMPURE LCIMPU==IMPURE LCPURE==PURE LCCURR==IMPURE DEFINE PHASE X OFFSET X-. TERMIN DEFINE DEPHASE OFFSET 0 TERMIN DEFINE POINT (S,ADDR,B=-1,) <<<<35.-.RADIX 10.,B>&77>_30.\<<.RADIX 10.,S>&77>_24.> ADDR>TERMIN DEFINE INSIRP A,B IRPS XXX,,[B] A,XXX TERMIN TERMIN DEFINE SYSCAL NAME,ARGS .CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] TERMIN DEFINE SYSCLV NAME,ARGS .CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] .LOSE 1000 TERMIN DEFINE ERROUT STRING/ .SUSET [.RJPC,,ERRJPC] MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC SOS UUOH .VALUE [ASCIZ \:STRING 2\] SETZM UUO40 JRST 2,@UUOH TERMIN COMMENT  .XCREF A,B,C,D,E,P HERE ARE THE ITS AND DEC UUOS LINED UP FOR ALL TO SEE THOSE WHICH ARE NOT IMPLEMENTED ARE DENOTED WITH A "*". 40 .IOT CALL 41 .OPEN INIT 42 .OPER 43 .CALL 44 .USET 45 .BREAK 46 .STATUS 47 .ACCESS CALLI 50 OPEN 51 TTCALL 52 53 54 55 RENAME 56 IN 57 OUT 60 SETSTS 61 STATO 62 GETSTS 63 STATZ 64 INBUF 65 OUTBUF 66 INPUT 67 OUTPUT 70 CLOSE 71 RELEASE 72 MTAPE 73 UGETF* 74 USETI 75 USETO 76 LOOKUP 77 ENTER 100 UJEN*  IFNDEF .JB41,[ .INSRT SYS:DECDFS > .DECDF .DEC.J .DECS1 ;WE WANT THE JOBDAT SYMBOLS IN OUR OWN BLOCK BECAUSE WE DON'T .DECJH .DECHK ;HAVE A JOBDAT.REL LINKED IN WITH US. ] .INSRT SYS:DECBTS > CL.LOS==1000 ;CLOSE SHOULDN'T FILE AWAY (IE, SHOULD RENAME FIRST). ;IO CHANNELS LOADCH==0 ;CHANNEL USED FOR LOADING ;CHANNELS 16, 17 INITIALLY USED FOR TTY I/O BUT THEY MAY BE CHANGED ;DURING OPRERATION - SEE TTYOCH AND TTYICH. ;SIMILARLY, 14 INITIALLY USED FOR DISPLAY HACKERY. SIXCH==15 ;DPY TYPES DPY340==0 ;DEC 340 DPYGT4==1 ;GT40 DPYTV==2 ;PDP-11 TV TVOR==16 ;TV ALU MODES TVSET==17 ;WE PREFER ZENITH TVXOR==6 TVNXM==TVBUF+ ;FIRST ILLEGAL LOC AFTER TV MAP TVCREG==TVNXM DEFINE TVALU [341000,,TVCREG]TERMIN PGLEN==20 ;NUMBER OF PIECES OF GLASS PPLEN==1 ;NUMBER OF PIECES OF PAPER PGPPLN==PGLEN+PPLEN PPHDL==2 ;LENGTH OF PIECE OF PAPER HEADER PPBKL==200 ;SIZE OF CURRENT PIECE OF PAPER BUFFER HIBASE==600000 ;BASE ADDRESS OF DISPLAY LIST STORAGE MAXJ==200 ;MAX # JOBS (AS FAR AS SIMULATED PROGRAM IS CONCERNED) ;OUGHT TO BE > I.T.S. MAX # OF JOBS. subttl PDP-6 Display Program STORAGE(PURE) SIXPRG==. DIS==130 SIXORG==100 ;ORIGIN OF PDP-6 PROGRAM IN PDP-6 PHASE SIXORG SIXGO:: CONO DIS,100 ;GRAB THE 340 6WAIT:: SKIPN DLSTOP-HIBASE JRST .-1 MOVEI A,DLVIS-HIBASE LOOP:: JUMPE A,6WAIT ;END OF LIST CONO DIS,100 ;RESET 340 MOVE A,(A) HLRZ B,A ;POINTS TO BLKO POINTER HRRZS A CAIE A,0 ;DONT RELOCATE NULL POINTER SUBI A,HIBASE JUMPE B,LOOP ;POINTS AT NOTHING SUBI B,DLPP-DLPP6+HIBASE ;POINTS TO BLKO POINTER SKIPL B,(B) ;THE BLKO POINTER JRST LOOP ;NOT REALLY BLKO POINTER SUBI B,HIBASE LOOP1:: MOVEI C,100 ;TIME OUT IN CASE DISPLAY HANGS CONSO DIS,200 ;WAIT FOR DONE SOJG C,.-1 JUMPE C,ERR SKIPN DLSTOP-HIBASE JRST 6WAIT ;DISPLAY STOPPED BY PDP10 BLKO DIS,B JRST .+2 ;BLKO COUNTED OUT JRST LOOP1 ;MORE TO GO MOVEI C,200 CONSO DIS,100 ;WAIT FOR DONE SOJG C,.-1 JRST LOOP ERR:: CONSO DIS,5000 JRST LOOP CONO DIS,200 ;EDGE PROTECTION VIOLATION JRST LOOP1 SIXPAT::BLOCK 20 SIXEND::0 DEPHASE HIUSE==SIXEND DEFINE DPYSTG(NAME,LENGTH) NAME=HIUSE+HIBASE ? HIUSE==HIUSE+LENGTH TERMIN DPYSTG(DLSTOP,1) ;-1=>DISPLAY RUNNING DPYSTG(PPBLK,PPBKL) ;BUFFER FOR ACTIVE PIECE OF PAPER DPYSTG(DLVIS,PGPPLN) ;THAT WHICH IS GIVEN TO THE SYSTEM DPYSTG(DLPP6,1) ;BLKO POINTER TO ACTIVE PIECE OF PAPER (MUST PRECEDE DLPG6) DPYSTG(DLPG6,PGPPLN) ;340 PAGE POINTERS (BLKO FORMAT)(ACCESSIBLE TO PDP-6) subttl Configuration Variables STORAGE IMPURE IFN .-IMPURE,.ERR IMPURE WORDS ASSEMBLED BEFORE COMFIGURATION VARS ;ADD TO THIS PAGE ONLY AT THE END. ;WORDS TO SET TO DEBUG PROGRAM'S REACTIONS TO ADVERSE OPERATING SYSTEM CONDITIONS CORMAX: HIBASE ;# OF WORDS JOB CAN HAVE. FT2REL:: TWOSEG: -1 ;WE DO HANDLE TWO SEGMENTS ;WORDS THAT ENABLE OR DISABLE SYSTEM FUNCTIONS SELECTIVELY FT5UUO: -1 ;IF 0, ALL CALLS THAT REQUIRE IT SIMPLY FAIL TO SKIP. ;SINCE SOME AREN'T IMPLEMENTED AND WILL GO TO MISSING, ;SOME PROGRAMS CAN ONLY BE SIMULATED WITH THIS SWITCH = 0. PRIVIL: 0 ;NONZERO => JOB IS PRIVILEGED. THAT MEANS THAT PRIVILEGED ;SYSTEM FUNCTIONS WILL GO TO MISSING INSTEAD OF JUST ;FAILING TO SKIP. ;THIS WORD IS READ IN BY GETTAB AS THE JOB'S PRIVILEGE WORD. ;FLAGS TO MAKE SPECIFIC UUOS AVOID COMPLAINING. ZDISK.: 0 ;0 => DISK. JUST RETURNS. -1 => CALLS MISSING FTTMP:: ZTMPCO: 0 ;0 => TMPCOR SAYS FILE NOT FOUND. -1 => MISSING ZREASS: 0 ;0 => REASSI TRIES TO AVOID COMPLAINING. -1 => MISSING ZSEEK: 0 ;0 => SEEK IS A NO-OP. -1 => MISSING FTSFD: -1 ;0 => PATH. NOT IMPLEMENTED. -1 => TRIES TO WORK. ZSFDTRN:-1 ;0 => NO SFD'S EXIST. -1 => SFD "FOO" IS I.T.S. UFD "FOO". ZPTLOA: 0 ;0 => PTLOAD IS NO-OP. -1 => MISSING. 0 ;(obsolete) 0 ;(obsolete) FTSET: -1 ;-1 => SETUUO EXISTS (BUT IS EITHER MISSING, PRIV OR NO-OP). ZSTUUO: 0 ;0 => UNIMPLEMENTED UNPRIVILEGED SETUUO FUNCTIONS ARE NO-OPS. ;-1 => THEY ARE MISSING. ZJOBS: 0 ;-1 => JOBS OTHER THAN THIS ONE SAY MISSING. ;0 => THEY GIVE "JOB DOESN'T EXIST" RETURN. ZPROT: 0 ;-1 => BARF IF TRY TO SET PROTECTION CODE WITH ENTER ZCRDAT: 0 ;-1 => BARF IF TRY TO SET CREATION DATE WITH ENTER ZMPV: -1 ;0 => DON'T LET USER PROGRAM ENABLE MPV WITH APRENB ;(JUST IGNORE ATTEMPTS). MPV'S ALWAYS CAUSE ERRORS. 0 ;(obsolete) ZGTTAB: -1 ;0 => IMPORTANT GETTABS THAT WE CAN'T HANDLE FAIL. ;-1 => THEY ARE MISSING. FTPTYUUO:-1 ;-1 => JOBSTS AND CTLJOB UUOS EXIST, MINIMALLY. ZPHYS: 0 ;0 => IGNORE UU.PHY, UU.PHS, UU.DER, UU.DEL. -1 => MISSING 0 ;(obsolete) ZNDATE: 0 ;0 => GMT TIME RETURNED AS 0 (ENOUGH FOR COMPIL!); -1 => MISSING ztrmop: 0 ;0 => TRMOP. is a no-op ;-1 => it is missing zobsolete:0 ;0 => obsolete UUO's work normally ;-1 => they are obsolete zimplement:0 ;0 => never implemented UUO's are no-ops ;-1 => they are never implemented STORAGE PURE subttl Impure Storage ;INTERRUPT LEVEL STORAGE TTYBFL==200 TTYBPW==4 ;NUMBER BYTES PER WORD IN TTY BUFFER INT1PL==20 INTPDL==3* STORAGE(IMPURE) DITSVR: .FNAM1 ;SOURCE FILE IN SIXBIT .FNAM2 WATCH: 0 ;JOB'S WATCH BITS. APRBIT: 0 ;APR TRAP BITS ENABLED CLKENB: 0 ;-1 => CLOCK INTS ARE NEEDED, SO ENABLE THEM. ACTCHR: 0 ;NUMBER ACTIVE CHARACTERS IN TTYBUF ACTLIN: 0 ;NUMBER LINEFEEDS IN TTYBUF GETCC: 0 ;GET CHARACTER COUNTER GETBPT: 0 ;GET BYTE POINTER PUTCC: 0 ;PUT CHARACTER COUNTER PUTBPT: 0 ;PUT BYTE POINTER RIB: 0 ;RUBOUT IN PROGRESS CHAR: 0 ;CHARACTER TYPED TTYNUM: 0 ;THE TTY NUMBER OF OUR CONSOLE QUOTE: QQUOTE ; THE CHARACTER THAT UNMAPS TV KEYBOARD INPUT QUOTEF: 0 ; -1 IF TV KEYBOARD QUOTE CHARACTER TYPED TCTYPE: 0 ;CONSOLE TYPE TCMXH: 0 ;HORIZ SIZE OF TTY TCMXV: 0 ;VERT SIZE OF TTY TTYOPT: 0 ;TTY CHARACTERISTICS BITS TTYST1: 0 ;OUR TTY'S TTYST1 VARIABLE IN I.T.S. TTYST2: 0 ;OUR TTY'S TTYST2 VARIABLE. TTYSTS: 0 ;OUR TTY7S TTYSTS VARIABLE. TVDPY: 0 ;-1 IF ON A TV TVCORE: 0 ;HAVE TV PAGES IN MAP TTYMTA: 0 ;-1 IF META BITS IN CHARACTER SUPPLIED BY I.T.S. BRKTAB: BLOCK 4 ;TTY BREAK TABLE, 1 BIT FOR EACH ASCII CHARACTER STKSW: 0 ;-1=>WE HAVE STANFORD KEYBOARD TICKS: 0 ;# HALF SECOND CLOCK TICKS INBLNK: 0 ;DLVIS INDEX FOR BLINKING PIECE OF GLASS BLNTIM: 0 ;1/2 SECOND CLOCK COUNTDOWN FOR BLINK THROTTLE PGBLNK: 0 ;BLINKING PIECE OF GLASS BLNKIT: 0 ;-1=>NEXT UPGIOT WILL BLINK TTYBUF: BLOCK TTYBFL ;TTY BUFFER INTPDP: -INTPDL,,INTPDB-1;INTERRUPT LEVEL PUSH DOWN POINTER INTPDB: BLOCK INTPDL ;INTERRUPT LEVEL PUSH DOWN STACK TTYICH: -1 ;TTY INPUT CHANNEL NUMBER, OR -1 IF THERE IS NONE. TTYOCH: -1 ;TTY OUTPUT CHANNEL NUMBER, ... DSPCH: -1 ;DISPLAY OUTPUT CHANNEL NUMBER, ... ERRJPC: 0 ;JPC AT LAST ERROR RETURN TO USER ;FOR FINDING WHERE IN DECUUO THE ERROR WAS DETECTED. INTJPC: 0 ;JPC AT LAST INTERRUPT. INTPC: 0 ;PC AT LAST INTERRUPT (FOR DEBUGGING) INTBTS: 0 ;LAST INTERRUPT'S BITS (FOR DEBUGGING) JOBNAM: 0 ;JOB NAME AS SET BY SETNAM. HSGNUM: -1 ;"JOB NUMBER" OF HISEG. INFNAM: 'HISEG0 ;JNAME TO USE WHEN OPENING INFERIOR TO SAV EA HISEG IN. IFNDEF HSGTBL,HSGTBL==10 ;WE CAN HAVE ONLY THAT MANY INFERIORS ANYWAY. HSGNUT: BLOCK HSGTBL ;REMEMBER THE JOB #S OF ALL OUR INFERIORS. IFNDEF DEVCSL,DEVCSL==20 DEVCSH: BLOCK DEVCSL ;EACH ENTRY IS NAME OF DEV KNOWN TO EXIST OR TO NOT EXIST, OR 0. DEVCS1: BLOCK DEVCSL ;-1 IF CORRESP. DEV. IN DEVCSH EXISTS; 0 IF IT DOES'T EXIST. TTYLCH: 0 ;TELETYPE GETCHR WORD AND TTY I/O STATUS WORD. ;LH IS HACKED BY GETLCH AND SETLCH. ;RH REFLECTS CHDMOD OF LAST TTY CHANNEL TO HAVE INIT, OPEN OR SETSTS. ;LH BITS TT.III==400000 ;(SAIL ONLY) THIS TTY IS AN III. TT.HDX==10000 ;HALF DUPLEX TERMINAL TT.IMP==1000 ;(SAIL ONLY) THIS TTY IS A PTY BEING RUN BY A STELNT. TT.PWT==400 ;(SAIL ONLY) TTY INPUT SHOULD TERMINATE PTY INPUT WAIT. TT.ACT==100 ;(DEC ONLY) AN ACTIVATION CHAR IS PRESENT IN INPUT BUFFER. ;(SAIL ONLY) SPECIAL ACTIVATION MODE. TT.RUB==40 ;RUBBING OUT IS IN PROGRESS. TT.NCC==20 ;NO CONVERSION OF LOWER CASE TO UPPER. TT.TAB==10 ;(DEC) TTY HAS HDWR TABS (SAIL) TTY DOESN'T HAVE HDWR TABS. ;ALL TTYS ALWAYS CLAIM TO HAVE THEM. TT.NEC==4 ;DON'T ECHO (TREAT TTY AS HALF-DUPLEX) TT.ILF==2 ;(DEC ONLY) PAPER TAPE MODE. ;(SAIL ONLY) INHIBIT INSERTION OF LF AFTER CR. TT.DEC==36 ;DEC SYSTEM ALLOWS THESE BITS TO BE SET. TT.SAI==101536 ;SAIL ALLOWS THESE BITS TO BE SET. TT.LOS==1012 ;THESE BITS ARE MISSING IF USER TRIES TO CHANGE THEM. ;TT.RUB, AND TT.ACT IN DEC MODE, DON'T REALLY LIVE IN TTYLCH. ;THEY ARE COMPUTED BY GETLCH. ;RH BITS IO.FLS==1000 ;1 => OUTPUT HAS BEEN SILENCED BY ^O OR FLUSHING A --MORE--. IO.TEC==SETZ_-27. ;(DEC) DON'T ECHO ALTMODE ;(SAIL) DON'T ECHO CONTROL AND META CHARS. IO.SUP==SETZ_-28. ;DON'T ECHO ANYTHING IO.FCS==SETZ_-29. ;(DEC) FULL CHARACTER SET. RUBOUT, ^U ARE PASSED TO PROGRAM. subttl I/O Channel Tables CHDEV: BLOCK 20 ;DEVICE NAME OF CHANNEL. 0 => CHANNEL NOT INITTED. CHNAME: BLOCK 20 ;FN1 OF CHANNEL CHEXTE: BLOCK 20 CHSNAM: BLOCK 20 ;"PPN" OF CHANNEL. CHSFD: BLOCK 20 ;SFD NAME OF CHANNEL'S PATH CHOSNM: BLOCK 20 ;I.T.S. DIRECTORY OF FILE. = CHSFD, OR CHSNAM IF CHSFD = 0. CHRDEV: BLOCK 20 ;"REAL" (TRANSLATED) DEVICE NAME OF CHANNEL. CHIHDR: BLOCK 20 ;INPUT BUFFER HEADER ADDRESS. -1 => DUMP MODE. ;0 => NO HEADER OR CHANNEL NOT INITTED. CHOHDR: BLOCK 20 ;SIMILAR, FOR OUTPUT BUFFER HEADER. CHIOPN: REPEAT 20,-1 ;-1 => INPUT SIDE OF THIS DEC CHANNEL ISN'T FULLY OPEN YET. ;ELSE # OF I.T.S. CHANNEL IN USE BY IT. ;20 => FULLY OPEN, BUT DOESN'T NEED ANY I.T.S. CHANNEL. ;1,, FULLY OPEN SIMULATED UFD, READING I.T.S. UFD ON ;CHANNEL . CHOOPN: REPEAT 20,-1 ;LIKE CHIOPN, BUT FOR OUTPUT SIDE OF DEC CHANNEL. CHIMOD: BLOCK 20 ;I.T.S. MODE FOR INPUT SIDE. RANDOM IF CHANNEL NOT INITTED. CHOMOD: BLOCK 20 ;I.T.S. MODE FOR OUTPUT SIDE. RANDOM IF CHANNEL NOT INITTED. CHDMOD: BLOCK 20 ;DEC I/O MODE CHANNEL IS INITTED IN. " " " " " " CHLKEN: BLOCK 20 ;BIT 4.9 => ENTER DONE. BIT 4.8 => LOOKUP DONE. CHBENT==400000 CHBLKP==200000 CHBREN==100000 ;DURING RENAME, C HAS CHOLKE: BLOCK 20 ;0 => NO LOOKUP OR ENTER DONE ON THIS CHANNEL ;1 => MOST RECENT LOOKUP OR ENTER SUCCEEDED ;-1 => MOST RECENT ONE FAILED. USED TO DECIDE WHETHER RENAME WINS. CHNDLE: BLOCK 20 ;NONZERO => THIS DEVICE NEEDS LOOKUP/ENTER. 0 IF NOT INITTED. CHDIDX: BLOCK 20 ;NEGATIVE => INDEX OF INITTED DEVICE IN DEVTAB AND OTHER TABLES. ;IN THIS CASE, THE DEVICE IS A KNOWN ONE. ;0 => CHANNEL NOT INITTED. ;ELSE RH IS INDEX OF "DSK" IN DEVTAB AND OTHER TABLES. CHEOFC: BLOCK 20 ;0=>CHANNEL CLEAR ;0,,-1=>EOF SEEN NOT AT BEGINNING OF A TRANSFER ;-1 => AN IN OR INPUT WAS GIVEN WHEN AT EOF. chufdu: block 20 ;useti pointer for simulated ufd's(sigh) CHIWRD: BLOCK 20 ;BUFFERED-AHEAD WORD OF INPUT. CHOPN: BLOCK 20 ;-1 => I.T.S. CHANNEL IS OPEN ;CAN BE SET IF SIMULATED CHANNEL IS FREE, IF ITS CHANNEL ;IS IN USE AS TTYICH, TTYOCH OR DSPCH. ;CAN BE OFF IF SIMULATED CHANNEL IS IN USE FOR A DEVICE ;SUCH AS TTY, THAT DOESN'T NEED AN ITS CHANNEL. ;ITS CHANNEL MAY BE IN USE FOR INTERNAL REASON AT SAME ;TIME THAT SIMULATED CHANNEL IS IN USE BUT DOESN'T NEED ;AN ITS CHANNEL. ENNAME: 0 ;ARGS TO ENTER/LOOKUP/RENAME PUT HERE FOR PRELIMINARY ENEXTE: 0 ;DECODING. BEFORE BEING TRANSFERED TO CHNAME, CHEXTE, CHSNAM. ENSNAM: 0 ENOSNM: 0 ENSFD: 0 SNAME: 0 ;THESE THREE ARE INITIAL VALUES OF THE .SUSET VARIABLES. UNAME: 0 XUNAME: 0 SFD: 0 ;INITIAL DEFAULT SFD IS 0 (NONE). ITSVER: 0 ;VERSION OF THIS MACHINE'S I.T.S. MNAME: 0 ;NAME OF THIS MACHINE. ;THE FILE TO OPEN, FOR RUN/GETSEG/SWAP. OPNDEV: SIXBIT /DSK/ OPNFN1: 0 OPNFN2: 0 OPNSNM: 0 RUNDEV: 0 ;THE "REAL" DEV NAME AT RUNI (BEFORE CHANGING SYS: TO DECSYS;). RUNOFS: 0 ;IN RUN UUO, HOLDS START-ADDRESS OFFSET RUNCOR: 0 ;IN RUN UUO, HOLDS USER-SPEC'D CORE SIZE. RUNLDH: 0 ;-1 IN RUNI WHEN OLD HISEG IF ANY HAS BEEN CLOBBERED. RUNLDL: 0 ;-1 IN RUNI WHEN OLD LOWSEG IF ANY HAS BEEN CLOBBERED. ;.CBLK AC, ;AC 4.9 MUST BE ZERO ;4.7 USED INTERNALLY IN CODE (W RQ ON PDP-6) ;4.3-4.1 = 0 GET PAGE FROM SELF ; = 1 GET ABSOLUTE PAGE ; = 2 GET PAGE FROM USER OPEN ON CH # 3.1-3.8 ; = 3 GET PAGE FROM USER NUMBER 3.1-3.8 ; = 4 GET PAGE ; = 5 GET PAGE (PUBLIC) ; = 6 MAKE PAGE PRIVATE ; = 7 MAKE PAGE PUBLIC ;3.9=1 REQUEST WRITE PERMISSION (IGNORED ON FRESH PAGE, OTHERWISE VALID ONLY FOR ; SELF OR DIRECT INFERIOR OPEN ON CH OR PUBLIC PAGE) ;3.1-3.8 USER NUMBER OR CH # (377 = CREATOR IF JOB DEVICE) ;2.9=1 INSERT PAGE, 0 DELETE (IGNORES 4.3-4.1 EXCEPT FOR 6 OR 7 WHEN IT IS IGNORED) ;2.1-2.8 VIRTUAL PAGE TO BE AFFECTED ;1.1-1.9 BLOCK # IN ABSOLUTE OR OTHER USER (OR SELF IF 4.3-4.1 = 0) CWORD1: 0 ;USED BY .CBLK TO MANIPULATE DISPLAY SEGMENT CURPG: 0 ;SELECTED PIECE OF GLASS UUOPDL==60 UUOPDP: -UUOPDL,,UUOPDB-1;UUO LEVEL PUSH DOWN POINTER UUOPDB: BLOCK UUOPDL ;UUO LEVEL PUSH DOWN STACK UUO40: 0 UUO41: JSR UUOH UUO42: -TSINTL,,TSINT UUOJPC: 0 UUOACS: BLOCK HIGHAC-LOWAC+1 ;USER ACS STORED HERE DURING UUO UUOH: 0 ;UUO PC STORED HERE .SUSET [.RJPC,,UUOJPC] JRST UUOH1 ;INTERRUPT TABLE FOR CATCHING MPV'S WHEN LOOKING FOR THEM MEMINT: P %PIMPV ? 0 ? -1 ? -1 ? .+1 MEMINL==.-MEMINT SYSCLV DISMIS,[P ? MOVEI MEMHIT] PRSVEX: 0 ;-1 IF /PRSV SWITCH WAS EXPLICITLY SPEC'D ;(AS OPPOSED TO TURNED ON BECAUSE A PROGRAM ;NAMED LOADER OR LINK WAS RUN). DEBUG: -1 ;-1 => SIMULATOR BEING DEBUGGED. ZEROED BY PURIFY. OPTION: 0 ;JOB'S OPTION BITS JCLGOT: 0 ;-1 => JCL HAS BEEN SNARFED AND HANDLED APPROPRIATELY. TITROP: 0 ;-1 => EXIT 1, KILLS THE JOB. IIIRN: 0 ;ATTEMPT TO GOBBLE DISPLAY AT RUN TIME IF SET METARN: 0 ;GIVER USER TTY META BITS IF SET MAPRN: 0 ;-1 => DO PHYSICAL MAPPING OF TV KBD TO SAIL KBD. SYMSRN: 0 ;PASS CLIENT'S SYMBOLS UP TO DDT DBUGRN: 0 ;GOES TO DDT BEFORE STARTING CLIENT, PASSES UP SYMBOLS DECRN: 0 ;0 => SIMULATE SAIL -1 => SIMULATE DEC SYSTEM. TTYRN: 0 ;RUN WITHOUT THE TTY FN2RN: 0 ;-1 => ASSUME EXTENSION IN LOOKUP/ENTER/RENAME TAKES ;A WHOLE WORD. USED FOR PJ'S SEMI-CONVERTED PROGRAMS ;THAT WANT TO BE ABLE TO WIN WITH I.T.S. FIE NAMES. PRSVRN: 0 ;-1 => EXIT 0, SHOULD REFRAIN FROM SUICIDE. ;SET TO -1 BY RUNNING A PROGRAM NAMED LOADER OR LINK. subttl TS Initiialization COMMENT  This is the startup code for DECUUO. The purpose is look around at JCL and our JNAME and open a disk file which will be a program (here after called the CLIENT) filled with DEC TOPS-10 system calls. The starting address of the CLIENT is left at the top of stack. When ITSGO finally gets around to returning with a POPJ; the CLIENT will start and everyone will be happy. If the JNAME is one of the known programs (e.g. SAIL, FAIL, PUB, WL, D), various switches which configure the UUO handler are set to the assembled in values. If the JNAME is not known, the JCL is scanned for a file name, and for switch settings. The switches of interest are IIIRN and METARN. IIIRN will try to grab a display and will simulate the SAIL III display system. The currently available displays include the 340, GT-40's and the TV's. METARN will attempt to simulate the effect of the control and meta keys of the TV keyboards, no matter what keyboard you are near. Good luck!  DDTBFL==80./5 ;80 CHARACTERS OF STORAGE STORAGE IMPURE DDTCMD: 0 ;COMMAND FROM DDT FLAG DDTPTR: 0 ;BYTE POINTER INTO DDT BUFFER DDTEOF: 0 ;SEEN END OF DDT BUFFER DDTBUF: BLOCK DDTBFL DDTEND: 0 ;FENCE POST FOR DDTBUF MATCH: 0 ;PARTIAL MATCH FLAG FOR SWITCH RECOGNIZER EXACT: 0 ;EXACT MATCH FLAG FOR SWITCH RECOGNIZER JNAME: 0 ;JOB NAME ;THIS IS THE TABLE OF KNOWN PROGRAMS TO LOAD DEFINE CHECK(TAG,LEN) IFN .-TAG-LEN,[PRINTX /TAG LOSES /] TERMIN DEFINE FNAM(SNAME,FN1,FN2) [ SIXBIT /FN1/ ? SIXBIT /FN2/ ? SIXBIT /SNAME/ ]TERMIN STORAGE PURE ;ASEMBLE THE TABLE OF SWITCH NAMES, AND ASSIGN THE BITS TO THE SWITCHES. SWTNAM: IRPS X,,III META SYMS TTY DBUG DEC MAP SAIL SDIS FN2 PRSV 010700,,[ASCIZ /X/]-1 X!BT==1_.IRPCN TERMIN NSWTS==.-SWTNAM ONBITS==DECBT ;THE DEFAULTS FOR JCL SPECIFIED CLIENT JNMTBL: 0 ;HOLDS SPACE FOR JCL SPECIFIED CLIENT SIXBIT /D/ SIXBIT /PC/ SIXBIT /WL/ SIXBIT /NODIPS/ SIXBIT /DPLT/ SIXBIT /PCPLT/ SIXBIT /SAIL/ SIXBIT /PUB/ JNMLEN==.-JNMTBL OPNTBL: 0 ;HOLDS SPACE FOR JCL SPECIFIED CLIENT FNAM(DRAW,D,BIN) FNAM(DRAW1,PC,BIN) FNAM(DRAW1,WL,BIN) FNAM(DRAW1,WL,NODIPS) FNAM(DRAW1,DPLT,BIN) FNAM(DRAW1,PCPLT,BIN) FNAM(SAIL,SAIL,BIN) FNAM(PUB,PUB,BIN) CHECK OPNTBL,JNMLEN STORAGE IMPURE SWTTMP: BLOCK NSWTS ;TEMPORARY AREA FOR SWITCH NAME RECOGIZER BITTBL: ONBITS ;HOLDS SPACE FOR JCL SPECIFIED CLIENT IIIBT\METABT\MAPBT ;III, AND META BITS FOR DRAWING PROGRAM IIIBT\METABT\MAPBT ;PC METABT ;NOIII BUT META BITS FOR WIRE LISTER METABT\SYMSBT ;NODIPS ALSO WANTS SYMBOLS LOADED WITH IT 0 ;DPLT 0 ;PCPLT 0 ;SAIL 0 ;PUB CHECK BITTBL,JNMLEN STORAGE PURE ;THIS IS DECUUO'S NORMAL STARTING ADDRESS. GO: TDZA D,D ;BOOTSTRAP ENTERS HERE SKIPA D,[-1] SETZ 17, MOVE P,UUOPDP ;USE THE TTY BUFFER FOR A PUSH DOWN AREA HLRZ B,17 SKIPE B ;IF BOOTSTRAPPER PROVIDED A FLAG-SETTING ROUTINE, JSR (B) ;CALL IT. MOVE B,17 PUSHJ P,DOBIT1 ;PROCESS THE SWITCHES GIVEN BY THE BOOTSTRAP, IF ANY. HRRZM P,UUO40 ;RIGHT NOW WE WANT UUOS TO BE ITS-HANDLED, NOT SIMULATED .SUSET [.RSNAM,,SNAME] .SUSET [.RUNAM,,UNAME] .SUSET [.RXUNAM,,XUNAME] .SUSET [.RXJNAM,,A] MOVEM A,JNAME MOVEM A,JOBNAM SYSCLV SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM MNAME ? MOVEM ITSVER] .SUSET [.S40AD,,[UUO40]] .SUSET [.ROPTI,,A] TLO A,OPTDEC\OPTINT ;TRAP SYSTEM UUO'S AT UUO40 MOVEM A,OPTION ;SAVE AWAY THE OPTION BITS .SUSET [.SOPTI,,A] MOVE A,APRBIT ;INIT .MASK. PUSHJ P,XAPRE1 MOVEI A,1 ;IF WE GO TO ILLUUO, LEAVE PC SET TO 0. MOVEM A,UUOH JUMPE D,GO3 ;IF WE HAVE BEEN BOOTSTRAPPED IN, FIND OUT HOW PUSHJ P,JOBVAR ;MUCH CORE OUR PROGRAM HAS PUSHJ P,JOBVA1 SETO D, GO3: SKIPN MEMT ;IF JUST LOADED, AND NOT BOOTSTRAPPED, DON'T LOOK AT JRST GO2 ;.JBSA BECAUSE THE CORE DOESN'T EXIST. SKIPE .JBSA ;IF WE ARE INCLUDED WITH A PROGRAM ALREADY, JRST GO1 ;AVOID FLUSHING IT. GO2: SKIPN OPNFN1 ;IF WE'VE BEEN PATCHED WITH NAME OF FILE, USE IT. PUSHJ P,SETOPN ;SET UP THE FILE TO OPEN PUSHJ P,ZAPCOR ;FLUSH ALL CORE BUT SIMULATOR AND 1K LOWSEG. GO1: MOVE A,PRSVRN MOVEM A,PRSVEX ;REMEMBER WHETHER /PRSV WAS EXPLICITLY SPEC'D. PUSHJ P,INITTY MOVE A,APRBIT ;INIT .MASK AND .MSK2 AGAIN, NOW THAT CLKENB PUSHJ P,XAPRE1 ;HAS BEEN SET UP BY INITTY. SKIPE .JBSA ;IF INCLUDED WITH A PROGRAM IN CORE ALREADY, JRST DDTGO ;NO NEED TO LOAD ONE. PUSHJ P,RUNI ;DO A RUN UUO TO LOAD IN THE PROGRAM. CAIA JRST DDTGO MOVEI A,1000 ;IN CASE USER WANTS TO $X SOME STUFF, MAKE BUFFER RING HRLM A,.JBSA ;CREATION HAVE A PLACE TO ALLOCATE FROM. MOVEM A,.JBFF SKIPE OPNFN1 ;OMIT ERROR MESSAGE IF FAILURE BECAUSE NO FILE WAS SPEC'D PUSHJ P,XRUNE2 ;RUN UUO FAILED => PRINT ERR MSG AND SETOM DBUGRN ;STOP IN DDT WITH PC=0. HLLZS .JBSA JRST DDTGO ; The sources for DECUUO live on MC:DECSYS;. ; They are DECUUO > (the main body) and DECBOT > (which, assembled separately, ; gives the mergeable bootstrap). ; An unPURIFY'd binary should exist on all machines as DECSYS;DECUUO BIN. ; The installed pure binary should be called DECSYS;TS DEC, linked to from SYS. ; In addition, on AI, the DRAWing system programs actually run DRAW;TS DECUUO ; which should point to the pure binary which has been installed for the ; DRAWing system (normally also DECSYS;TS DEC, but sometimes may be an older version). ; When a new version is installed, the old DECSYS;DECUUO BIN should be moved ; to BACKUP;DECUUO BINnnn where nnn is the version number. The date of ; the new file should be set to that of the old. Then, the old version's ; binary should be copied to DECSYS;DECUUO BIN, loaded, and PURIFY'd with ; PURIFY$G. ; After assembling a new version of DECUUO, it should be loaded up and dumped ; back out with GAPFLS$G. This will flush most of the wasted space, ; making loading the file much faster. Page 0 is not flushed, since flushing ; it would disable breakpoint-proceed in DDT until the time DECUUO gets around ; to recreating that page. PURIFY does flush the page, since otherwise ; booting in DECUUO would clobber page 0 of the program doing the booting. ; When DECUUO is patched, PDM$G should be used instead of :PDUMP alone. ; This will barf if the job to be dumped has been run significantly already. ;START HERE TO PURIFY. PURIFY: SKIPE MEMT .LOSE MOVE P,UUOPDP SETZM DEBUG TWO,[ .VALUE [ASCIZ *B..BTAD/0 P*] MOVE C,[-CLEAN,,/2000] SYSCLV CORBLK,[MOVEI %CBRED ? 1000,,-1 ? C] ] MOVSI C,-AVAILP ;FLUSH ALL INBETWEEN PAGES LEFT BY LOADING PUSHJ P,ZAPLOW ;INCLUDING PG 0, ELSE WHEN BOOTING PAGE 0 WOULD BE LOST. .VALUE [ASCIZ /:pdump DECSYS;TS DEC/] ;START HERE TO MERELY FLUSH THE WASTED PAGES. GAPFLS: MOVE P,UUOPDP MOVE C,[1-AVAILP,,1] PUSHJ P,ZAPLOW PDM: SKIPE MEMT .LOSE .VALUE [ASCIZ /:pdump/] SETOPN: MOVE B,JNAME MOVEI D,0 ;HAVE TRIED LOPING DIGITS FLAG SETOP1: MOVSI A,-JNMLEN CAME B,JNMTBL(A) AOBJN A,.-1 JUMPGE A,SIGH ;LOP OFF TRAILING DIGITS AND TRY AGAIN MOVS B,OPNTBL(A) HRRI B,OPNFN1 ;BLT IN THE FILE NAME BLT B,OPNSNM DOBITS: MOVE B,BITTBL(A) DOBIT1: TRNE B,SDISBT TRO B,SAILBT\METABT\MAPBT\IIIBT TRNE B,DECBT SETOM DECRN TRNE B,SAILBT SETZM DECRN TRNE B,IIIBT SETOM IIIRN TRNE B,METABT SETOM METARN TRNE B,MAPBT SETOM MAPRN TRNE B,SYMSBT SETOM SYMSRN TRNE B,TTYBT SETOM TTYRN TRNE B,DBUGBT SETOM DBUGRN TRNE B,FN2BT SETOM FN2RN TRNE B,PRSVBT SETOM PRSVRN POPJ P, ;HERE TO LOP OFF TRAILING DIGITS FROM THE JNAME TO TRY AGAIN SIGH: JUMPN D,JCLCMD ;AVOID INFINITE LOOPS SIGH1: MOVEI C,0 ADDI D,6 ;SHIFT 6 AT A TIME LSHC B,-6 JUMPE C,SIGH2 ;IF SPACE, THEN SHIFT AGAIN CAML C,[SIXBIT /0/] CAMLE C,[SIXBIT /9/] JRST [ LSHC B,(D) ;ITS NOT A DIGIT, TRY AGAIN JRST SETOP1] SIGH2: JUMPN B,SIGH1 ;JUMP IF STILL MORE TO TRY ;HERE TO JCL COMMAND FOR CLIENT AND HIS SWITCHES JCLCMD: .LOGOUT ;IF WE ARE TOP LEVEL, . . . PUSHJ P,JCLGET ;SNARF OUR JCL INTO DDTBUF SKIPN A,DDTBUF ;IF NO JCL, LEAVE OPNFN1 ZERO, SO THAT JRST DOBITS ;NO ATTEMPT TO LOAD A FILE WILL BE MADE. .BREAK 12,[SETZ [0](5)] SKIPE DDTBUF SETOM JCLGOT MOVE A,[440700,,DDTBUF] MOVEM A,DDTPTR SETZM DDTEOF PUSHJ P,GETFIL ;PARSE THE FILE NAME JFCL SKIPN A ;DEVICE MOVSI A,'DSK MOVEM A,OPNDEV MOVEM C,OPNFN1 MOVEM D,OPNFN2 MOVEM E,OPNSNM MOVEI A,ONBITS MOVEM A,BITTBL ;THE DEFAULT BITS MOVEI A,0 ;INDEX FOR CLIENT'S BITS SWLOOP: JUMPLE B,DOBITS ;REMATURE END CAIN B,15 JRST DOBITS ;GOT TO THE END CAIE B,"/ ;IS THIS A SWITCH WHICH FOLLOWS JRST NOJCL ;UNKNOWN SWITCH, OR GARBAGE AT END OF COMMAND LINE PUSHJ P,RSWITCH ;PROCESS SWITCH JRST SWLOOP NOJCL: .VALUE [ASCIZ *:Bad JCL 2*] SETZM JCLGOT JRST GO ;HERE TO PROCESS A SWITCH RSWITC: MOVE B,[SWTNAM,,SWTTMP] ;GET SWITCH NAMES INTO TEMPORARY AREA BLT B,SWTTMP+NSWTS-1 SETZB C,D ;ACCUMULATE DECIMAL IN D AND OCTAL IN C MOVEI E,1 ;KEEP SIGN IN E SWTARG: PUSHJ P,NEXTC ;GET NEXT CHARACTER JUMPLE B,CPOPJ ;JUMPE IF END CAIN B,"- ;MINUS SIGN IS FINE JRST [ JUMPL E,CPOPJ ;DOUBLE MINUS IS A NO, NO MOVNI E,1 ;PLUNK IN THE SIGN JRST SWTARG] CAIL B,"0 ;TEST FOR DIGIT CAILE B,"9 JRST NOTDIG IMULI C,10 IMULI D,10. ADDI C,-"0(B) ADDI D,-"0(B) JRST SWTARG JCLGET: SETZM DDTBUF ;READ THE JCL (IF ANY) FROM DDT INTO DDTBUF .SUSET [.ROPTI,,C] TLNN C,OPTCMD JRST CPOPJ ;CAN'T READ HIS MIND MOVE C,[DDTBUF,,DDTBUF+1] SETZM DDTBUF BLT C,DDTBUF+DDTBFL-1 SETOM DDTEND ;DDT WILL NOT CLOBBER NON-ZERO WORD .BREAK 12,[5,,DDTBUF] ;READ THE JCL SETZM DDTEND ;GUARATEES THERE WILL BE A WELL DEFINED END POPJ P, ;HERE WHEN ARGUMENT TO SWITCH IS EATEN NOTDIG: JUMPE C,[ MOVE C,E ;RETURN "SIGN" MOVE D,E JRST SWTRED] ;GET NAME OF SWITCH IMUL C,E IMUL D,E SWTRED: PUSH P,C HRLM D,(P) ;DECIMAL,,OCTAL ON TOP OF STACK PUSHJ P,FNDSWT ;FIND THAT SWITCH JUMPGE C,NOJCL ;JUMP IF SWITCH NOT FOUND MOVEI D,1 LSH D,(C) ;BIT POSITION OF FLAG POP P,E ;GET ARG OFF STACK SKIPL E IORM D,BITTBL ;HE WANTS BIT ON SKIPGE E ANDCAM D,BITTBL ;HE WANTS BIT OFF POPJ P, FNDSWT: MOVSI C,- SETOM MATCH SETZM EXACT SKIPA ;WE ALREADY HAVE FIRST CHARACTER OF SWITCH FNDSW2: PUSHJ P,NEXTC JUMPLE B,FNDSW3 ;END OF STRING? PUSHJ P,UPPER ;CONVERT TO UPPER CASE JRST FNDSW3 ; NON-SKIP RETURN FOR CAN'T CONVERT TO UPPER CASE PUSHJ P,FNDSRC ;SEARCH FOR THAT ONE JUMPL C,FNDSW2 POPJ P, ;NO MATCHES ON THAT CHARACTER FNDSW3: SKIPE MATCH ;WAS MATCH UNIQUE? MOVEI C,0 ; NOT UNIQUE SKIPE EXACT ;WELL, MAYBE IT WAS EXACT MOVE C,EXACT ; FOUND EXACT MATCH POPJ P, ;HERE TO TEST NEXT CHARACTER IN STRING AGAINST BOARD NAMES FNDSRC: SETOM MATCH ;SEEN A MATCH FLAG SETZM EXACT ;EXACT MATCH FLAG FNDS1: SKIPG SWTTMP(C) ;IS THIS STRING EXHAUSTED? JRST FNDS2 ; YEP, ADVANCE TO NEXT NAME ILDB TT,SWTTMP(C) ;NEXT CHARACTER FROM TABLE SKIPE TT ;PERHAPS THIS IS LAST CHARACTER OF STRING CAME B,TT ;MATCH? JRST FNDS1A ; YEP AOSN MATCH ;MATCH, TRIP MATCH FLAG PUSH P,C ;SAVE FIRST MATCH MOVE TT,SWTTMP(C) ;CHECK FOR EXACT MATCH ILDB TT,TT JUMPN TT,FNDS2 ;JUMP IF NOT EXACT MATCH MOVEM C,EXACT ;YES, THAT IS AN EXACT MATCH SKIPA FNDS1A: SETOM SWTTMP(C) ;DOES NOT MATCH, ELIMINATE FROM CONSIDERATION FNDS2: AOBJN C,FNDS1 ;INCREMENT ALL BYTE POINTERS YET? SKIPL MATCH ;ANY MATCHES? POP P,C ; YES, THIS IS THE FIRST ONE POPJ P, ;TAKES CHARACTER IN B CONVERTS TO UPPER CASE TAKES NON-SKIP RETURN IF CHARACTER IS ;NOT ALPHABETIC UPPER: CAIL B,"0 CAILE B,"Z SKIPA JRST POPJ1 ;ITS UPPER CASE ALREADY CAIL B,"a CAILE B,"z POPJ P, ;ITS NOT ALPHABETIC SUBI B,"a-"A ;MAKE IT UPPER CASE JRST POPJ1 .BEGIN FNR ;its style command line scanner ; non-skip return for null file spec ;clobbers acs with reckless abandon break=b ;returns with character that broke scan dev=a ;returns dev,fn1,fn2,sname fn1=c fn2=d sname=e ac=t char=tt acptr=12 limbo=13 ;scanner read ahead character ;cannot leave psname until zero ;filnam subroutines getcc: skipn break,limbo pushj p,nextc setzm limbo popj p, .U"nextc: movei break,0 ;assume no more skipe ddteof popj p, ildb break,ddtptr jumpn break,cpopj setom ddteof popj p, psname: pushj p,getcc ;break off word from input stream caie break,40 ;ignore leading spaces cain break,11 ;tabs too jrst psname move acptr,[440600,,ac] tdza ac,ac name1: pushj p,getcc pushj p,brktst jrst nambrk ;found a break character name2: tlne acptr,770000 ;ignore everything after 6 characters idpb char,acptr jrst name1 nambrk: jumpn char,cpopj ;no trailing spaces nambr1: pushj p,getcc caie break,40 ;ignore trailing spaces cain break,11 jrst nambr1 pushj p,brktst popj p, ;a break character movem break,limbo ;space broke us movei break,40 popj p, ;converts break to sixbit and puts result in char ;^Q quotes next character ;fails to skip on break character brktst: cain break,11 movei break,40 pushj p,sixtst jumpl char,[ caie break,21 ;^Q popj p, ;non-sixbit breaks us pushj p,getcc pushj p,sixtst jumpl char,cpopj ;non-sixbit jrst brkt1] jumpe char,cpopj caie char,': cain char,'; popj p, cain char,'/ popj p, brkt1: aos (p) popj p, ;convert break to sixbit sixtst: movni char,1 cail break,40 caile break,"_ jrst sixt1 ;might be lower case movei char,-40(break) popj p, sixt1: cail break,"a caile break,"z popj p, movei char,<"A-"a-40>(break) popj p, ;this routine scans command line for file specification .U"getfil:setzb fn1,fn2 setzb dev,sname setzm limbo pushj p,psname jumpe ac,cpopj aosa (p) getf1: pushj p,psname ;break off first name jumpe ac,cpopj ;let initl worry about it cain break,": jrst [ move dev,ac jrst getf1] cain break,"; jrst [ move sname,ac jrst getf1] ;this must be fn1 or fn2 caie break,40 jrst [ jumpn fn1,[ move fn2,ac popj p,] move fn1,ac popj p,] jumpn fn1,[ move fn2,ac jrst getf1] move fn1,ac jrst getf1 .END FNR ;INITIALIZE THE TTY AND VARIABLES ASSOCIATED WITH IT. INITTY: SETOB M,DPYTYP ;ASSUME NO DPY SETZM TVDPY PUSHJ P,TTYIRS ;CLEAR INPUT BUFFER TO INIT INPUT. MOVE C,[HIBASE/2000-AVAILP,,HIBASE/2000] PUSHJ P,ZAPLOW ;FLUSH CORE USED FOR DISPLAY HANDLING (WE WILL GET AGAIN IF NEC) IRPS X,,TTYICH TTYOCH DSPCH SKIPL A,X SETZM CHOPN(A) SETOM X TERMIN INSIRP SETZM 0,SIXSW CLKENB DISPSW TVCORE TTYICB SETZB C,STKSW ;ASSUME NOT STK DEVICE UNTIL PROVEN OTHERWISE SKIPE TTYRN JRST NOTTY ;DON'T TRY TTY PUSHJ P,ALCHAN ;ELSE GET IN D A CHANNEL TO TRY. SYSCAL OPEN,[D ? 5000,,%TJDIS+.UAO ? ['TTY,,]] JRST NOTTY ;OPEN FAILS, DON'T TRY IT MOVEM D,TTYOCH ;REMEMBER THE TTY OUTPUT CHANNEL SETOM CHOPN(D) PUSHJ P,ALCHAN ;AND GET AN INPUT CHANNEL MOVEM D,TTYICH SETOM CHOPN(D) ;HAVE A TTY; SEE WHAT KIND. .SUSET [.RTTY,,A] ANDI A,77 MOVEM A,TTYNUM SYSCLV CNSGET,[ TTYOCH ;FOR TTY OPEN ON THIS CHANNEL 2000,,TCMXH ;HORIZONTAL SCREEN SIZE 2000,,TCMXV ;VERTICAL SCREEN SIZE 2000,,TCTYPE ;TCTYPE 2000,,TTYOPT ;TTYCOM (DISCARD) 2000,,TTYOPT] ;TTYOPT SETOM TTYMTA MOVE A,TTYOPT TLNE A,%TOFCI ;TTYMTA GETS -1 IF TTY CAN SUPPLY CTL AND META BITS SKIPN METARN ;AND THIS PROGRAM WANTS THEM. SETZM TTYMTA MOVSI B,TT.NCC ;WE DON'T WANT CASE CONVERSION (BUT PROGRAM CAN CLEAR). SKIPE DECRN ;INITIALIZE TTYLCH. TT.TAB IS ON FOR DEC, OFF FOR SAIL. TLO B,TT.TAB TLNE A,%TOHDX ;TT.HDX AND TT.NEC SET FOR HALF-DUPLEX TERMINALS. TLO B,TT.HDX\TT.NEC MOVEM B,TTYLCH TRNE A,%TP11T ;TV11 TERMINAL? SETOM TVDPY ;LET D KNOW WE HAVE A TV JRST ITSG1 ITSG1: MOVEI A,%TINWT\%TIINT ;OPEN MODE FOR NORMAL TTY - ASCII MODE FOR NOW. SKIPE TTYMTA IORI A,%TIFUL ;HE CAN HAVE CONTROL AND META BITS DIRECTLY SYSCAL OPEN,[TTYICH ? ['TTY,,] ? 4000,,A] .LOSE 1000 PUSHJ P,TTYLM ;INITIALIZE TTY BREAK TABLE SETOM INBLNK ;MAKE SURE WE DON'T TRY TO BLINK ANYTHING JRST ITSGO0 ;COME HERE TO RUN WITH NO TTY. NOTTY: SETZM TTYRN SETZM IIIRN ITSGO0: MOVEI B,1 ;NOW SET UP TTYICB TO THE INT. BIT CORRESPONDING MOVE A,TTYICH ;TO THE CHANNEL IN TTYICH. LSH B,(A) MOVEM B,TTYICB MOVEI B,1 MOVE A,TTYOCH ;SIMILAR FOR TTYOCH. LSH B,(A) MOVEM B,TTYOCB IOR B,TTYICB .SUSET [.SMSK2,,B] JRST ITSG2 TTYSET: SYSCLV TTYSET,TTYOCH ? TTYST1 ? TTYST2 ? TTYSTS POPJ P, ;NOW, IF WE WANT TO TRY TO SIMULATE STANFORD DISPLAYS, SEE IF IT'S POSSIBLE ;AND BY WHAT METHOD, AND INITIALIZE FOR IT. ITSG2: SKIPN IIIRN ;ATTEMPT TO HACK THE DISPLAY? JRST NODPY SYSCLV STATUS,[TTYICH ? MOVEM A] TRNN A,200000 JRST ITSGO3 ;ISN'T NEAR THE 340 SETOM SIXSW ;TRY TO GET THE PDP-6 FIRST .IOPUS SIXCH, SYSCAL OPEN,[ 1000,,SIXCH 5000,,7 ;OPEN MODE ['USR,,] UNAME [SIXBIT /PDP6/]] PUSHJ P,SIXNOT SKIPN SIXSW JRST ITSGO1 ;WE DID NOT GET THE PDP-6, TRY GRABBING THE 340 .RESET SIXCH, SYSCLV ACCESS,[MOVEI SIXCH ? MOVEI SIXORG] MOVE A,[-HIUSE,,SIXPRG] SYSCLV IOT,[1000,,SIXCH ? A] MOVE A,[2000+400+SIXCH,,HIBASE/2+400000] .CBLK A, .LOSE MOVEM A,CWORD1 SETZM SIXSW ;FORCE TYPE OUT ON TTY MOVEI A,[ASCIZ / Start the PDP-6/] PUSHJ P,XOUTS0 SETOM SIXSW MOVE A,[JRST SIXGO] MOVEM A,HIBASE+41 .IOPOP SIXCH, JRST ITSGO2 ITSGO1: .IOPOP SIXCH, PUSHJ P,ALCHAN MOVEM D,DSPCH SETOM DISPSW SYSCAL OPEN,[DSPCH ? ['DIS,,] ? 5000,,7] PUSHJ P,DSPNOT SKIPN DISPSW JRST NODPY ;WE DON'T HAVE THE DISPLAY ITSGO2: SETOM CLKENB ;ENABLE CLOCK INTERRUPTS FOR BLINKING SETZB M,DPYTYP ;WE HAVE A 340 JRST GOTDPY ;DON'T HAVE 340; CHECK FOR TV OR IMLAC OR GT40. ITSGO3: SKIPE TVDPY JRST [ MOVEI M,DPYTV MOVEM M,DPYTYP SETOM CLKENB ;FIRST WORD OF EXTRA PAGE IS CONSOLE REGISTER MOVE A,[-,,TVBUF/2000] MOVEI B,0 SYSCLV CORBLK,[1000,,600000 ? 1000,,-1 ? A ? 1000,,-2 ? B] SETOM TVCORE JRST GOTDPY] MOVE B,TTYOPT MOVE A,TCTYPE ;IMLACS CAN SIMULATE GT-40'S (SIGH) TLNE B,%TOFCI ;if we have a meta keyboard, we are probably winning JRST [ SETZM GTYPE CAIN A,%TNSFW ; SIMLAC? (DOUBLE SIGH) SETOM GTYPE JRST ITSGO4] CAIE A,%TNDP ;TRY TO CHECK FOR A GT40. JRST NODPY TLNN B,%TOOVR ;WHICH IS THE ONLY OVERPRINTING DATAPOINT. JRST NODPY ITSGO4: MOVEI M,DPYGT40 MOVEM M,DPYTYP PUSHJ P,ALCHAN MOVEM D,DSPCH SYSCLV OPEN,[DSPCH ? ['TTY,,] ? 5000,,41] ; UNIT SUP. IMAGE FOR SIOT PUSHJ P,PPFRGT ; CLEAR GT40 OR IMLAC SCREEN MOVEI A,%TNIML ; IF IMLAC, SEND OUT INITIALIZING CTRL CHARS CAME A,TCTYPE JRST GOTDPY MOVE A,[ASCII / /] ; ^A^K^D SET GT40 GRAPHICS MOVEM A,TYOBUF MOVEI A,5 MOVEM A,DSPCNT MOVE A,[440700,,TYOBUF] PUSHJ P,DSPTYO ; ^A^N SET SAIL CHARACTER SET MODE JRST GOTDPY GOTDPY: MOVSI A,TT.III ;SET FOR THE DISPLAY IORM A,TTYLCH CAIA NODPY: SETOM DSPCH SKIPL A,DSPCH SETOM CHOPN(A) SKIPN IIIRN JRST NODPY1 SKIPN A,CWORD1 MOVE A,[4000,,HIBASE/2+400000] ;INITIALIZE DISPLAY SEGMENT MOVEM A,CWORD1 SKIPE SIXSW JRST .+3 .CBLK A, .LOSE MOVEI A,2000-HIUSE MOVEM A,DLBFL PUSHJ P,@PPFRSH(M) SETZM CURPP PUSHJ P,DLCLR NODPY1: SKIPE TTYRN POPJ P, sysclv ttyget,[ttyoch ? movem a ? movem b ? movem c] tlo a,(%tgimg_36) ;output control chars im image mode ior b,[<%tgimg_22>#<%tgimg_14>#<%tgimg_6>];output cr, ro, alt in image mode. tlo c,%tsint .see itsg3 ;int on next char movem a,ttyst1 movem b,ttyst2 movem c,ttysts ;the ttyset will be done there SKIPN IIIRN JRST ITSG4 MOVSI A,%TSMOR ;TURN OFF --MORE-- WHEN SIMULATING AN III. MOVE B,TTYOPT TLNE B,%TOSAI ;ALSO, USE SAIL CHAR SET IF TTY CAN HANDLE IT. TLO A,%TSSAI IORM A,TTYSTS ITSG4: MOVEI A,IO.SUP IOR A,TTYLCH ;TURN ON IO.SUP TO PREVENT ECHOING, EXCH A,TTYLCH PUSHJ P,TTYSET ;SET UP OUR TTYSTS; ALSO READ IN ALL TYPE-AHEAD. MOVEM A,TTYLCH ;THEN RESTORE IO.SUP. MOVE A,[202020,,202020] .SEE %TGPIE ANDCAM A,TTYST1 ;NOW THAT ALL CHARS WILL INTERRUPT AND BE ECHOED ANDCAM A,TTYST2 ;BY US, TURN OFF SYSTEM ECHOING. JRST TTYSET ;MAJOR RESET OF DISPLAY DLCLR: PUSHJ P,@DSTOP(M) ;MARK DISPLAY STOPPED FOR INTERRUPT ROUTINE SETOM PGBLNK ;INITIALIZE DISPLAY PROCESSOR SETOM INBLNK SETZM BLNKIT MOVEI A,HIBASE+HIUSE ;CLEAR DISPLAY SPACE MOVEM A,DLBFP MOVE D,DLBFL XCT BYTES(M) MOVEM D,DLBCNT MOVEM D,DLFBYT HRLI A,1(A) MOVS B,A SETZM (A) ADD A,DLBFL BLT B,-1(A) MOVEI A,DLLIST+1 ;INITIALIZE 340 DISPLAY CHAIN MOVEI B,0 MOVEM A,DLLIST(B) ADDI A,1 CAIGE B,PGPPLN-2 AOJA B,.-3 SETZM DLMODE SETZM DLLIST+PGPPLN-1 SETZM IIIPG ;PIECE OF GLASS MAP MOVE A,[IIIPG,,IIIPG+1] BLT A,IIIPG+PGLEN-1 SETZM PGSG ;NO ENTRIES IN SORTED LIST PUSHJ P,@DPYCLR(M) SETZM IIIPC ;INITIALIZE III VARIABLES SETZM IIIX SETZM IIIY MOVEI A,7 MOVEM A,IIIBRT SETZM IIISIZ SETZM IIIFLG AOS IIIFLG ;ALWAYS HAS 1.1 SET CAIE M,DPYTV JRST FLASH SETOM TVPURE ;DEBUGGING CHECK FOR RECURSIVE CALLS TO TVSIM SETZM TVBLNK MOVE A,[TVBLNK,,TVBLNK+1] BLT A,TVBLNK+PGLEN-1 JRST TVCLR ;CLEAR SCREEN DSPNOT: SETZM DISPSW MOVEI A,[ASCIZ / Display not available type "C" to continue without it */] DSPN1: PUSHJ P,XOUTS0 PUSH P,A SOS -1(P) SOS -1(P) SKIPG ACTCHR PUSHJ P,TIHANG PUSHJ P,GETCHA CAIE A,"C CAIN A,"c SKIPA JRST POPAJ AOS -1(P) AOS -1(P) JRST POPAJ SIXNOT: SETZM SIXSW MOVEI A,[ASCIZ / PDP-6 not available, type "C" to continue without it */] JRST DSPN1 ZAPLOW: SYSCLV CORBLK,[1000,,0 ? 1000,,-1 ? C] POPJ P, ZAPRUN: MOVSI C,-200 ;IN RUNI, LOADING LOWSEG: SKIPN RUNLDH ;IF HISEG WAS JUST LOADED, DON'T FLUSH IT NOW. ZAPCOR: MOVSI C,-HIBASE/2000 PUSHJ P,ZAPLOW ;FLUSH ALL CORE SETZM MEMT PUSH P,A MOVEI A,400000 SKIPN RUNLDH MOVEM A,HMEMT MOVEI A,1777 ;THEN GET 1K OF LOWSEG. PUSHJ P,XCORER .LOSE PUSHJ P,INSBOT JRST POPAJ IFN 0,[ ;INITIALIZE THE DISPLAY PAGES IF NECESSARY SKIPN IIIRN POPJ P, ;GO AWAY IMMEDIATELY IF NO DISPLAY SKIPE DISPSW ;CHECK FOR 340 MOVE A,[2400+SIXCH,,HIBASE/2+400000] SKIPE SIXSW ;GET FIRST PAGE OF DISPLAY STORAGE MOVE A,[4000,,HIBASE/2+400000] MOVEM A,CWORD1 JUMPL A,CPOPJ ;SOMETHING OTHER THAN 340 .CBLK A, .LOSE POPJ P, ] ;GET HERE AFTER FINISHING UP IN ITSGO. POPJ'S OUT TO THE STARTING ADDRESS ;OF THE CLIENT PROGRAM. IF DBUGRN IS SET, STOPS IN DDT BEFORE THE 1ST INSTRUCTION. ;$G WILL ALSO WORK FROM DDT DDTGO: HRRZ A,.JBSA MOVEM A,UUOH MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC SKIPE DBUGRN .VALUE [ASCIZ /2/] SETZM UUO40 JRST @UUOH subttl Interrupt Routines STORAGE(IMPURE) MPVXIT: 0 ;INTERRUPTING PC SAVED HERE WHEN DISMISSING VIA MPVBRK. INTFLG: 0 ;NONZERO => INTERRUPT IN PROGRESS. INTLOS: 0 ;.LOSE CODE FOR MPV OR PDL OV, USED IN ERROR HANDLING. TSINT: SETZ INTPDP(HIGHAC+1) -1 ? 0 ? #%PIPDL ? -1 ? PURINT ;ERROR AND CLOCK INTERRUPTS 0 ;TYPE-IN INTERRUPTS TTYICB: 0 #%PIPDL ? -1 ? TYIINT 0 ;BOTTOM OF PAGE INTERRUPTS TTYOCB: 0 #%PIPDL ? 0 ? MORINT TSINTL==.-TSINT DEFINE INTINI AOS INTFLG MOVE E,INTPDP SUBI E,HIGHAC+4 ;E -> SAVED PC ON INT. STACK. MOVE P,[INT1PL,,INT1PL] ADD P,INTPDP EXCH P,INTPDP ;PUSH INT1PL WORDS ON INT STACK; P POINTS BELOW THEM. HRLI P,1-INT1PL ;MAKE P A PDL POINTER TO THOSE INT1PL WORDS. MOVE A,(E) MOVEM A,INTPC SKIPN A,-4(E) MOVSI A,400000 IOR A,-3(E) ;THIS CREATES AN OLD-STYLE "INTERRUPT BIT" WORD MOVEM A,INTBTS ;WHICH WINS SINCE NO GROUP HAS BOTH 1ST WD AND 2ND WD INTS. SKIPE TVCORE PUSH P,TVCREG PUSH P,UUO40 SETOM UUO40 MOVE M,DPYTYP TERMIN ;JUMP HERE TO RETURN FROM AN INTERRUPT. INTRET: SOS INTFLG ;CLEAR INTERRUPT IN PROGRESS FLAG POP P,UUO40 SKIPE TVCORE POP P,TVCREG MOVE A,[-] ADDM A,INTPDP SYSCLV DISMIS,[INTPDP ? 5000,,(SETZ (HIGHAC+1))] STORAGE(PURE) PURINT: INTINI MOVE -4(E) ;GET THE BITS OF THIS INTERRUPT. SKIPE (P) ;IF INT. CAME FROM USER MODE, IS IT A JRST TSINT1 MOVE A,APRBIT ;USER-ENABLE APRENB INTERRUPT? SKIPN ZMPV TRZ A,AP.ILM TDNN 0,A JRST TSINT1 SKIPN A,.JBAPR .LOSE ;USER HAS NO HANDLER? MOVE B,0 AND B,APRBIT ;TELL THE USER ABOUT ONLY THE BITS HE HAS ENABLED. TLZE B,%PJFOV IORI B,AP.FOV ;MOVE ITS'S FLOATING OVFL BIT INTO DEC'S. MOVEM B,.JBCNI ;STORE HIS INT. BITS. EXCH A,(E) ;CHANGE HIS PC. MOVEM A,.JBTPC ANDCM APRBIT ;MARK INTS GIVEN TO USER AS HANDLED FOR OUR SAKE. MOVE B,APRBIT TRNE B,AP.REN ;IF THE USER DOESN'T WANT AUTO-RE-ENABLE, JRST TSINT1 SETZB A,APRBIT ;TURN OFF HIS INT. HANDLING. PUSHJ P,XAPRE1 TSINT1: TRZE %PICLK JRST CLKBRK TRZE %PIPDL JRST PDLBRK TRZE %PIMPV JRST MPVBRK JUMPE INTRET .LOSE PDLBRK: SKIPA C,[1+.LZ %PIPDL] MPVBRK: MOVEI C,1+.LZ %PIMPV MOVEM C,INTLOS ;REMEMBER THE .LOSE ARG TO SIGNAL THIS INT. TO DDT. MOVE A,(E) HRRZ B,A ;IF PC IS AT 32, DDT IS HACKING BREAKPOINT PROCEED, CAIN B,31 ;SO SAVE WHAT THE PC WAS REALLY SUPPOSED TO BE. HRR A,32 HRRI A,-1(A) MOVEM A,MPVXIT ;MPVXIT GETS REAL RETURN ADDRESS; RETURN TO MOVEI B,MPVBR3 ;MPVBR3 FOR MPV'S OR PDL OV'S FROM SIMULATOR, OR TO SKIPN (P) MOVEI B,MPVBR2 ;MPVBR2 FOR MPV'S OR PDL OV'S FROM USER MODE. ANDI A,-1 CAIE A,MPVOK1 CAIN A,MPVOK2 ;MPV'S FROM THESE SPECIAL PLACES ARE SURE TO BE MOVEI B,MPVBR5 ;THE USER'S FAULT, SO SAY SO. CAIE A,MPVOK3 CAIN A,MPVOK4 MOVEI B,MPVBR5 MOVEM B,(E) MOVEI A,[ASCIZ /Error in Simulator:/] CAIN B,MPVBR3 PUSHJ P,XOUTS0 JRST TSINT1 MPVBR3: JFCL ;THESE 2 TAGS MUSTN'T BE EQUAL, SO CAIN CAN DISTINGUISH. MPVBR2: SYSCAL LOSE,[INTLOS ? MPVXIT ? 5000,,4] .LOSE JRST .-1 MPVBR5: ERROUT Address Check ;HANDLE --MORE-- INTERRUPTS MORINT: INTINI SKIPE IIIRN JRST INTRET PUSH P,TTYLCH MOVEI A,IO.FCS ;TEMPORARILY ENTER FULL CHAR SET MODE IORM A,TTYLCH ;SO WAY CAN GET HANDS ON THE RUBOUT. MOVEI A,[ASCIZ /--More--/] PUSHJ P,XOUTS0 ;PRINT --MORE-- SAYING WE ARE SMART. SKIPG ACTCHR PUSHJ P,TIHANG ;WAIT FOR AN INPUT CHARACTER POP P,TTYLCH MOVE A,GETBPT SKIPG GETCC MOVE A,[1100,,TTYBUF-1] ILDB A,A ;LOOK AHEAD AT THE CHARACTER CAIN A,40 JRST MORPRC ;SPACE => PROCEED CAIN A,177 PUSHJ P,GETCHA ;RUBOUT SHOULD BE GOBBLED. MOVEI A,[ASCIZ /Flushed /] PUSHJ P,XOUTS0 ;ANY NON-SPACE MEANS FLUSH. MOVEI A,IO.FLS ;WHICH WE DO BY SILENCING TYPEOUT IORM A,TTYLCH MOVEI B,2 HRRZ A,(E) ;IF THE PC IS POINTING AT THE TTY OUTPUT CALL, CAIE A,STYO ADDM B,(E) ;SKIP OVER IT. JRST INTRET MORPRC: PUSHJ P,GETCHA ;GOBBLE THE SPACE. PUSHJ P,CRLF ;CONTINUE FROM --MORE--: JUST TYPE CRLF AND RETURN JRST INTRET TYIINT: INTINI TYILOP: TYINT: PUSHJ P,TYI ;CHARACTER TYPED JUMPE A,TYILOP ;IGNORE NULLS JUMPL A,INTRET ;JUMP IF NO MORE CHARACTERS HRRZ B,(E) CAIN B,TIHAN1 ;IF PROGRAM IS IN THE .IOT TYIC, USE AS A .HANG, AOS (E) ;MAKE IT CONTINUE PAST. SKIPE MAPRN SKIPN IIIRN JRST NOMAP AOSE QUOTEF ;ARE WE GOING TO QUOTE THIS CHARACTER? MOVE B,TTYOPT TLNN B,%TOFCI ;META KEYBOARD? JRST NOMAP ;NO, SKIP MAPPING MOVE B,A ANDI B,177 CAMN B,QUOTE JRST [ SETOM QUOTEF PUSHJ P,ECHO JRST TYILOP] HLRZ B,TTYMAP(B) SKIPE B ; (characters echo as mapped) DPB B,[700,,A] ; A "physical" mapping, for keyboard convenience NOMAP: SKIPE METARN JRST NOMAP4 CAIE A,^O CAIN A,^S JRST CTLO NOMAP4: PUSH P,TTYLCH MOVEI B,IO.FLS ANDCAB B,TTYLCH ;DURING ECHOING, IGNORE ^O (IO.FLS) TRNE B,IO.FCS JRST NOMAP2 CAIN A,177 JRST RUBOUT SKIPE METARN JRST NOMAP2 CAIN A,^U JRST CTLU NOMAP2: PUSH P,A ANDI A,177 CAIL A,"A+40 ;CONVERT LOWER-CASE TO UPPER UNLESS INHIBITED. CAILE A,"Z+40 JRST NOMAP3 TLNN B,TT.NCC TRZ A,40 NOMAP3: SKIPE RIB ;IF WE HAD BEEN RUBBING OUT, PRINT A "\". PUSHJ P,RUBEND POP P,A PUSHJ P,ECHO SKIPN IIIRN ; map the TV chars into SAIL chars JRST NOMAP1 ; This is a "permanent" mapping, MOVE B,A ; not quotable, echos as typed ANDI B,177 HRRZ B,TTYMAP(B) SKIPE B DPB B,[700,,A] NOMAP1: SKIPN TTYMTA ; ARE META BITS IN CHARACTER? JRST [ SKIPN METARN JRST .+1 ; HE'S NOT INTERESTED IN SIMULATING META BITS CAIN A,CTRL JRST TYCTRL CAIN A,META JRST TYMETA CAIN A,CTLMTA JRST TYCTLM JRST .+1] IORM A,CHAR TDZ A,[-1,,777600] CAIN A,15 PUSHJ P,TYICR CAIN A,12 MOVEM A,CHAR PUSHJ P,PUTCH TYIXIT: POP P,TTYLCH JRST TYILOP ; MAP TV11 KEYBOARD CHARACTERS INTO STANFORD CHARACTERS FOR D ;THERE ARE TWO REASONS FOR MAPPING CHARACTERS ON INPUT ;Renaming: Some of the codes for a given printing representation are different ; on the TV keyboards. The codes are changed to the character code that ; prints that way at Stanford. Therefore, these keys will have their ; meaning to the Drawing program defined by the figure on the keytop. ; This is what happens normally when using the Stanford keyboard ; on the 340. ; This mapping takes place whenever SAIL display programs are in use. ;Physically moving: Of the eight cursor moving characters, ()[] /\, seven ; are physically displaced on the TV keyboard. For convenience, the ; codes for []{}\/| are mapped so that they will mean ()[]/\ to the ; Drawing program. Of course this is fine for cursor moving ; commands, but other types of keyboard input (i.e., text on points) ; will be mapped also. In this case, the user may type the quote character () ; to prevent the mapping. ; In addition, caret (^) is mapped into + since there is no code ; anyway in the Stanford set for caret and at best it would be ; equivalent to uparrow. With this convention, drawing lines is easier.(??) comment  ;These are the logical mappings, designed to preserve the visual semantics. ;The table makes more sense in 1FSSAIL$ mode! Input from ITS KBD code to SAIL program (whose meaning in ITS is) 13 136 ^ 30  137  _ 32  33  136 ^ (no such character) 137 _ 30 _  175 } 176 } ~ 176 ~ 032 ~  ;These are the "physical" mappings for convenience. 57 / 134 \ \ 133 [ 50 ( ( 134 \ 57 / / 135 ] 51 ) ) 136 ^ 53 + + 173 { 133 [ [ 174 | 17   175 } 135 ] ]  TTYMAP: LOC TTYMAP+13? 0,,136 ; up-arrow LOC TTYMAP+30? 0,,137 ; left-arrow LOC TTYMAP+32? 0,,33 ; not-equal LOC TTYMAP+57? 134,, ;INTO BACKSLASH * LOC TTYMAP+133? 50,, ;INTO OPEN-PAREN * LOC TTYMAP+134? 57,, ;INTO SLASH * LOC TTYMAP+135? 51,, ;INTO CLOSE-PAREN * LOC TTYMAP+136? 53,, ;INTO PLUS * LOC TTYMAP+137? 0,,30 ; underbar LOC TTYMAP+173? 133,, ;INTO OPEN BRACKET * LOC TTYMAP+174? 17,, ;INTO PARTIAL * LOC TTYMAP+175? 135,,176;INTO CLOSE BRACKET * ; close-brace LOC TTYMAP+176? 0,,32 ; tilde LOC TTYMAP+200 ;HERE FOR HALF SECOND CLOCK --BLINK-- CLKBRK: CAIE M,DPYTV JRST CLKBR1 SKIPL INBLNK ;BLINKING ENABLED?? SOSL BLNTIM ;Throttle blinking if it is eating too much time JRST TSINT1 .RDTIM B, PUSH P,B MOVEI B,PGLEN-1 CLKBR3: SKIPE IIIPG(B) ;BLINK ALL THE PGS MARKED SKIPN TVBLNK(B) CAIA PUSHJ P,TVSIM ;XOR THAT PG CLKBR2: SOJGE B,CLKBR3 .RDTIM B, SUB B,(P) ;Time used for Blinking, 4 usec. units SUB P,[1,,1] ADDI B,4 ;Round up ASH B,-3 ;fair-ticks = time-used * 1/30sec/(50% * 1/2sec) = 2**-3 SKIPGE B SETZ B, MOVEM B,BLNTIM JRST TSINT1 CLKBR1: SKIPE DLSTOP SKIPGE B,INBLNK JRST TSINT1 ;NO BLINKING SKIPL C,PGBLNK CAILE C,17 JRST TSINT1 ;GARBAGE, MIGHT BE JUST BEFORE DPYOUT SKIPN IIIPG(C) JRST TSINT1 ;PIECE OF GLASS NOT ACTIVE MOVEI A,DLPG(C) CAIL B,DLVIS CAILE B,DLVIS+PGLEN-1 .lose AOS D,TICKS TRNE D,1 JRST BLANK ;BLANK THE BLINK HRLM A,(B) JRST TSINT1 BLANK: HRRZS (B) JRST TSINT1 TYCTRL: SKIPA B,[200] TYMETA: MOVEI B,400 TYCM: IORM B,CHAR JRST TYIXIT TYCTLM: MOVEI B,600 JRST TYCM RUBOUT: SKIPN RIB SKIPE ACTCHR CAIA JRST TYIXIT SKIPN RIB PUSHJ P,RUBEG SKIPE A,CHAR PUSHJ P,RBMETA PUSHJ P,BACKUP MOVE B,TTYLCH TRNE B,IO.SUP JRST TYIXIT JUMPE A,[ SETZM RIB SYSCLV IOT,[TTYOCH ? ["\]] PUSHJ P,CRLF JRST TYIXIT] TRNE A,600 PUSHJ P,RBMETA PUSHJ P,TYO JRST TYIXIT TYI: SYSCLV IOT,[TTYICH ? A] JUMPL A,CPOPJ ANDI A,777 POPJ P, RUBEND: SETZM RIB JRST RUB1 RUBEG: SETOM RIB RUB1: PUSH P,B MOVE B,TTYLCH TRNE B,IO.SUP ;SUPPRESS ECHOING SUPPRESSES RUBBINGOUT AS WELL. JRST POPBJ POP P,B SKIPA A,["\] TYO: JUMPE A,CPOPJ PUSH P,A ; throw away other bits temporarily to avoid ANDI A,177 ; I.T.S. hacking of meta bits on output CAIE A,177 PUSHJ P,TYOAND JRST POPAJ TYOAND: JUMPGE M,@PPTYO(M) CAIN A,^P ; CHECK FOR ^P LOSSAGE JRST [ PUSHJ P,STYO MOVEI A,"P JRST STYO] STYO: PUSH P,B MOVEI B,IO.FLS TDNE B,TTYLCH JRST POPBJ SYSCLV IOT,[TTYOCH ? A] JRST POPBJ CRLF: MOVEI A,15 CRLF1: PUSHJ P,TYO MOVEI A,12 PUSHJ P,TYO MOVEI A,^M POPJ P, RBMETA: PUSH P,A SETZM CHAR RBM3: TRNE A,200 TRNN A,400 JRST RBM1 MOVEI A,CTLMTA RBM2: PUSHJ P,TYO POPAJ: POP P,A POPJ P, RBM1: TRNE A,200 SKIPA A,[CTRL] MOVEI A,META JRST RBM2 ECHO: PUSH P,B MOVE B,[TT.NEC,,IO.SUP] SKIPE DECRN CAIE A,33 TRNE A,600 TRO B,IO.TEC TDNE B,TTYLCH ;SEE IF APPROPRIATE FLAVOR OF NO-ECHO BITS ARE SET. JRST POPBJ POP P,B CAIN A,^U SKIPN DECRN CAIA POPJ P, CAIN A,15 JRST CRLF1 TRNN A,600 ;CHECK FOR EXTRA BITS JRST [ jumpge m,tyo ;fix Drawing Program lossage sysclv iot,[ttyoch ? a ? 5000,,%tjech] popj p,] PUSH P,.-1 ;POPJ TO TYO PUSH P,A JRST RBM3 TTYOFF: SKIPN INTFLG .SUSET [.SPICL,,[0]] POPJ P, TTYON: SKIPN INTFLG .SUSET [.SPICL,,[-1]] POPJ P, ;^O => COMPLEMENT THE SUPPRESS-TYPEOUT FLAG. CTLO: PUSH P,TTYLCH MOVEI B,IO.FLS XORM B,(P) ANDCAM B,TTYLCH PUSHJ P,TYO PUSHJ P,CRLF JRST TYIXIT ;^U => CLEAR THE INPUT BUFFER. CTLU: PUSHJ P,TTYIRS MOVEI A,[ASCIZ /^U /] PUSHJ P,XOUTS0 JRST TYIXIT ;SKIP IF 9-BIT CHAR IN A ISN'T A BREAK CHARACTER. CLOBBERS B, C, D. BREAK: MOVE B,TTYLCH TLNN B,TT.ACT ;SKIP IFF SPECIAL ACTIVATION MODE. JRST BREAK1 ;NO PROBLEM WITH DEC SYS SINCE TT.ACT IS VIRTUAL (SEE XGETLC) TRNN A,600 JRST BREAK2 MOVE B,BRKTAB+3 TRNN B,1 ;UNLESS BIT 35 OF LAST BRKTAB WORD IS SET, POPJ P, ;CHARS WITH CONTROL BITS ALWAYS ACTIVATE. CAIGE A,600 JRST BREAK2 TRNE B,4 ;BIT 33 => ALL CONTROL-META CHARACTERS ACTIVATE. POPJ P, BREAK2: HRRZ B,A ;ELSE FIND BIT IN BRKTAB FOR THE BOTTOM 7 BITS THIS CHAR HAS. ANDI B,177 IDIVI B,36. MOVNS C MOVSI D,400000 LSH D,(C) TDNN D,BRKTAB(B) AOS (P) POPJ P, BREAK1: TRNE A,600 ;NORMALLY, ALL CONTROL AND META CHARACTERS ACTIVATE IN SAIL MODE POPJ P, MOVE B,A ANDI B,177 ;TEST FOR THE NORMAL (NOT SPECIAL ACTIVATION MODE) BREAK CHARS CAIE B,177 ;WHICH DO NOT HAVE THE CONTROL BIT. CAIN B,33 POPJ P, CAIN B,^J POPJ P, SKIPE METARN ;WHEN META BITS IN USE, OTHER ACT. CHARS ARE REALLY CONTROLS JRST POPJ1 ;AND THE ASCII-CONTROLS ARE SAIL GRAPHICS, WHICH DON'T ACTIVATE. CAIE B,^C CAIN B,^R POPJ P, CAIE B,^G CAIN B,^J POPJ P, caie b,^L cain b,^K popj p, CAIE B,^U CAIN B,^Z POPJ P, JRST POPJ1 BACKUP: SOSGE ACTCHR JRST [ SETZB A,ACTCHR POPJ P,] AOS A,PUTCC CAILE A,TTYBFL*TTYBPW PUSHJ P,BACKWP LDB A,PUTBPT LDB B,[360600,,PUTBPT] ADDI B,11 CAIL B,44 JRST [ SOS PUTBPT MOVEI B,0 JRST .+1] DPB B,[360600,,PUTBPT] POPJ P, BACKWP: MOVEI A,1 MOVEM A,PUTCC MOVE A,[1100,,TTYBUF+TTYBFL-1] MOVEM A,PUTBPT POPJ P, TYICR: MOVEM A,CHAR PUSHJ P,PUTCH MOVEI A,12 POPJ P, PUTCH: AOSLE B,ACTCHR CAILE B,TTYBFL*TTYBPW .LOSE SOSGE B,PUTCC PUSHJ P,PUTWRP MOVEI A,0 EXCH A,CHAR PUSHJ P,BREAK ;SKIPS ON NON BREAK CHARACTER AOS ACTLIN IDPB A,PUTBPT POPJ P, PUTWRP: MOVEI A,TTYBFL*TTYBPW-1 MOVEM A,PUTCC MOVE A,[1100,,TTYBUF-1] MOVEM A,PUTBPT POPJ P, GETCHA: SOSGE ACTCHR JRST [ SETZB A,ACTCHR POPJ P,] SOSGE GETCC PUSHJ P,GETWRP ILDB A,GETBPT PUSHJ P,BREAK SOS ACTLIN POPJ P, GETWRP: MOVEI A,TTYBFL*TTYBPW-1 MOVEM A,GETCC MOVE A,[1100,,TTYBUF-1] MOVEM A,GETBPT POPJ P, subttl UUO Dispatch Table and Routines UUOLOW==40 ;LOWEST LEGAL UUO CODE IOTLOW==700 ;LOWEST LEGAL IOT CODE FIXOP==110 ;OPCODE FOR "FIX" INSN UUOH1: MOVEM A,UUOACS+A-LOWAC LDB A,[POINT 9,UUO40,8] CAIN A,FIXOP ;SIMULATE STANFORD'S FIX INSN (IF DECRN, JSP A,FIXUUO ;WILL COME BACK AND EVENTUALLY GET TO ILLUUO). MOVEM M,UUOACS+M-LOWAC MOVE M,[B,,UUOACS+B-LOWAC] BLT M,UUOACS+HIGHAC-LOWAC MOVE P,UUOPDP LDB B,[270400,,UUO40] MOVE M,DPYTYP SKIPGE UUO40 JRST IOTUUO ;AN IOT TRAPPED SUBI A,UUOLOW JUMPL A,ILLUUO CAIL A,UUOMAX JRST UUOH2 IOTUU1: XCT UUOTAB(A) CAIA UUOXSK: AOS UUOH UUOXIT: SETZM UUO40 ;BEGIN SIMULATING UUOS AGAIN. MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC JRST 2,@UUOH UUOH2: HLRZ C,UUO40 ;"PORTAL" SHOULD BE JUST A JUMP. CAIN C,(JRST 1,) JRST [ HRRZ C,UUO40 HRRM C,UUOH JRST UUOXIT] ;COME HERE WHEN USER DOES SOMETHING ILLEGAL UNDER DEC SYSTEM. ;RETURN TO DDT WITH AN ILOPR INTERRUPT, W/ PC -> USER'S UUO. ;WE DON'T SOS UUOH SINCE DDT WILL SOS THE PC AFTER RETUEN (BECAUSE OPTOPC=0). ILLUUO: .SUSET [.RJPC,,ERRJPC] MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC .VALUE [ASCIZ *2.PIRQC/%PIILO P*] SETZM UUO40 JRST 2,@UUOH ;COME HERE WHEN THE USER REQUESTS SOMETHING LEGITIMATE THAT WE CAN'T HANDLE. ;RETURN TO DDT WITH THE PC POINTING AT THE USER'S UUO. MISSING: ERROUT Simulator Deficiency Encountered IOTUUO: SUBI A,IOTLOW ;HERE IF IOT TRAPS JUMPL A,ILLUUO caig a,iotmax SKIPE DECRN ;SAIL'S IOT UUOS DON'T EXIST UNDER DEC SYSTEM JRST ILLUUO ADDI A,IOTTAB-UUOTAB JRST IOTUU1 UUOTAB: PUSHJ P,XCALL ; 40 JRST XINIT ; 41 JRST ILLUUO ; 42 JRST ILLUUO ; 43 JRST ILLUUO ; 44 JRST ILLUUO ; 45 JRST ILLUUO ; 46 PUSHJ P,XCALLI ; 47 PUSHJ P,XOPEN ; 50 PUSHJ P,XTTYUU ; 51 JRST ILLUUO ; 52 JRST ILLUUO ; 53 JRST ILLUUO ; 54 PUSHJ P,XRENAM ; 55 PUSHJ P,XIN ; 56 PUSHJ P,XOUT ; 57 PUSHJ P,XSTSTS ; 60 JRST XSTATO ; 61 PUSHJ P,XGTSTS ; 62 JRST XSTATZ ; 63 PUSHJ P,XINBUF ; 64 PUSHJ P,XOUTBUF ; 65 PUSHJ P,XINPUT ; 66 PUSHJ P,XOUTPUT ; 67 PUSHJ P,XCLOSE ; 70 PUSHJ P,XRELEAS ; 71 pushj p,xmtape ; 72 (MTAPE) JFCL ; 73 (UGETF) JRST XUSET ; 74 JRST XUSET ; 75 PUSHJ P,XLOOKUP ; 76 PUSHJ P,XENTER ; 77 JRST illuuo ; 100 (UJEN) UUOMAX==.-UUOTAB IOTTAB: JRST ILLUUO ;700 JRST .DPYCLR ;701 JRST .PPIOT ;702 JRST .UPGIOT ;703 REPEAT 710-704+1,JRST ILLUUO JRST XPTYUUO ;711 JRST ILLUUO ;712 JRST .UPGME ;713 JRST .UPGMM ;714 JRST .PGIOT ;715 IOTMAX==.-IOTTAB STORAGE(IMPURE) FIXAC: 0 ;SAVE AC FIELD OF FIX INSN STORAGE(PURE) USAVEA==UUOACS-LOWAC+A USAVEB==UUOACS-LOWAC+B USAVEC==UUOACS-LOWAC+C USAVED==UUOACS-LOWAC+D ;HANDLE STANFORD'S FIX INSTRUCTION. A ALREADY SAVED IN UUOACS BUT OTHER ACS UNSAVED. ;A HAS ADDR TO JUMP INTO UUOH1 AND FALL THROUGH TO ILLUUO IN CASE WE ARE ;NOT SIMULATING SAIL. FIXUUO: SKIPE DECRN JRST (A) MOVEM B,USAVEB MOVEM C,USAVEC MOVEM D,USAVED SKIPL FIXINP ;TRY TO COMPILE THE INSN IF ALLOWED. JRST FIXCMP FIXCMX: LDB B,[270400,,UUO40] MOVEM B,FIXAC MOVE A,USAVEA MOVE B,USAVEB MOVE A,@FIXAC MOVE C,A ASH C,8 ;SHOVE OVER FRACTION TO LEFT EDGE MOVMS A LDB D,[111100,,UUO40] ; EXPONENT OF FIX INSTRUCTION LDB B,[331100,,A] ;EXPONENT OF NUMBER SUBI B,8(D) ; FIX SHIFT PLUS COMPENSATE FOR ASH BEFORE ASH C,(B) EXCH C,FIXAC MOVE D,USAVED MOVE B,USAVEB MOVE A,USAVEA SETZM UUO40 CAIN C,C JRST [ MOVE C,FIXAC JRST 2,@UUOH] EXCH C,FIXAC MOVEM C,@FIXAC MOVE C,USAVEC JRST 2,@UUOH FIXCMP: HRRZ A,UUOH ;CAN'T COMPILE IF EXECUTED IN AN AC. CAIGE A,20 JRST FIXCMX MOVE A,-1(A) CAME A,UUO40 ;CAN'T COMPILE IF INDEXED, INDIRECT, OR XCT'D. JRST FIXCMX SETZ B, ;SEE IF WE'VE ALREADY HANDLED THIS INSN BEFORE FIXCM0: CAMN B,FIXINP ;(MUST HAVE SAME OPCODE, AC AND ADDRESS). JRST FIXCM1 ;NO - WE'VE CHECKED ALL INSNS SEEN BEFORE. CAME A,FIXINS(B) AOJA B,FIXCM0 ADD B,[XCT FIXXCT] ;YES! DO XCT OF A JSR TO FIXJSR, INSTEAD OF THE FIX INSN HRRZ A,UUOH MOVEM B,-1(A) JRST FIXCMX ;NOW GO AHEAD AND RUN THE FIX THIS TIME. ;HERE IF INSN HASN'T BEEN SEEN BEFORE FIXCM1: CAIL B,FIXINL ;NO ROOM IN TABLE => CAN'T COMPILE. JRST FIXCMX MOVEM A,FIXINS(B) AOS FIXINP ;ELSE GOBBLE NEXT TABLE ENTRY FOR THIS INSN JRST FIXCM0 ;AND PRETEND ENTRY WAS ALREADY THERE. STORAGE IMPURE IFNDEF FIXINL,FIXINL==10 ;# OF DIFFERENT INSNS WE CAN COMPILE. FIXINP: 0 ;POINTER TO FIRST UNUSED ENTRY IN FIXINS FIXINS: BLOCK FIXINL ;EACH DIFFERENT-LOOKING INSN WE COMPILE GETS AN ENTRY ;IN THIS TABLE. FIXJSR: 0 JRST FIXJS1 STORAGE PURE FIXJS1: MOVEM A,USAVEA MOVEM B,USAVEB MOVEM C,USAVEC MOVEM D,USAVED MOVE A,FIXJSR MOVEM A,UUOH HRRZ A,-1(A) ;GET THE ADDRESS FIELD OF THE XCT INSN MOVE A,FIXINS-FIXXCT(A) ;GET THE CORRESPONDING INSN IN FIXINS MOVEM A,UUO40 ;AND GO EXECUTE THAT INSN JRST FIXCMX ;WITHOUT TRYING TO COMPILE IT AGAIN! FIXXCT: REPEAT FIXINL,JSR FIXJSR ;COMPILE INSN IS AN XCT OF SOME WORD IN FIXJSR. ;FIXJSR USES THE PRECISE ADDRESS OF THE XCT TO SEE ;WHICH INSN IN FIXINS SHOULD BE RUN. ;THESE ARE SOME OF THE STANFORD UUOS (INCLUDING ALL THE ONES WE SIMULATE). IFN 0,[ DPYCLR= 701_33 ] PPIOT= 702_33 UPGIOT= 703_33 UINBF= 704_33 UOUTBF= 705_33 FBREAD= 706_33 FBWRT= 707_33 MAIL= 710_33 PTYUUO= 711_33 POINTS= 712_33 UPGMVE= 713_33 UPGMVM= 714_33 PGIOT= 715_33 IFN 0,[ PPSEL= PPIOT 0, PPACT= PPIOT 1, DPYPOS= PPIOT 2, DPYSIZ= PPIOT 3, PPREL= PPIOT 4, PGSEL= PGIOT 0, PGACT= PGIOT 1, PGCLR= PGIOT 2, DPYOUT= UPGIOT ] subttl TTY UUO Action Routines ;HANDLE SAIL'S TTYUUO OR DEC'S TTCALL. XTTYUU: HLRZ C,XTTYUT(B) SKIPN DECRN HRRZ C,XTTYUT(B) JRST (C) XTTYUT: XINCW,,XINCW ; 0 XOUTCH,,XOUTCH ; 1 XINCS,,XINCS ; 2 XOUTST,,XOUTST ; 3 XINCWL,,XINCWL ; 4 XINCSL,,XINCSL ; 5 XGETLC,,XGETLC ; 6 XSETLC,,XSETLC ; 7 XRESCA,,XRESCA ;10 XCLRBI,,XCLRBI ;11 XCLRBO,,XCLRBO ;12 XSKPIC,,XINSKI ;13 XSKPIL,,XINWAI ;14 XIONEO,,XSETAC ;15 uuoxit,,MISSING ;16 uuoxit,,MISSING ;17 DEFINE LINMOD FLAG MOVEI A,IO.FCS\IO.FLS ANDCAM A,TTYLCH TERMIN DEFINE CHRMOD MOVEI A,IO.FLS ANDCAM A,TTYLCH MOVEI A,IO.FCS IORM A,TTYLCH TERMIN XINCWL: PUSHJ P,XINWAI ;4 (INCHWL) JRST XINCW1 XINCW: CHRMOD ;0 (INCHRW) SKIPG ACTCHR PUSHJ P,TIHANG XINCW1: PUSHJ P,GETCHA SKIPN METARN ;UNLESS SIMULATING META-BITS, ^C => RETURN TO HACTRN CAIE A,^C JRST UPUTA SOS UUOH ;WHICH IS DONE BY SOS'ING PC AND THEN EXIT 1,ING. JRST XEXIT1 XOUTCH: PUSHJ P,UGETA ;1 JUMPE A,CPOPJ JRST TYO XINCSL: LINMOD ;5 (INCHSL) SKIPG ACTLIN POPJ P, JRST XINCS1 XINCS: CHRMOD ;2 (INCHRS) SKIPG ACTCHR POPJ P, ;NO CHARACTERS, NON-SKIP RETURN XINCS1: AOS (P) JRST XINCW1 XOUTST: PUSHJ P,UGETAI ;3 (OUTSTR) XOUTS0: HRLI A,440700 MOVE B,A XOUTS1: ILDB A,B JUMPE A,CPOPJ PUSHJ P,TYO JRST XOUTS1 XGETLC: PUSHJ P,UGETA ;6 (GETLCH) JSP B,THSTTY HLLZ A,TTYLCH SKIPE RIB TLO A,TT.RUB ;TT.RUB SAYS RUBBING OUT IS IN PROGRESS. SKIPE ACTLIN SKIPN DECRN ;IN DEC MODE, TT.ACT IS 1 IFF ACTLIN > 0. CAIA TLO A,TT.ACT HRR A,TTYNUM SKIPE DECRN TRO A,200000 ;DEC WANTS THIS BIT WITH THE TTY NUMBER. SKIPE TTYRN SETO A, JRST UPUTA ;JSP B,THSTTY TO COMPLAIN UNLESS C(A) SPECIFIES OUR TTY THSTTY: JUMPL A,(B) ANDI A,177777 ;FLUSH THE IGNORED BITS. CAMN A,TTYNUM JRST (B) JRST MISSING XSETLC: PUSHJ P,UGETA ;7 (SETLCH) MOVSI C,TT.SAI SKIPE DECRN ;GET A MASK TO THE BITS THAT CAN SUPPOSEDLY BE SET MOVSI C,TT.DEC PUSHJ P,TTYOFF XOR A,TTYLCH ;WHICH BITS IS USER TRYING TO CHANGE? AND A,C ;FORGET ABOUT THOSE THE REAL SYSTEM WON'T LET HIM CHANGE. TLNE A,TT.LOS ;THESE ARE THE ESSENTIAL BITS THAT WE CAN'T HANDLE. JRST MISSING XORM A,TTYLCH JRST TTYON XCLRBI: PUSHJ P,TTYOFF ;11 (CRLBFI) SYSCLV RESET,TTYICH CLRBI1: PUSHJ P,TTYIRS ;RESET THOSE POINTERS TTYXIT: PUSHJ P,TTYON JRST UUOXIT XCLRBO: SYSCLV RESET,TTYOCH ;12 (CLRBFO) JRST UUOXIT XINSKI: HRRE A,UUO40 ;13 (INSKIP) SIGN OF ADDRESS DECIDES WHETHER JUMPGE A,XSKPIC ;TO TEST FOR 1 CHAR OR A LINE. XSKPIL: LINMOD ;14 (SKPINL) SKIPG ACTLIN POPJ P, JRST POPJ1 XSKPIC: CHRMOD ;13 (SKPINC OR INSKIP) SKIPG ACTCHR POPJ P, JRST POPJ1 XINWAI: LINMOD ;14 (INWAIT) SKIPG ACTLIN PUSHJ P,TIHANG POPJ P, XRESCA: HRRZ B,UUO40 ;10 (RESCAN) SETZB A,DDTBUF ;DDTBUF=0 => WE HAVEN'T GOT JCL FOR THIS RESCAN. SKIPN JCLGOT PUSHJ P,JCLGET ;IF HAVEN'T ALREADY SNARFED OUR JCL, TRY TO SNARF IT. SKIPN DDTBUF ;IF SOME WAS SNARFED, JRST XRESC1 SKIPE DECRN SETOM JCLGOT ;SAIL WILL LET YOU RE-RESCAN, BUT DEC WON'T. PUSHJ P,TTYOFF ;PREVENT TTY INTERRUPTS WHILE WE SIMULATE SOME. PUSH P,B PUSH P,PUTCC PUSH P,PUTBPT MOVE A,[440700,,DDTBUF] PUSH P,A SETZ C, XRESC4: ILDB B,A ;SCAN THROUGH THE JCL, COUNTING # CHARS IN C. CAIN B,^M AOSA C SKIPE B AOJA C,XRESC4 PUSH P,C ;PUSH # CHARS. MOVE B,GETBPT ;WE WANT TO PUT THOSE CHARS IN THE INPUT BUFFER BEFORE SKIPG A,GETCC MOVE B,[1100,,TTYBUF+TTYBFL-1] ADD A,C ;THE CHARS ALREADY IN IT; GETCC AND GETBPT POINT AT WHERE THEY ROT C,-2 SUBI B,(C) ;SHOULD STOP; FIND OUT WHERE THEY SHOULD START. ROT C,2 ANDI C,3 ;ESSENTIALLY SUBTRACT # CHARS FROM GETCC AND GETBPT, WRAPPING IMUL C,[110000,,] ADD B,C ;AROUND IF NECESSARY, TO GET PLACE TO START STORING SKIPGE B SUB B,[440000,,1] CAIGE A,TTYBFL*TTYBPW JRST XRESC3 SUBI A,TTYBFL*TTYBPW ADDI B,TTYBFL XRESC3: MOVEM A,PUTCC ;WHICH IS PUT WHERE PUTCH LOOKS. MOVEM B,PUTBPT MOVEM A,GETCC ;INPUT WILL READ THESE CHARS BEFORE WHAT WAS ALREADY THERE. MOVEM B,GETBPT XRESCL: ILDB A,-1(P) ;THEN SCAN JCL AGAIN JUMPE A,XRESC2 PUSHJ P,XRESCP ;GOBBLING EACH CHAR AS INPUT. LDB B,-1(P) MOVEI A,^J CAIN B,^M PUSHJ P,XRESCP JRST XRESCL XRESCP: MOVEM A,CHAR ;STORE CHAR IN A IN TYPE-IN BUFFER, COUNTING # CHARS STORED. JRST PUTCH XRESC2: POP P,A SUB P,[1,,1] POP P,PUTBPT POP P,PUTCC POP P,B PUSHJ P,TTYON XRESC1: SKIPN DECRN JUMPN B,UPUTA ;SAIL => STORE ZERO IN ADDRESSED WORD, UNLESS IT IS AC. 0. TRNE B,1 ;DEC => IF USER WANTS SKIP ON FAILURE, GIVE IT TO HIM. JUMPE A,POPJ1 POPJ P, ;HERE TO HANG FOR TTY INPUT TO MAKE INTERRUPT DRIVEN PTY'S HAPPY ;(I.E. THE FRIENDLY PEOPLE AT DM) TIHANG: SOS (P) ;POINT RETURN PC AT "FLSINS" SOS (P) SKIPE STKSW JRST STKHNG PUSH P,A TIHAN1: SYSCAL IOT,[TTYICH ? 5000,,%TIPEK\%TINWT\%TIINT ? A] JFCL XCT @-1(P) ;A TTY INT. HAPPENED; IS CONDITION TRUE NOW? JRST TIHAN1 ;NO, WAIT SOME MORE. POP P,A STKHNG: XCT @(P) ;STK MUST DO A HANG .HANG POPJ P, XSETAC: PUSHJ P,UGETA ;15 (SETBRK) TLNN A,-1 JRST XSETA1 ;DOESN'T WANT TO SAVE OLD TABLE MOVE B,A MOVE C,A HRLI B,BRKTAB BLT B,3(C) XSETA1: TRNN A,-1 JRST UUOXIT ;DOESN'T WANT NEW TABLE PUSHJ P,TTYOFF MOVS B,A HRRI B,BRKTAB BLT B,BRKTAB+3 JRST CLRBI1 XIONEO==xoutch ;IONEOU is an OUTCHR, because: ;(1) ITS does not have 8-bit OUTPUT ;(2) DECUUO does not have image mode ; to reset ;(3) For 7-bit output, the only difference ; between OUTCHR and IONEOU is that ; OUTCHR does not do nulls. DECUUO's ; OUTCHR does, since it doesn't make ; any difference anyway, so there is ; no difference between the two. ; This may change if image mode is ever ; implemented! ;SET UP INITIAL SPECIAL ACTIVATION TABLE AND RESET INPUT. TTYLM: MOVE C,[[ 777777,,777777 777700,,037600 000000,,374777 000007,,600000],,BRKTAB] BLT C,BRKTAB+3 POPJ P, TTYIRS: SETZM ACTLIN SETZM ACTCHR PUSH P,A MOVE A,GETCC MOVEM A,PUTCC MOVE A,GETBPT MOVEM A,PUTBPT SETZM RIB JRST POPAJ XPTYUU: PUSHJ P,UGETAI ;GETS EFFECTIVE ADDRESS OF UUO IN A SKIPE (A) JRST MISSING ;ONLY ALLOW TO SELF JRST @.+1(B) ;DISPATCH ON ACFIELD MISSING ; 0 (PTYGET) MISSING ; 1 (PTYREL) XPTIFR ; 2 (PTIFRE) MISSING ; 3 (PTOCNT) UUOXIT ; 4 (PTRD1S) UUOXIT ; 5 (PTRD1W) XPTW1S ; 6 (PTWR1S) XPTW1W ; 7 (PTWR1W) UUOXIT ;10 (PTRDS) XPTWS7 ;11 (PTWRS7) XPTWS9 ;12 (PTWRS9) MISSING ;13 (PTGETL) MISSING ;14 (PTSETL) XPTLOA ;15 (PTLOAD) XPTJOB ;16 (PTJOBX) ILLUUO ;17 XPTIFR: MOVEI C,TTYBFL*TTYBPW ;# CHARACTERS IN EMPTY BUFFER SUB C,ACTCHR PUSHJ P,UPUTC1 JRST UUOXIT PTYPUT: PUSHJ P,UGETC1 PUSHJ P,TTYOFF PUSH P,CHAR MOVEM C,CHAR ;CHARACTER TO PUT IN BUFFER PUSHJ P,PUTCH PTPXIT: POP P,CHAR JRST TTYON XPTW1S: PUSHJ P,PTYPUT JRST UUOXSK XPTW1W: PUSHJ P,PTYPUT JRST UUOXIT XPTWS7: PUSHJ P,UGETC1 TLNN C,7777 HRLI C,440700 ;MAKE IT INTO A BYTE POINTER PUSHJ P,PTWRSX JRST UUOXIT PTWRSX: PUSHJ P,TTYOFF PUSH P,CHAR PUSH P,C PTWLOP: ILDB A,(P) JUMPE A,[ SUB P,[1,,1] JRST PTPXIT] MOVEM A,CHAR PUSHJ P,PUTCH JRST PTWLOP XPTWS9: PUSHJ P,UGETC1 TLNN C,7777 HRLI C,441100 ;MAKE IT 9-BIT BYTE STRING PUSHJ P,PTWRSX JRST UUOXIT XPTLOA: SKIPN ZPTLOA POPJ P, JRST MISSING XPTJOB: PUSHJ P,UGETC1 ;COMMAND JUMPG C,[SOJA C,XPTJO1] MOVE A,C MOVSI C,-6 CAME A,XPTJBN(C) AOBJN C,.-1 ANDI C,-1 XPTJO1: CAIL C,6 JRST ILLUUO MOVEI D,IO.SUP XCT XPTJBT(C) JRST UUOXIT JRST UUOXSK XPTJBT: JRST ILLUUO ;HALT AOSA UUOH ;CONT SKIPS TWICE IORM D,TTYLCH ;DOFF ANDCAM D,TTYLCH ;DON JRST MISSING ;LOGIN JFCL ;SKIP IF INPUT WAIT XPTJBN: SIXBIT/HALT/ SIXBIT/CONT/ SIXBIT/DOFF/ SIXBIT/DON/ SIXBIT/LOGIN/ SIXBIT/IWAITS/ ;AC MAPPING NON-SENSE UGETAI: MOVEI A,@UUO40 UGET1: CAIL A,LOWAC CAILE A,HIGHAC POPJ P, ADDI A,UUOACS-LOWAC ;MAP THE ACS THAT UUOH SAVES. POPJ P, UGET3: PUSHJ P,UGET1 JRST UGET2 UGETA: PUSHJ P,UGETAI MPVOK1:: UGET2: MOVE A,(A) POPJ P, UPUTA: PUSH P,A PUSHJ P,UGETAI MPVOK2:: UPUT1: POP P,(A) POPJ P, UGETAC: LDB A,[270400,,UUO40] UGETA1: PUSHJ P,UGET1 JRST UGET2 UPUTAC: PUSH P,A LDB A,[270400,,UUO40] PUSHJ P,UGET1 JRST UPUT1 UGETC1: MOVEI A,@UUO40 UGETCI: ADDI A,1 UGETC: PUSH P,A PUSHJ P,UGET1 MPVOK3:: MOVE C,(A) JRST POPAJ UPUTC1: MOVEI A,@UUO40 UPUTCI: ADDI A,1 UPUTC: PUSH P,A PUSHJ P,UGET1 MPVOK4:: MOVEM C,(A) JRST POPAJ subttl INIT and OPEN ;INIT SNARFS ITS ARGS FUNNY AND THEN DOES AN OPEN, ;AFTER WHICH THE PC IS INCREMENTED AN EXTRA 2 TIMES. XINIT: MOVE A,UUOH MOVEI A,-1(A) ;GET THE ADDR OF THE INIT CAIN A,BOTGO ;IF THIS INIT IS REALLY THE .OPEN AT THE BEGINNING OF DECBOT, JRST DDTGO ;JUST START THE USER PROGRAM SINCE THE USER MUST HAVE TYPED $G. CAIE A,31 JRST XINIT1 HRRZ A,32 ;IF EXECUTED FROM 31, DDT IS HACKING PROCEED FROM BREAKPOINT, HRRM A,UUOH ;SO MAKE UUOH -> WHERE UUO IS SUPPOSED TO BE JRST XINIT ;SINCE THAT'S WHERE THE INIT'S ARGS REALLY ARE. XINIT1: HRRZ C,UUO40 ;GET THE 1ST ARG, WITH ZEROS IN THE LH (UU.PHS, ETC) PUSHJ P,INIT0 ;DO THE WORK, WITH AN EXTRA SKIP IF IT SUCCEEDS. CAIA AOS UUOH MOVEI A,2 ;SKIP OVER THE ARGS ADDM A,UUOH JRST UUOXIT XOPEN: HRRZ A,UUO40 PUSHJ P,UGETC ;DO PAY ATTENTION TO LH OF USER'S 1ST ARG FOR OPEN. INIT0: PUSH P,C ;SAVE 1ST ARG (I/O MODE) PUSHJ P,UGETCI ;GET DEVICE NAME PUSH P,C PUSHJ P,UGETCI ;GET IHDR,,OHDR. PUSH P,C SETZ A, SKIPE CHDEV(B) ;RELEAS ANY INITTED DEVICE ON THIS CHANNEL. PUSHJ P,CHREL POP P,A ;HEADER ADDRS INTO A POP P,E ;DEVICE NAME INTO E POP P,C ;I/O MODE INTO C. SKIPN ZPHYS TLZ C,(UU.DEL\UU.DER\UU.PHS) TDNE C,[UU.AIO\UU.DEL\UU.DER\UU.PHS] JRST MISSING ;WE CAN'T DO ASYNCHRONOUS IO OR HACK ERROR LOGGING. MOVEM C,CHDMOD(B) ANDI C,17 ;GET JUST THE BASIC IO MODE MOVE D,INITMT(C) ;WHAT I.T.S. MODES DOES THAT CORRESPOND TO? HRRZM D,CHOMOD(B) HLRZM D,CHIMOD(B) setzm chufdu(b) ;no ufd useti yet(sigh) SETZM CHLKEN(B) ;NO LOOKUP/ENTER DONE YET. JUMPE E,ILLUUO ;DEVICE IS 0? INSIRP PUSH P,A B C E MOVE A,E ;DECODE THE DEVICE TO SEE IF IT EXISTS. PUSHJ P,DEVDCD JRST [ SUB P,[4,,4] ;IT DOESN'T; THE UUO SHOULD FAIL. POPJ P,] INSIRP POP P,E C EXCH B,(P) ;POP THE CHANNEL # AND STORE DEV NAME RETURNED POP P,CHRDEV(B) ;BY DEVDCD AS THE "REAL"" DEV NAME. POP P,A HLRZ D,E ;NOW WE MUST CONVERT "TTYnn" TO "Tnn" cain d,'mta movsi e,'mt0 CAIN D,'TTY ;BEFORE THE ACTUAL OPEN. TRNN E,-1 JRST INIT3 LSH E,14 TLC E,<'T#'Y>_14 ;SHIFT SO HAVE JUST Ynn, THEN CHANGE Y TO T. INIT3: MOVEM E,CHDEV(B) ;CHANNEL OFFICIALLY INITTED. HRRZM A,CHIHDR(B) ;SO WE CAN STORE THE HEADER ADDRESSES. HLRZM A,CHOHDR(B) CAIGE C,.IOIDP JRST INIT1 HRROS CHIHDR(B) ;DUMP MODE => SET SIGN BIT OF BOTH HEADER ADDRESS WORDS HRROS CHOHDR(B) JRST INIT2 INIT1: HRL C,INITBT(C) ;BUFFERED MODE => GET APPROPRIATE BYTE SIZE CAMN E,['PLT,,] HRLI C,700 ;PLOTTER NEEDS 7-BIT BYTES. IRPS X,,CHIHDR CHOHDR SKIPN D,X(B) JRST .+11 skipn decrn ;apparently only DEC system cares(?) jrst .+4 caile d,.jbpfi ;all I/O must be above .JBPFI caml d,memt ;and below C(.JBREL) jrst initck ;addr check SETZM (D) ;INITIALIZE BOTH BUFFER HEADERS. SETZM 2(D) HLLZM C,1(D) TERMIN INIT2: MOVSI A,-DEVTLN MOVE C,CHRDEV(B) CAME C,DEVTAB(A) ;FIND THIS DEVICE IN DEVTAB, OR LEAVE A -> END OF DEVTAB. AOBJN A,.-1 MOVE C,CHDMOD(B) ANDI C,17 ;NOW THAT WE KNOW WHICH DCHTAB WORD TO USE, SEE IF THIS DEV MOVEI D,1 ;SUPPORTS THE SPECIFIED DATA MODE. LSH D,(C) TDNN D,DCHTAB(A) JRST ILLMOD MOVEM A,CHDIDX(B) ;REMEMBER THE DEVTAB INDEX. HRRZ C,CHDMOD(B) TRNN A,-1 ;ALL INITS & OPENS OF TTY SET TTYLCH'S RH TO I/O STATUS WORD. HRRM A,TTYLCH SETZM CHNDLE(B) ;NOW SET CHNDLE UNLESS DEVICE IS MENTIONED IN DEVTAB. JUMPL A,POPJ1 SETOM CHNDLE(B) JRST POPJ1 INITCK: SETZM CHDEV(B) ;UNDO WHAT WE'VE DONE SO FAR SINCE OPEN ISN'T SUCCEEDING. SETZM CHRDEV(B) ERROUT Address Check in buffer headers INITMT: REPEAT 2, .BAI,,.BAO REPEAT 16, .BII,,.BIO INITBT: REPEAT 3, 0700 REPEAT 15, 4400 ILLMOD: SETZM CHDEV(B) SETZM CHRDEV(B) SETZM CHIHDR(B) SETZM CHOHDR(B) ILLMO1: ERROUT Illegal or Unsimulated Data Mode ;TABLE OF KNOWN DEVICE NAMES. ;MUST INCLUDE ALL DEVICES THAT ARE NOT TO BE TREATED JUST LIKE DSK. ;TTY MUST COME FIRST. DEVTAB: 'TTY,, ? 'MTA,, ? 'NUL,, ? 'PTR,, ? 'PTP,, ? 'DIS,, ? 'PLT,, ? 'LPT,, ? 'TPL,, DEVTLN==.-DEVTAB ;DEVCHR WORD FOR A DEVICE, INDEXED BY CHDIDX (DEVTAB TABLE IDX). ;NOTE WE SAY ALL DEVICES ARE AVAILABLE AND ASSIGNED. THAT MIGHT BE FALSE FOR A FEW ;BUT THERE IS NO EASY WAY TO TELL. ;THERE IS AN EXTRA ENTRY AT THE END FOR ALL UNKNOWN DEVICES (INCL. DSK). ;FOR DEVS NOT IN DEVTAB, THE AOBJN POINTER, FULLY AOBJN'ED, POINTS THERE. DCHTAB: 030053,,600003 ;TTY 000063,,574403 ;MTA 773777,,774403 ;NUL 000242,,404003 ;PTR 000441,,404003 ;PTP 000041,,400003 ;DIS 000041,,574403 ;PLT 040041,,400403 ;LPT 040041,,400403 ;TPL 201047,,774403 ;DSK, AND ALL UNKNOWN DEVICES. IFN .-DCHTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH ;TABLE OF DEVTYP VALUES, EXCEPT FOR THE JOB # OF JOB ASSIGNED TO. DTYTAB: 57,,3 ;TTY 47,,2 ;MTA 47,, ;NUL 46,,4 ;PTR 45,,5 ;PTP 45,,61 ;DIS 45,,13 ;PLT 45,,7 ;LPT 61,,7 ;TPL 400043,,0 ;DSK, ETC. IFN .-DTYTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH ;TABLE OF DEFAULT BUFFER SIZES, WHICH INCLUDE THE THREE OVERHEAD WORDS OF THE BUFFER. DSZTAB: 23 ;TTY 203 ;MTA 203 ;NUL 43 ;PTR 43 ;PTP 43 ;DIS 43 ;PLT 37 ;LPT 37 ;TPL 203 ;DSK, ETC. IFN .-DSZTAB-DEVTLN-1,.ERR WRONG TABLE LENGTH ;table of devsts coni instructions dsttab: setz a, ;TTY coni 344,a ;MTA setz a, ;NUL coni 104,a ;PTR coni 100,a ;PTP coni 130,a ;DIS coni 140,a ;PLT coni 124,a ;LPT coni 124,a ;TPL coni 270,a ;DSK ifn .-dsttab-devtln-1,.err Wrong Table Length subttl LOOKUP and ENTER XLOOKU: SKIPA C,[CHBLKP,,CHBENT] XENTER: MOVE C,[CHBENT,,CHBLKP] SKIPN CHDEV(B) JRST IOUNAS SKIPN CHNDLE(B) JRST POPJ1 ;NON-DIRECTORY-DEVICE; ALWAYS SUCCEED. TSNE C,CHLKEN(B) ;TRYING TO DO BOTH DIRCETIONS => JRST XENTL1 ;IT'S EITHER ILGL SEQUENCE OF UUOS, OR UPDATE (UNSUPPORTED) TRZ C,-1 SETZ A, PUSH P,C PUSHJ P,[ JUMPL C,OCLS ;CLOSE THE SIDE OF THE CHANNEL THAT'S BEING HACKED. JRST ICLS] POP P,C PUSHJ P,XENTD ;FETCH ARGS AND BEGIN DECODING THEM IN ENNAME, ETC. ;ALSO D HAS THE EXTENSION. IRPS X,,ENNAME ENEXTE ENSNAM ENOSNM ENSFD,Y,,CHNAME CHEXTE CHSNAM CHOSNM CHSFD MOVE A,X MOVEM A,Y(B) TERMIN SKIPN E,CHNAME(B) JRST XENTL3 ;COMPLAIN TO PROGM IF FILENAME IS ILLEGAL. SKIPN FN2RN ANDCMI D,-1 CAMN E,[SIXBIT/-FILE-/] ;PROVIDE A WAY TO SPECIFY THE I.T.S. FILE DIRECTORIES: MOVE E,['.FILE.] ;-FILE-. TURNS INTO .FILE. (DIR) CAMN E,['.FILE.] MOVE D,[SIXBIT /(DIR)/] CAMN E,[SIXBIT/M-F-D-/] ;AND M-F-D-. TURNS INTO M.F.D. (FILE) MOVE E,['M.F.D.] CAMN E,['M.F.D.] MOVE D,[SIXBIT/(FILE)/] MOVEM D,CHEXTEN(B) PUSHJ P,[ JUMPL C,OOPEN ;NOW TRY TO ACTUALLY OPEN THIS SIDE OF CHANNEL. JRST IOPEN] JRST XENTL2 ;FAILURE; E HAS I.T.S. ERROR CODE; GIVE USER THE DEC ERROR CODE. IORM C,CHLKEN(B) MOVS A,CHEXTE(B) CAIN A,'UFD JRST XLUFD HRRZM P,CHOLKE(B) ;SAY WE HAD A SUCCESSFUL LOOKUP OR ENTER ON THIS CHANNEL. ;THE LOOKUP OR ENTER HAS WON, SO STORE BACK APPROPRIATE VALUES IN ARGUMENT BLOCK. XENT2: HRRZ A,UUO40 PUSH P,C PUSHJ P,UGETC MOVE D,C POP P,C SKIPE DECRN TLNE D,-1 CAIA JUMPN D,XENTY ;VALUES OF EXTENDED LOOKUP/ENTER STORED DIFFERENTLY. ADDI A,3 ;MAKE A POINT AT PLACE TO STORE SIZE. JUMPL C,XENT1 hlrz c,chexte(b) ; get extension cain c,'UFD ; a directory? jrst [ move c,chname(b); get file name camn c,[1,,1] ; the MFD? skipa c,[512.] ; never even this big movei c,256. ; UFD's even smaller jrst xent2a] ; and be done with it SYSCAL FILLEN,CHIOPN(B) ? MOVEM C SETZ C, ;FOR LOOKUP, GET LENGTH OF FILE CAIGE C,400000 ;CONVERT TO EITHER NEGATIVE SIZE IN WORDS MOVNS C CAIL C,400000 LSH C,-7 ;OR POSITIVE SIZE IN BLOCKS xent2a: HRLZS C PUSHJ P,UPUTC XENT1: PUSHJ P,DATCNV ;GET .RBPRV IN C AND RB.CRX IN E. SUBI A,1 PUSHJ P,UPUTC SUBI A,1 PUSHJ P,UGETC ;NOW STORE RB.CRX IN WORD 1. HRR C,E PUSHJ P,UPUTC JRST POPJ1 ;HANDLE ERROR-RETURNS FROM LOOKUP/ENTER/RENAME XENTL1: JUMPL C,MISSING ;ENTER AFTER LOOKUP MISSING. XENTL5: SKIPA D,[ERISU%] ;LOOKUP AFTER ENTER IS ERRONEOUS. XENTL4: MOVEI D,ERSNF% ;COME HERE IF PATH CONTAINING SFD'S IS SPEC'D. JRST XENTL0 XENTL2: MOVEI D,ERIPP% SKIPE CHSFD(B) MOVEI D,ERSNF% CAIE E,%ENSDR XENTL3: MOVEI D,ERFNF% JRST XENTL0 XENTL7: SKIPA D,[ERLVL%] XENTL6: MOVEI D,ERAEF% XENTL0: SETOM CHOLKE(B) ;SAY LAST LOOKUP/ENTER/RENAME ON THIS CHANNEL FAILED. HRRZ A,UUO40 ;STORE THE ERROR CODE IN B. PUSHJ P,UGETC ;IT GOES IN ADDR+1 FOR ORDINARY LOOKUP, TLNN C,-1 ;IN ADDR+.RBEXT FOR EXTENDED ONE. ADDI A,.RBEXT-1 PUSHJ P,UGETCI ;ADD 1 TO A, READ WORD POINTED AT. HRR C,D ;STICK ERROR CODE INTO RH AND WRITE BACK. PUSHJ P,UPUTC JRST UUOXIT UNMON==270400 ;BYTE FIELD FOR MONTH UNDAY==220500 ;BYTE FIELD FOR DAY UNYRB==330700 ;BYTE FIELD FOR YEAR UNTIME==002200 ;BYTE FIELD FOR # HALF SECONDS SINCE MIDNIGHT ;CONVERT AN ITS DISK FORMAT DATE/TIME TO DEC FORMAT. ;ALSO MERGE IN THE DATA MODE, TO GET (IN C) A WORD SUITABLE FOR .RBPRV. ;E'S RH HAS THE RB.CRX FIELD SET UP IN IT, FOR PUTTING IN .RBEXT DATCNV: MOVE C,CHIOPN(B) TDNE C,[-20] ;FIGURE OUT WHICH CHANNEL REALLY HAS FILE OPEN. MOVE C,CHOOPN(B) SYSCAL RFDATE,c ? MOVEM E SETZ E, LDB C,[UNYRB,,E] SUBI C,64. IMULI C,12. ;YEAR LDB D,[UNMON,,E] ADDI C,-1(D) IMULI C,31. ;MONTH LDB D,[UNDAY,,E] ADDI C,-1(D) ;DAY LDB D,[UNTIME,,E] IDIVI D,2*60. ;MINUTES SINCE MIDNIGHT LDB E,[140300,,C] ;GET THE TOP 3 BITS WHICH MUST GO IN .RBEXT LSH E,15. DPB D,[141300,,C] ;STORE THE TIME IN WITH THE DATE. LDB D,[0400,,CHDMOD(B)] DPB D,[270400,,C] POPJ P, ;FETCH THE ARGS TO A RENAME, LOOKUP OR ENTER AND PARTIALLY TEST THEM FOR VALIDITY. ;RETURN WITH THE ARGS IN ENNAME, ENEXTE AND ENSNAM; THE EXTENSION ALSO IN D. ;DOESN'T CLOBBER B OR C. XENTD: HRRZ A,UUO40 PUSH P,C PUSHJ P,UGETC ;KEEP INCREMENTING A AND FETCHING, GETTING INTO C MOVE D,C SKIPN DECRN JRST XENTD1 TLNN D,-1 ;IF 1ST ARG'S LH IS 0, WE HAVE AN EXTENDED CALL. JUMPN D,XENTX ;EXTENDED LOOKUP/ENTER FETCHES ARGS DIFFERENTLY XENTD1: MOVEM D,ENNAME ;THE 4 ARGS: NAME, EXTENSION, PROT/MODE/DATE, SNAME. PUSHJ P,UGETCI MOVEM C,ENEXTE PUSHJ P,UGETCI MOVEM C,D PUSHJ P,UGETCI MOVEM C,ENSNAM POP P,C ;COME HERE WITH ENNAME, ENEXTE AND ENSNAM SET UP; D HAS .RBPRV OR EQUIVALENT. XENT3: JUMPGE C,XENT4 SKIPN ZPROT ;FOR ENTER, COMPLAIN IF SETTING MISSING DATA. TLZ D,777000 ;ZPROT=0 => DON'T COMPLAIN IF SETS PROTECTION CODE. TLZ D,740 ;NEVER COMPLAIN JUST BECAUSE DATA MODE FIELD IS NONZERO. SKIPN ZCRDAT ;ZCRDAT=0 => DON'T COMPLAIN ABOUT CREATION DATE AND D,[-40,,] JUMPN D,MISSING HRRZ D,ENEXTE SKIPE FN2RN ;IF WE'RE HACKING FULL WORD EXTENSIONS, ITS NO ERROR JRST XENT4 ;IF RH IS NONZERO. SKIPE ZCRDAT ;COMPLAIN ABOUT SETTING ACCESS DATE UNLESS ZCRDAT=0. JUMPN D,MISSING HLLZS ENEXTE ;IF NOT FN2SW, EVEN IF DON'T BARF AT RH, MUST IGNORE IT. XENT4: SETZM ENSFD ;INITIALLY ASSUME NO SFD SPEC'D. SKIPE D,ENSNAM JRST XENT5 MOVE D,SFD ;PATH DEFAULTED => USE DEFAULTS FOR SFD AND SNAME. TLNE C,CHBREN MOVE D,CHSFD(B) ;FOR RENAME, DEFAULT IS PATH OF LOOKED-UP FILE. MOVEM D,ENSFD MOVE D,SNAME ;0 => USE THE DEFAULT. TLNE C,CHBREN MOVE D,CHSNAM(B) XENT5: TLNN D,-1 JRST [ SKIPE E,3(D) ;PATHS SUPPORTED ONLY IF SPECIFY NO SFD'S. PUSHJ P,XENT6 ;PROCESS A PATH WHICH SPEC'S AN SFD. MOVE D,2(D) ;GET OUT THE SPEC'D UFD AND MAKE IT THE SNAME. JRST .+1] MOVEM D,ENSNAM SKIPE ENSFD ;USE SNAME=SFD IF SFD TO BE USED, ELSE USE SNAME=PPN. MOVE D,ENSFD MOVEM D,ENOSNM SKIPN D,ENEXTEN ;I.T.S. DOESN'T ALLOW BLANK FN2, SO USE ">" INSTEAD. MOVSI D,(SIXBIT/>/) CAME D,['UFD,,] JRST XENTD2 JUMPL C,XENTL3 ;ERROR IF TRY TO WRITE A UFD OR RENAME A FILE INTO ONE. MOVE E,ENSNAM CAME E,[1,,1] JRST XENTL3 ;UFDS ARE FOUND ONLY ON 1,,1. XENTD2: CAMN D,['SFD,,] JRST [ TLNN C,CHBLKP\CHBREN JRST XENTL7 ;CAN'T ENTER AN SFD, JRST XENTL3] ;AND NONE EXIST ALREADY. ALSO, ERROR TO RENAME TO SFD. POPJ P, XENT6: SKIPE ZSFDTRN ;BARF IF SFD => SNAME FEATURE OFF. SKIPE 4(D) ;BARF AT NESTED SFD'S IN ANY CASE. JRST XENTL4 MOVEM E,ENSFD ;ELSE MARK SFD AS SPEC'D. POPJ P, ;DECODE ARGUMENTS OF EXTENDED LOOKUP/ENTER XENTX: POP P,C CAIGE A,.JBPFI JRST MISSING CAIGE D,.RBEXT JRST XENTL3 ;TOO FEW ARGS. PUSH P,A ADDI A,-1(D) ;MAKE SURE GET MPV NOW IN ACCEPTIBLE PLACE PUSHJ P,UGET3 ;IF WE ARE GOING TO GET ONE AT ALL. POP P,A JUMPG C,XENTX1 XENTX2: SKIPN PRIVIL ;IGNORE PRIVILEGED ARGS FOR UNPRIVILEGED PROGRAM. JRST XENTX1 IRPS X,,.RBMTA .RBSTS .RBAUT .RBNXT .RBPRD CAIGE D,X JRST XENTX1 SKIPE X(A) JRST priv TERMIN XENTX1: HRROI A,.RBEXT(A) ;NO UNHANDLEABLE ARGS: PROCESS THE IMPORTANT ONES. POP A,ENEXTE POP A,ENNAME POP A,ENSNAM MOVE D,.RBPRV(A) JRST XENT3 ;GO DEFAULT THEM, ETC. AS FOR NORMAL LOOKUP/ENTER. ;STORE VALUES OF EXTENDED LOOKUP/ENTER ;A HAS ADDR OF ARG BLOCK, D HAS 1ST WORD (# OF FOLLOWING WORDS). ;B AND C HAVE CONTENTS AS OF XENTER/XLOOKUP. XENTY: HRRZI E,.RBVER+1(A) HRLI E,-1(E) ;FIRST, ZERO OUT ALL VALUES ASKED FOR PUSH P,A ;STARTING WITH .RBVER. ADD A,D SETZM -1(E) CAIL A,(E) BLT E,(A) MOVE E,CHSNAM(B) MOVS A,CHRDEV(B) CAIN A,'SYS MOVE E,['DECSYS] CAIN A,'COM MOVE E,['COMMON] POP P,A SKIPN .RBPPN(A) ;WRITE BACK SNAME IF WASN'T SPEC'D. MOVEM E,.RBPPN(A) CAIGE D,.RBSIZ ;RETURN SIZE IN .RBSIZ IF .RBSIZ IS THERE. JRST XENTY1 hlrz e,.rbext(a) ; get extension cain e,'UFD ; a UFD or MFD? jrst [ move e,.rbnam(a); get the name camn e,[1,,1] ; is it the MFD? skipa e,[512.] ; reasonable default for MFD I think movei e,256. ; " " " UFD " " movem e,.rbsiz(a); save it in RIB block jrst xenty1] ; and continue with date hackery SYSCAL FILLEN,CHIOPN(B) ? movem .RBSIZ(A) SETZM .RBSIZ(A) XENTY1: PUSH P,D PUSHJ P,DATCNV ;CALCULATE .RBPRV AND RB.CRX POP P,D CAIL D,.RBPRV MOVEM C,.RBPRV(A) HRRM E,.RBEXT(A) CAIGE D,.RBALC JRST POPJ1 MOVE E,.RBSIZ(A) trne e,177 ;see if unfilled last block addi e,200 ;yes, count it too! LSH E,-7 MOVEM E,.RBALC(A) CAIGE D,.RBDEV JRST POPJ1 movs e,chrdev(b) ;get device name caie e,'DSK cain e,'SYS movs e,mname ;moby translation for simulation of structures cain e,'COM movs e,mname MOVSM E,.RBDEV(A) CAIGE D,.RBAUT JRST POPJ1 MOVE E,CHSNAM(B) MOVEM E,.RBAUT(A) CAIGE D,.RBTIM JRST POPJ1 SKIPE ZNDATE JRST MISSING SETZM .RBTIM(A) JRST POPJ1 ;COME HERE FROM IN/INPUT WHEN INPUT SIDE ISN'T FULLY OPENED. IOPENX: SKIPN CHDEV(B) ;CHANNEL NOT INITTED => ERROR MESSAGE. JRST IOUNAS SKIPE CHNDLE(B) JRST NOFILE ;GIVE UP IF DIRECTORY DEVICE. PUSHJ P,IOPEN ;ELSE TRY TO OPEN. skipa e,[iopen,,ocls4] ; failed, try closing output POPJ P, ;ELSE CONTINUE WITH THE IN/INPUT. mtarev: move a,chdidx(b) ; get device index move a,dchtab(a) ; and do a DEVCHR on it tlnn a,(dv.dsk) ; kludge for NUL tlnn a,(dv.mta) ; was it an MTA? jrst wrndir ; no; probably wrong direction I/O pushj p,(e) ; close the other side movss e ; get address to try opening pushj p,(e) ; and try again .lose ; strange lossage popj p, ; excelsior ;SIMILAR FOR OUT/OUTPUT. OOPENX: SKIPN CHDEV(B) JRST IOUNAS SKIPE CHNDLE(B) JRST NOFILE PUSHJ P,OOPEN skipa e,[oopen,,icls3] ; failed, try closing input POPJ P, jrst mtarev ; reverse what magtape is doing ;OPEN THE INPUT SIDE OF CHANNEL IN B. DON'T CLOBBER C. ;SKIP IF SUCCESSFUL, ELSE RETURN I.T.S. ERROR CODE IN E. IOPEN: PUSHJ P,IOPEN1 ;DO THE OPEN POPJ P, AOS (P) ;THEN GOBBLE UP A WORD TO FILL THE LOOK-AHEAD BUFFER "CHIWRD". HRRZ E,CHIOPN(B) ;(BUT TTY'S DON'T DO THAT) CAIN E,20 POPJ P, SETZ E, JRST XCTIN2 IOPEN1: SKIPA A,[CHIOPN,,CHIMOD] OOPEN: MOVE A,[CHOOPN,,CHOMOD] ADDI A,(B) ;GET ADDR OF MODE TO OPEN IN PUSH P,C MOVE E,CHRDEV(B) ;GET THE TRANSLATED DEV NAME TO FIGURE WHAT TYPE DEVICE. MOVE C,CHDEV(B) ;OPEN THE REAL DEV NAME, NOT TRANSLATED. THE OPEN WILL TRANSLATE IT. MOVE D,['DECSYS] CAMN E,['SYS,,] ;TURN SYS: INTO DECSYS; MOVEM D,CHOSNM(B) CAMN E,['SYS,,] MOVSI C,'DSK ;DO THE ACTUAL OPEN ON DSK: INSTEAD OF SYS: movem c,chdev(b) MOVEI D,20 CAMN E,['TTY,,] ;IF DEVICE IS TTY, JUST MARK SIDE AS OPEN ON CHANNEL 20. JRST IOPEN3 HRRZ D,B ;ELSE FIND AN I.T.S. CHANNEL TO OPEN ON. SKIPN CHOPN(D) ;FIRST TRY THE SAME # AS THAT OF THE DEC CHANNEL. JRST IOPEN2 PUSHJ P,ALCHAN ;D HAS THE I.T.S. CHANNEL TO USE FOR THIS SIDE. IOPEN2: MOVS E,CHEXTE(B) CAIN E,'UFD JRST [ move e,chname(b) camn e,[1,,1] ;is it the MFD? jrst [ syscal open,[d ? 5000,,.bii ? 3000,,e ? c ['M.F.D.] ? [sixbit/(FILE)/]] .lose 1000 JRST IOPEN4] SYSCAL OPEN,[D ? 5000,,.BII ? 3000,,E c ? ['.FILE.] ? [SIXBIT /(DIR)/] ? CHNAME(B)] JRST POPCJ JRST IOPEN4] SYSCAL OPEN,[D ? 4000,,(A) ? C ? CHNAME(B) ? CHEXTE(B) ? CHOSNM(B) ? 3000,,E] JRST POPCJ IOPEN4: SETOM CHOPN(D) ;WE WIN! MARK I.T.S. CHANNEL AS IN USE IOPEN3: POP P,C HLRZS A ADDI A,(B) MOVEM D,(A) ;AND SAY THIS SIDE IS USING IT. JRST POPJ1 NOFILE: MOVEI D,IO.IMP IORM D,CHDMOD(B) JRST UUOXIT ;FIND A FREE I.T.S. CHANNEL AND LEAVE NUMBER IN D. SCAN FROM TOP DOWN TO AVOID USING ;I.T.S. CHANNELS CORRESPONDING TO DEC CHANNELS THE USER IS LIKELY TO USE. ALCHAN: MOVEI D,17 ALCHA1: SKIPN CHOPN(D) POPJ P, SOJGE D,ALCHA1 TMCH: ERROUT Too many I/O channels in use IOUNAS: ERROUT I/O to Unassigned Channel ADRCHK: ERROUT Address Check in Buffer Ring Creation WRNDIR: SOS UUOH MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC SETZM UUO40 SYSCLV LOSE,[[IOPEN2,,1000] ? UUOH] POPCJ: POP P,C POPJ P, subttl CLOSE and RELEASE XCLOSE: HRRZ A,UUO40 ANDI A,CL.IN\CL.OUT\CL.RST\CL.ACS CHCLS: PUSH P,A TRNN A,CL.OUT PUSHJ P,OCLS POP P,A TRNE A,CL.IN POPJ P, ICLS: MOVSI C,CHBLKP ;SAY LOOKUP HASN'T BEEN DONE THIS CH. ANDCAM C,CHLKEN(B) SETZM CHEOFC(B) ;CLOSING INPUT CLEARS THE EOF FLAG. MOVEI D,IO.EOF ANDCAM D,CHDMOD(B) MOVEI D,CHIHDR(B) ;GIVE ADDRESS OF HEADER SO CAN CLEAR THE BYTE COUNT. SKIPN CHNDLE(B) ;IF FILE-STRUCTURED DEVICE, CLOSE THE CHANNEL NOW. JRST ICLS2 icls3: SETO C, EXCH C,CHIOPN(B) ;SAY THIS CHANNEL'S INPUT SIDE IS CLOSED, GET I.T.S. CHNL #. ICLS1: ANDI C,-1 CAIL C,20 JRST ICLS2 ;I.T.S. CHANNEL 20 => DEVICE DOESN'T NEED AN I.T.S. CHANNEL. ;-1 => THIS SIDE WAS CLOSED ALREADY. SYSCLV CLOSE,C SETZM CHOPN(C) ICLS2: SKIPLE C,(D) ;IF THERE'S A BUFFER HEADER, SETZM 2(C) ;ZERO THE BYTE COUNT IN IT. SKIPN (C) POPJ P, ;(DON'T SET BF.VBR IF NO BUFFERS IN HEADER) MOVSI D,(BF.VBR) SKIPLE C IORM D,(C) ;MARK BUFFER AS RESTORED TO VIRGINITY. POPJ P, OCLS: SKIPGE CHOOPN(B) JRST OCLS1 TRNN A,CL.ACS JRST OCLS3 SYSCAL RESRDT,CHOOPN(B) JFCL OCLS3: HRRZ C,CHOOPN(B) CAIGE C,20 ;(IGNORE CL.RST ON TTY'S; ELSE IOPUSH WOULD FAIL). TRNN A,CL.RST ;CL.RST SAYS DON'T REALLY CLOSE FILE IF AN OLD ONE EXISTS. JRST OCLS2 SYSCLV IOPUSH,CHOOPN(B) SYSCAL OPEN,[CHOOPN(B) ? CHDEV(B) ? CHNAME(B) ? CHEXTEN(B) ? CHSNAM(B) ? 4000,,CHIMOD(B)] CAIA TRO A,CL.LOS ;OPEN SUCCEEDED; SAY DON'T CLOBBER THE OLD FILE. SYSCLV IOPOP,CHOOPN(B) OCLS2: TRNE A,CL.LOS ;DON'T WANT TO REALLY WRITE THE FILE => SYSCAL RENMWO,[CHOOPN(B) ? ['_DECUU] ? [SIXBIT/>/]] JFCL ;RENAME IT AWAY SO DON'T CLOBBER ANYTHING. TRNN A,CL.LOS SKIPG A,CHOHDR(B) ;PICKUP CHANNEL HEADER POINTER JRST OCLS1 ;NO HEADER POINTER SKIPLE (A) ;NO OUTPUT FOR VIRGIN BUFFER PUSHJ P,LASTO ;PUSH OUT THAT LAST LITTLE BIT OCLS1: MOVSI C,CHBENT ANDCAM C,CHLKEN(B) MOVEI D,CHOHDR(B) SKIPN CHNDLE(B) JRST ICLS2 ocls4: SETO C, EXCH C,CHOOPN(B) JRST ICLS1 ;D -> THE CHIHDR OR CHOHDR WORD OF A CHANNEL. FREE THE BUFFER HEADER. RELBUF: MOVE A,(D) JUMPLE A,RELBU1 ;NO BUFFER HEADER MOVSI C,400000 ;MARK BUFFER RING AS FREE SKIPE (A) ;SKIP IF BUFFER RING NEVER SET UP. IORM C,(A) RELBU1: SETZM (D) ;SAY NO HEADER ADDRESS KNOWN THIS CHANNEL. POPJ P, ;RESDV. RESETS A SINGLE CHANNEL. LIKE RELEAS, BUT THROWS AWAY ANY OUTPUT FILE. XRESDV: PUSHJ P,UGETAC MOVE B,A SKIPN CHDEV(B) JRST XRETM1 AOS (P) JRST CHRELI XRELEA: SKIPE DECRN TDZA A,A ;DEC, RELEAS PRESERVES OUTPUT FILE. HRRZ A,UUO40 ;SAIL, CL.OUT => DISCARD OUTPUT FILE. ANDI A,CL.OUT TRZE A,CL.OUT CHRELI: MOVEI A,CL.LOS ;RELEASE CHANNEL AND DISCARD OUTPUT FILE. CHREL: SETOM CHNDLE(B) ;MAKE SURE CHCLS CLOSES THE I.T.S. CHANNELS. PUSHJ P,CHCLS SETZM CHLKEN(B) ;CLEAR OUT AND FORGET ABOUT THE BUFFER HEADERS. MOVEI D,CHIHDR(B) PUSHJ P,RELBUF MOVEI D,CHOHDR(B) PUSHJ P,RELBUF SETZM CHDMOD(B) SETZM CHNDLE(B) SETZM CHDEV(B) SETZM CHRDEV(B) SETZM CHDIDX(B) SETZM CHOLKE(B) POPJ P, XSTATO: pushj p,xgtst1 TDNN A,UUO40 JRST UUOXIT JRST UUOXSK XSTATZ: pushj p,xgtst1 TDNE A,UUO40 JRST UUOXIT JRST UUOXSK XGTSTS: pushj p,xgtst1 JRST UPUTA xgtst1: hrrz a,chdmod(b) ;get status word move c,chdidx(b) ;get device index move c,dchtab(c) ;now get it's chars tlnn c,(dv.dsk) ;kludge for NUL: tlnn c,(dv.mta) ;is it an MTA? popj p, ;no, return .suset [.roption,,c] ;read options tlz c,optdec .suset [.soption,,c] ;allow coni's consz 344,100000 ;at load point? tro a,io.bot ;set bot bit consz 344,4000 ;at eot? tro a,io.eot ;set eot bit consz 344,20000 ;parity error? tro a,io.dte ;set parity error bit consz 344,403620 ;device error? tro a,io.der ;set device error bit consz 344,40000 ;illegal op.? tro a,io.imp ;set improper i/o bit tlo c,optdec .suset [.soption,,c] ;back to dec mode popj p, ;and return XSTSTS: SKIPN CHDEV(B) JRST IOUNAS HRRZ A,UUO40 LDB C,[.BP 17,A] MOVEI D,1 LSH D,(C) ;FIND DEVCHR BIT FOR THE DESIRED NEW MODE. HRRZ E,CHDIDX(B) TDNN D,DCHTAB(E) JRST ILLMO1 ;BARF IF MODE NOT SUPPORTED. SKIPN E ;STETSTS OF TTY SHOULD BE REMEMBERED SO WILL HAVE HRRM A,TTYLCH ;DESIRED EFFECT ON ECHOING, ETC. HRRM A,CHDMOD(B) SETO A, CAIGE C,.IOIDP ;IS THE NEW MODE DUMP MODE? SETZ A, ;IF SO, PROPAGATE IT INTO LH OF CHIHDR & CHOHDR TO HLLM A,CHIHDR(B) ;INFORM THE IN AND OUT ROUTINES. HLLM A,CHOHDR(B) POPJ P, XRENAM: SKIPN CHDEV(B) JRST IOUNAS ;MUST HAVE DONE INIT OR OPEN. SKIPN CHNDLE(B) JRST POPJ1 ;ALWAYS SUCCEED ON NON-DIR-DEVS MOVE D,CHOLKE(B) JUMPE D,XENTL5 ;BARF IF HASN'T DONE LOOKUP OR ENTER JUMPL D,XENTL3 ;OR IF MOST RECENT ONE FAILED MOVSI C,CHBENT\CHBREN ;WE ARE SOMEWHAT LIKE AN ENTER, BUT REALLY A RENAME. PUSHJ P,XENTD ;GO FETCH ARGS, MOSTLY LIKE AN ENTER. MOVEM D,ENEXTE SKIPN ENNAME ;DETECT DELETES. JRST XRENDL MOVE A,CHOSNM(B) CAME A,ENOSNM JRST MISSING ;I.T.S. CAN'T RENAME FROM ONE DIR TO ANOTHER. XREND1: PUSH P,CHLKEN(B) SKIPE CHLKEN(B) ;IF FILE ISN'T OPEN, OPEN IT ON SOME CHANNEL SO THAT JRST XRENA1 PUSHJ P,IOPEN ;XENT2'S SYSTEM CALLS WILL SUCCEED. JRST XENTL2 ;CAN'T OPEN => RETURN ERROR TO USER. XRENA1: SKIPGE A,CHOOPN(B) MOVE A,CHIOPN(B) ;GET IN A THE CHANNEL IT IS OPEN ON. SYSCAL RENMWO,[A ? ENNAME ? ENEXTE ? 3000,,E] JRST XRENML SUB P,[1,,1] MOVE A,ENNAME ;COPY RENAME'S ARGS INTO NAMES OF OPEN FILE. MOVEM A,CHNAME(B) MOVE A,ENEXTE MOVEM A,CHEXTE(B) PUSHJ P,XENT2 ;STORE FILE LENGTH, CR. DATE., ETC. .lose SETZ A, PUSHJ P,CHCLS ;THEN CLOSE THE CHANNEL. JRST POPJ1 XRENML: POP P,A SKIPN A PUSHJ P,CHCLS ;RENAME LOST: CLOSE FILE IF WE HAD JUST OPENED IT NOW. CAIN E,%EEXFL JRST XENTL6 ;"FILE ALREADY EXISTS" HAS A SPECIAL ERROR CODE. JRST XENTL2 XRENDL: MOVE A,[[SIXBIT /_DECUU/ ? SIXBIT /DELETE/],,ENNAME] BLT A,ENEXTE SKIPN CHLKEN(B) ;IF FILE IS OPEN, RENAME IT AS GARBAGE TO JRST XREND2 PUSHJ P,XREND1 ;PREVENT DELETING THE WRONG THING. .LOSE XREND2: SYSCAL DELETE,[CHDEV(B) ? CHNAME(B) ? CHEXTE(B) ? CHOSNM(B) ? 3000,,E] JRST XENTL2 JRST POPJ1 subttl Buffers and I/O Transfers ;CREATE AN INPUT BUFFER RING FOR CHANNEL IN B. XINBU1: SKIPE (A) ;IF ALREADY BUFFERS, INPUT SHOULDN'T MAKE NEW ONES. POPJ P, SKIPA D,[2] ;D GETS # OF BUFFERS. XINBUF: HRRZ D,UUO40 SKIPN CHDEV(B) JRST IOUNAS SKIPG A,CHIHDR(B) JRST ADRCHK MOVSI E,400000 ;SAY INPUTR BUFFERS ARE ALWAYS FULL OF DATA. IOBUF1: SKIPN D ;DEFAULT # OF BUFFERS IS 2, IN INBUF/OUTBUF MOVEI D,2 ;THAT DOESN'T SPECIFY. HRRZ C,CHDIDX(B) PUSH P,DSZTAB(C) ;PUSH THE BUFFER SIZE OF THIS DEVICE. MOVE C,D ;GET # BUFFERS TIMES TOTAL SIZE OF BUFFER. IMUL C,(P) ADD C,.JBFF ;GET START OF BUFFER, AND MOVE .JBFF UP OVER THEM. PUSH P,A PUSH P,B PUSH P,C ;IF MAKING THE BUFFERS WILL REQUIRE MORE CORE, GET IT. PUSH P,D PUSH P,E MOVE A,C CAMG A,MEMT JRST IOBUF2 SUBI A,1 PUSHJ P,XCORER JRST ADRCHK IOBUF2: POP P,E POP P,D POP P,C POP P,B MOVE A,(P) EXCH C,.JBFF ;C HAS ADDR OF START OF 1ST BUFFER. ADDI C,1 HRLI C,(BF.VBR) ;MAKE HEADER POINT TO 1ST BUFFER, AND MARK RING FRESH. MOVEM C,(A) TSO E,-1(P) ;MERGE BUFFER SIZE IN WITH THE BUFFER-FULL-OF-DATA BIT. SUB E,[2,,] ;CONVERT TOTAL SIZE TO DATA AREA SIZE. SETZ A, ;INITIAL "PREVIOUS BUFFER'S ADDR" IS 0 SINCE NO PREVIOUS IOBUF3: MOVEM A,(C) ;MAKE THIS BUFFER POINT AT PREVIOUS. MOVE A,C ;THIS BUFFER BECOMES PREVIOUS HLL A,E ;(MERGE IN DESIRED LH FOR WD 1 OF NEXT BUFFER) ADD C,-1(P) ;C -> NEXT BUFFER. SOJG D,IOBUF3 ;NEED MORE => REPEAT. EXCH A,(P) ;DONE => GET BACK ADDR OF HEADER MOVE C,(A) ;WHICH POINTS AT THE FIRST BUFFER. POP P,(C) ;MAKE IT POINT AT LAST BUFFER. SUB P,[1,,1] ;FLUSH SAVED BUFFER LENGTH MOVE C,CHDMOD(B) MOVSI D,(BF.IBC) TLNE C,(UU.IBC) ;COPY UU.IBC SPEC'D WHEN CHANNEL WAS OPENED IORM D,(A) ;INTO BF.IBC OF BUFFER. POPJ P, XOUTB1: SKIPE (A) POPJ P, SKIPA D,[2] XOUTBU: HRRZ D,UUO40 SKIPN CHDEV(B) JRST IOUNAS SKIPG A,CHOHDR(B) JRST ADRCHK SETZ E, JRST IOBUF1 ;SPECIAL HACKS FOR TTY DEVICE IO TTYO: PUSH P,A PUSH P,B HRRZ B,(A) ;GET POINTER TO ILDB 1ST CHAR OF BUFFER. ADD B,[010700,,1] MOVE E,1(A) IBP E ;GET POINTER TO STOP BEFORE LDB'ING THROUGH. TTYO1: IBP B CAMN B,E JRST POPBAJ LDB A,B PUSHJ P,TYO JRST TTYO1 POPBAJ: POP P,B JRST POPAJ TTYI: PUSH P,A PUSH P,B HRRZ B,(A) ADD B,[010700,,1] PUSH P,B ;THIS WILL BECOME B.P. TO END OF BUFFER. PUSH P,B ;THIS IS B.P. TO STUFF INTO BUFFER THROUGH. HLRZ E,-1(B) TRZ E,400000 SUBI E,1 ADDM E,-1(P) PUSH P,[0] ;THIS IS # OF CHARS READ SO FAR. PUSH P,A PUSHJ P,XINWAI POP P,A TTYI1: SKIPG ACTCHR PUSHJ P,TIHANG PUSHJ P,GETCHA AOS (P) ;CHARACTER COUNT SKIPE METARN ;Only convert ^C to ^Z and non-insertion of ^Z in buffer JRST TTYI4 ;if a non-META-bit version CAIN A,^C ;^C AND ^Z BOTH MEAN EOF (ONE IS DEC STANDARD, ONE IS I.T.S.) MOVEI A,^Z skipn decrn ;If a SAIL version, ... caie a,^Z ; ... and ^Z, it is not put in the buffer ttyi4: IDPB A,-1(P) skipn metarn caie a,^Z JRST TTYI3 MOVE B,-3(P) ;EOF ISN'T PASSED TO PROGRAM; IT CAUSES NEXT INPUT TO FAIL. HLLOS CHEOFC(B) JRST TTYI2 TTYI3: MOVE E,-1(P) CAMN E,-2(P) JRST TTYI2 ;FILLED THE WHOLE BUFFER => STOP. PUSHJ P,BREAK CAIA ;FOUND A BREAK => STOP JRST TTYI1 TTYI2: POP P,C SUB P,[2,,2] ;IGNORE BYTE POINTER AND END POINTER POP P,B POP P,A MOVEM C,2(A) ;BYTE COUNT INTO BUFFER HEADER MOVE D,(A) ADDI D,1 HRLI D,010700 MOVEM D,1(A) JRST UUOXIT ;WORKS FOR BOTH IN AND INPUTS ;"IN" UUO. XIN: SKIPL A,CHIHDR(B) ;IF NOT DUMP MODE, CREATE A BUFFER RING IF THERE ISN'T ONE. PUSHJ P,XINBU1 SKIPGE CHIOPN(B) ;IF INPUT SIDE NOT FULLY OPEN, FINISH OPENING IT. PUSHJ P,IOPENX SKIPGE A,CHIHDR(B) JRST UBFIN ;UNBUFFERED INPUT. JRST BLKIN ;BUFFERED INPUT. XOUT: SKIPL A,CHOHDR(B) PUSHJ P,XOUTB1 ;IF NOT DUMP MODE, CREATE BUFFERS IF NECESSARY. SKIPGE CHOOPN(B) PUSHJ P,OOPENX ;IF OUTPUT SIDE ISN'T FULLY OPEN, FINISH OPENING IT. SKIPGE A,CHOHDR(B) JRST UBFOUT ;UNBUFFERED IO SKIPGE (A) JRST XOUT2 ;NO OUTPUT FOR FRESH BUFFER PUSHJ P,XCTOUT CAIA AOS (P) XOUT2: PUSHJ P,CLRBUF MOVE D,(A) ;FOR OUTPUT, REGARDLESS OF # CHARS OUTPUT THE WHOLE OF THE HLRZ C,(D) ;NEW BUFFER IS AVAILABLE FOR MORE. TRZ C,400000 SUBI C,1 JRST BLKIO2 XINPUT: PUSHJ P,XIN POPJ P, POPJ P, XOUTPUT: PUSHJ P,XOUT POPJ P, POPJ P, ;A -> BUFFER HEADER; ADVANCE TO NEXT BUFFER AND ZERO IT. ALSO STORE STATUS, ETC. CLRBUF: MOVE D,(A) ;GET CURRENT BUFFER ADDRESS. HRRZ C,UUO40 ;DID USER SPECIFY NEXT BUFFER'S ADDRESS? SKIPN C HRRZ C,(D) ;NO, GET IT FROM THIS BUFFER. HRRM C,(A) ;MARK IT NOW AS CURRENT BUFFER. HRRZ D,CHDMOD(B) MOVEM D,-1(C) ;STORE THE CHANNEL STATUS IN THE BUFFER. MOVSI D,(BF.VBR) ANDCAB D,(A) ;MARK RING AS HAVING HAD I/O DONE IN IT. TLNE D,(BF.IBC) ;THE RING CAN SAY POPJ P, ;THAT THE BUFFER SHOULDN'T BE CLEARED. HLRZ D,(C) ;ELSE, ZERO OUT THE DATA AREA. TRZ D,400000 ;BUFFER DATA AREA SIZE + 1. ADDI C,2 ;START OF DATA AREA OF BUFFER. HRLI C,1(C) MOVSS C ;1ST DATA WORD,,2ND DATA WORD. SETZM -1(C) ADDI D,-2(C) ;ADDRESS OF 1ST WORD AFTER BUFFER. BLT C,-1(D) POPJ P, ;BUFFERED I/O ROUTINES BLKIN: PUSHJ P,CLRBUF ;ADVANCE AROUND RING AND ZERO THE BUFFER. SKIPE CHEOFC(B) JRST BLKIO1 ;AT EOF => READ NOTHING AND FAIL. PUSHJ P,XCTIN ;ELSE READ SOME STUFF move c,cheofc(b) ;kludge for simulated useti aoje c,blkio1 ;on simulated ufd(ugh!) SUB E,D ;SUBTRACT POINTER BEFORE IOT FROM POINTER AFTER MOVEI C,(E) ;SO RH GETS # OF WORDS TRANSFERED. JUMPE C,BLKIO1 ;GOT NO NEW WORDS GIVE EOF RETURN BLKIO2: LDB E,[300600+A,,1] MOVEI D,36. IDIV D,E ;NUMBER OF BYTES PER WORD FOR USER'S B.P. SIZE. IMUL C,D ;NUMBER OF BYTES IN BUFFER MOVEM C,2(A) ;INTO HEADER MOVE C,1(A) ;OLD BYTE POINTER TLZ C,770077 HRRZ D,(A) HRRI C,1(D) MOVEM C,1(A) ;NEW BYTE POINTER POPJ P, BLKIO1: SETZM 2(A) ;ATTEMPTED BUFFERED INPUT AT EOF. UUO FAILS. SETOM CHEOFC(B) MOVEI D,IO.EOF IORM D,CHDMOD(B) POPJ1: AOS (P) ;ERROR RETURN CPOPJ: POPJ P, ;WRITE LAST OUTPUT BUFFER. CALLED FROM OCLS. LASTO: MOVS E,CHRDEV(B) CAIN E,'TTY JRST TTYO ;SPECIAL HACK FOR TTY HRRZ E,1(A) ;FIND ADDR OF LAST DATA WORD HACKED. MOVE D,CHDMOD(B) TRNN D,IO.UWC JRST LASTO3 HRRZ E,(A) ;IF IO.UWC IS SET, GET BUFFER BEGINNING ADD E,1(E) ;AND ADD IN THE USER'S WORD COUNT. MOVEI E,1(E) LASTO3: HRRZ D,(A) CAIN E,1(D) ;IF NO WORDS ARE IN THE BUFFER, IGNORE IT. POPJ P, PUSH P,E MOVE D,CHIMOD(B) CAIE D,.BAI ;IF I.T.S. CHANNEL IN ASCII MODE, JRST LASTO2 ;REPLACE TRAILING ^@'S IN LAST WORD WITH ^C'S. HRLI E,010700 ;GET PTR TO AFTER LAST WORD WRITTEN IN BUFFER. LASTO1: LDB D,E JUMPN D,LASTO2 ;ALSO STOP AT NON-^@. MOVEI D,^C DPB D,E ADD E,[070000,,] JUMPGE E,LASTO1 ;BACK THROUGH LAST WORD, STOPPING AT HIGH END. LASTO2: POP P,E ;THE LAST WORD THAT HE HACKED SUB E,(A) ;SUBTRACT OF ORIGIN OF BUFFER SOJE E,CPOPJ ;THIS BUFFER IS EMPTY MOVN D,E ;MAKE WORD COUNT NEGATIVE MOVS E,D HRR E,(A) ;AOBJN POINTER TO BUFFER ADDI E,2 JRST XCTOU1 XCTIN: MOVE E,CHIOPN(B) CAIN E,20 JRST TTYI ;SPECIAL HACK FOR TTY PUSHJ P,BUFAOB ;COME HERE WITH AOBJN IN E TO REGION TO BE READ INTO. XCTIN1: PUSH P,E HLRZ E,CHIOPN(B) CAIN E,1 ;SPECIAL HACK FOR READING A UFD. JRST [ POP P,E ? JRST UFDIN] POP P,E PUSH P,CHIWRD(B) POP P,(E) ;FIRST, SNARF THE BUFFERED-AHEAD WORD. AOBJP E,XCTIN2 SYSCLV IOT,CHIOPN(B) ? E ;THEN, READ FROM FILE. XCTIN2: JUMPL E,XCTINE PUSH P,E ;IF WE MANAGE TO FILL THE BUFFER, HRROI E,CHIWRD(B) ;READ AHEAD 1 WORD AGAIN TO SEE IF WE ARE AT EOF. SYSCLV IOT,CHIOPN(B) ? E JUMPGE E,POPEJ POP P,E XCTINE: PUSH P,E ;WE HAVE JUST READ THE LAST WORD OF THE FILE. HLLOS CHEOFC(B) ;WE ARE AT EOF; MAKE SURE WE DON'T TRY TO READ ANY MORE PUSH P,D MOVE D,CHIMOD(B) ;IF THE I.T.S. CHANNEL IS OPEN IN ASCII MODE, CAIE D,.BAI JRST POPDEJ HRLI E,010700 ;CONVERT TRAILING ^C'S IN LAST WORD TO ^@'S. SUBI E,1 XCTIN3: LDB D,E CAIE D,^C JRST POPDEJ SETZ D, DPB D,E ADD E,[070000,,] ;BACK UP B.P. JUMPL E,POPDEJ ;BUT QUIT AFTER ROCESSING ONE WORD. JRST XCTIN3 POPDEJ: POP P,D POPEJ: POP P,E POPJ P, XCTOUT: MOVS E,CHRDEV(B) CAIN E,'TTY JRST TTYO ;SPECIAL HACK FOR TTY SKIPGE CHDIDX(B) JRST LASTO ;FOR NON-DISK, OUTPUT ONLY THE FILLED PART OF BUFFER. PUSHJ P,BUFAOB XCTOU1: SYSCLV IOT,CHOOPN(B) ? E POPJ P, BUFAOB: MOVE E,(A) HLL E,(E) TLZ E,400000 TLC E,-1 ADD E,[2,,2] MOVE D,E POPJ P, ;UNBUFFERED IO ROUTINES UBFOUT: SKIPA C,[UBFOUZ] UBFIN: MOVEI C,CHEOFC(B) MOVEI D,@UUO40 ;CHANNEL COMMAND PC UBFIO1: MOVE A,D PUSHJ P,UGET1 SKIPL E,(A) JRST [ JUMPE E,CPOPJ ;END COMMAND LIST TLNE E,-1 .LOSE ;GARBAGE IN LEFT HALF MOVE D,E ;CHANNEL JUMP JRST UBFIO1] ADDI E,1 ;WAS IOWRD, NOW IS AOBJN SKIPE (C) JRST [ HRLOS (C) movei c,io.eof iorm c,chdmod(b) JRST POPJ1] ;TAKE ERROR EXIT, TRIED TO READ PAST EOF PUSHJ P,UBFIO2 SKIPGE E ;IF DIDN'T FILLTHE BUFFER ON INPUT SKIPN CHNDLE(B) ;FROM A DSK-LIKE DEVICE AOJA D,UBFIO1 push p,c ;ufd useti could have set eof move c,(c) ;so this losing routine aoje c,[pop p,c ;has to try and undo by losing movei c,io.eof iorm c,chdmod(b) jrst popj1] ;on input pop p,c ;***end of crock*** HRRZ A,(A) ;IMPLEMENT THE CROCK THAT DSK ALWAYS XFERS 200 WDS ADDI A,200 ;WHAT WOULD BE LAST WORD XREFED INTO? CAIGE A,(E) ;NOTE MORE THAN 1 RECORD MAY HAVE BEEN XFERRED. JRST .-2 ;SO FIND END OF LAST ONE THA WAS. SETZM (E) ;THEN ZERO OUT REST OF THAT RECORD. CAIE A,(E) AOJA E,.-2 AOJA D,UBFIO1 UBFOUZ: 0 ;FOR UBFOUT, C -> THIS WORD, WHICH ALWAYS IS 0 ;SO OUTPUT NEVER THINKS IT'S AT EOF. UBFIO2: CAIE C,UBFOUZ ;ALSO, C IS USED TO TELL WHICH DIRECTION OF IOT TO DO. JRST XCTIN1 JRST XCTOU1 ;A CHANNEL ON WHICH A SIMULATD DEC UFD IS OPEN HAS CHIOPN/ 1,,. ;ALSO, CHNDLE WILL BE -1 SINCE THE DEVCE IS CLEARLY A DIRECTORY DEVICE. ;CHOLKE WILL ALWAYS BE 0 TO PREVENT RENAMES. ;CHIWRD IS A BUFFERED-AHEAD WORD, UNLESS IT IS ZERO. ;THAT IS USED FOR BUFFERING BACK THE EXTENSIONS OF FILES. ;READ FROM A SIMULATED UFD INTO AOBJN IN E. UFDIN: PUSH P,A PUSH P,C HRRZ C,CHIOPN(B) push p,d skipn d,chufdu(b);was there a simulated useti? jrst [ pop p,d ;no, no cretinous crockery needed jrst ufdin1] caig d,400 ;ridiculous arg? pushj p,ufdinw ;no, get a word jrst [pop p,d ;ran out setom cheofc(b) jrst popcaj+1] sojg d,.-2 ;and continue the crockery pop p,d ;don't forget to get d back! UFDIN1: PUSHJ P,UFDINW ;COMPUTE THE NEXT UFD WORD JRST POPCAJ ;NO MORE? AOBJN E,UFDIN1 ;LOOP TILL BUFFER FULL. aosa (P) POPCAJ: hllos cheofc(b) POP P,C JRST POPAJ ;READ INTO (E) THE NEXT WORD OF A SIMULATED UFD OPEN ON CHANNEL IN B. ;SKIPS IF SUCCESSFUL; ELSE THERE ARE NO MORE WORDS IN SIMULATED UFD. UFDINW: SKIPE A,CHIWRD(B) ;ABOUT TO READ A FILE'S EXTENSION => IT HAS ALREADY JRST UFDINA ;BEEN READ AND PUT IN CHIWRD(B). UFDIN2: HRROI A,(E) PUSHJ P,UFDRD1 ;ELSE READ NEXT I.T.S. FILE'S NAME JUMPL A,UFDINE ;END OF I.T.S. UFD => NON-SKIP RETURN. HRROI A,CHIWRD(B) PUSHJ P,UFDRD1 ;AND FN2. ; This kludge assumes that each second word of MFD entry is zero -- may ; cause problems if ITS is changed. skipn chiwrd(b) ;kludge for MFD jrst [ movsi a,'UFD movem a,chiwrd(b) jrst popj1] MOVE A,[-3,,DDTBUF] PUSHJ P,UFDRD1 ;SKIP THE REMAINING 3 WDS OF AN I.T.S. UFD ENTRY. MOVE A,CHIWRD(B) SKIPN FN2RN TRNN A,-1 ;FN2 > 3 CHARS => INACCESSIBLE FROM DECUUO, SO DON'T MENTION. JRST POPJ1 ;ELSE WE WON; FN1 ALREADY IN (E). JRST UFDIN2 UFDINA: MOVEM A,(E) SETZM CHIWRD(B) JRST POPJ1 UFDINE: SETZM (E) POPJ P, UFDRD1: SYSCLV IOT,C ? A POPJ P, ;FINISH LOOKING UP A SIMULATED UFD. XLUFD: PUSH P,C HRRZ C,CHIOPN(B) ;C GETS I.T.S. CHANNEL # FOR UFDRD1. SETZM CHOLKE(B) ;PREVENT RENAMES SETZM CHIWRD(B) ;NO EXTENSION IS BUFFERED BACK YET. MOVEI A,1 HRLM A,CHIOPN(B) ;MARK THIS CHANNEL AS HAVING A SIMULATED UFD OPEN. HRROI A,DDTBUF+1 ;1 WORD WAS READ BY IOPEN. READ THE 2ND PUSHJ P,UFDRD1 ; (2ND IS PTR TO NAME AREA OF UFD) MOVNI A,2 ADDM A,DDTBUF+1 ;ACCOUNT FOR THE TWO WORDS ALREADY READ XLUFD1: HRROI A,DDTBUF PUSHJ P,UFDRD1 ;SKIP UNTIL REACH THE NAME AREA. SOSE DDTBUF+1 JRST XLUFD1 POP P,C JRST XENT2 ;NOW GO BACK AND STORE VALUES INTO LOOKUP-BLOCK. ;USETI AND USETO XUSET: SKIPN CHDEV(B) JRST IOUNAS SKIPGE D,CHIOPN(B) JRST XUSETO JUMPL D,UUOXIT XUSTO1: CAIN D,20 JRST UUOXIT setzm chufdu(b) HRRZ A,UUO40 HLRZ C,D CAIN C,1 jrst [ lsh a,7 ;convert to blocks for simulated subi a,200 jumple a,uuoxit movem a,chufdu(b) ;useti on simulated ufd (sigh) jrst uuoxit] SOJL A,XUSET1 ;DETECT 0, -1, -2, ETC. LSH A,7 ;ELSE A HAS ORIGIN-0 BLOCK #; CONVERT TO WORD #. XUSET3: SYSCLV ACCESS,[D ? A] SETZB E,CHEOFC(B) skipl chiopn(b) ;do not do input if file not open for it PUSHJ P,XCTIN2 JRST UUOXIT XUSET1: CAME A,[-1] JRST MISSING ;WE CAN'T HANDLE READING RIB'S. LDB C,[331100,,UUO40] ;ARG WAS -1; USETI AND USETO DIFFER CAIE C,74 JRST XUSET2 ;USETO MOVES BACK 1 BLOCK. SYSCAL FILLEN,[D ? MOVEM A] JRST UUOXIT ;GIVE UP IF NOT DISK. JRST XUSET3 ;USETI -1 ACESSES TO EOF. XUSET2: HRLZ A,D HRRI A,XUSETB .RCHST A, ;READ THE CURRENT ACCESS POINTER MOVE A,XUSETB+4 JUMPL A,UUOXIT ;GIVE UP IF FILE NOT RANDOM ACCESS. SUBI A,200 JRST XUSET3 ;MOVE BACK ONE BLOCK. XUSETO: SKIPGE D,CHOOPN(B) ;SO IS CHANNEL OPEN FOR WRITING? JRST UUOXIT ;NOPE, RETURN SKIPE DECRN ;THIS SAIL? JRST XUSTO1 ;NOPE, DON'T NEED TO DO THE REST LDB C,[331100,,UUO40] ;CHECK IF USETO SKIPL A,CHOHDR(B) ;MUST BE BUFFERED OUTPUT CAIE C,75 ;AND USETO JRST XUSTO1 ;NOT USETO OR UNBUFFERED, SO DON'T NEED THIS PUSH P,UUO40 ;RH MUST BE ZERO HLLZS UUO40 PUSHJ P,XOUT ;OUTPUT ANY FILLED BUFFERS JRST XUSTO2 POP P,UUO40 JRST UUOXIT ;IF FAILED, JUST RETURN XUSTO2: POP P,UUO40 MOVE D,CHOOPN(B) ;RESTORE D AND CONTINUE JRST XUSTO1 ;ELSE CONTINUE WITH PROCESSING STORAGE IMPURE XUSETB: BLOCK 8 STORAGE PURE ;MTAPE xmtape: skipn chdev(b) ; insure device on this channel jrst iounas ; ** I/O to unassigned channel ** move a,chdidx(b) ; get device index move a,dchtab(a) ; get device DEVCHR word tlnn a,(dv.dsk) ; crock; NUL is DSK and MTA tlnn a,(dv.mta\dv.dta) ; is it a magtape or DECtape? jrst uuoxit ; no, then it's a no-op skipge d,chiopn(b) ; get the ITS channel--try input move d,choopn(b) ; hmm...try output caige d, ; is there any ITS channel for it? jrst [ pushj p,iopen1 ; no, assign it an ITS channel jrst wrndir ; lose move d,chiopn(b); win jrst .+1] ; finished assigning hrrz c,uuo40 ; get MTAPE argument hrr a,c ; and copy it hrli a,1 ; do it once cain c,3 ; EOF? hrri a,5 cain c,7 ; BACKSPACE record? move a,[-1,,6] cain c,11 ; UNLOAD? hrri a,2 cain c,13 ; 3" blank tape? hrri a,4 cain c,16 ; SPACE file? hrri a,7 cain c,17 ; BACKSPACE file? move a,[-1,,7] cain c,100 ; I'm hacking DEC-style tapes already jrst uuoxit cain c,101 ; I don't know how to hack industry jrst missing ; tapes, so I am missing hrls d ; channel to LH hrri d,a ; function to RH .mtape d, ; do it setzm cheofc(b) ; clear EOF nonsense jrst uuoxit ; and return subttl CALL and CALLI DEFINE CALLS DECALL RESET,0,XRESET DECALL DDTIN,1,setz MISSING DECALL SETDDT,2,XSETDD DECALL DDTOUT,3,setz XDDTOU DECALL DEVCHR,4,XDEVCH DECALL DDTGT,5,setz UUOXIT DECALL GETCHR,6,setz XDEVCH DECALL DDTRL,7,setz UUOXIT DECALL WAIT,10,UUOXIT DECALL CORE,11,XCORE DECALL EXIT,12,XEXIT DECALL UTPCLR,13,UUOXIT DECALL DATE,14,XDATE DECALL LOGIN,15,PRIV DECALL APRENB,16,XAPREN DECALL LOGOUT,17,xexit DECALL SWITCH,20,XSWITC DECALL REASSI,21,XREASS DECALL TIMER,22,XTIMER DECALL MSTIME,23,XMSTIM DECALL GETPPN,24,XGETPP DECALL TRPSET,25,PRIV DECALL TRPJEN,26,setz ILLUUO DECALL RUNTIM,27,XRUNTI DECALL PJOB,30,XPJOB DECALL SLEEP,31,XSLEEP DECALL SETPOV,32,setz xsetpo DECALL PEEK,33,PRIV DECALL GETLIN,34,XGETLI DECALL RUN,35,XRUN DECALL SETUWP,36,XSETUW DECALL REMAP,37,XREMAP DECALL GETSEG,40,XGETSE DECALL GETTAB,41,XGETTA DECALL SPY,42,PRIV DECALL SETNAM,43,XSETNA DECALL TMPCOR,44,XTMPCO DECALL DSKCHR,45,XDSKCH DECALL SYSSTR,46,xsysst DECALL JOBSTR,47,XJBSTR DECALL STRUUO,50,uuoxit DECALL SYSPHY,51,XSYSPH DECALL FRECHN,52,nvrimp DECALL DEVTYP,53,XDEVTY DECALL DEVSTS,54,XDEVST DECALL DEVPPN,55,XDEVPP DECALL SEEK,56,XSEEK DECALL RTTRP,57,PRIV DECALL LOCK,60,PRIV DECALL JOBSTS,61,XJBSTS DECALL LOCATE,62,uuoxit DECALL WHERE,63,uuoxit DECALL DEVNAM,64,XDEVNA DECALL CTLJOB,65,XCTLJB DECALL GOBSTR,66,XGBSTR DECALL ACTIVA,67,nvrimp DECALL DEACTI,70,nvrimp DECALL HPQ,71,PRIV DECALL HIBER,72,xhiber DECALL WAKE,73,uuoxit DECALL CHGPPN,74,PRIV DECALL SETUUO,75,XSTUUO DECALL DEVGEN,76,nvrimp DECALL OTHUSR,77,xgetpp DECALL CHKACC,100,XCHKAC DECALL DEVSIZ,101,XDEVSI DECALL DAEMON,102,uuoxit DECALL JOBPEK,103,PRIV DECALL ATTACH,104,PRIV DECALL DAEFIN,105,PRIV DECALL FRCUUO,106,PRIV DECALL DEVLNM,107,XDEVLN DECALL PATH.,110,XPATH. DECALL METER.,111,PRIV DECALL MTCHR.,112,XMTCHR DECALL JBSET.,113,PRIV DECALL POKE.,114,PRIV DECALL TRMNO.,115,XTRMNO DECALL TRMOP.,116,xtrmop DECALL RESDV.,117,XRESDV DECALL UNLOK.,120,uuoxit DECALL DISK.,121,XDISK. DECALL DVRST.,122,PRIV DECALL DVURS.,123,PRIV DECALL XTTSK.,124,nvrimp DECALL CAL11.,125,PRIV DECALL MTAID.,126,priv DECALL IONDX.,127,MISSING DECALL CNECT.,130,MISSING DECALL MVHDR.,131,XMVHDR DECALL ERLST.,132,MISSING DECALL SENSE.,133,MISSING DECALL CLRST.,134,MISSING DECALL PIINI.,135,MISSING DECALL PISYS.,136,MISSING DECALL DEBRK.,137,MISSING DECALL PISAV.,140,MISSING DECALL PIRST.,141,MISSING DECALL IPCFR.,142,uuoxit DECALL IPCFS.,143,uuoxit DECALL IPCFQ.,144,uuoxit DECALL PAGE.,145,uuoxit DECALL SUSET.,146,PRIV DECALL COMPT.,147,nvrimp DECALL SCHED.,150,PRIV DECALL ENQ.,151,uuoxit DECALL DEQ.,152,uuoxit DECALL ENQC.,153,uuoxit DECALL TAPOP.,154,MISSING DECALL FILOP.,155,MISSING DECALL CAL78.,156,PRIV DECALL NODE.,157,uuoxit DECALL ERRPT.,160,priv DECALL ALLOC.,161,priv DECALL PERF.,162,priv TERMIN ;DEFINE THE SAIL SYSTEM CALLS WE RECOGNIZE. DEFINE SCALLS DECALL OSETNA,400002,XSETNA DECALL SHOWIT,400011,UUOXIT DECALL TTYMES,400047,XTTYME DECALL SWAP,400004,XSWAP DECALL CORE2,400015,XCOR2 DECALL DSKPPN,400071,XDSKPP DECALL PNAME,400007,XPNAME DECALL SEGNUM,400021,XSGNUM DECALL ATTSEG,400016,XATTSE DECALL DETSEG,400017,XDETSE TERMIN ;THIS IS THE CALL NAME TABLE. ;THERE ARE NO ENTRIES FOR CALLI'S AFTER 55 SIXBIT /LIGHTS/ NAMTAB: DEFINE DECALL NAME,NUMBER,ADDR IFL NUMBER-56, SIXBIT /NAME/ TERMIN CALLS NAMTLN==.-NAMTAB ;THIS IS THE DISPATCH ADDRESS TABLE. XLIGHT DSPTAB: DEFINE DECALL NAME,NUMBER,ADDR IFN .-DSPTAB-NUMBER,.ERR DECALL NAME OF ORDER IFN NAME-,.ERR DECALL NAME MISNUMBERED ADDR TERMIN CALLS DSPTLN==.-DSPTAB LSACAL==44 ;HIGHEST # DEC CALLI THAT SAIL HAS XCALLI: hrre c,uuo40 ;get the calli effective address trne c,400000 ;and skip the uu.phy cruft jrst xcali1 ;if it is negative! MOVEI C,200000 ;IF WE ARE SUPPOSED TO IGNORE UU.PHY AND UU.PHS, SKIPN ZPHYS ANDCAM C,UUO40 ;CLEAR IT OUT. HRRE C,UUO40 xcali1: MOVE D,C ;(IN CASE GO TO XCALLS) PUSHJ P,UGETAC ;SET UP AC CONTENTS IN A FOR THE ROUTINE. TRNE C,200000 JUMPGE C,MISSING ;WANTS SUPPRESS LOGICAL DEVNAMES FEATURE. CAMGE C,[-1] JRST XCALLS SKIPN DECRN CAIGE C,LSACAL ;SAIL DOESN'T HAVE ALL THE DEC CALLI'S. CAIL C,DSPTLN JRST uuoxit ;non-existant calli is a no-op skipe zobsolete ;do obsolete UUO's work? skipl dsptab(c) ;no, is the UUO obsolete? JRST @DSPTAB(C) errout Obsolete UUO XCALL: PUSHJ P,UGETA MOVE D,A PUSHJ P,UGETAC ;SET UP AC CONTENTS IN A FOR THE ROUTINE. MOVSI C,-NAMTLN CAME D,NAMTAB(C) AOBJN C,.-1 JUMPL C,@DSPTAB(C) MOVEI C,-1 CAMN D,['LIGHTS] JRST @DSPTAB(C) ;HERE TO DECODE A SAIL-ONLY CALL OR CALLI. NAME OR NUMBER IN A. XCALLS: SKIPE DECRN jrst uuoxit ;no customer defined calli's--no-op MOVSI C,-SCALTL CAME D,SCALT(C) AOBJN C,.-1 JUMPGE C,ILLUUO JRST @SCALD(C) SCALT: DEFINE DECALL NAME,NUMBER,ADDR SIXBIT /NAME/ ? -1,,NUMBER TERMIN SCALLS SCALTL==.-SCALT SCALD: DEFINE DECALL NAME,NUMBER,ADDR ADDR ? ADDR TERMIN SCALLS ;COME HERE WHEN PROGRAM REQUESTS A PRIVILEGED FUNCTION. EITHER GIVE THE ;SIMULATED PROGRAM AN ERROR RETURN OR COMPLAIN TO THE USER. PRIV: SKIPN PRIVIL JRST UUOXIT ERROUT Privileged UUO ;come here when the UUO was never implemented by DEC nvrimp: skipn zimplement jrst uuoxit errout Never Implemented by DEC subttl RUN, GETSEG and SWAP UUOs; Loading Binary Files XSWAP: TLNE A,-1 JRST MISSING JUMPE A,CPOPJ XRUN: PUSHJ P,XRESET XGETSE: PUSHJ P,UGETAC HLRM A,RUNOFS ;RUN UUO'S START OFFSET IS IN LH(AC) ANDI A,-1 PUSH P,A PUSHJ P,UGET3 ;GET FIRST WORD OF BLOCK MOVEM A,OPNDEV AOS A,(P) ;FILE NAME 1 PUSHJ P,UGET3 MOVEM A,OPNFN1 AOS A,(P) ;FILE NAME 2 PUSHJ P,UGET3 MOVEM A,OPNFN2 AOS A,(P) ;STARTING ADDRESS OFFSET FOR SWAP UUO PUSHJ P,UGET3 HRRZ B,UUO40 CAIE B,RUN HRRM A,RUNOFS HLRZM A,RUNCOR ;SWAP UUO'S CORE SIZE IS IN 3RD WORD AOS A,(P) ;PPN PUSHJ P,UGET3 MOVEM A,OPNSNM AOS A,(P) PUSHJ P,UGET3 CAIN B,RUN HRRZM A,RUNCOR ;CORE SIZE FOR RUN UUO IN 5TH WORD SUB P,[1,,1] CAIN B,GETSEG JRST XGETS1 PUSHJ P,RUNI ;LOAD UP THE FILES. JRST XRUNE MOVE A,RUNCOR CAMG A,MEMT JRST XRUN1 SUBI A,1 ;IF UUO SPEC'D MORE CORE THAN MINIMUM, PUSHJ P,XCORER ;GET IT. JRST XRUNEC XRUN1: JRST DDTGO ;THEN START THE PROGRAM. ;HERE FOR GETSEG, AFTER GETTING ARGS. XGETS1: PUSHJ P,RUNINI ;SET UP FOR RUN/GETSEG MOVEI B,ERILU% SKIPN TWOSEG JRST XRUNE SETZB B,A PUSHJ P,CHREL ;RELEASE CHANNEL 0 (SINCE DEC SYS DOES IT TOO) SKIPN A,OPNFN2 JRST XGETS2 MOVEI B,ERFNF% .CALL LODOPN JRST XRUNE PUSHJ P,LODH1 ;OPENED THE SPEC'D FILENAME; LOAD IT. JRST XRUNE JRST POPJ1 XGETS2: PUSHJ P,LODHGH ;DIDN'T SPEC FN2 => TRY THE STANDARD ONES. JRST XRUNE JRST XRUNE MOVE A,.JBSA ;FLUSH THE START AND RE-ENTER ADDRESSES TRNE A,400000 ;IF THEY ARE IN THE HISEG THAT WAS THROWN AWAY. HLLZS .JBSA MOVE A,.JBREN TRNE A,400000 SETZM .JBREN JRST POPJ1 ;ERROR HANDLING FOR RUN AND GETSEG UUOS. ;COME HERE TO REPORT A NOT-ENOUGH-CORE ERROR. XRUNEC: MOVEI B,ERNEC% ;COME HERE WITH ERROR CODE IN B. EITHER REPORT TO USER OR TYPE ERR MSG. XRUNE: MOVE A,UUOH TRNE A,400000 SKIPL RUNLDH SKIPGE RUNLDL JRST XRUNE1 ;RETURN ADDR CLOBBERED BY LOADING; USER CAN'T HANDLE. SKIPN DECRN ;ON SAIL, USER NEVER HANDLES THE ERROR ?? JRST XRUNE1 ;AT LEAST, UUO MANUAL GIVES THAT IMPRESSION. PUSHJ P,UGETA HLRZS A CAIN A,(JRST 4,) JRST XRUNE1 ;USER'S ERROR RETURN IS A HALT => HE DOESN'T WANT IT. MOVE A,B JRST UPUTAC ;ELSE JUST GIVE HIM ERROR CODE AND TAKE THE DIRCET EXIT. ;COME HERE IF USER CAN'T OR WON'T HANDLE THE ERROR, TO PRINT A MESSAGE AND ERR OUT. XRUNE1: PUSHJ P,XRUNE2 JRST ILLUUO XRUNE2: MOVE A,XRUNET(B) ;GET ERR MSG FOR THIS ERROR CODE. XRUNE3: PUSHJ P,XOUTS0 ;PRINT IT ON THE TTY MOVEI A,[ASCIZ / - /] PUSHJ P,XOUTS0 PUSHJ P,LSTFIL ;ALONG WITH NAME OF LOSING FILE. MOVEI A,[ASCIZ / /] JRST XOUTS0 XRUNET: OFFSET -. [ASCIZ /File can't be OPENed/] BLOCK 6 [ASCIZ /Attempt to load bad-format file/] [ASCIZ /Not enough core available to load file/] BLOCK 2 [ASCIZ /Illegal UUO (eg, GETSEG on 1-segment machine)/] OFFSET 0 ;PRINT OUT THE FILENAMES IN OPNDEV, ETC. LSTFIL: IRPS X,Y,[;OPNDEV:OPNSNM;OPNFN1 OPNFN2,]Z,,4 SNAME 1 2 SKIPN B,X IFSE Z,SNAME, MOVE B,SNAME .ELSE JRST .+Z PUSHJ P,LSTSIX IFSN [Y][,][ MOVEI A,"Y PUSHJ P,TYO ] TERMIN POPJ P, LSTSIX: SETZ A, ;PRINT SIXBIT WORD IN B AS A FILENAME. ROTC A,6 ADDI A,40 CAIE A,": CAIN A,"; PUSHJ P,LSTSI1 CAIE A,"/ CAIG A,40 PUSHJ P,LSTSI1 PUSHJ P,TYO JUMPN B,LSTSIX POPJ P, LSTSI1: PUSH P,A MOVEI A,^Q PUSHJ P,TYO JRST POPAJ ;LOAD UP FILES FOR A RUN UUO, ACCORDING TO THE FILENAMS IN OPNDEV, ETC. RUNI: PUSHJ P,RUNINI PUSHJ P,LODHGH ;TRY TO LOAD A HISEG JRST RUNLOW ;THERE IS NO FILE FOR ONE. POPJ P, ;THERE IS, AND LOADING IT FAILED. PUSHJ P,VESTIG ;SET JOBDAT AREA FROM VESTIGIAL ONE IN FILE HLRZ A,.JBCOR ;IF FILE SAYS IT HAS A LOSEG FILE, LOAD IT. CAIGE A,140 JRST RUNNL RUNLOW: PUSHJ P,LODLOW POPJ P, CAIA RUNNL: SETZM .SGLOW ;NO LOWSEG FILE LOADED => TELL USER. MOVE .SGNAM,OPNFN1 ;TELL HIM THE OTHER NAMES OF WHAT WAS LOADED MOVE .SGDEV,RUNDEV SKIPN A,OPNSNM MOVE A,SNAME MOVEM A,.SGPPN-LOWAC+UUOACS MOVE A,OPNFN1 ;SET UP THE DEC SYSTEM "JOB NAME" BASED ON THE NAME CAMN A,[SIXBIT /TS/] ;OF THE PROGRAM WE ARE ABOUT TO LOAD. MOVE A,OPNFN2 MOVEM A,JOBNAM HLRZ A,.JBSA MOVEM A,.JBFF HRRZ C,.JBSA ;UPDATE START ADDR FROM FILE BY OFFSET SPEC'D IN UUO. ADD C,RUNOFS HRRM C,.JBSA HRRZ A,.JBCOR CAMG A,RUNCOR ;IF FILES SAY WANT MORE CORE THAN WAS LOADED, JRST POPJ1 PUSHJ P,XCORER ;GET IT. JRST LODNC JRST POPJ1 ;AFTER LOADING A HIGH SEGMENT, INITIALIZE THE JOB DATA AREA FROM THE VESTIGIAL ;JOB DATA AREA. VESTIG: HRROI A,.JBHSM+.JBHGH ;POINT AT LAST WORD IN VESTIGIAL JOBDAT AREA POP A,.JBSYM ;HANDLE .JBHSY POP A,B ;IGNORE .JBHNM POP A,.JBVER ;HANDLE .JBHVR POP A,B ;HANDLE .JBHRN HRRM B,.JBREN HLLM B,.JBHRL POP A,.JBCOR ;HANDLE .JBHCR POP A,.JB41 ;HANDLE .JBH41 POP A,.JBSA ;HANDLE .JBHSA POPJ P, ;INITIALIZE FOR RUN/GETSEG. SAY THAT NEITHER SEGMENT HAS BEEN CLOBBERED, ;AND CHANGE DEVICE "SYS:" TO "DSK:DECSYS;" RUNINI: SETZM RUNLDH SETZM RUNLDL MOVEI A,1 MOVEM A,XSETU1 ;AFTER GETTING NEW HISEG, IT'S SUPPOSED TO BE PURE. MOVE A,OPNDEV MOVEM A,RUNDEV CAME A,[SIXBIT /SYS/] POPJ P, MOVE A,[SIXBIT/DECSYS/] MOVEM A,OPNSNM MOVE A,[SIXBIT/DSK/] MOVEM A,OPNDEV POPJ P, ;TRY TO LOAD THE HISEG FILE OF THE PROGRAM TO BE RUN. ;EXTENSIONS SHR AND HGH HAVE THEIR DEC MEANINGS. ;EXTENSION HBIN IMPLIES AN ITS BINARY FILE (MUST BE PDUMP'ED). ;THE SPECIFIED EXTENSION IS IGNORED, AND ONLY THOSE THREE ARE TRIED. ;USUALLY, NONE OF THEM EXISTS. ;NO SKIP RETURN => FILE NOT FOUND. ;1 SKIP RETURN => FILE FOUND, BUT IT COULDN'T LOAD PROPERLY; ERR CODE IN B. ;2 SKIP RETURN => SUCCESS. LODHGH: IRPS HGH,,SHR HGH HBIN MOVE A,[SIXBIT/HGH/] .CALL LODOPN CAIA JRST LODH1 TERMIN JRST LODLO3 ;CAN'T FIND ANY OF THE THREE NORMAL NAMES. LODH1: AOS (P) SETOM RUNLDH ;SAY USER'S OLD HISEG IF ANY HAS BEEN CLOBBERED. PUSH P,A ;WHEN WE DO, WE'LL NEED TO KNOW WHICH FORMAT TO LOAD. MOVSI A,1 ;FOUND A FILE; FLUSH EXISTING HISEG. PUSHJ P,XCORER .LOSE POP P,A CAME A,['HGH,,] CAMN A,['SHR,,] ;DETERMINE WHICH FORMAT TO LOAD. JRST LODHD PUSHJ P,LODITS POPJ P, ;LODITS FAILS => WE FAIL; ERR CODE IN B ALREADY. HRRZ B,.JBHSA;.JBHGH ;GET I.T.S. START ADDRESS AND PUT IT IN VESTIGIAL SKIPN B HRRZM C,.JBHSA+.JBHGH ;JOB DATA AREA SO IT WILL BE SEEN BY EVERYONE ELSE. JRST LODH3 ;LOAD THE LOW SEGMENT FILE OF THE SPECIFIED PROGRAM. IF AN EXTENSION ;WAS SPECIFIED, IT IS USED HERE; OTHERWISE, LOW, SAV AND BIN ARE TRIED. LODLOW: SKIPN A,OPNFN2 JRST LODLO1 .CALL LODOPN JRST LODLO3 JRST LODLO2 LODLO1: IRPS LOW,,SAV LOW BIN MOVE A,[SIXBIT/LOW/] .CALL LODOPN CAIA JRST LODLO2 TERMIN LODLO3: MOVEI B,ERFNF% POPJ P, ;NO FILE WAS FOUND WITH A STANDARD FN2. LODLO2: MOVEM A,.SGLOW PUSHJ P,ZAPRUN ;FLUSH OUR LOWSEG, AND OUR HISEG IF IT WASN'T JUST LOADED. SETOM RUNLDL SETOM RUNLDH CAME A,['LOW,,] CAMN A,['SAV,,] JRST LODLD ;DEC STANDARD EXTENSION => LOAD DEC FORMAT. PUSHJ P,LODITS ;LOAD AN ITS FORMAT FILE, AND LEAVE START ADDR IN C. POPJ P, HRRZ A,.JBSA SKIPN A ;DON'T CLOBBER HIS IDEA OF STARTING ADDRESS HRRM C,.JBSA ;WHAT THE HECK, HE MAY BE INTERESTED PUSHJ P,JOBVA1 LODH3: .CLOSE LOADCH, JRST POPJ1 LODOPN: SETZ ? SIXBIT /OPEN/ 1000,,LOADCH ? 5000,,.BII OPNDEV ? OPNFN1 ? A ? SETZ OPNSNM ;LOAD A DEC SHR OR HGH FILE. CLOBBERS ALL UUO ACS. LODHD: MOVEI B,%CBNDR ;FIRST, TRY MAPPING THE PAGES. CAME A,['SHR,,] ;DON'T SHARE IF FN2 ISN'T SHARE. MOVEI B,%CBCPY MOVE A,[-/2000,,200] SYSCAL CORBLK,[B ? MOVEI -1 ? A ? MOVEI LOADCH] JFCL CAMN A,[-/2000,,200] JRST LODHD1 ;GOT NO PAGES => CHANCES ARE IT ISN'T DSK:, SO IOT INSTEAD. JUMPG A,MISSING ;CAN'T LOAD UP MORE THAN TILL HIBASE - SORRY. LSH A,10. HRRZM A,HMEMT SETOM HSPURE ;INDICATE OUR HISEG IS REALLY PURE. JRST LODH3 LODHD1: HRLZ A,HMEMT PUSHJ P,XCORER ;ADD 1 PAGE TO HISEG. JRST LODNC MOVE A,HMEMT SUB A,[2000,,2000] ;MAKE AOBJN PTR TO NEWLY ADDED K. .CALL LODIOT .LOSE 1000 JUMPGE A,LODHD ;FILLED THIS K => TRY TO LOAD ANOTHER. TLNE A,1777 ;DIDN'T FILL ANY OF THE LAST K => JRST LODH3 HRLZI A,-1(A) ;FLUSH IT. PUSHJ P,XCORER .LOSE JRST LODH3 ;LOAD A DEC SAV OR LOW FILE. RETURN START ADDRESS IN C. CLOBBERS ALL UUO ACS. LODLD: HRROI A,C .CALL LODIOT ;READ 1 WORD INTO C. .LOSE 1000 JUMPL A,LODBF JUMPGE C,LODLD2 ;IT IS POSITIVE => IT IS START INSTRUCTION. HRRI C,1(C) ;ELSE CONVERT IOWD INTO AOBJN POINTER HLRE A,C SUBM C,A ;COMPUTE ADDR OF 1ST WORD AFTER THE BLOCK TO BE LOADED ANDI A,-1 CAMG A,MEMT ;IF WON'T FIT IN EXISTING CORE, JRST LODLD1 SUBI A,1 ;GET MORE. CONVERT TO HIGHEST ADDR THAT SHOULD EXIST. PUSH P,C PUSHJ P,XCORER JRST [ POP P,C ? JRST LODNC] POP P,C LODLD1: MOVE A,C .CALL LODIOT ;NOW READ THE DATA INTO WHERE IT GOES IN CORE. .LOSE 1000 JUMPL A,LODBF JRST LODLD ;AND READ THE NEXT BLOCK. LODLD2: PUSHJ P,JOBVAR MOVE A,114 SKIPN .JBDDT ;THE DEC MONITOR LIKES TO SAVE .JBDDT AND .JB41 MOVEM A,.JBDDT MOVE A,122 ;AS IF THEY WERE IN 114 AND 122. SKIPN .JB41 MOVEM A,.JB41 JRST LODH3 LODNC: MOVEI B,ERNEC% ;GIVE UP AND REPORT NO CORE AVL. JRST LODERR LODBF: MOVEI B,ERNSF% ;GIVE UP AND REPORT ILGL FORMAT FILE. LODERR: .CLOSE LOADCH, POPJ P, ;LOAD THE ITS-FORMAT BINARY FILE OPEN ON LOADCH. RETURN THE START ADDR IN C. LODITS: SYSCAL LOAD,[MOVEI -1 ? MOVEI LOADCH] JRST LODBF SYSCLV CORTYP,[MOVEI -1 ? MOVEI 200 ? MOVEM A] SKIPLE A ;IF PAGE 200 EXISTS AND IS PURE, SETOM HSPURE ;SAY WE HAVE A REALLY PURE HISEG. HRROI A,C ;READ 1 WORD INTO C .CALL LODIOT ;IT IS THE STARTING ADDRESS. .LOSE 1000 JUMPL A,LODBF PUSHJ P,JOBVAR ;PASS SYMBOLS TO DDT IF DESIRED. .SUSET [.ROPTIO,,A] TLNN A,OPTDDT JRST POPJ1 SKIPN SYMSRN JRST POPJ1 ;HE'S NOT INTERESTED IN THE SYMBOLS PUSH P,C HRROI A,C ;READ WORD INTO C .CALL LODIOT ;GET AOBJN POINTER TO SYMBOLS. .LOSE 1000 JUMPL A,LODBF JUMPGE C,POPJ1 ;JUMPE IF NO SYMBOLS IN FILE HRR C,MEMT ;WHERE THE SYMBOLS WILL START PUSH P,C ;SAVE IT HLRES C MOVN A,C ;# WORDS IN SYMBOL TABLE ADD A,MEMT SUBI A,1 PUSHJ P,XCORER ;GET THE CORE .LOSE MOVE A,(P) ;AOBJN POINTER TO SYMBOL TABLE .CALL LODIOT .LOSE 1000 JUMPL A,[SUB P,[2,,2] ? JRST LODBF] MOVEI A,(P) ;POINTER TO AOBJN POINTER HRLI A,400007 ;WRITE SYMBOLS INTO DDT .BREAK 12,A POP P,A MOVEI A,-1(A) ;FLUSH THE EXTRA CORE. PUSHJ P,XCORER .LOSE POPCJ1: POP P,C JRST POPJ1 LODIOT: SETZ ? 'IOT,, MOVEI LOADCH ? SETZ A ;HERE TO SET JOB DATA AREA JOBVAR: PUSHJ P,INSBOT ;PUT THE BOOTSTRAP IN IT, W/ SWITCHES. MOVEI B,0 MOVEI E,HIBASE PUSHJ P,MEMSIZ ;DETERMINE SIZE OF LOW CORE MOVEM B,MEMT MOVEI E,400000 MOVEM E,HMEMT ;DETECT THE CASE OF LOWSEG LONGER THAN 200K, CAML B,E ;AND SAY THERE'S NO HISEG. JRST [ SKIPN .JBHRL ;WAS THIS FILE 2 SEGS WHEN DUMPED, THOUGH? POPJ P, SKIPN B,.JBREL POPJ P, AOS B LSH B,-10. HRLI B,-200(B) ;DELETE THE GAP PAGES THAT SHOULDN'T EXIST SYSCLV CORBLK,[MOVEI 0 ? MOVEI -1 ? B] MOVEI A,[ASCIZ /has 2 segs; should be :PDUMP'd, not $Y'D/] PUSHJ P,XRUNE3 ;TELL USER TO FIX THINGS JRST JOBVAR] ;REFIGURE MEMT AND HMEMT NOW THAT GAP IS THERE. MOVE B,E MOVEI E,HIBASE PUSHJ P,MEMSIZ ;AND THEN HIGH SEGMENT MOVEM B,HMEMT POPJ P, JOBVA1: MOVE A,MEMT HLRZ B,.JBSA SKIPN B HRLM A,.JBSA ;INIT THINGS THAT POINT TO TOP, IF USER HASN'T. HLRZ A,.JBSA CAMG A,MEMT ;MAKE SURE CORE EXTENDS PAST PROGRAM BREAK. JRST XCOREX SUBI A,1 PUSHJ P,XCORER .LOSE POPJ P, ;HERE TO FIND FIRST MPV IN CORE BETWEEN C(B) AND C(E). RETURN ADDR IN B. MEMSIZ: PUSH P,A PUSH P,UUO42 ;SAVE POINTER TO NORMAL INTERRUPT GUY .SUSET [.SDF1,,[#%PIMPV]] .SUSET [.SDF2,,[-1]] ;DEFER ALL INTS BUT THOSE WE WANT TO HANDLE. MOVE A,[-MEMINL,,MEMINT] MOVEM A,UUO42 MEMSZ1: MOVE A,100(B) ;AC WILL NEVER GIVE MPV, SPLIT CYCLE DETECTS WRITE PROTECTED PAGES CAML B,E ;MAYBE THERE NEVER WILL BE AN MPV JRST MEMHIT ;RETURN HIGHEST LEGAL ADDRESS ADDI B,2000 JRST MEMSZ1 MEMHIT: POP P,UUO42 ;RESTORE OLD INTERRUPT HANDLER .SUSET [.SDF2,,[0]] .SUSET [.SDF1,,[0]] JRST POPAJ subttl System Commands ;CMDSAV IS THE SUBROUTINE USED TO SAVE CRUFT AND PRETEND TO BE IN A UUO. ;THE PC WHEN JRST 45 OR WHATEVER WAS $X'D IS PUT IN UUOH. ;IF A UUO IS ALREADY IN PROGRESS, EITHER WAIT FOR IT TO FINISH ;OR BACK OUT OF IT IF WE KNOW HOW. IF AN INTERRUPT IS IN PROGRESS, ;JUST BARF (BUT MANAGE NOT TO CLOBBER THINGS) STORAGE IMPURE CMDACA: 0 ;SAVE AC A IF CMDSAV CALLED WHILE UUO IN PROGRESS. CMDACB: 0 ;SAVE B, ETC CMDACC: 0 CMDSAV: 0 JRST CMDSA1 STORAGE PURE CMDSA1: SKIPE INTFLG ;INT IN PROGRESS? IF SO, LOSE. JRST CMDINT SKIPE UUO40 ;IF INSIDE A UUO, CAN'T AFFORD TO SAVE IN UUOACS, ETC. JRST CMDUUO ;SO CLOBBER EXIT AND RETURN TO UUO, WHICH WILL COME BACK HERE. CMDUOX: MOVEM M,UUOACS+M-LOWAC MOVE M,[A,,UUOACS+A-LOWAC] BLT M,UUOACS+HIGHAC-LOWAC MOVE P,UUOPDP MOVE M,DPYTYP HRRZM P,UUO40 .VALUE [ASCIZ *..XECP/ 2/ 1Q P*] MOVEM A,UUOH ;THE USER'S "$X PC" IS OUR RETURN ADDRESS. JRST 2,@CMDSAV CMDINT: .VALUE [ASCIZ *:Interrupt in progress - can't do system command  P*] .BREAK 16,400000 ;GET HERE IF USER DOES JRST 45$X OR SOME SUCH WHILE INSIDE A UUO. CMDUUO: MOVEM A,CMDACA MOVEM B,CMDACB MOVEM C,CMDACC .VALUE [ASCIZ *..XECP/ 2/ 1Q P*] ;GET THE UUO HANDLER'S PC. MOVE B,A MOVEI A,CMDUOX ;SET UUO TO RETURN TO US (CMDUOX) EXCH A,UUOH ;AND PUT UUO'S OLD RET ADDR IN ..XECP HRRZ C,B ;SO THAT WHEN WE ARE RE-ENTERED AFTER THE UUO WE WILL CAIN C,TIHAN1 ;USE IT AS OUR RETURN ADDRESS. MOVEI B,UUOXIT ;IF HE WAS JUST WAITING IN TYI, PCLSR HIM. CAIN B,UUOXIT SOS A CAIE B,UUOXIT .VALUE [ASCIZ *:Finishing up a UUO first...  P*] .VALUE [ASCIZ *2/ ..XECP/ 1Q P*] MOVE A,CMDACA ;RESTORE OUR ACS, PUTTING UUO HANDLER PC IN CMDACB. EXCH B,CMDACB MOVE C,CMDACC JRST 2,@CMDACB ;GO FINISH THE UUO. ;45 CONTAINS A JUMP TO HERE: DECS1: JSR CMDSAV DECS2: MOVE P,UUOPDP PUSH P,[DECSAX] MOVEI A,[ASCIZ / Command: /] PUSHJ P,XOUTS0 SKIPG ACTCHR PUSHJ P,TIHANG ;READ A CHARACTER FROM THE TERMINAL. PUSHJ P,GETCHA CAIL A,140 SUBI A,40 CAIN A,"D ;D => DO S, V, P AND F. JRST DECDMP CAIN A,"S ;S => DO A DECSAV. JRST DECSAV CAIN A,"F ;F => DO A DECFLS JRST DECFLS CAIN A,"R ;R => RE-ENTER. JRST DECRE1 CAIN A,"V ;V => STUFF THE VESTIGIAL JOBDAT AREA JRST DECVES CAIN A,"P ;P => PURIFY HIGH SEGMENT (FOR PDUMPING) JRST DECPUR cain a,"? ;? => list the available commands jrst dechlp cain a,"H ;H => list commands with more detail jrst dechl1 caie a,"N ;N => No-op to finish off UUO JRST DECS2 movei a,[asciz/o-op/] pushj p,xouts0 move highac,[uuoacs,,lowac] blt highac,highac .value [asciz/2:vk /] setzm @uuo40 jrst 2,@uuoh ; Type out a little help cruft dechlp: movei a,[asciz/ Dump, Flush, Help, No-op, Purify, Reenter, Symbols, Vestigal/] pushj p,xouts0 jrst decs2 dechl1: movei a,hlpcrf pushj p,xouts0 jrst decs2 hlpcrf: asciz/elp for system commands. Type one of: D Prepare simulated program for :PDUMPing F Flush DECUUO from core H Help cruft typeout N (No-op)Merely finish up current UUO P Purify high segment, does a V also R Reenter program from .JBREN S Pass simulated program's symbols up to DDT V Copy job data information to Vestigal JOBDAT area ? Short list of commands / ;HANDLE "R" = RE-ENTER DECRE1: movei a,[asciz/eenter/] pushj p,xouts0 SKIPN A,.JBREN JRST [ .VALUE [ASCIZ *: No REENTER address P*] POPJ P,] ;$X-RETURN, TO RESTORE USER'S PC. EXCH A,UUOH HRRZ B,A CAIE B,31 JRST DECRE2 HRR A,32 SUBI A,1 DECRE2: MOVEM A,.JBOPC JRST UUOXIT DECVES: movei a,[asciz/estigal/] pushj p,xouts0 DECVS1: MOVE B,HMEMT ;"V" - STUFF VESTIGIAL JOBDAT ARE WITH PROPER DATA. CAIN B,400000 ;WORKS ONLY IF THERE IS A HISEG. JRST [ .VALUE [ASCIZ *: No high segment P*] POPJ P,] MOVEI A,377777 SETZ B, MOVE C,.JBREN HLL C,.JBHRL IRPS X,,.JBSA .JB41 .JBCOR C .JBVER B .JBSYM PUSH A,X TERMIN POPJ P, ;PURIFY THE PAGES OF THE SIMULATED HIGH SEGMENT. DECPUR: movei a,[asciz/urify/] pushj p,xouts0 DECPR1: MOVN B,HMEMT LSH B,18.-10. ;GET AOBJN TO ALL SIMULATED PAGES ADD B,[200,,200] ;TAKE THE LOW HALF OF MEMORY AWAY JUMPGE B,CPOPJ ;NO HIGH SEG? PUSH P,B SYSCLV CORTYP,[MOVEI -1 ? MOVEI 200 ? MOVEM B] SKIPGE B ;DON'T TRY WRITING IN HISEG IF IT'S PURE. PUSHJ P,DECVS1 ;BETTER SET UP VESTIG JOBDAT AREA WHILE STILL CAN. POP P,B SYSCLV CORBLK,[MOVEI %CBRED ? MOVEI -1 ? B] SETOM HSPURE ;SAY WE HAVE A TRULY PURE HISEG. POPJ P, ;DECFL1 FLUSHES DECUUO FROM CORE, AND MAKES THE I.T.S. START ADDRESS POINT AT ;THE BOOTSTRAP. decfls: movei a,[asciz/lush/] pushj p,xouts0 DECFL1: .BREAK 12,[400001,,[JUMPA BOTGO]] .SUSET [.ROPTIO,,A] TLZ A,OPTDEC .SUSET [.SOPTIO,,A] .SUSET [.SMASK,,[0]] .SUSET [.SMSK2,,[0]] PUSHJ P,INSBOT ;INSERT BOT (BOOTSTRAP) IN JOBDAT AREA move a,[.lose] MOVEM A,BOTBEG ;REFUSE TO RECOGNIZE SYSTEM COMMANDS NOW. HRRZ A,.JBFF CAML A,MEMT ;NOW ZERO ALL CORE FROM .JBFF TO TOP OF LOW SEG. JRST DECFL2 SETZM (A) ADDI A,1 CAML A,MEMT JRST DECFL2 HRLI A,-1(A) BLT A,@.JBREL DECFL2: MOVE 15,[DECSAB,,.JBDDT+1] BLT 15,DECSAE ;PUT FLUSH ROUTINE IN JOB DATA AREA. MOVE 17,HMEMT CAIN 17,400000 MOVE 17,MEMT LSH 17,-10. ;TELL FLUSH ROUTINE HOW MUCH CORE TO PRESERVE. HRRM 17,.JBDDT+1 SETZ 0, ;CLEAR ALL ACS SO IN CASE LOADED IN BY DECUUO MOVEI 17,1 ;IT WON'T CLOBBER LODITS'S ACS. BLT 17,17 JRST .JBDDT+1 DECSAB: OFFSET .JBDDT+1-. ;FLUSH ROUTINE TO EXPUNGE DECUUO FROM CORE. .CORE 10000. .LOSE .BREAK 16,100000 DECSAE::JRST BOTGO OFFSET 0 INSBOT: MOVE A,[BOTBOT,,BOTBEG] ;PUT THE BOOTSTRAP INTO THE JOB DATA AREA. BLT A,BOTEND SETZ A, IRPS X,,FN2RN TTYRN DECRN MAPRN METARN IIIRN PRSVEX,Y,,[ FN2BT TTYBT DECBT MAPBT METABT IIIBT PRSVBT] SKIPE X TRO A,Y TERMIN HRRM A,BOTSWITCH ;PUT OUR CURRENT SWITCH SETTINGS INTO BOOTSTRAP. POPJ P, ;DECSAV CONVERTS A DEC FORMAT SYMBOL TABLE IN THE CORE IMAGE TO AN ;ITS FORMAT SYMBOL TABLE AND PASSES IT UP TO DDT. ;DECDMP DOES DECSAV AND THEN DECFLS. decsav: movei a,[asciz/ymbols/] pushj p,xouts0 PUSHJ P,DECSA0 ;FIRST, PASS UP THE SYMBOLS. DECSAX: MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC SETZM UUO40 .BREAK 16,700000 ;THEN SAY WE WON. decdmp: movei a,[asciz/ump/] pushj p,xouts0 MOVE P,UUOPDP PUSHJ P,DECSA0 ;FIRST, PASS UP THE SYMBOLS. PUSHJ P,DECPR1 ;THEN SET UP VESTIG AREA AND PURIFY HIGH SEG. JRST DECFL1 ;THEN SET START ADDR -> BOOT, AND FLUSH US FROM CORE. ;SUBOUTINE TO PASS A DEC-STYLE IN-CORE SYM TAB UP TO DDT, AND THEN FLUSH IT ;FROM CORE IF POSSIBLE (UNLESS THERE'S A DEC-STYLE DDT IN CORE) DECSA0: HLRE A,.JBSYM JUMPE A,CPOPJ ;RETURN IF NO SYMS IN CORE. MOVNS A ;GET # WDS SYMTAB NEEDS ADD A,MEMT SUBI A,1 ;GET ENOUGH NEW CORE TO COPY THE SYMTAB PUSH P,MEMT ;AT THE TOP OF THE LOW SEG. PUSHJ P,XCORER .LOSE POP P,A MOVE B,A HRL B,.JBSYM HLRE C,.JBSYM SUBM A,C BLT B,-1(C) ;COPY THE SYMTAB SETZ C, HLL A,.JBSYM ;AOBJN -> COPY. PUSH P,A DECSAL: SKIPN B,(A) JRST DECSA4 ;ZERO SYMBOLS COME AT BEGINNGING OF PROGRAMS. TLZ B,740000 ;BLOCK NAMES COME AT END. JUMPE B,DECSA4 DECSA3: CAML B,[50*50*50*50*50] JRST DECSA5 IMULI B,50 ;AND LEFT-JUSTIFY IT. JRST DECSA3 DECSA5: DPB B,[4000,,(A)] ;STORE THE NOW LEFT-JUSTIFIED SQUOZE MOVE B,(A) ;GET BACK THE SYMBOL FLAGS TLNE B,740000 ;IF IT'S A PROGRAM NAME, WE MUST HACK AROUND JRST DECSA2 ;SINCE I.T.S. AND TOPS-10 HAVE DIFFERENT CONVENTIONS. SETZM 1(A) ;MAKE VALUE OF PROGRAM NAME BE 0 FOR DDT'S SAKE. JUMPE C,DECSA2 ;IF WE KNOW WHERE THIS PROGRAM STARTED IN SYMTAB, MOVE D,(A) ;EXCHANGE THE PROGRAM NAME WITH THE ZERO SYMBOL THERE EXCH D,(C) MOVEM D,(A) MOVE D,1(A) EXCH D,1(C) MOVEM D,1(A) SETZ C, ;AND SAY THAT ZERO-SYMBOL HAS BEEN USED UP. JRST DECSA2 DECSA4: HRRZ C,A ;REMEMBER ADDR OF THE ZERO SYMBOL THAT STARTS THE BLOCK, MOVE B,[SQUOZE 44,FOOFOO] MOVEM B,(A) ;AND MAKE IT NOT BE ZERO SO DDT WON'T LOSE. DECSA2: AOBJP A,.+1 AOBJN A,DECSAL POP P,A ;GET BACK THE AOBJN TO THE COPY. .VALUE [ASCIZ *2/P*] ;PASS THE COPY TO DDT. HLRE B,.JBSYM ;RH(A) HAS START ADDR OF COPY. WILL FLUSH CORE DOWN TO THERE. MOVNS B ADD B,.JBSYM ;FIND ADDR OF 1ST WORD AFTER THE UN-COPIED SYMTAB ANDI B,-1 CAMN B,.JBFF ;IF IT IS AT THE END OF USED CORE SKIPE .JBDDT ;AND NO DDT NEEDS THE SYMTAB JRST DECSA6 HRRZ A,.JBSYM ;FLUSH THE SYMTAB'S CORE AS WELL AS THE COPY'S CORE. HRRZM A,.JBFF HRLM A,.JBSA MOVEI B,-1(A) HRLM B,.JBCOR SETZM .JBSYM DECSA6: MOVEI A,-1(A) PUSHJ P,XCORER ;NOW FLUSH THE CORE HOLDING THE COPY. .LOSE POPJ P, subttl Random CALLI Routines XRESET: MOVEI B,17 XRESE1: PUSHJ P,CHRELI SOJGE B,XRESE1 HLRZ A,.JBSA ;SET .JBFF FROM .JBSA MOVEM A,.JBFF MOVEI A,1 MOVEM A,XSETU1 ;SET THE SO-CALLED WRITE-PROTECT BIT MOVE A,PRSVEX iorm a,prsvrn ;prsvrn := prsvrn | prsvex | JNAME={LINK | LOADER} MOVE A,JOBNAM CAME A,['LOADER] CAMN A,[SIXBIT/LINK/] JRST [SETOM PRSVRN ;RUNNING LOADER => INHIBIT SUICIDE ON EXIT 1, SETZM TITROP ;IN CASE LOADER WAS RUN BY CCL. JRST .+1] CAME A,['CCL,,] ;ONCE WE RUN CCL, EXIT 1, SHOULD KILL THE JOB CAMN A,['COMPIL] ;SINCE CUSPS LIKE TO DO EXIT 1, WHEN RUN BY CCL. SETOM TITROP HLLZS TTYLCH ;RESET TTY I/O STATUS WORD SKIPE DECRN POPJ P, PUSHJ P,SEGFLS ;THROW AWAY REMEMBERED SAIL HISEGS. HRLOI A,TT.ACT\TT.ILF ANDCAM A,TTYLCH ;RESET A COUPLE OF LIN CHARACTERISTICS BITS JRST TTYLM ;AND RE-INIT SPECIAL ACTIVATION TABLE. ; HIBER UUO. The teletype input wake bits are missing because there ; is no excuse for them not to be there. The other bits are ignored, ; since there is no WAKE, PTYs, or IPCF. xhiber: tlne a,(hb.rtc\hb.rtl) jrst missing hrrzs a imuli a,30. idivi a,1000. .sleep a, aos (p) popj p, XSLEEP: IMULI A,30. .SLEEP A, POPJ P, XDSKPP: JUMPE A,XDSKP1 .SUSET [.SSNAM,,A] MOVEM A,SNAME POPJ P, XDSKP1: MOVE A,SNAME JRST UPUTAC XGETPP: MOVE A,UNAME JRST UPUTAC XSWITC: .RDSW A, ; datai won't win w/ optdec set JRST UPUTAC XPJOB: .SUSET [.RUIND,,A] JRST UPUTAC XTTYME: MOVE B,(A) ; name of destination terminal TLNE B,-1 ; can be sixbit or numeric JRST [ XOR B,['TTY,,] JUMPE B,XTTYMW ; exactly TTY => win JRST MISSING] ; somebody will have to make TTYnn work. CAME B,TTYNUM JRST MISSING ; trying to hack someone else's TTY? XTTYMW: MOVE B,1(A) TLNN B,770000 TLO B,440000 ; default pointer to start of word LDB C,[221400,,B] ; cretinous way to pack count SKIPN C MOVEI C,777777 ; 0 means infinite TLZ B,7777 ; set up 7 bit bp TLO B,0700 XTTYML: ILDB A,B JUMPE A,UUOXIT PUSHJ P,TYO SOJG C,XTTYML JRST UUOXIT XEXIT: PUSHJ P,INSBOT MOVEI A,IO.FLS ANDCAM A,TTYLCH LDB A,[270400,,UUO40] JUMPE A,XEXIT0 SKIPN DEBUG ;EXIT 1,: IF TITROP AND NOT DEBUGGING, KILL JOB SKIPN TITROP ;OTHERWISE RETURN RELATIVELY QUIETLY TO DDT. JRST XEXIT1 ;TITROP IS SET :CCL SINCE CUSPS SEEM TO DO EXIT 1, SKIPN PRSVRN .BREAK 16,160000 XEXIT1: MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC .VALUE [ASCIZ /2:VK /] SETZM UUO40 JRST 2,@UUOH XEXIT0: MOVSI B,-20 XEXIT2: SETZ A, SETOM CHNDLE(B) PUSHJ P,CHCLS ;FIRST, CLOSE ALL FILES (ELSE THE RESET WOULD FLUSH THEM) AOBJN B,XEXIT2 push p,prsvrn ; xreset clears prsvrn PUSHJ P,XRESET ;THEN CLOSE ALL DEVICES. .LOGOUT pop p,a ; get old value of prsvrn in a skipn a ; and see if i should suicide SKIPE DEBUG JRST XEXIT3 .BREAK 16,160000 XEXIT3: MOVEI A,^P PUSHJ P,STYO MOVEI A,"A PUSHJ P,STYO MOVE HIGHAC,[UUOACS,,LOWAC] BLT HIGHAC,HIGHAC setzm uuo40 ; clear UUO in progress .VALUE [ASCIZ /:EXIT  :vk /] .value [asciz/:Can't Continue  :vk /] jrst .-1 ;never continue on EXIT 0, ;DEVCHR UUO XDEVCH: PUSHJ P,DEVDCD JRST XRETN0 MOVE A,DCHTAB(A) JUMPGE C,UPUTAC IORI A,200000 JRST UPUTAC ;DEVTYP UUO XDEVTY: SKIPN FT5UUO POPJ P, AOS (P) PUSHJ P,DEVDCD JRST XRETN0 MOVE A,DTYTAB(B) JUMPGE C,UPUTAC .SUSET [.RUIND,,B] LSH B,9 IOR A,B JRST UPUTAC ;DEVSIZ AC, AC/ ADDR ADDR/ MODE ? SIXBIT/DEVICE/ XDEVSI: SKIPN FT5UUO POPJ P, AOS (P) ;THIS UUO ALWAYS SKIPS IFF IMPLEMENTED. PUSH P,A PUSHJ P,UGETA1 ;GET 1ST WORD OF BLOCK ADDRESSED BY AC. MOVE D,A POP P,A AOS A PUSHJ P,UGETA1 ;GET 2ND WORD (THE DEVICE NAME) PUSHJ P,DEVDCD ;DECODE IT. JRST XPUTM1 ;NON-EX DEVICE => RETURN -1. ANDI D,17 ;GET THE DATA MODE SPEC'D IN 1ST WORD. CAIL D,.IOIDP JRST XPUTA0 ;DUMP MODE => RETURN 0. MOVEI C,1 LSH C,(D) ;FIND BIT IN DCHTAB WORD FOR SPEC'D MODE. TDNN C,DCHTAB(A) JRST XPUTM2 ;ILLEGAL MODE => RETURN -2. HRRZ A,DSZTAB(A) HRLI A,2 JRST UPUTAC XPUTA0: TDZA A,A XPUTM1: MOVNI A,1 JRST UPUTAC XPUTM2: MOVNI A,2 JRST UPUTAC ;DECODE A DEVICE OR CHANNEL IN A. ;NO SKIP => ILLEGAL DEVICE OR CHANNEL NOT INITTED. ;ELSE RETURN IN B THE DEVICE NAME; IN A, THE DEVTAB IDX; ;IN C, NEGATIVE IFF THE DEVICE IS INITTED ON ANY CHANNEL. DEVDCD: TDNE A,[-20] JRST DEVDC1 MOVE B,CHRDEV(A) SKIPN A,CHDIDX(A) POPJ P, JRST DEVDC2 DEVDCH==0 DEVDC1: SYSCLV TRANS,[A ? MOVEM B] CAME A,B ;IF SPEC'D DEVICE NAME GETS TRANSLATED, JRST DEVDC3 ;USER MUST MEAN TO SAY IT EXISTS. CAME B,['TTY,,] CAMN B,['DSK,,] ;DSK: AND TTY: EXIST. JRST DEVDC3 MOVSI C,-20 ;IF DEVICE IS INITTED, IT MUST EXIST. CAME B,CHRDEV(C) AOBJN C,.-1 JUMPL C,DEVDC3 MOVSI C,-DEVCSL ;IF DEVICE IS IN THE ASSOCIATIVE MEMORY, CAME B,DEVCSH(C) AOBJN C,.-1 JUMPL C,[SKIPL DEVCS1(C) POPJ P, ;THAT MEMORY SAYS WHETHER IT EXISTS. JRST DEVDC3] HLRZ C,B cain c,'mta ;convert device MTA to... movsi b,'mt0 ; ...MT0 for ITS happiness CAIN C,'TTY TRNN B,-1 JRST DEVDC5 LSH B,14 ;HE'S USING TTYnn TO SPECIFY A PARTICULAR TTY TLC B,<'T#'Y>_14 ;SHIFT SO HAVE JUST Ynn, THEN CHANGE Y TO T. DEVDC5: .IOPUS DEVDCH, ;FIND OUT WHETHER DEVICE EXISTS. SYSCAL OPEN,[MOVEI DEVDCH ? ['DSK,,] ? ['JOBDEV] ? B ? ['DEVICE]] CAIA ;THIS OPEN IS LOGICALLY SUPERFLUOUS JRST DEVDC4 ;BUT SAVES MUCH TIME IF DEVICE IS "ML", ETC. SYSCAL OPEN,[MOVEI DEVDCH ? B ? ['.FILE.] ? [SIXBIT /(DIR)/] ? 3000,,C] CAIE C,%ENSDV ;ERROR IS NO SUCH DEVICE => DEVDCD FAILS. JRST DEVDC4 ;SUCCESS, OR LOST FOR OTHER REASON, => DEV EXISTS. .IOPOP DEVDCH, TDZA C,C ;MARK DEV IN A AS NOT EXISTING, USING DEVCSH DEVDC8: SETO C, ;MARK DEV IN A AS EXISTING MOVE B,A PUSH P,E MOVSI E,-DEVCSL ;PUT THIS DEV IN AT FRONT, MOVING ALL OTERS DOWN DEVDC7: EXCH B,DEVCSH(E) EXCH C,DEVCS1(E) CAME B,DEVCSH(E) ;AND FLUSHING ANY DUPLICATE ENTRY. AOBJN E,DEVDC7 JRST POPEJ DEVDC4: PUSHJ P,DEVDC8 ;DEV EXISTS; MARK IT SO. .IOPOP DEVDCH, MOVE B,A DEVDC3: MOVSI A,-DEVTLN CAME B,DEVTAB(A) AOBJN A,.-1 DEVDC2: MOVSI C,-20 CAME B,CHRDEV(C) AOBJN C,.-1 JRST POPJ1 XRUNTI: JSP B,THSJOB ;ERROR RETURN IF FOR OTHER JOB THAN THIS ONE JRST XRETN0 .SUSET [.RRUNT,,A] IDIVI A,250. JRST UPUTAC ;FOR A DEC CALL THAT TAKES A JOB # OR 0 FOR CURRENT JOB, ;JSP B,THSJOB TO COMPLAIN IF ANOTHER JOB IS SPEC'D. ;SKIPS IF CURRENT JOB IS SPEC'D. OTHERWISE, DOESN'T SKIP ;OR GOES TO MISSING ACCORDING TO ZJOBS. THSJOB: JUMPE A,1(B) THSJO1: .SUSET [.RUIND,,C] CAMN A,C JRST 1(B) SKIPE ZJOBS JRST MISSING JRST (B) XDATE: MOVEI A,0 .RDATE B, CAMN B,[-1] JRST UPUTAC ;DATE NOT AVAILABLE MOVE C,[440600,,B] PUSHJ P,POOF ;YEAR SUBI D,64. ;THIS PROGRAM WILL NOT WORK IN 28 YEARS MOVE A,D IMULI A,12. PUSHJ P,POOF ;MONTH SUBI D,1 ADD A,D IMULI A,31. PUSHJ P,POOF ;DAY SUBI D,1 ADD A,D XDATE1: PUSHJ P,UPUTAC JRST UUOXIT XTIMER: PUSHJ P,TIME1 IMULI A,60. JRST UPUTAC XMSTIM: PUSHJ P,TIME1 ;TIME OF DAY IN SECONDS IMULI A,1000. JRST UPUTAC ;CALCULATE NUMBER SECONDS SINCE MIDNIGHT TIME1: MOVEI A,0 .RTIME B, CAMN B,[-1] JRST XDATE1 ;TIME NOT AVAILABLE MOVE C,[440600,,B] PUSHJ P,POOF ;HOURS IMULI D,60.*60. MOVE A,D PUSHJ P,POOF ;MINUTES IMULI D,60. ADD A,D PUSHJ P,POOF ;SECONDS ADD A,D POPJ P, ;GOBBLES DOWN 2 SIXBIT DECIMAL DIGITS AND ;RETURNS NUMBER IN D POOF: ILDB D,C SUBI D,'0 ILDB E,C SUBI E,'0 IMULI D,10. ADD D,E POPJ P, STORAGE IMPURE MEMT: 0 ;CURRENT TOP OF LOW SEG HMEMT: 400000 ;CURRENT TOP OF HIGH SEG STORAGE PURE ;CORE AC, WHERE AC HAS ,,, OR ZERO IN EITHER HALF FOR NO CHANGE. ;RETURNS CORMAX IN AC. SKIPS IF SUCCESSFUL. XCORE: MOVE B,[JRST DECS1] MOVEM B,BOTBEG ;SET UP 45 IN CASE LOADER HAS JUST CLOBBERED IT. JUMPE A,XCORE9 SKIPN DECRN ;SAIL IGNORES THE L.H. AND HAS A SPECIAL CORE2 UUO ANDI A,-1 XCOR2A: PUSHJ P,XCORER CAIA AOS (P) XCORE9: MOVE A,CORMAX JRST UPUTAC ;SAIL'S CORE2 UUO - SETS HISEG SIZE. XCOR2: SKIPN A AOSA A ;0 => KILL HISEG; CHANGE TO "MAKE IT END BELOW 400000" IORI A,401777 ;ELSE ROUND UP AND IGNORE BIT 2.9. HRLZS A ;PUT IN LH TO MAKE LOOK LIKE A DEC-STYLE SET HISEG SIZE. JRST XCOR2A ;"INTERNAL" CORE UUO: ARG IN A. SKIPS/ACTS JUST LIKE CORE UUO. XCORER: SETZ D, ;SET UP BEG, END AND ARG FOR LOW SEG MOVEI B,MEMT ;AND PTR TO CURRENT SIZE HRRZ C,A PUSHJ P,XCORE1 JRST XCOREX MOVEI B,HMEMT ;THEN DO THE SAME FOR HIGH SEG MOVEI D,400000 HLRZ C,A SKIPN TWOSEG ;IF ONLY ONE SEG ALLOWED, REFUSE TO CREATE HISEG CAIGE C,400000 PUSHJ P,XCORE1 JRST XCOREX AOS (P) ;SET .JBREL AND .JBHRL FROM MEMT AND HMEMT XCOREX: MOVE A,MEMT SUBI A,1 MOVEM A,.JBREL MOVE A,HMEMT CAIN A,400000 TDZA A,A SUBI A,1 MOVEM A,.JBHRL SKIPN A ;IF HISEG HAS BEEN FLUSHED, SAY IT HAS NO # ASSIGNED. SETOM HSGNUM ;ELSE NEXT TIME ONE IS CREATED WE MIGHT THINK IT HAD ONE. SKIPN A SETZM HSPURE ;FLUSHING THE HISEG => IF WE MAKE ANOTHER, IT WON'T BE PURE. POPJ P, ;ADJUST CORE IN ONE SEGMENT. ;B -> MEMT OR HMEMT ;C = DESIRED HIGHEST EXISTENT ADDRESS ;D = BOTTOM ;E = HIGHEST TOP SIMULATOR CAN HANDLE. XCORE1: JUMPE C,POPJ1 TRO C,1777 AOS C CAMG C,D ;ADJUST NEW TOP AT LEAST UP TO BOTTOM MOVE C,D CAIL C,HIBASE JRST MISSING CAIG C,400000 JRST XCORE4 MOVEI E,MEMT+HMEMT SUBI E,(B) ;E -> THE ONE OF (MEMT, HMEMT) WHICH B DOESN'T POINT TO. MOVE E,(E) CAILE E,400000 ;TRYING TO MAKE BOTH SEGS GO ABOVE 200K LOSES JRST MISSING ;(IE, TRYING TO HAVE NONNULL HISEG NOT STARTING AT 200K) XCORE4: SUB C,(B) ;GET AMOUNT OF CHANGE IN WORDS JUMPE C,POPJ1 JUMPL C,XCORE2 ;SHRINKING... MOVE E,C ADD E,MEMT ;COMPUTE NEW TOTAL SIZE, ADD E,HMEMT ;AND COMPLAIN IF TOO BIG SUBI E,400000 CAMLE E,CORMAX ;(TO ALLOW DEBUGGING OF NO-CORE-AVAILABLE RECOVERY) POPJ P, MOVN E,C ;GROWING. HRLZS E HRR E,(B) ;AOBJN -> RANGE TO ACQUIRE MOVEI D,%CBWRT ;SAY GET IT. XCORE3: ASH E,-10. SYSCLV CORBLK,[D ? 1000,,-1 ? E ? 1000,,400001] ADDM C,(B) ;ADJUST MEMT OR HMEMT JRST POPJ1 XCORE2: HRLZ E,C HRR E,(B) ADD E,C ;AOBJN -> RANGE TO FLUSH SETZ D, ;SAY FLUSH IT. JRST XCORE3 XSETUW: SKIPN TWOSEG ;SETUWP PRETENDS TO WORK, BUT DOESN'T REALLY DO ANYTHING. JRST XRETN0 AOS (P) ANDI A,1 EXCH A,XSETU1 PUSHJ P,UPUTAC SKIPN XSETU1 ;IF HE WANTS IT IMPURE, AND IT IS REALLY PURE, SKIPN HSPURE POPJ P, MOVN A,HMEMT ;MUST UNPURIFY IT, BY COPYING PAGES 1 AT A TIME. CAMN A,[-HIBASE] JRST MISSING ;WE NEED A SCRATCH PAGE TO COPY INTO. USE THE ONE BELOW HIBASE. LSH A,8. ;-<1 + LAST HISEG PAGE> ADD A,[200,,200] ;AOBJN -> HISEG PAGES. MOVEI B,400000 ;AND B -> 1ST ADDR OF PAGE A POINTS AT. XSETU2: SYSCLV CORBLK,[MOVEI %CBWRT ? MOVEI -1 ? MOVEI HIBASE/2000-1 ? MOVEI 400001] HRLZ C,B HRRI C,HIBASE-2000 BLT C,HIBASE-1 ;COPY THE DATA INTO THE FRESH PAGE, THEN REPLACE ORIGINAL PAGE. SYSCLV CORBLK,[MOVEI %CBWRT ? MOVEI -1 ? MOVEI (A) ? MOVEI -1 ? MOVEI HIBASE/2000-1] ADDI B,2000 AOBJN A,XSETU2 ;DO THIS FOR ALL THE HISEG PAGES. SYSCLV CORBLK,[MOVEI 0 ? MOVEI -1 ? MOVEI HIBASE/2000-1] ;CLEAN OUT SCRATCH SLOT. SETZM HSPURE ;HISEG NOW ISN'T REALLY PURE. POPJ P, STORAGE IMPURE XSETU1: 1 ;1 => HISEG IS SUPPOSEDLY PURE (NEED NOT REALLY BE). HSPURE: 0 ;-1 => HISEG IS REALLY PURE. STORAGE PURE XREMAP: SKIPN TWOSEG POPJ P, TRO A,1777 ;ROUND UP TO TOP OF A PAGE MOVEI A,1(A) ;GET NEW MEMT AFTER REMAPPING CAMLE A,MEMT POPJ P, ;REMAPPING A NEGATIVE # OF WORDS? MOVE B,MEMT CAILE B,400000 JRST MISSING PUSH P,A MOVSI A,377777 ;FLUSH ANY EXISTING HISEG. PUSHJ P,XCORER .LOSE MOVE A,(P) SUB A,MEMT ;# OF WORDS TO REMAP PUSH P,A HRLZS A HRRI A,400000 ASH A,-10. ;AOBJN PTR TO THEIR PAGES MOVE B,-1(P) LSH B,-10. ;COPY THOSE PAGES INTO HISEG SYSCLV CORBLK,[1000,, %CBWRT 1000,,-1 ? A ? 1000,,-1 ? B] POP P,A MOVMS A ;GET # WORDS REMAPPED ADDI A,400000 ;NEW HISEG TOP MOVEM A,HMEMT PUSHJ P,UGETAC LSH A,-35. SKIPE DECRN ;ON SAIL, SET WRITE-PROTECT BIT ONLY IF SIGN OF ARG SET MOVEI A,1 ;FOR DEC, ALWAYS SET IT. MOVEM A,XSETU1 ;WRITE-PROTECT THE NEW SEGMENT. POP P,A ;ORIGINAL ARG (DESIRED LOSEG TOP) +1 SUBI A,1 ;ORIGINAL ARG TO REMAP (BUT STILL ROUNDED UP) JRST XCORER ;GO FLUSH THE REMAPPED CORE FROM THE LOW SEG. ;SHSNUM IS CALLED TO CREATE AN INFERIOR IN WHICH WE CAN LATER SAVE TH ;PAGES OF OUR HISEG, SO THAT THE "JOB NUMBER" OF THE HISEG CAN BE KNOWN. ;THE NUMBER IS PUT IN HSGNUM, AND ALSO IN AN ENTRY IN HSGNUT, WHICH IS ;A LIST OF THE NUMBERS OF ALL OUR HISEGS. ;SKIPS IF SUCCESSFUL. SHSNUM: SKIPL HSGNUM ;IF INFERIOR NOT CREATED, CREATE ONE. JRST POPJ1 .IOPUS LOADCH, SHSNU0: SYSCAL OPEN,[[.BIO,,LOADCH] ? ['USR,,] ? MOVEI 0 ? INFNAM ? 3000,,A] CAIA JRST SHSNU2 CAIN A,%EFLDR ;DIR FULL (TOO MANY INFS)? JRST SHSNUL ;IT'S HOPELESS. AOS INFNAM ;ELSE TRY AGAIN WITH A DIFFERENT JNAME. JRST SHSNU0 SHSNU2: .USET LOADCH,[.RUIND,,A] MOVEM A,HSGNUM ;HISEG NUMBER NOW KNOWN. MOVSI B,-HSGTBL SKIPE HSGNUT(B) ;NOW ENTER THE NUMBER IN HSGNUT SO WE'LL REMEMBER AOBJN B,.-1 SKIPL B ;THAT WE HAVE A HISEG WITH THAT NUMBER. .LOSE ;HSGNUT OUGHT TO BE BIG ENOUGH TO HOLD ALL 8 THAT WE CAN HAVE. MOVEM A,HSGNUT(B) AOS (P) SHSNUL: .IOPOP LOADCH, POPJ P, ;SWPSEG CREATES AN INFERIOR IF NECESSARY, THEN PUSHES THE HISEG PAGES INTO IT. ;SKIPS IF SUCCESSFUL. SWPSEG: PUSHJ P,SHSNUM ;MAKE SURE THE INFERIOR EXISTS. POPJ P, MOVEI B,400000/2000 MOVE A,[-/2000,,400000/2000] MOVE C,HSGNUM SYSCAL CORBLK,[MOVEI %CBWRT\%CBNDR ? MOVEI 400000(C) ? A ? MOVEI -1 ? B] JFCL JRST POPJ1 ;THROW AWAY ALL OUR INFERIOR HISEGS. SEGFLS: MOVSI A,-HSGTBL .IOPUS LOADCH, SEGFL1: SKIPN B,HSGNUT(A) JRST SEGFL2 SYSCAL OPEN,[[.BII,,LOADCH] ? ['USR,,] ? MOVEI 400000(B) ? MOVEI 0] JRST SEGFL2 .UCLOSE LOADCH, SETZM HSGNUT(A) SEGFL2: AOBJN A,SEGFL1 SETOM HSGNUM ;OUR CURRENT HISEG, IF ANY, NOW HAS NO # ASSIGNED. JRST SHSNUL ;DETSEG UUO. DETACH THE CURRENT HISEG, SO THAT WE HAVE NONE, BUT THE PAGES ;ARE SWAPPED INTO AN INFERIOR. XDETSE: LDB A,[270400,,UUO40] TRNE A,1 JRST MISSING MOVE B,HMEMT CAIG B,400000 POPJ P, PUSHJ P,SWPSEG .LOSE MOVSI A,377777 PUSHJ P,XCORER .LOSE POPJ P, ;ATTSEG UUO. SPECIFIES A HISEG THAT WE HAVE DETACHED (RIGHT NOW, BY NUMBER ONLY) ;AND GETS BACK THE PAGES OF IT, MAKING IT OUR CURRENT HISEG. ;NOT ALLOWED IF A HISEG EXISTS ALREADY. XATTSE: MOVE B,HMEMT CAIE B,400000 JRST XRETN4 ;ERROR IF HISEG EXISTS. MOVE B,MEMT CAILE B,400000 JRST MISSING ;WE DON'T KNOW HOW TO HAVE HISEG NOT START AT 400000. TDNE A,[-100] JRST MISSING ;WE DON'T KNOW HOW TO HACK SEGMENT NAMES; ONLY ALLOW #S AS ARGS. MOVSI B,-HSGTBL CAME A,HSGNUT(B) AOBJN B,.-1 JUMPGE B,XRETN2 ;ERROR IF # ISN'T THAT OF ONE OF OUR HISEGS. MOVEM A,HSGNUM ;ELSE WE WIN; MAKE THIS HISEG CURRENT. MOVE B,[-/2000,,400000/2000] MOVEI C,400000/2000 SYSCAL CORBLK,[MOVEI %CBWRT\%CBNDR ? MOVEI -1 ? B ? MOVEI 400000(A) ? C] JFCL ANDI B,-1 ;GET PAGE # OF 1ST NON-EX PAGE. LSH B,10. MOVEM B,HMEMT ;THAT IS TOP OF HISEG. AOS (P) JRST XCOREX ;THEN SET .JBHRL. XRETN2: SKIPA A,[2] XRETN4: MOVEI A,4 PUSHJ P,UPUTAC JRST UUOXIT ;SEGNUM UUO. RETURN HISEG # IN AC, OR 0 IF NO HISEG. TAKES JOB # OR 0 => THIS JOB ;IN AC. MUST ASSIGN HISEG # AND CREATE INFERIOR IF THAT WASN'T DONE ALREADY. XSGNUM: JSP B,THSJOB JRST XRETN0 MOVE B,HMEMT CAIG B,400000 JRST XRETN0 PUSHJ P,SHSNUM .LOSE MOVE A,HSGNUM JRST UPUTAC ;DEC SYSTEM INTERRUPT BITS ;AP.REN==400000 ;RE-ENABLE INTERRUPTS AUTOMATICLY ;AP.POV==200000 ;PDL OVERFLOW ;AP.ABK== 40000 ;ADDRESS BREAK (WE COULD USE THE MAR, BUT BETTER TO LET DDT ALONE). ;AP.ILM== 20000 ;MEMORY PROTECTION ;AP.NXM== 10000 ;NON EX-MEM ;AP.PAR== 4000 ;PARITY ERROR ;AP.CLK== 1000 ;CLOCK ;AP.FOV== 100 ;FLOATING OVERFLOW ;AP.AOV== 10 ;ARITHMETIC OVERFLOW AP.OK==AP.REN+AP.POV+AP.ILM+AP.AOV+AP.FOV ;BITS THAT CAN BE HANDLED AP.IGN==AP.NXM\AP.PAR\AP.ABK ;BITS WE CAN CLAIM TO HANDLE BUT WHICH ;WILL NEVER BE SET. AP.NUL==102667 ;BITS THAT MEAN NOTHING ; SETPOV UUO is an obsolete way of trapping for PDL overflows. This ; is the way TEN50 does it and therefore (I presume) the way TOPS-10 ; does it. xsetpo: movem a,.jbapr ; ac contains routine address movei a,ap.pov ; load APR CONI bit for PDL OV ; jrst xapren ; and do an APRENB XAPREN: TRNE A,#AP.OK#AP.IGN#AP.NUL JRST MISSING MOVEM A,APRBIT XAPRE1: TRZ A,AP.REN\AP.NUL\AP.IGN ;FLUSH BITS THAT AREN'T I.T.S. INT BITS ;NOTE WE REMEMBER HE ENABLED THEM, BUT DON'T DO ANYTHING FOR THEM. IORI A,%PIPDL\%PIMPV ;AND THE BITS DECUUO IS ENABLING SKIPE CLKENB IORI A,%PICLK TRZE A,AP.FOV TLO A,%PJFOV .SUSET [.SMASK,,A] ;HANDLE BOTH GROUPS. POPJ P, XDDTOU: JRST XOUTS0 XDEVPP: PUSHJ P,DEVDCD POPJ P, PUSHJ P,XDEVP1 JUMPE A,CPOPJ AOS (P) JRST UPUTAC XDEVP1: SETZ A, CAMN B,['SYS,,] MOVE A,['DECSYS] CAMN B,['COM,,] MOVE A,['COMMON] POPJ P, XREASS: SKIPE ZREASS JRST MISSING JUMPLE A,MISSING XRETN0: TDZA A,A XRET1: MOVEI A,1 PUSHJ P,UPUTAC JRST UUOXIT ;GETLIN - AC GETS EITHER DEV NAME OF TTY, ;OR RH OF DEV NAME OF MOST RECENT TTY IF THERE IS NONE NOW. XGETLI: MOVE A,[SIXBIT/TTY00/] MOVE B,TTYNUM DPB B,[060300,,A] ;STORE THE TTY NUMBER'S 2 DIGITS INTO THE TWO 0'S. LSH B,-3 DPB B,[140300,,A] SKIPE TTYRN ANDI A,-1 JRST UPUTAC XRETM2: SKIPA A,[-2] XRETM1: MOVNI A,1 PUSHJ P,UPUTAC JRST UUOXIT XSETDD: MOVEM A,.JBDDT POPJ P, XSETNA: MOVEM A,JOBNAM POPJ P, ;sysstr/sysphy uuo xsysph: ;[237] sysphy <==> sysstr xsysst: movsi b,-strcnt ; load number of strs came a,strtab(b) ; match with a str? aobjn b,.-1 ; not yet jumpge b,cpopj ; err out if not found aos (p) ; bump return pc move a,strtab+1(b) ; get next str in table jrst uputac ; and return strtab: 0 ? sixbit/ai/ ? sixbit/mc/ ? sixbit/ml/ ? sixbit/dm/ strcnt==.-strtab 0 ; end of table ;GOBSTR AND JOBSTR UUOS. XGBSTR: TLNN A,-1 HRLI A,3 ;# ARGS NOT SPEC'D => ASSUME 3. HLRZ B,A CAIL B,3 CAILE B,5 JRST XGBSE1 PUSH P,A ANDI A,-1 PUSHJ P,UGET3 JUMPE A,XGBST1 ;0 => SYSTEM SEARCH LIST. JSP B,THSJO1 ;ELSE MUST BE THIS JOB JRST XGBSE4 ;WHAT DO WE DO IF NOT?? HRRZ A,(P) PUSHJ P,UGETCI CAME C,SNAME JRST XGBSE2 ;SNAME AND JOB # DON'T MATCH?? XGBST1: POP P,A ADD A,[-2,,2] ;FLUSH THE ARGS SPECIFIC TO GOBSTR, LEAVING THOSE FOR JOBSTR. XJBSTR: HLRZ B,A TRNN B,-1 MOVEI B,3 ANDI A,-1 PUSHJ P,UGETC ;GET USER'S PREVIOUS FILE STR NAME. MOVE D,C SETZ C, camn d,[-1] ;for -1, return machine name move c,mname cain d,0 ;for 0, return -1 seto c, came d,mname ;for machine name, return 0 jumpe c,xgbse3 ;else it is not one of [-1,mname,0] PUSHJ P,UPUTC SETZ C, CAIE B,1 ;UNLESS THERE'S ONLY 1 WORD IN ARG BLOCK, PUSHJ P,UPUTCI ;STORE ZERO IN 2ND. CAIN B,3 PUSHJ P,UPUTCI ;STORE 0 IN 3RD IF THERE IS ONE. JRST POPJ1 XGBSE1: MOVEI A,12 ;WRONG # OF ARGS ERROR; RETURN CODE IN ACS. JRST UPUTAC XGBSE4: SUB P,[1,,1] ;JOB DOESN'T EXIST. IS THIS THE RIGHT ERROR CODE?? XGBSE2: SKIPA A,[6] ;JOB # AND PPN DON'T MATCH. XGBSE3: MOVEI A,3 ;ARG ISN'T A FILE STRUCTURE. JRST UPUTAC XCTLJB: SKIPE FTPTYUUO JSP B,THSJOB POPJ P, JRST XRETM1 ;SAY JOB NOT CONTROLED BY PTY. XJBSTS: SKIPN FTPTYUUO POPJ P, JUMPGE A,CPOPJ ;CHANNEL => GIVE ERROR RETN, SINCE CHANNEL CAN'T HAVE PTY OPEN. MOVNS A JSP B,THSJOB ;JOB # => MUST BE THIS JOB. JRST XRETN0 HRLI A,600000 ;SAY THIS JOB IS RUNNING AND JOB # IS ASSIGNED. AOS (P) JRST UPUTAC ;PATH. READS THE PATH OF A CHANNEL, ;OR READS OR SETS THE DEFAULT PATH. ;AC/ NARGS,,ARG1 ARG1/ DEVNAME OR CHANNEL OR JOB,,CODE ;ARG1+1/ SCAN SWITCH ARG1+2/ PPN ARG1+3/ 1ST SFD NAME ... ARG1+N-1/ 0 ;ARGS AFTER ARG1+NARGS-1 ARE TREATED AS 0. XPATH.: SKIPN FTSFD POPJ P, PUSH P,A ;SAVE NARGS,,ARG1 FOR PUTARG MOVE E,A ;PUT IT IN E FOR GETARG. PUSHJ P,GETARG ;GET ARG1 TDNN A,[-20] JRST XPATHC ;ARG IS CHANNEL #. HRRE B,A CAML B,[-4] JUMPL B,XPATHD ;ARG IS A SPECIAL CODE (-1, -2, -3 OR -4). POP P,E ;ARG IS A DEVICE NAME. START PUTTING VALUES. PUSHJ P,DEVDCD JRST XRETN0 JUMPL A,XRETN0 ;DEV NON EX OR NOT A DISK-LIKE DEV => RETURN 0. MOVE C,B PUSHJ P,PUTARG ;ELSE RETURN THE DEV NAME, THE SCAN SWITCH, MOVE C,PATHSS PUSHJ P,PUTARG MOVE C,SNAME ;AND THE APPROPRIATELY HACKED SNAME. MOVS A,B MOVEI B,-CHLKEN+[0] ;FAKE OUT CODE EXPECTING A CHANNEL # IN B. JRST XPATHA XPATHC: POP P,E ;NOW START PUTTING ARGS INSTEAD OF GETTING. SKIPG CHDIDX(A) JRST XRETN0 ;ERROR CODE 0 IF CHANNEL DOESN'T HAVE A DISK DEVICE OPEN. MOVE B,A MOVE C,CHRDEV(B) PUSHJ P,PUTARG ;PUT DEVICE NAME FIRST. MOVE C,PATHSS ;THEN DEFAULT SCAN SWITCH PUSHJ P,PUTARG MOVE C,CHSNAM(B) ;THEN FILE'S SNAME IF THERE IS ONE, SKIPN CHLKEN(B) MOVE C,SNAME ;ELSE THE DEFAULT. MOVS A,CHRDEV(B) XPATHA: CAIN A,'SYS ;BUT IF DEVICE IS SYS, USE SYS. SIMILAR FOR COM. MOVE C,['DECSYS] CAIN A,'COM MOVE C,['COMMON] PUSHJ P,PUTARG ;STORE THIS SNAME SKIPN CHLKEN(B) SKIPA C,SFD ;DECIDE WHICH PATH'S SFD TO RETURN, MOVE C,CHSFD(B) JRST XPATR3 ;AND RETURN IT, FOLLOWED BY A ZERO. XPATHD: HLRES A ;ARG IS A SPECIAL CODE: SEE WHAT JOB THE LH SPECIFIES. PUSH P,B JUMPLE A,XPATH1 ;OUT OF RANGE => SELF. CAIL A,MAXJ JRST XPATH1 JSP B,THSJO1 ;ELSE MUST BE THIS JOB'S NUMBER. JRST UUOXIT ;ELSE ERROR RETURN FROM UUO. XPATH1: POP P,B JRST XPATHT(B) ;DECODE THE SPECIAL CODE (-1, -2, -3 OR -4) JRST XPATRA ;-4 => RETURN THE ADDITIONAL PATH. JRST MISSING ;-3 => SET THE ADDITIONAL PATH. JRST XPATSD ;-2 => SET DEFAULT PATH. JRST XPATRD ;-1 => READ DEFAULT PATH. XPATHT: .lose XPATRA: SETZ C, ;READ ADDITIONAL PATH: RETURN 0, SCAN SW, 0. POP P,E PUSHJ P,PUTARG MOVE C,PATHSS PUSHJ P,PUTARG XPATR2: SETZ C, PUSHJ P,PUTARG JRST POPJ1 XPATRD: SETZ C, ;READ DEFAULT: RETURN 0, SCAN SW, SNAME, 0. POP P,E PUSHJ P,PUTARG MOVE C,PATHSS PUSHJ P,PUTARG MOVE C,SNAME PUSHJ P,PUTARG MOVE C,SFD XPATR3: SKIPE C PUSHJ P,PUTARG JRST XPATR2 XPATSD: PUSHJ P,GETARG ;GET AND PUSH 2ND ARG PUSH P,A PUSHJ P,GETARG ;GET AND PUSH 3RD ARG PUSH P,A PUSHJ P,GETAR0 ;GET AND PUSH 4TH ARG, OR 0 IF ONLY 3 SKIPE ZSFDTRN PUSH P,A PUSHJ P,GETAR0 JUMPN A,XRETM1 ;BETTER NOT HAVE A NONZERO 5TH ARG. SKIPE ZSFDTRN POP P,SFD ;IF SFD TRANSLATION ENABLED, SET DEFAULT SFD. JUMPN A,XRETM1 ;ERROR IF 4TH ARG NONZERO (A SFD IS SPEC'D). POP P,SNAME ;3RD ARG IS NEW DEFAULT SNAME POP P,PATHSS ;2ND ARG IS NEW SCAN SWITCH. POP1J1: SUB P,[1,,1] ;THROW AWAY PUTARG POINTER. JRST POPJ1 ;LIKE GETARG, BUT RETURNS 0 AS THE ARG IF IT WASN'T SPEC'D, INSTEAD OF BOMBING OUT. GETAR0: SETZ A, TLNN E,-1 POPJ P, ;E HAS <# ARGS LEFT>,,. LOAD NEXT ARG INTO A AND ADVANCE POINTER. GETARG: MOVE A,E TLZN A,-1 JRST XRETN0 ;RUN OUT OF ARGS => RETURN 0 FROM THE UUO. ADD E,[-1,,1] ;ELSE COUNT THIS ARG AND ADVANCE POINTER. JRST UGET3 ;AND GET THE ARG INTO A. ;E HAS <# ARGS LEFT>,,. STORE C IN NEXT ARG AND ADVANCE POINTER. PUTARG: MOVE A,E TLZN A,-1 POPJ P, ADD E,[-1,,1] JRST UPUTC STORAGE IMPURE PATHSS: 0 ;DEFAULT PATH SCAN SWITCH. DOESN'T AFFECT ANYTHING ;BUT REMEMBERED IN CASE USER SETS IT AND THEN READS IT. STORAGE PURE XGETTA: HRRE E,A ;GET TABLE # IN E. JUMPL E,CPOPJ SKIPE DECRN CAIL E,GETMAX POPJ P, ;TABLE DOESN'T EXIST => FAIL. HLRES A MOVE C,GETTBL(E) ;TABLE IS PER JOB => CHECK THE INDEX. TLNN C,200000 JRST XGETT3 CAMN A,[-2] ;FOR A TABLE INDEXED BY HISEG #, -2 IS OK. JRST XGETT2 JUMPGE C,GETTLS ;ELSE IF HISEG # IS ONLY ALLOWED INDEX, BARF. XGETT3: JUMPGE C,XGETT2 CAMN A,[-1] ;FOR TABLES IDXD BY JOB #, JRST XGETT2 ;EITHER -1 OR OUR OWN JOB # IS OK. JSP B,THSJO1 JRST XRETN0 XGETT2: LDB B,[270400,,GETTBL(E)] ;FIGURE OUT WHAT OP-CODE TO USE. XCT XGETTI(B) ;EXECUTE IT, WITH APPROPRIATE ADDRESS FOR THIS TABLE. XGETT1: AOS (P) ;SKIP AND RETURN THE CONTENTS. JRST UPUTAC XGETTI: OFFSET -. GT$JMP:: JRST @GETTBL(E) ;CODE FOR JRST IS ASSUMED BELOW TO BE 0. GT$PSJ:: PUSHJ P,@GETTBL(E) GT$MOV:: MOVE A,@GETTBL(E) GT$MVI:: MOVEI A,@GETTBL(E) OFFSET 0 GETTBL: TRN gt$mov,[440004,,] ;.GTSTS ;JOB STATUS WORD TRN gt$psj,getadr ;.GTADR ;RELOCATE & PROTECT REGISTERS TRN GT$MOV,UNAME ;.GTPPN ;JOB'S PPN TRN GT$MOV,JOBNAM ;.GTPRG ;PROGRAM NAME SETZ GT$PSJ,GETRNT ;.GTTIM ;RUN TIME IN TICKS SETZ UUOXIT ;.GTKCT ;KILO-CORE-TICKS SETZ GT$MOV,PRIVIL ;.GTPRV ;PRIVILEGES TRN UUOXIT ;.GTSWP SETZ GETTLS ;.GTTTY 0 GT$PSJ,GETCNF ;.GTCNF 0 GT$PSJ,GETNSW ;.GTNSW UUOXIT ;.GTSDT SETZ GETTLS ;.GTSGN UUOXIT ;.GTODP 0 GT$PSJ,GETLVD ;.GTLVD SETZ UUOXIT ;.GTRCT SETZ UUOXIT ;.GTWCT UUOXIT ;.GTDBS UUOXIT ;.GTTDB UUOXIT ;.GTSLF MOVE GT$MOV,RUNDEV ;.GTDEV 0 gt$mov,['rnrnrn] ;.GTWSN SETZ GT$MVI,0 ;.GTLOC ;JOB'S LOGICAL STATION #. UUOXIT ;.GTCOR UUOXIT ;.GTCOM SETZ GT$MOV,XUNAME ;.GTNM1 ;THESE 2 ARE USER'S NAME IN SIXBIT SETZ GT$MVI,0 ;.GTNM2 ;12 CHARS IN ALL. SETZ UUOXIT ;.GTCNO SETZ UUOXIT ;.GTTMP SETZ GT$MOV,WATCH ;.GTWCH SETZ GT$MVI,0 ;.GTSPL SETZ UUOXIT ;.GTRTD SETZ GT$MVI,0 ;.GTLIM UUOXIT ;.GTQQQ SETZ GT$MVI,0 ;.GTQJB UUOXIT ;.GTCM2 UUOXIT ;.GTCRS UUOXIT ;.GTISC UUOXIT ;.GTOSC UUOXIT ;.GTSSC UUOXIT ;.GTRSP UUOXIT ;.GTSYS UUOXIT ;.GTWHY SETZ UUOXIT ;.GTTRQ UUOXIT ;.GTSPS GETTLS ;.GTC0C GETTLS ;.GTC0V REPEAT 10.,0 GT$JMP UUOXIT ;TABLES FOR OTHER CPU'S DON'T EXIST IN THIS MONITOR. 0 gt$psj,getfet ;.GTFET REPEAT 16.,UUOXIT ;.GTEDN ... .GTABS GETTLS ;.GTCMP -- WE SHOULD USE THIS!! REPEAT 13.,UUOXIT ;.GTVM ... .GTENQ GETTLS ;.GTJLT REPEAT 4.,UUOXIT ;.GTEBT ... .GTMBR GETMAX==.-GETTBL GETTLS: SKIPN ZGTTAB ;HERE FOR GETTAB'S WE CAN'T SIMULATE, THAT CAN MATTER. JRST XRETN0 ;EITHER FAIL OR COMPLAIN ACC. TO SWITCH. JRST MISSING ;VARIOUS GETTABL TABLE ROUTINES GETRNT: .SUSET [.RRUNT,,A] LSH A,-12. ;CONVERT 4.069 USEC UNITS TO 1/60 SEC UNITS. POPJ P, getadr: camn a,[-2] ;a high segment? skipa a,hmemt ;yup move a,memt ;nope movss a ;anyway, swap ourselves popj p, ;and return GETLVD: CAIL A,%LDMAX JRST UUOXIT MOVE A,GETLVT(A) POPJ P, GETLVT: OFFSET -. 1,,1 ;%LDMFD 'DECSYS ;%LDSYS '.TAPE0 ;%LDFFA '.INFO. ;%LDHLP '.LPTR. ;%LDQUE 0 ;%LDSPB 0 ;%LDSTR 0 ;%LDUNI 0 ;%LDSWP 69. ;%LDCRN 000 ;%LDSTP 777 ;%LDUFP 2 ;%LDMBN 'DSK,, ;%LDQUS SIXBIT/CRASH/ ;%LDCRP 0 ;%LDSFD 000 ;%LDSPP 000 ;%LDSYP 000 ;%LDSSP 0 ;%LDMNU 100000 ;%LDMXT 'DECSYS ;%LDNEW 'DECSYS ;%LDOLD 'DEC,, ;%LDUMD 2 ;%LDNDB 0 ;%LDMSL 'DECSYS ;%LDALG 'DECSYS ;%LDBLI 'DECSYS ;%LDFOR 'DECSYS ;%LDMAC 'DECSYS ;%LDUNV 'SYS,, ;%LDPUB '.TECO. ;%LDTED 'DECSYS ;%LDREL 'DECSYS ;%LDRNO 'DECSYS ;%LDSNO '.INFO. ;%LDDOC 'DECSYS ;%LDFAI 'DECSYS ;%LDMUS 'DECSYS ;%LDDEC 0 ;%LDSLP 'DECSYS ;%LDBAS 'DECSYS ;%LDCOB 'DECSYS ;%LDMXI 'DECSYS ;%LDNEL 'BACKUP ;%LDDMP 'DECSYS ;%LDPOP 'DECSYS ;%LDTST 0 ;%LDLSO 0 ;%LDMBR 0 ;%LDBBP %LDMAX:: OFFSET 0 GETNSW: CAIGE A,%NSMAX ;WE CAN ONLY HANDLE A FEW .GTNSW WORDS. CAIGE A,10 ;THOSE BELOW %NSCMX CONTAIN GARBAGE, SO TELL THE USER JRST UUOXIT ;HIS PROGRAM IS OBSOLETE. XCT GETNST-10(A) POPJ P, GETNST: OFFSET 10-. MOVE A,CORMAX JRST UUOXIT MOVEI A,69. ;FREE VIRT CORE (GARBAGE VALUE) JRST UUOXIT JRST UUOXIT JRST [.RDTIM A, ? LSH A,1 ? POPJ P,] JRST UUOXIT SETZ A, .SUSET [.RUIND,,A] JRST UUOXIT JRST UUOXIT MOVSI A,<512.*2000>_-18. REPEAT 8.,JRST UUOXIT MOVSI A,1 REPEAT 8.,JRST UUOXIT %NSMAX:: OFFSET 0 ;GETTAB ROUTINE FOR THE CONFIGURATION TABLE. GETCNF: JUMPL A,UUOXIT CAIL A,GETCNL JRST UUOXIT XCT GETCNT(A) POPJ P, GETCNT: JRST GTMNM1 ;%CNFG0 ;NAME OF SYSTEM IS "MIT-XX I.T.S.", XX=MACHINE NAME. JRST GTMNM2 MOVE A,[ASCII /.S./] SETZ A, SETZ A, SETZ A, ;%CNDT0 SETZ A, MOVSI A,'DSK ;%CNTAP JRST GTTOD ;%CNTIM JRST GTDATE ;%CNDAT setz a, ;%CNSIZ SETZ A, ;%CNOPR ;WE HAVE NO OPERATOR. JRST UUOXIT ;%CNDEV MOVE A,[-MAXJ,,MAXJ] ;%CNSJN MOVE A,TWOSEG ;%CNTWR MOVE A,[641015,,500] ;%CNSTS MOVEI A,69. ;%CNSER MOVEI A,1000. ;%CNNSM SETZ A, ;%CNPTY REPEAT 9,JRST UUOXIT ;%CNFRE ... %CNLNP MOVEI A,60200 ;%CNVER (DEC 6.02 IS LATEST DEC MONITOR) REPEAT 6,JRST UUOXIT ;%CNDSC ... %CNPUC SETZ A, ;%CNWHY MOVEI A,60. ;%CNTIC JRST UUOXIT ;%CNPDB MOVEI A,250000. ;%CNRTC JRST UUOXIT ;%CNCHN MOVEI A,20. ;%CNLMX SETZ A, ;%CNBMX SETZ A, ;%CNBMN jrst gettls ;%CNDTM MOVEI A,1 ;%CNLOG SETZ A, ;%CNBAT REPEAT 6,JRST GTYEAR ;%CNYER ... %CNSEC JRST GETTLS ;%CNGMT SETZ A, ;%CNDBG JRST UUOXIT ;%CNFRU JRST UUOXIT ;%CNTCM MOVE A,DITSVR+1 ;%CNCVN -- VERSION OF DECUUO MOVE A,ITSVER ;%CNDVN -- VERSION OF I.T.S. (WHY NOT??) REPEAT 12.,JRST UUOXIT ;%CNDFC ... %CNEXM MOVEI A,20 ;%CNST2 REPEAT 3.,JRST UUOXIT ;%CNPIM ... %CNPIA MOVEI A,20000 ;%CNMNT (GUESS WHAT! 2 MEANS I.T.S.!) REPEAT 2.,JRST UUOXIT ;%CNOCR ... %CNOCP MOVEI A,2000 ;%CNPGS MOVSI A,1 ;%CNMMX REPEAT 4.,JRST UUOXIT ;%CNNSC ... %CNHSL MOVSI A,2 ;%CNNWC GETCNL==.-GETCNT %CN602==123 ; LAST ONE IN 6.02 IFN GETCNL-%CN602-1,.ERR GETCNT TABLE BAD ;ROUTINES FOR ENTRIES IN THE CONFIGURATION TABLE. GTMNM1: LDB A,[360600,,MNAME] ADDI A,40 LSH A,1 ADD A,[ASCII /MIT-/] POPJ P, GTMNM2: LDB A,[300600,,MNAME] ROT A,-7 ADD A,[ASCII / I.T/] POPJ P, GTTOD: PUSHJ P,TIME1 ;GET SECONDS SINCE MIDNIGHT IMULI A,60. POPJ P, ;RETURN JIFFIES SINCE MIDNIGHT. GTDATE: AOS UUOH JRST XDATE CNYER==%CNYER_-18. ;GET HERE TRYNG TO READ YEAR, MONTH, DAY, HOUR, MIN OR SEC. GTYEAR: MOVE C,GTYERT-CNYER(A) ;DECIDE WHAT INFO TO EXTRAC FROM A, B. .RDATIM A, ;READ DATE AND TIME INTO A, B. PUSHJ P,POOF ;GOBBLE DESIRED FIELD INTO NUMBER IN D MOVE D,A POPJ P, GTYERT: 440600,,A 300600,,A 140600,,A 440600,,B 300600,,B 140600,,B ;gettab routine for feature table getfet: jumpl a,uuoxit ;barf if negative cail a,getftl ;too large? jrst uuoxit ;lose move a,getftt(a) ;load the feature popj p, ;and return getftt: 403 ;%ftuuo 4 ;%ftrts 440 ;%ftcom 5 ;%ftacc 0 ;%fterr 0 ;%ftdeb 30 ;%ftstr 430000 ;%ftdsk 0 ;%ftscn 0 ;%ftper getftl==.-getftt ;end of table XLIGHT: MOVEM A,LITES POPJ P, STORAGE IMPURE LITES: 0 STORAGE PURE XSEEK: SKIPN ZSEEK POPJ P, JRST MISSING XTMPCO: SKIPN ZTMPCO JRST XRETN0 JRST MISSING XDISK.: SKIPN ZDISK. JRST POPJ1 JRST MISSING XTRMNO: SKIPN FT5UUO POPJ P, JSP B,THSJOB ;REFUSE TO TRY TO HACK ANY JOB BUT SELF JRST XRETN0 ;IF USER WANTS NO COMPLAINTS, JUST RETURN "JOB NON-EX". .SUSET [.RTTY,,A] ;RETURN 200000+TTY # IF HAVE TTY, ELSE 0 AND NO SKIP JUMPL A,XRETN0 AOS (P) MOVEI A,200000(A) JRST UPUTAC xtrmop: skipn ztrmop popj p, jrst missing XDEVNA: SKIPN FT5UUO ;ALLOW USER TO SAY UUO ISN'T IMPLEMENTED. POPJ P, ;DEVNAM AC, WHERE AC HAS DEV NAME OR CHANNEL # XPNAME: PUSHJ P,DEVDCD ;RETURNS THE PHYSICAL DEVICE NAME, OR 0 IF NONE. JRST [ SKIPN DECRN POPJ P, ;SAIL'S PNAME UUO DOESN'T CHANGE AC IF NO SUCH DEV. JRST XRETN0] ;DEC'S DEVNAM UUO SETS AC TO 0 IN THAT CASE. MOVE A,B JRST XGETT1 XMTCHR: SKIPN FT5UUO POPJ P, JRST XRETM1 XMVHDR: MOVE B,A LDB A,[270400,,UUO40] ADDI A,1 ANDI A,17 ;GET THE # OF "AC+1", WHERE AC IS WHAT WAS SPEC'D. PUSHJ P,UGET3 ;GET ITS CONTENTS SKIPN CHDEV(B) JRST XRET1 ;RETURN 1 IF CHANNEL NOT INITTED. TLNE A,-1 ;ELSE SET THE HEADER ADDR'S, EXCEPT THAT ARG=0 HLRM A,CHOHDR(B) ;IMPLIES "DON'T CHANGE THIS ONE". TRNE A,-1 HRRM A,CHIHDR(B) JRST POPJ1 XDEVLN: skipn ft5uuo popj p, pushj p,devdcd ;decode device name jrst [movni a,1 ? pushj p,uputac ? jrst uuoxit] ldb a,[270400,,uuo40] aoj a, andi a,17 ;point to ac+1 pushj p,uget3 ;get its contents syscal tranad,[[400003,,-1] ? [-1,,a] ? [-1,,b]] popj p, ;failed somehow jrst popj1 ; and return XDEVST: SKIPN FT5UUO POPJ P, pushj p,devdcd ;decode device jrst xretn0 ;sigh move a,dsttab(a) ;get appropriate coni .suset [.roption,,c] ;read options tlz c,optdec ;allow coni to win .suset [.soption,,c] ; by turning off dec option xct a ;do the coni tlo c,optdec ;re-enable dec options .suset [.soption,,c] ;set it aos (p) ;set skip return jrst uputac ;and return XCHKAC: SKIPN FT5UUO POPJ P, AOS (P) JRST XRETN0 ;ALWAYS SAY ACCESS IS ALLOWED. XSTUUO: SKIPN FTSET POPJ P, HLRZ B,A ;GET FUNCTION CODE IN B. CAIL B,.STMAX POPJ P, CAIN B,.STWTC ;SETTING THE WATCH BITS IS ALLOWED. JRST [ HRRZM A,WATCH JRST POPJ1] ;THE WATCH BITS DO NOTHING, BUT CAN BE READ BACK. SETZ C, LSHC B,-4 ROT C,5 ;GET TOP BITS IF FUNCTION CODE IN B, LOW 4 BITS (TIMES 2) IN C. MOVE D,XSTTAB(B) ROT D,2(C) ;EXTRACT THE BITS FROM XSTTAB THAT REFER TO THIS FUNCTION CODE. ANDI D,3 JRST .+1(D) JRST PRIV SKIPN ZSTUUO JRST POPJ1 JRST MISSING XSTTAB: .BYTE 2 ;8 CODES PER LINE; MUST HAVE .WALGN AFTER EACH GROUP OF 2 LINES. 0 ? 0 ? 0 ? 0 ? 1 ? 1 ? 1 ? 0 ;CODES 0-7 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ;CODES 10-17 .WALGN 0 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ? 1 ;CODES 20-27 .STMAX==.BYTC .BYTE XDSKCH: jumpl a,xsdskc ; undocumented short dskchr(sigh) pushj p,ugetc ;losing way to set up names irps quux,,[0,.dcsnm,.dculn,.dcupn,.dcuid] movem c,dskcht+quux ;. . . termin .suset [.ruind,,dskcht+.dcsaj] tlnn a,-1 ;expect at least 1 argument hrli a,1 ;well, i got an argument, didn't i? hlrz d,a ;get # of arguments caile d,.dcufs ;more than i can handle? jrst uuoxit ;lose then movns d ;negate # of args soj a, ;kludge to debump a first(sigh) hrlz b,d ;make it an aobjn pntr move c,dskcht(b) ;load "dskchr" table word pushj p,uputci ;and save it for user aobjn b,.-2 ;and do some more xsdskc: movei a,2020 ;result in ac for simulated dskchr aos (p) ;success return jrst uputac ;and value return storage impure ;thanks robt@ml!!! dskcht: 0 ;device name or something 400000 ;.dcuft := infinity 3000. ;.dcfct := random 3000. ;.dcunt ditto 0 ;.dcsnm 5012,,310 ;.dcuch := blocks/thing 4000000. ;.dcusz := some random number 1 ;.dcsmt := 1 luser known by decuuo 160 ;.dcwps := what s.i.t. has 4 ;.dcspu := " " " 0 ;.dck4s := imagine no nasty swapping 0 ;.dcsaj := job # repeat 3.,0 ;.dculn ... .dcuid 0 ;.dcufs := no swapping again storage pure ;back to pure again subttl III UUO Action Routines .PPIOT: JUMPE B,.+2 ;PPSEL CAIN B,1 jrst missing ;ppact CAIN B,2 JRST .DPYPOS ;DPYPOS CAIN B,3 JRST .DPYSIZ ;DPYSIZ CAIN B,4 JRST .PPREL ;PPREL jrst missing ;don't know .DPYPOS: MOVNI D,-1000 HRRE E,UUO40 MOVEM E,IIIPOS ;REMEMBER III COORDS OF PP PUSHJ P,IIICKE ; ?? meaningfull when not in DPYOUT ?? PUSHJ P,ITOD MOVEM E,PPORG PUSHJ P,@DPYPOS(M) JRST UUOXIT .DPYSI: PUSHJ P,TTYOFF ;INHIBIT TTY INTERRUPTS WHILE WE DO THIS PUSH P,PPORG PUSHJ P,@PPFRSH(M) POP P,PPORG PUSHJ P,@DPYSIZ(M) HRRZ A,UUO40 IDIVI A,1000 CAIN A,0 MOVEI A,1 CAIN B,0 MOVEI B,1 MOVEM A,PPGLTS MOVEM B,PPGLSZ JRST TTYXIT ;ENABLE TTY INTERRUPTS AND EXIT .PPREL==missing .DPYCLR: PUSHJ P,DLCLR JRST UUOXIT .UPGME: MOVE B,CURPG SKIPE IIIPG(B) PUSHJ P,UPGCHK .lose ;display protection violation ADD A,C ;POINTS INTO DISPLAY SPACE MOVE A,(A) ;III DISPLAY INSTRUCTION TRNN A,1 ;TEXT OR RESTORE WORD... TRNE A,2 ;OR SVW, OR LVW, OR TSS... JRST UPGME1 ;REQUIRE NO RELOCATION HRRZ D,(D) ;RELOCATION BASE SUB C,D ;USER BASE-RELOCAION BASE HRLZS C ADD A,C UPGME1: PUSHJ P,UPUTAC JRST UUOXIT .UPGMM: MOVE B,CURPG SKIPN IIIPG(B) JRST UUOXIT ;FORGIVE AND FORGET PUSHJ P,UPGCHK .lose ;illegal ;RELOCATE USER'S DISPLAY WORD TO CURRENT BASE CAIN M,DPYTV PUSHJ P,TVERASE ; CLEAR THIS PGLASS OFF TV SCREEN MOVE E,D ;DISPLAY SPACE ORIGIN ADD E,A ;POINTS INTO DISPLAY SPACE PUSHJ P,UGETAC ;GET DISPLAY INSTRUCITION PUSHJ P,@DSTOP(M) HRRZ D,(D) ;RELOCATION BASE TRNN A,1 TRNE A,2 JRST UPGMM1 SUB D,C ;RELOCATION BASE-USER DISPLAY ORIGIN HRLZS D ADD A,D ;RELOCATE ;FIRST WE SAVE III PORTION OF PIECE OF GLASS IN FREE STORAGE UPGMM1: MOVEM A,(E) ;INTO DISPLAY SPACE PUSH P,DLBFP ;DESTINATION MOVE C,IIIPG(B) HLRO A,(C) MOVNS A ;# WORDS IN III DISPLAY LIST PUSH P,IIIPG(B) HRLM A,(P) ;# WORDS,,SOURCE PUSHJ P,UPGBLT ;FLUSH PIECE OF GLASS FROM DISPLAY SPACE PUSH P,PGBLNK PUSH P,IIIUPG(B) PUSHJ P,PGCLR ;CLEAR OUT THAT PIECE OF GLASS POP P,IIIUPG(B) POP P,PGBLNK ;NOW WE ATTACH SAVE III DISPLAY LIST TO DISPLAY SPACE POP P,A HLRZS A ;# WORDS IN III DISPLAY LIST POP P,C ;ORIGIN OF III DISPLAY LIST PUSH P,(C) ;CURRENT RELOCATION BASE PUSH P,DLBFP MOVE D,(C) HLLM D,(P) ;AOBJN POINTER TO III DISPLAY LIST MOVE D,DLBFP HRL D,C ;SOURCE,,DESTINATION ADDB A,DLBFP BLT D,-1(A) JRST IIISIM ;COMPILE 340 DISPLAY LIST ;HERE TO CHECK FOR DISPLAY PROTECTION VIOLATION ;RETURNS ; A/ OFFSET INTO DISPLAY LIST ; C/ USER DISPLAY ORIGIN ; D/ DISPLAY SPACE ORIGIN UPGCHK: PUSHJ P,UGETAI HRRZ C,IIIUPG(B) SUB A,C ;OFFSET INTO DISPLAY LIST JUMPLE A,CPOPJ ;ILLEGAL HRRZ D,IIIPG(B) ;DISPLAY SPACE ORIGIN HLRO E,(D) MOVNS E ;LENGTH OF DISPLAY LIST CAMLE A,E POPJ P, ;ILLEGAL JRST POPJ1 UPGBLT: MOVS C,-1(P) HRR C,DLBFP ;SOURCE,,DESTINATION HLRZ D,-1(P) ;# WORDS IN DISPLAY LIST XCT BYTES(M) ;# HALF WORDS EXCH D,DLFBYT SUBB D,DLFBYT JUMPGE D,UPGBL1 ;JUMP IF ENOUGH ROOM IN DISPLAY SPACE PUSHJ P,GETHI ;NOT ENOUGH ROOM SKIPGE DLFBYT JRST .-2 UPGBL1: HLRZ D,-1(P) ADDB D,DLBFP ;UPDATE FIRST FREE BYTE BLT C,-1(D) ;INTO DISPLAY SPACE POPJ P, GETHI: SKIPE INTFLG .lose ;ppblk needs to be bigger PUSH P,D MOVEI D,1000 ;GETS MORE CORE FOR DISPLAY SPACE SKIPE SIXSW MOVEI D,1001 ADDB D,CWORD1 .CBLK D, .VALUE .lose MOVEI D,2000 ;# WORDS WE GET ADDM D,DLBFL ;# WORDS IN DISPLAY SPACE XCT BYTES(M) ;# BYTES ADDM D,DLFBYT ;# FREE BYTES POP P,D POPJ P, .UPGIOT: PUSHJ P,PGCLR ;CLEAR OUT THAT PIECE OF GLASS SKIPGE @UUO40 ;DOES HE WANT BLINKING? SETOM BLNKIT ; YES SETZM TVBLNK(B) ; in case no blinking AOSE BLNKIT ;DOES HE WANT BLINKING? JRST UPG4 SETOM TVBLNK(B) ;TURN ON BLINKER FOR THIS PAGE MOVEM B,PGBLNK ; for old 340 routines that only win on one PG UPG4: HRRZ A,UUO40 ;POINTS TO USER DISPLAY LIST MOVN C,1(A) ;-# WORDS IN SAME JUMPE C,.PGA1 CAMN C,[-1] JRST .PGA1 ;NULL DISPLAY LIST SOJGE C,[.lose] ;ILLEGAL PUSH P,(A) ;POINTS TO USER DISPLAY LIST PUSH P,DLBFP ;ORIGIN OF III DISPLAY LIST HRLM C,(P) ;AOBJN POINTER INTO DISPLAY SPACE HRL C,(A) HLRZM C,IIIUPG(B) ;ORIGIN OF USER DISPLAY LIST PUSH P,(A) ;SOURCE MOVE C,1(A) ADDI C,1 ;AN EXTRA WORD FOR A HALT AT THE END HRLM C,(P) ;# WORDS,,SOURCE PUSHJ P,UPGBLT POP P,(P) MOVE C,DLBFP ;PUT A HALT AT THE END SETZM -1(C) ;STATE OF STACK AT THIS POINT ; -1(P) CURRENT RELOCATION BASE ; (P) AOBJN POINTER TO III DISPLAY LIST IN DISPLAY SPACE IIISIM: CAIN M,DPYTV SETOM INBLNK PUSHJ P,UPGREL ;RELOCATE III DISPLAY PROGRAM IN DISPLAY SPACE HLRO C,(P) MOVNS C MOVE A,(P) HRL A,C ;# WORDS,,ORIGIN OF PIECE OF GLASS MOVEM A,IIIPG(B) MOVE D,PGSG ;ADD TO SORTED LIST AOS PGSG HRL A,B ;PIECE OF GLASS,,ORIGIN MOVEM A,PGSORT(D) SUB P,[2,,2] CAIE M,DPYTV JRST DO340 AOSN TVFRSH ;NEED TO REFRESH ENTIRE SCREEN MOVSI B,-PGLEN ;DO ALL PGS THEN SKIPE IIIPG(B) ;ANYTHING THERE?? PUSHJ P,TVSIM AOBJN B,.-2 CHKBLN: MOVEI B,PGLEN-1 SKIPN TVBLNK(B) SOJGE B,.-1 JUMPL B,UUOXIT SETZM INBLNK ;AT LEAST ONE NEEDS BLINKING JRST UUOXIT DO340: CAIN C,1 JRST .PGA1 ;NULL DISPLAY PROGRAM PUSH P,DLBFP ;ORIGIN OF DPY DISPLAY LIST HRRZM A,IIIPC AOS IIIPC ;START DISPLAY RUNNING HERE SETZM DLBCNT SETZM IIIFLG AOS IIIFLG SETZM IIISIZ AOS IIISIZ SETZM IIIX SETZM IIIY PUSHJ P,@DPYINT(M) ;CENTER BEAM ETC. PUSH P,B ;MUST DO PUSH, WE MIGHT HAVE COME FROM .UPGMM UPGLOP: PUSHJ P,IIIINS ;EXECUTE INSTRUCTION MOVE A,IIIFLG TRNE A,1 JRST UPGLOP ;III STILL RUNNING SKIPN C,DLBCNT ;III STOPPED PREPARE TO FLASH DPY .lose ;no 340 code generated POP P,B PUSHJ P,@DPYEND(M) MOVE A,DLBCNT ;# PDP10 WORDS IN DPY LIST HLRZ C,IIIPG(B) ADD C,A HRLM C,IIIPG(B) ;INCLUDE DPY DISPLAY LIST IN PIECE OF GLASS ADDM A,DLBFP MOVNS A POP P,C ;ORIGIN OF DPY DISPLAY LIST HRLI A,-1(C) MOVSM A,DLPG(B) ;BLKO POINTER TO DPY DISPLAY LIST MOVEI A,DLPG(B) HRLM A,DLLIST(B) ;MAKE VISIBLE .PGA1: PUSHJ P,FLASH ;FLASH THE DPY CAIE M,DPYTV JRST UUOXIT JRST CHKBLN ;HERE TO RESTART THE DISPLAY FLASH: CAIN M,DPYTV POPJ P, ;no need for diddling 340 variables SETOM INBLNK SETZM BLNTIM ;Blink throttle reset to full speed MOVEI A,DLLIST ;ONLY DISPLAY THOSE WHICH ARE VISIBLE MOVEI C,DLVIS+1 MOVEI D,DLVIS+2 MOVE B,[DLPP,,DLVIS+1] ;initial PPaper MOVEM B,DLVIS SETZB B,DLVIS+1 FLASH1: MOVE A,(A) ; next BLKO ptr for PGlass TLNN A,-1 JRST FLASH2 ; empty MOVE E,A ; LH has ptr to BLKO wrd HRR E,D ; chain in DLVIS list MOVEM E,(C) CAMN B,PGBLNK MOVEM C,INBLNK ;HE WANTS THIS PIECE OF GLASS BLINKING ADDI D,1 ADDI C,1 FLASH2: TRNE A,-1 AOJA B,FLASH1 HLLZS -1(C) ;END OF LIST JRST @DSTART(M) ;dlvis: ; [BLKO for piece of paper],,.+1 ; [BLKO for first piece of glass visible],,.+1 ; ... ; [BLKO for last piece of glass],,0 .PGIOT: JUMPE B,.PGSEL CAIN B,1 JRST .PGACT CAIN B,2 JRST .PGCLR jrst illins ;illuuo .PGSEL: HRRZ A,UUO40 CAILE A,17 jrst illins ;illegal piece of glass MOVEM A,CURPG JRST UUOXIT .PGACT: jrst missing ;THIS CODE LOOKS WRONG ifn 0,[ CAIN M,DPYTV JRST UUOXIT HRRZ A,UUO40 MOVE B,CURPG SKIPN B,IIIPG(B) .lose MOVEI C,400000 MOVN D,CURPG LSH C,(D) PUSHJ P,@DSTOP(M) TLNN A,C ; ??? JRST [ HRRZS DLLIST(B) ;MAKE INVISIBLE ??? B CLOBBERED ??? JRST .PGA1] SKIPN DLPG(B) ;MAKE VISIBLE .lose ;no display list MOVEI C,DLPG(B) HRLM C,DLLIST(B) JRST .PGA1 ;flash it ];; end ifn 0 .PGCLR: SETOM INBLNK SETZM BLNTIM MOVEI B,PGLEN-1 PUSHJ P,PGCLR SOJGE B,.-1 JRST UUOXIT PGCLR: PUSHJ P,@DSTOP(M) CAIN M,DPYTV PUSHJ P,TVERAS ;CLEAR THIS PG SETZM TVBLNK(B) ;STOP BLINKING FOR THIS PAGE CAMN B,PGBLNK ;WAS THIS PAGE BLINKING SETOM PGBLNK ;NO LONGER SKIPLE C,PGSG ;CHECK TO SEE IF SORTED LIST STILL VAILID SOJA C,PGCBLT ;WIN, DO NOT HAVE TO SORT JUMPE C,CPOPJ ;NO ENTRIES IN LIST, DONE .lose ;LIST SHOULD NEVER NEED SORTING ;SORT PHASE OVER PREPARE TO BLT ;GET HERE WITH HIGHEST VALID PGSORT INDEX IN C PGCBLT: PUSH P,B ;SAVE PIECE OF GLASS MOVEI A,0 PGCBL0: HLRZ D,PGSORT(A);FIND OUR PIECE OF GLASS IN PGSORT CAMN B,D JRST PGCBL1 ;FOUND HIM CAMGE A,C AOJA A,PGCBL0 SKIPA A,[-1] ;NOT FOUND ;HERE WITH PIECE OF GLASS IN B AND PGSORT INDEX IN A PGCBL1: PUSH P,IIIPG(B) ;DESTINATION OF BLT SETZM IIIPG(B) SETZM DLPG(B) SETZM IIIUPG(B) HRRZS DLLIST(B) ;MAKE INVISIBLE JUMPL A,POPBJ ;JUMP IF PIECE OF GLASS NOT ACTIVE PUSH P,A PUSHJ P,@DELITM(M) POP P,A SOSG PGSG JRST PGCF1 ;DONE IF NO ACTIVE PIECE OF GLASS CAMN A,PGSG JRST [ MOVE C,(P) ;BEGINNING OF FREE STORAGE JRST PGCFIN] ;NO BLT NECESSARY HLRZ C,(P) MOVNS C ;RELOCATION CONSTANT ADDI A,1 ;SET FOR NEXT PGSORT ENTRY HLRZ B,PGSORT(A);PIECE OF GLASS NUMBER PUSH P,IIIPG(B) ;SOURCE OF BLT SKIPA D,[0] ;# WORDS TO BLT PGCBL2: HLRZ B,PGSORT(A) HLRZ E,IIIPG(B) ADD D,E ADDM C,IIIPG(B) ADDM C,DLPG(B) MOVE E,PGSORT(A) ;SHIFT BACK SORTED LIST MOVEI B,-1(A) ADD E,C MOVEM E,PGSORT(B) CAMGE A,PGSG AOJA A,PGCBL2 ;FINALLY WE DO THE BLT POP P,B ;SOURCE MOVE A,(P) ;DESTINATION HRL A,B ;SOURCE,,DESTINATION MOVEI B,(A) ADD B,D BLT A,-1(B) ;WHEW!!! SKIPA C,B PGCF1: MOVEI C,HIBASE+HIUSE ;DLBFP=HIBASE+HIUSE PGCFIN: POP P,D ;IIIPG HLRZS D ;WORD COUNT XCT BYTES(M) ;BYTE COUNT ADDM D,DLFBYT ;MORE FREE BYTES HRRZM C,DLBFP ;NEW BUFFER POPBJ: POP P,B POPJ P, ;HERE TO RELOCATE III DISPLAY PROGRAM ;CALLED WITH TWO ARGUMENTS ON STACK ; -2(P) ORIGIN OF SOURCE DISPLAY LIST ; -1(P) AOBJN POINTER TO CURRENT DISPLAY LIST UPGREL: HRRZ C,-1(P) HRRZ A,-2(P) SUB C,A HRLZS C ;RELOCATION CONSTANT MOVE A,-1(P) CAMN A,(A) POPJ P, ;NO RELOCATION NECESSARY MOVEM A,(A) ;VALIDATE AOBJP A,CPOPJ ;NULL DISPLAY LIST PGRLOP: MOVE D,(A) trne d,3 ;DON'T RELOCATE TEXT OR RESTORE WORD jrst pgrlo1 ;DON'T RELOCATE SVW(2), LVW(6), OR TSS(12) ADDM C,(A) ;RELOCATE ALL OTHERS hlrz d,(a) sub d,-1(p) trnn d,-1 setzm (a) pgrlo1: AOBJN A,PGRLOP POPJ P, subttl III Display Simulator IIIINS: MOVE A,@IIIPC ;INSTRUCTION AOS IIIPC ;INCREMENT PC TRNE A,1 JRST @CHR(M) ;CHARACTER MODE LDB B,[010300,,A] ;DISPATCH ON NEXT 3 BITS MOVSS A ;PUT ADDRESS IN RIGHT HALF JRST @.+1(B) JMPHLT ; 0 JMP(20) OR HALT(0) SVW ; 2 SHORT VECTOR WORD JMSJSR ; 4 JMS(4), JSR(24), OR SAVE(64) LVW ; 6 LONG VECTOR WORD ILLINS ;10 ILLEGAL INSTRUCTION TSS ;12 TEST SET AND SKIP REST ;14 RESTORE ILLINS ;16 ILLEGAL INSTRUCTION illins==illuuo IIIUPK: LDB B,[IIIXBP,,A] ;X UNPACKS III STATUS WORD PUSHJ P,IIILNM MOVE D,B LDB B,[IIIYBP,,A] ;Y PUSHJ P,IIILNM MOVE E,B LDB B,[IIIBBP,,A] ;BRIGHTNESS CAIE B,0 MOVEM B,IIIBRT LDB B,[IIISBP,,A] ;SIZE CAIE B,0 MOVEM B,IIISIZ POPJ P, ;MASK TO USE IN $T MODE IN DDT TO TYPE OUT III INSTUCTIONS LVWMSK==777600034260 ;X(11),Y(11),BRT(3),SIZ(3),UNUSD(1),MODE(1),T(2),OPCD(4) SVWMSK==774014017717 ;DX1(7),DY1(7),T1(2),DX2(7),DY(2),T2(2),OPCD(4) TSSMSK==776003774057 ;RESET(8),SET(8),TEST(8),UNUSD(7),I(1),OPCD(4) STSMSK==776000343400 ;X(11),Y(11),BRT(3),SIZ(3),FLGS(8) ;SOME HANDY BYTE POINTERS IIIXBP==311300 ;POINTS TO X FIELD IN POSITION WORD IIIYBP==161300 ;Y FIELD IIIBBP==130300 ;BRIGHTNESS IIISBP==100300 ;SIZE IIIFBP==001000 ;FLAGS JMPHLT: TLNN A,20 JRST HLT JMP: HRRZM A,IIIPC ;JUMP POPJ P, JMSJSR: TLNN A,20 JRST ILLINS ;JMS ILLEGAL TLNN A,40 JRST XJSR ;JSR MOVE B,IIIX ;HERE TO EXECUTE SAVE INSTRUCTION DPB B,[IIIXBP,,C] ;X MOVE B,IIIY DPB B,[IIIYBP,,C] ;Y MOVE B,IIIBRT DPB B,[IIIBBP,,C] ;BRIGHTNESS MOVE B,IIISIZ DPB B,[IIISBP,,C] ;SIZE MOVE B,IIIFLG DPB B,[IIIFBP,,C] ;FLAGS MOVEM C,(A) POPJ P, XJSR: HRLZ C,IIIPC IORI C,20 MOVEM C,(A) AOJA A,JMP ;DO THE JUMP HLT: MOVEI A,1 ;CLEAR RUNNING FLAG ANDCAM A,IIIFLG POPJ P, IIILNM: TRNE B,2000 ;NORMALIZE LONG VECTOR COORDINATE TO 36 BITS TDO B,[-1,,776000] POPJ P, IIISNM: TRNE B,100 ;NORMALIZE SHORT VECTOR COORDINATE TO 36 BITS TDO B,[-1,,777600] POPJ P, REST: MOVE C,(A) TRNN C,1 .lose ;running flag not set TLNN A,40 JRST RESTFL PUSH P,A PUSH P,C MOVE A,C PUSHJ P,IIIUPK SUB D,IIIX SUB E,IIIY MOVEI B,2 ;DO INVISIBLE SET POINT PUSHJ P,ASVW POP P,C POP P,A RESTFL: TLNN A,20 POPJ P, LDB B,[IIIFBP,,C] ;RESTORE FLAGS MOVEM B,IIIFLG POPJ P, TSS: MOVSS A ;GET A BACK INTO ORIGINAL SHAPE TV.TSS: MOVEI D,0 ;NONE SKIP CONDITION LDB B,[141000,,A] ;SKIP BITS MOVE E,IIIFLG ;MANIPULATE FLAGS IN E PUSHJ P,TSS1 ;SWAP BITS TO USE TSS NOMENCLATURE TDNE E,B MOVEI D,1 ;SET SKIP CONDITION MOVEI B,1 ;NOW TO DECIDE WHETHER TO SKIP OR NOT TRNN A,20 MOVEI B,0 XOR D,B ;SKIP CONDITION AND BIT 31 OF INSTUCTION TRNE D,1 AOS IIIPC ;SKIP!!!! LDB B,[341000,,A] ;RESET BITS LDB C,[241000,,A] ;SET BITS MOVE D,C AND D,B ;COMPLEMENT BITS IN D TRZ B,(D) ;ZERO COMPLEMENT BITS IN SET AND RESET TRZ C,(D) TRZ E,(B) ;RESET TRO E,(C) ;SET TRC E,(D) ;COMPLEMENT PUSHJ P,TSS1 TRO E,1 ;ALWAYS RUNNING MOVEM E,IIIFLG POPJ P, TSS1: TRCE E,11 ;INTERCHANGE WRAP AROUND AND NOT RUNNING MASK TRCE E,11 TRCE E,11 POPJ P, SVW: MOVSS A ;GET THE RIGHT ORDER LDB B,[350700,,A] ;DX1 PUSHJ P,IIISNM ;NORMALIZE MOVE D,B LDB B,[260700,,A] ;DY1 PUSHJ P,IIISNM MOVE E,B LDB B,[240200,,A] ;T1 PUSHJ P,ASVW ;ACTION ROUTINE LDB B,[150700,,A] ;DX2 PUSHJ P,IIISNM MOVE D,B LDB B,[060700,,A] ;DY2 PUSHJ P,IIISNM MOVE E,B LDB B,[040200,,A] ;T2 ASVW: PUSH P,A CAIN B,3 ;CALLED WITH MODE IN B, (X AND Y) IN (D AND E) .lose ;undefined ADDM D,IIIX ADDM E,IIIY PUSHJ P,IIICKE ;CHECK EDGE OVERFLOW JUMPE B,@SVW2(M) ;WANTS TO DRAW VECTOR JRST @SVW1(M) ;DO POINT LVW: MOVSS A ;RIGHT ORDER PUSHJ P,IIIUPK ;UNPACK STATUS REGISTER LDB B,[040200,,A] ;TYPE TRNN A,100 JRST LVW0 ;RELATIVE MODE SUB D,IIIX SUB E,IIIY LVW0: JUMPN B,ASVW ;JUMP IF NOT VECTOR LVW1: PUSHJ P,LVWCHK ;CHECK TO SEE THAT THE 340 CAN HACK IT JRST ASVW ;VECTOR SHORT ENOUGH, NO HASSLE JRST @LVW2(M) ;DO A LONG VECTOR IIICKE: PUSH P,D ;CHECK FOR EDGE OVERFLOW MOVE D,IIIX PUSHJ P,IIICK1 MOVE D,IIIY PUSHJ P,IIICK1 POP P,D POPJ P, IIICK1: CAMGE D,[1000] CAMGE D,[-1000] JRST .+2 POPJ P, ;OKAY MOVEI D,40 IORM D,IIIFLG ;SET EDGE OVERFLOW POPJ P, ITOD: ADDI D,1000 ;SHIFT FROM III COORDINATES TO 340 ADDI E,1000 SKIPGE D ;CLIP IF NECESSARY MOVEI D,0 SKIPGE E MOVEI E,0 CAML D,[2000] MOVEI D,1777 CAML E,[2000] MOVEI E,1777 POPJ P, LVWCHK: CAMGE E,SYMAX(M) CAMG E,SYMIN(M) JRST POPJ1 ;VECTOR TOO LONG FOR 340 CAMGE D,SXMAX(M) CAMG D,SXMIN(M) JRST POPJ1 POPJ P, ADBYTE: SOSGE DLFBYTE ;DISPLAY LIST FREE BYTES PUSHJ P,GETHI ;OVERFLOW AOS DLBCNT ;BYTE COUNT IDPB A,DLPC ;HALF WORD INTO DISPLAY LIST POPJ P, SGNMAG: JUMPGE D,SGNM1 ;CONVERT TO SIGN MAGNITUDE MOVNS D IOR D,A ;SIGN BIT SGNM1: JUMPGE E,CPOPJ MOVNS E IOR E,A POPJ P, CHRSET: MOVEI B,5 ;7 BIT CHARACTERS PER WORD MOVEI A,@IIIPC SUBI A,1 ;PC HAS BEEN ALREADY AOSED HRLI A,440700 MOVEM A,IIIBP ;BYTE POINTER POPJ P, CHRPOS: MOVE D,IIISIZ ;GET CHARACTER SIZE HRRZ E,STAB(D) HLRZ D,STAB(D) MOVNS E CAIE A,15 JRST DCHP0A MOVNI D,1000 ;CARRIAGE RETURN GOES ALL THE WAY MOVEM D,IIIX JRST DCHP0 DCHP0A: CAIN A,12 ;LINE FEED JRST [ ADDM E,IIIY JRST DCHP0] ADDM D,IIIX DCHP0: PUSHJ P,IIICKE ;CHECK EDGE OVERFLOW POPJ P, ;STAB INDEXED BY CHARACTER SIZE ;TABLE ENTRY: DX,,DY ;THE GOSPEL ACCORDING TO HELLIWELL: CURSOR ENDS AT BOTTOM RIGHT OF CHARACTER STAB: 0 ;0 ILLEGAL 10,,20 ;1 12,,24 ;2 14,,30 ;3 20,,40 ;4 30,,60 ;5 40,,100 ;6 60,,140 ;7 subttl Display Type Dispatch Tables ;ALL OF THESE TABLES ARE INDEXED ON M ; -1 NO DISPLAY ; 0 DEC 340 ; 1 GT-40 ; 2 TV DISPLAY CPOPJ DSTOP: STP340 ;STOPS DISPLAY CPOPJ CPOPJ CPOPJ DSTART: STRT34 ;STARTS DISPLAY STRTGT CPOPJ CPOPJ DPYINT: INT340 ;INITIALIZE DISPLAY LIST INTGT CPOPJ CPOPJ DPYEND: END340 ;CLOSE DISPLAY LIST ENDGT CPOPJ CPOPJ DPYCLR: CLR340 ;INTIALIZE PIECE OF GLASS VARIABLES CLRGT CLRTV CPOPJ DELITM: CPOPJ ;DELETES A PIECE OF GLASS FROM DISPLAY LIST DELIGT CPOPJ CPOPJ DPYSIZ: DPYP1 SIZGT CPOPJ CPOPJ DPYPOS: DPYP2 POSGT TVPOS CPOPJ PPFRSH: PPFR34 ;CLEARS ALL PIECES OF PAPER PPFRGT CPOPJ JFCL BYTES: ASH D,1 ;CONVERTS # WORDS IN D TO # BYTES ASH D,1 JFCL JRST 4,. SVW1: SVW134 ;DOES SET POINT (B=1 FOR VISIBLE, ELSE INVISIBLE) SVW1GT JRST 4,. JRST 4,. SVW2: SVW234 ;DRAWS SHORT VECTOR SVW2GT JRST 4,. JRST 4,. LVW2: LVW234 ;DRAWS LONG VECTOR LVW2GT JRST 4,. JRST 4,. CHR: CHR340 ;CHARACTERS CHRGT JRST 4,. JRST 4,. PPTYO: PPTY34 ;PIECE OF PAPER TYO PPTYGT TVTYO 0 SXMAX: 200 100 0 0 SXMIN: -200 -100 0 0 SYMAX: 200 100 0 0 SYMIN: -200 -100 0 subttl TV Display Stuff TVW==576. ;number of points in line TVV==454. ;number of lines on screen NECHO==3 ; echo lines at bottom of TV screen ; SIMULATE III BUFFER IN PGlass B TVSIM: AOSN TVPURE ; Attempting a recursive call to this impure code?? SKIPN IIIPG(B) .lose PUSH P,A PUSH P,B ;SAVE PIECE OF GLASS # PUSH P,C PUSH P,D PUSH P,E HRRZ A,IIIPG(B) HRRZ C,(A) CAME A,C ;1ST WORD SHOULD POINT TO SELF IF RELOCATED RIGHT JRST [ MOVE A,IIIPG(B) PUSH P,(A) ;OLD RELOCATION ADDRESS HLL A,(A) ; COPY IN OLD AOBJN COUNT PUSH P,A ; NEW RELOCATION PUSHJ P,UPGREL SUB P,[2,,2] JRST .+1] HRRZ A,IIIPG(B) AOJ A, MOVEM A,IIIPC MOVEI A,1 MOVEM A,IIIFLG MOVEM A,IIISIZ ; SETZM IIIX ; Drawing prgm expects X and Y to be ; SETZM IIIY ; miraculously saved between PG's SETCMM TVPHAS(B) ;SCREEN IS NOW IN OTHER CLR/SET STATE MOVEM B,TVPG ;SAVE TO ALLOW THE SET UP OF THE CONSOLE REGISTER TVLUP: MOVEI A,TVSET DPB A,TVALU MOVE A,@IIIPC AOS IIIPC TRNE A,1 JRST TVCHR LDB B,[10300,,A] JRST @.+1(B) [ TRNE A,20 JRST TVJMP SETOM TVPURE ;WERE OUT OF IMPURE CODE NOW. POP P,E POP P,D POP P,C POP P,B POP P,A POPJ P,] TVSVW ; SHORT VECTOR TVJSR TVLVW ; LONG VECTOR TVILL TVTSS ;TEST AND SKIP TVRESTORE TVILL ; III LONG VECTOR TVLVW: LDB B,[IIISBP,,A] ;LONG VECTOR (IN A) SKIPE B MOVEM B,IIISIZ LDB B,[IIIXBP,,A] LDB D,[IIIYBP,,A] TRNE B,2000 ORCMI B,3777 ;EXTEND SIGN TRNE D,2000 ORCMI D,3777 TRNE A,100 JRST [ SUB B,IIIX SUB D,IIIY SUBI D,1000-TVV ;MAKE ACTUAL TOP OF SCREEN APPEAR AS 1000 JRST .+1] PUSHJ P,TVREL EDGECK: MOVEI A,40 ; Edge overflow flag SKIPL XOFF SKIPGE YOFF IORM A,IIIFLG JRST TVLUP TVREL: LDB E,[40200,,A] ;type JRST @TVDISP(E) TVDISP: TVVECT ;VISIBLE VECTOR TVPOINT ;END POINT TVINVIS ;INVISIBLE TVPOINT TVPOINT: TDZA E,E TVINVIS: SETO E, ADDB B,IIIX ADDB D,IIIY SETZM XOFF ;ASSUME X,Y ARE ON SCREEN SETZM YOFF CAML B,[-TVW] CAIL B,TVW SETOB E,XOFF ;X IS OFF CAML D,[-TVV] CAIL D,TVV SETOB E,YOFF ;Y IS OFF JUMPN E,CPOPJ ;invisible or off screen MOVNS D ;LOWER PART OF SCREEN IS HIGHER IN CORE ADDI D,TVV ;OFFSET SO 0,0 IS IN MIDDLE LSH D,-1 ;2 III PTS 1 TV PT IMULI D,18. ; 18 WDS PER TV LINE ADDI B,TVW IDIVI B,32.*2 ;CONVERT X TO WORD, BIT # (*2) ADD D,B ; WORD ADDRESSED MOVE E,TVBIT(C) XORM E,TVBUF(D) POPJ P, TVVECT: JUMPE B,TVVERT ;X DELTA=0, TRY ALL VERTICAL VECTOR JUMPE D,TVHORZ ;Y DELTA=0 MOVEM B,DX ;NEITHER=0, DO HARD CASE BY DDA MOVEM D,DY SKIPL E,XOFF MOVE E,YOFF ; REMEMBER IF STARTING PT IS OFF SCREEN SETZM XOFF SETZM YOFF ADD B,IIIX ADD D,IIIY CAML B,[-TVW] ; IS END POINT OFF?? CAIL B,TVW SETOB E,XOFF CAML D,[-TVV] CAIL D,TVV SETOB E,YOFF EXCH B,IIIX ; update x,y EXCH D,IIIY JUMPL E,CPOPJ ADDI B,TVW IDIVI B,32.*2 MOVNS D ADDI D,TVV ASH D,-1 IMULI D,18. ADD D,B MOVE E,TVBIT(C) MOVM A,DX MOVM B,DY CAMGE A,B ;x is major axis?? JRST STEPY HRLZS B ;dda rate has binary point in 2.9 IDIV B,A ; dy/dx MOVEM B,RATE MOVM B,DX ;iteration count ASH B,-1 ;< ;III PTS -> TV PTS MOVEI A,200000 ;dda accumulator starts at 1/4 VX: SKIPGE DX JRST [ ROT E,1 ;step x axis TRNN E,17 JRST VX1 MOVEI E,20 soja d,VX1] ROT E,-1 TRNN E,17 JRST VX1 AOJ D, MOVSI E,400000 VX1: ADD A,RATE SKIPGE DY JRST [ TLZE A,1 ;step -y ADDI D,18. XORM E,TVBUF(D) ; trne a,400000 ; xorm e,tvbuf+18.(d) SOJG B,VX POPJ P,] TLZE A,1 SUBI D,18. XORM E,TVBUF(D) ; trne a,400000 ; xorm e,tvbuf-18.(d) SOJG B,VX POPJ P, ;Major axis of vector is Y STEPY: HRLZS A IDIV A,B ; dx/dy MOVEM A,RATE MOVM B,DY ASH B,-1 MOVEI A,200000 VY: SKIPGE DY ; step in y axis ADDI D,18. SKIPL DY SUBI D,18. ADD A,RATE SKIPL DX JRST VYRITE TLZN A,1 ;now step x if dda carried JRST VYR ROT E,1 TRNN E,17 ;bit wrapped past left edge? JRST VYR SOJ D, ; step to next word MOVEI E,20 VYR: XORM E,TVBUF(D) ; trnn a,400000 ; jrst vyr1 ; move c,e ; rot c,1 ; trne c,17 ; jrst [ movei c,20 ; xorm c,tvbuf-1(d) ; jrst vyr1] ; xorm c,tvbuf(d) VYR1: SOJG B,VY POPJ P, VYRITE: TLZN A,1 ;minor axis (x) steps right JRST VYL ROT E,-1 TRNN E,17 JRST VYL AOJ D, MOVSI E,400000 VYL: XORM E,TVBUF(D) ; trnn a,400000 ; jrst vyr1 ; move c,e ; rot c,-1 ; trne c,17 ; jrst [ movsi c,400000 ; xorm c,tvbuf+1(d) ; jrst vyr1] ; xorm c,tvbuf(d) JRST VYR1 ; Vector is horizontal only ; B = delta X TVHORZ: MOVE D,B ;d has delta x ADDB B,IIIX JUMPL D,[ MOVMS D JRST .+2] SUB B,D ;leftmost x ADDI B,TVW ;offset to center SETZM XOFF JUMPGE B,HON ;on screen ADD D,B ;will we get on during vector JUMPL D,TVXOFF ;nope SETZ B, HON: CAIL B,TVW*2 JRST TVXOFF SKIPGE YOFF POPJ P, MOVEI C,TVW*2-1 SUB C,B ;steps to right edge CAMLE D,C SETOM XOFF CAMLE D,C MOVE D,C ;only step up to right edge IDIVI B,32.*2 ;iii pointswords,bits*2 MOVN E,IIIY ADDI E,TVV LSH E,-1 IMULI E,18. ADD B,E MOVE E,C ADD E,D ;delta+bit position CAIGE E,32.*2 JRST [ MOVE E,TVMASK(E) ;fits in one word ANDCA E,TVMASK(C) ;mask off bits beyond right edge of vector XORM E,TVBUF(B) POPJ P,] MOVE C,TVMASK(C) XORM C,TVBUF(B) MOVNI D,20 ;all ones to tv11 TVH1: SUBI E,32.*2 CAIL E,32.*2 JRST [ XORM D,TVBUF+1(B) AOJA B,TVH1] SETCM C,TVMASK(E) ;left over bits TRZ C,17 XORM C,TVBUF+1(B) POPJ P, ; vector is strictly vertical ; D = delta Y TVVERT: SKIPN B,D POPJ P, ADDB B,IIIY JUMPL D,[MOVNS D ;b now has small of pair of points ADD B,D ;get what will eventually be topmost point JRST .+1] MOVNS B ;make +y the top of the screen ADDI B,TVV SETZM YOFF JUMPGE B,VON ADD D,B JUMPL D,TVYOFF SETZ B, VON: CAIL B,TVV*2 JRST TVYOFF SKIPGE XOFF POPJ P, MOVEI C,TVV*2-1 SUB C,B CAMLE D,C SETOM YOFF ;will run off CAML D,C MOVE D,C MOVE E,B ;y position LSH E,-1 IMULI E,18. ; " in words MOVE B,IIIX ADDI B,TVW IDIVI B,32.*2 ADD B,E ASH D,-1 MOVE C,TVBIT(C) XORM C,TVBUF(B) ADDI B,18. SOJG D,.-2 POPJ P, ; displays word of packed ascii TVCHR: MOVE C,TVPG ;THE PIECE OF GLASS WE'RE PROCESSING MOVEI B,TVOR SKIPGE TVMODE(C) ; CAN WE JUST WRITE CHARACTERS IN SOLID?? MOVEI B,TVXOR ; NO, WE'LL HAVE TO ERASE SOMETIME DPB B,TVALU ; setup character store instructions HRRZ B,IIISIZ HLRZ B,STAB(B) ;real iii character spacing CAIN B,10 ; typical scale (which is too small!) MOVEI B,6*2 ;best we can do for now MOVEM B,TVSTEP HRRZ A,IIIPC SOJ A, HRLI A,440700 TVCHRL: ILDB B,A JUMPE B,TVCH3 CAIN B,15 JRST [ MOVNI B,-TVW ;reset to left edge MOVEM B,IIIX SETZM XOFF JRST TVCH1] CAIN B,12 JRST [ HRRZ C,IIISIZ HRRZ B,STAB(C) ;vertical spacing in this size MOVNS B ADDB B,IIIY CAMGE B,[-TVV] SETOM YOFF JRST TVCH1] SKIPL YOFF SKIPGE XOFF JRST TVCH1 IMULI B,5. ;font entries are 5 words each HRLI B,-5. MOVE C,IIIX ADDI C,TVW IDIVI C,32.*2 ; horizontal C=word, D=bit*2 MOVN E,IIIY ; III coordinates ADDI E,TVV-8.*2 ; line address*2, offset up to top line of char SKIPGE E ;character might not quite fit at the top SETZ E, ;why not gronk it down a little ASH E,-1 ; line number for top of character CAML E,tvbot1 ; is top of character just down in echo area? JRST TVCH1 ; yes, don't display ; but otherwise the bottom line will probably fit too IMULI E,18. ; word address for line that will have top of char ADD C,E ; add in address within line MOVNS D ; bits to right that character is offset (*2) ASH D,-1 SUBI D,4 ;extra 4 shifts to close gap at low end of word HRRM D,TVLSH ;shift character right by x bit position TVCH2: MOVE D,FONT(B) ; LH first row, RH second row TRZ D,-1 SETZ E, LSHC D,@TVLSH LSH D,4 ; caile c,-2 ; jrst .+3 ;character off screen MOVEM D,TVBUF(C) ;either XORM or IORM MOVEM E,TVBUF+1(C) HRLZ D,FONT(B) SETZ E, LSHC D,@TVLSH LSH D,4 ADDI C,18. ; caile c,-2 ; jrst .+3 ;character off screen MOVEM D,TVBUF(C) MOVEM E,TVBUF+1(C) ADDI C,18. AOBJN B,TVCH2 TVCH1: SETZM XOFF MOVE B,TVSTEP ADDB B,IIIX CAML B,[-TVW] CAIL B,TVW SETOM XOFF TVCH3: TLNE A,760000 JRST TVCHRL JRST TVLUP ; III short vector word TVSVW: PUSH P,A ;SAFE PLACE LDB B,[350700,,A] LDB D,[260700,,A] TRNE B,100 ORCMI B,77 TRNE D,100 ORCMI D,77 LDB E,[240200,,A] PUSHJ P,@TVDISP(E) POP P,A LDB B,[150700,,A] LDB D,[60700,,A] TRNE B,100 ORCMI B,77 TRNE D,100 ORCMI D,77 PUSHJ P,TVREL JRST EDGECK ; III test and skip TVTSS: PUSHJ P,TV.TSS ;TEST SKIP JRST TVLUP TVILL: .lose ; III restore instruction TVRESTORE: HLRZ C,A MOVE C,(C) LDB B,[IIIFBP,,C] TRNE A,20 ;RESTORE FLAGS? MOVEM B,IIIFLG TRNN A,40 ;restore x,y JRST TVLUP MOVE A,C ;look like vector TRO A,146 ;absolute invis JRST TVLVW ; III SAVE instruction TVSAV: SETZ C, MOVE B,IIIX DPB B,[IIIXBP,,C] MOVE B,IIIY DPB B,[IIIYBP,,C] MOVE B,IIISIZ DPB B,[IIISBP,,C] MOVE B,IIIFLG DPB B,[IIIFBP,,C] TRO C,1 ;make into a safe dpy wrd (character) HLRZ B,A MOVEM C,(B) JRST TVLUP ; III jsr TVJSR: TRNE A,40 ;save = 64 JRST TVSAV HLRZ B,A HRLZ C,IIIPC TRO C,20 MOVEM C,(B) JRST TVLUP ; III jmp TVJMP: HLRZM A,IIIPC JRST TVLUP ; Clear screen, erase PGlass ZEROS: BLOCK 4*18. CLRTV: SYSCLV SCML,[TTYICH ? 1000,,0] ; RESET TO 0 ECHO LINES TVCLR: PUSH P,A PUSH P,B SETOM INBLNK SETOM TVFRSH ; NEED TO UPDATE ALL PGLASS NOW SETZM TVPHAS ; ALL PG'S ARE IN CLEAR MODE NOW. MOVE A,[TVPHAS,,TVPHAS+1] BLT A,TVPHAS+PGLEN-1 MOVEI A,TVBUF TVCLR1: MOVE B,A HRLI B,ZEROS BLT B,4*18.-1(A) ADDI A,4*18. camge a,tvbot2 ; don't clear bottom echo area JRST TVCLR1 POP P,B JRST POPAJ TVERASE: SETOM INBLNK ;STOP BLINKER, FOR GOD'S SAKE SKIPL TVFRSH ;ALREADY CLEARED WHOLE SCREEN SKIPN IIIPG(B) POPJ P, SKIPL TVMODE(B) ; AN XOR TYPE PGLASS?? JRST TVCLR SKIPE TVPHAS(B) ; AND FORTUNATELY NOW IN CLEAR STATE JRST TVSIM ; HAVE TO WIPE IT OUT POPJ P, ; SERENDIPITY TVXOFF: SETOM XOFF POPJ P, TVYOFF: SETOM YOFF POPJ P, TVPOS: SETZ B, SKIPGE IIIPOS ;PPaper in top half?? SYSCLV SCML,[TTYICH ? CNECHO] ; SET NUMBER OF ECHO LINES POPJ P, storage impure cnecho: necho ; Number of echo lines tvbotm==*10.+8. ; leave echo lines and who line tvbot1: tvv-tvbotm ; tv bottom value #1 tvbot2: tvbuf+* storage pure TVTYO: CAIN A,20 ; CHECK FOR ^P LOSSAGE JRST [ PUSHJ P,STVTYO MOVEI A,120 JRST STVTYO] STVTYO: SYSCLV IOT,[TTYOCH ? A ? 5000,,400] POPJ P, TVI==<-1,,777760> TVII==TVI TVMASK: REPEAT 40,[ TVI TVI TVI==&TVII ] TVI==<400000,,0> TVBIT: REPEAT 40,[ TVI TVI TVI==TVI_-1 ] ; TV font tables - !!! Note that this is the Stanford character set !!! font: 000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,000000 ; 0 000000,,100000?100000,,100000?100000,,520000?340000,,100000?000000,,000000 ;  000000,,000000?000000,,320000?440000,,440000?440000,,320000?000000,,000000 ;  000000,,000000?000000,,340000?420000,,740000?420000,,740000?400000,,400000 ; 3 000000,,000000?000000,,100000?240000,,420000?000000,,000000?000000,,000000 ;  000000,,000000?000000,,000000?760000,,020000?000000,,000000?000000,,000000 ;  000000,,000000?000000,,140000?200000,,340000?200000,,140000?000000,,000000 ;  000000,,000000?000000,,760000?240000,,240000?240000,,240000?000000,,000000 ;  ;10 000000,,000000?400000,,400000?200000,,100000?240000,,420000?000000,,000000 ; 10 700000,,200000?200000,,200000?000000,,140000?120000,,140000?120000,,140000 ; 11 400000,,400000?400000,,700000?000000,,160000?100000,,140000?100000,,000000 ; 12 500000,,500000?500000,,200000?000000,,160000?040000,,040000?040000,,000000 ; v.t. ;000000,,100000?340000,,520000?100000,,100000?100000,,100000?000000,,000000 ; 000000,,100000?100000,,760000?100000,,100000?760000,,000000?000000,,000000 ; 14 340000,,400000?400000,,340000?000000,,340000?220000,,340000?220000,,220000 ; 15 000000,,000000?000000,,240000?520000,,520000?240000,,000000?000000,,000000 ;  000000,,300000?040000,,020000?360000,,420000?420000,,340000?000000,,000000 ;  ;20 000000,,000000?360000,,400000?400000,,400000?360000,,000000?000000,,000000 ;  000000,,000000?740000,,020000?020000,,020000?740000,,000000?000000,,000000 ;  000000,,000000?340000,,420000?420000,,420000?000000,,000000?000000,,000000 ;  000000,,000000?420000,,420000?420000,,340000?000000,,000000?000000,,000000 ;  000000,,420000?420000,,760000?420000,,240000?240000,,100000?000000,,000000 ;  000000,,760000?020000,,020000?360000,,020000?020000,,760000?000000,,000000 ;  000000,,000000?340000,,660000?520000,,660000?340000,,000000?000000,,000000 ;  000000,,100000?040000,,760000?040000,,100000?200000,,760000?200000,,100000 ;  ;30 000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,760000 ; _ ;000000,,000000?100000,,200000?760000,,200000?100000,,000000?000000,,000000 ;  000000,,000000?100000,,040000?760000,,040000?100000,,000000?000000,,000000 ;  320000,,540000?000000,,000000?000000,,000000?000000,,000000?000000,,000000 ; TILDA ;000000,,020000?040000,,760000?100000,,760000?200000,,400000?000000,,000000 ;  000000,,020000?040000,,760000?100000,,760000?200000,,400000?000000,,000000 ;  ;000000,,100000?100000,,240000?420000,,240000?100000,,100000?000000,,000000 ;  000000,,040000?100000,,200000?100000,,040000?000000,,340000?000000,,000000 ;  000000,,200000?100000,,040000?100000,,200000?000000,,340000?000000,,000000 ;  000000,,000000?760000,,000000?760000,,000000?760000,,000000?000000,,000000 ;  000000,,000000?000000,,420000?240000,,100000?000000,,000000?000000,,000000 ;  ;40 000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,000000 ; 000000,,100000?100000,,100000?100000,,100000?000000,,100000?000000,,000000 ; ! 240000,,240000?240000,,000000?000000,,000000?000000,,000000?000000,,000000 ; " 000000,,000000?240000,,760000?240000,,240000?760000,,240000?000000,,000000 ; # 100000,,340000?520000,,500000?340000,,120000?520000,,340000?100000,,000000 ; $ 000000,,760000?620000,,040000?100000,,200000?460000,,460000?000000,,000000 ; % 000000,,200000?500000,,500000?200000,,520000?440000,,320000?000000,,000000 ; & 300000,,300000?600000,,000000?000000,,000000?000000,,000000?000000,,000000 ; ' ;50 000000,,020000?040000,,100000?100000,,100000?040000,,020000?000000,,000000 ; ( 000000,,400000?200000,,100000?100000,,100000?200000,,400000?000000,,000000 ; ) 000000,,100000?520000,,340000?100000,,340000?520000,,100000?000000,,000000 ; * 000000,,000000?100000,,100000?760000,,100000?100000,,000000?000000,,000000 ; + 000000,,000000?000000,,000000?000000,,000000?300000,,300000?600000,,000000 ; , 000000,,000000?000000,,000000?760000,,000000?000000,,000000?000000,,000000 ; - 000000,,000000?000000,,000000?000000,,000000?300000,,300000?000000,,000000 ; . 000000,,000000?020000,,040000?100000,,200000?400000,,000000?000000,,000000 ; / ;60 000000,,340000?420000,,460000?520000,,620000?420000,,340000?000000,,000000 ; 0 000000,,100000?300000,,100000?100000,,100000?100000,,340000?000000,,000000 ; 1 000000,,340000?420000,,020000?040000,,100000?200000,,760000?000000,,000000 ; 2 000000,,340000?420000,,020000?140000,,020000?420000,,340000?000000,,000000 ; 3 000000,,040000?140000,,240000?440000,,760000?040000,,040000?000000,,000000 ; 4 000000,,760000?400000,,740000?020000,,020000?420000,,340000?000000,,000000 ; 5 000000,,140000?200000,,400000?740000,,420000?420000,,340000?000000,,000000 ; 6 000000,,760000?020000,,040000?040000,,100000?100000,,100000?000000,,000000 ; 7 ;70 000000,,340000?420000,,420000?340000,,420000?420000,,340000?000000,,000000 ; 8 000000,,340000?420000,,420000?360000,,020000?040000,,300000?000000,,000000 ; 9 000000,,000000?000000,,300000?300000,,000000?300000,,300000?000000,,000000 ; : 000000,,000000?000000,,300000?300000,,000000?300000,,300000?600000,,000000 ; ; 000000,,000000?040000,,100000?200000,,100000?040000,,000000?000000,,000000 ; < 000000,,000000?000000,,760000?000000,,760000?000000,,000000?000000,,000000 ; = 000000,,000000?200000,,100000?040000,,100000?200000,,000000?000000,,000000 ; > 000000,,340000?420000,,040000?100000,,100000?000000,,100000?000000,,000000 ; ? ;100 000000,,340000?420000,,560000?520000,,560000?400000,,340000?000000,,000000 ; @ 000000,,340000?420000,,420000?760000,,420000?420000,,420000?000000,,000000 ; A 000000,,740000?420000,,420000?740000,,420000?420000,,740000?000000,,000000 ; B 000000,,340000?420000,,400000?400000,,400000?420000,,340000?000000,,000000 ; C 000000,,740000?220000,,220000?220000,,220000?220000,,740000?000000,,000000 ; D 000000,,760000?400000,,400000?740000,,400000?400000,,760000?000000,,000000 ; E 000000,,760000?400000,,400000?740000,,400000?400000,,400000?000000,,000000 ; F 000000,,340000?420000,,400000?400000,,460000?420000,,340000?000000,,000000 ; G ;110 000000,,420000?420000,,420000?760000,,420000?420000,,420000?000000,,000000 ; H 000000,,340000?100000,,100000?100000,,100000?100000,,340000?000000,,000000 ; I 000000,,020000?020000,,020000?020000,,020000?420000,,340000?000000,,000000 ; J 000000,,420000?440000,,500000?600000,,500000?440000,,420000?000000,,000000 ; K 000000,,400000?400000,,400000?400000,,400000?400000,,760000?000000,,000000 ; L 000000,,420000?660000,,520000?420000,,420000?420000,,420000?000000,,000000 ; M 000000,,420000?420000,,620000?520000,,460000?420000,,420000?000000,,000000 ; N 000000,,340000?420000,,420000?420000,,420000?420000,,340000?000000,,000000 ; O ;120 000000,,740000?420000,,420000?740000,,400000?400000,,400000?000000,,000000 ; P 000000,,340000?420000,,420000?420000,,520000?440000,,320000?000000,,000000 ; Q 000000,,740000?420000,,420000?740000,,500000?440000,,420000?000000,,000000 ; R 000000,,340000?420000,,400000?340000,,020000?420000,,340000?000000,,000000 ; S 000000,,760000?100000,,100000?100000,,100000?100000,,100000?000000,,000000 ; T 000000,,420000?420000,,420000?420000,,420000?420000,,340000?000000,,000000 ; U 000000,,420000?420000,,420000?420000,,240000?240000,,100000?000000,,000000 ; V 000000,,420000?420000,,420000?420000,,520000?660000,,420000?000000,,000000 ; W ;130 000000,,420000?420000,,240000?100000,,240000?420000,,420000?000000,,000000 ; X 000000,,420000?420000,,240000?100000,,100000?100000,,100000?000000,,000000 ; Y 000000,,760000?020000,,040000?760000,,200000?400000,,760000?000000,,000000 ; Z 160000,,100000?100000,,100000?100000,,100000?100000,,100000?160000,,000000 ; [ 000000,,000000?400000,,200000?100000,,040000?020000,,000000?000000,,000000 ; \ 700000,,100000?100000,,100000?100000,,100000?100000,,100000?700000,,000000 ; ] 000000,,100000?340000,,520000?100000,,100000?100000,,100000?000000,,000000 ; ;100000,,240000?420000,,000000?000000,,000000?000000,,000000?000000,,000000 ; ^ 000000,,000000?100000,,200000?760000,,200000?100000,,000000?000000,,000000 ;  ;000000,,000000?000000,,000000?000000,,000000?000000,,000000?000000,,760000 ; _ ;140 140000,,140000?060000,,000000?000000,,000000?000000,,000000?000000,,000000 ; ` 000000,,000000?000000,,340000?020000,,360000?420000,,360000?000000,,000000 ; a 000000,,400000?400000,,740000?420000,,420000?420000,,740000?000000,,000000 ; b 000000,,000000?000000,,340000?420000,,400000?400000,,360000?000000,,000000 ; c 000000,,020000?020000,,360000?420000,,420000?420000,,360000?000000,,000000 ; d 000000,,000000?000000,,340000?420000,,740000?400000,,340000?000000,,000000 ; e 000000,,140000?220000,,200000?700000,,200000?200000,,200000?000000,,000000 ; f 000000,,000000?000000,,340000?420000,,420000?420000,,360000?020000,,340000 ; g ;150 000000,,400000?400000,,740000?420000,,420000?420000,,420000?000000,,000000 ; h 000000,,000000?100000,,000000?100000,,100000?100000,,100000?000000,,000000 ; i 000000,,000000?020000,,000000?020000,,020000?020000,,020000?420000,,340000 ; j 000000,,400000?400000,,420000?440000,,700000?440000,,420000?000000,,000000 ; k 000000,,100000?100000,,100000?100000,,100000?100000,,100000?000000,,000000 ; l 000000,,000000?000000,,640000?520000,,520000?520000,,520000?000000,,000000 ; m 000000,,000000?000000,,540000?620000,,420000?420000,,420000?000000,,000000 ; n 000000,,000000?000000,,340000?420000,,420000?420000,,340000?000000,,000000 ; o ;160 000000,,000000?000000,,740000?420000,,420000?420000,,740000?400000,,400000 ; p 000000,,000000?000000,,340000?420000,,420000?420000,,360000?020000,,020000 ; q 000000,,000000?000000,,540000?620000,,400000?400000,,400000?000000,,000000 ; r 000000,,000000?000000,,360000?400000,,340000?020000,,740000?000000,,000000 ; s 000000,,100000?100000,,760000?100000,,100000?100000,,060000?000000,,000000 ; t 000000,,000000?000000,,420000?420000,,420000?420000,,340000?000000,,000000 ; u 000000,,000000?000000,,420000?420000,,420000?240000,,100000?000000,,000000 ; v 000000,,000000?000000,,420000?420000,,520000?520000,,240000?000000,,000000 ; w ;170 000000,,000000?000000,,420000?240000,,100000?240000,,420000?000000,,000000 ; x 000000,,000000?000000,,420000?420000,,420000?240000,,100000?200000,,400000 ; y 000000,,000000?000000,,760000?040000,,340000?200000,,760000?000000,,000000 ; z 020000,,040000?040000,,040000?100000,,040000?040000,,040000?020000,,000000 ; { 100000,,100000?100000,,100000?100000,,100000?100000,,100000?100000,,100000 ; | 000000,,100000?100000,,240000?420000,,240000?100000,,100000?000000,,000000 ;  ;400000,,200000?200000,,200000?100000,,200000?200000,,200000?400000,,000000 ; } 400000,,200000?200000,,200000?100000,,200000?200000,,200000?400000,,000000 ; CLOSE BRACE ;320000,,540000?000000,,000000?000000,,000000?000000,,000000?000000,,000000 ; TILDA 760000,,760000?760000,,760000?760000,,760000?760000,,760000?760000,,760000 ; 177 subttl 340 Display Routines ;HANDY MACROS DEFINE DLWORD(MODE,LITPEN,STOP,SCALE,INTENS) <.BYTE -18.,-2,3,2,2,-2,3,4 MODE+0 ? LITPEN+0 ? STOP+0 ? SCALE+0 ? INTENS+0>TERMIN DEFINE DLPOINT(POS,MODE,LITPEN,INTENS,COORD) <.BYTE -18.,-1,1,3,2,1,10. POS+0 ? MODE+0 ? LITPEN+0 ? INTENS+0 ? COORD+0>TERMIN ;INITIALIZE ALL VARIABLES CONCERNED WITH PIECES OF PAPER CHR340: MOVEI C,3 ;TEST FOR CHARACTER CAMN C,DLMODE JRST CHR1 ;ALREADY IN CHARACTER MODE PUSHJ P,GETPAR ;GET 340 INTO PARAMETER MODE MOVEM C,DLMODE ;ENTER CHARACTER MODE MOVE A,IIISIZ MOVE A,SIZTAB(A) PUSHJ P,ADBYTE ;REFLECT IT IN DISPLAY LIST PUSHJ P,DCHSET ;SET UP BUFFER POINTERS FOR CHARACTER MODE SETOM DCHCAS ;START WITH SHIFT IN MOVEI A,35 PUSHJ P,DCHPT1 CHR1: PUSHJ P,CHRSET CHR2: ILDB A,IIIBP ;CHARACTER SKIPE A PUSHJ P,DCHPUT ;MAP ASCII TO 340 CODE AND SALT AWAY SOJG B,CHR2 POPJ P, DCHOUT: PUSH P,A PUSHJ P,DCHP1 SKIPE DCHCAS ;BELL MEANS UNPRINTABLE CONTROL CHARACTER JRST POPAJ ;CAN'T BE BELL, WRONG CASE LDB A,DCHBP ;THE CHARACTER WE JUST WROTE CAIE A,63 JRST POPAJ ;ITS NOT BELL!! POP P,A TDZ A,[-1,,777600] ADDI A,100 ;MAKE IT UPPER CASE JRST DCHP1 ;DISPLAY AND RETURN ;HERE TO SALT AWAT AN ASCII CHARACTER INTO 340 DISPLAY LIST DCHPUT: CAIN A,11 POPJ P, ;TAB DOES NOTHING PUSHJ P,CHRPOS ;UPDATE CURSOR POSITION DCHP1: PUSHJ P,DCHMAP ;MAP CHARACTER, DOES CASE SHIFTING DCHPT1: IDPB A,DCHBP SOSLE DCHCNT POPJ P, DCHSET: MOVE A,DLPC ;SET UP CHARACTER BYTE POINTER MOVEM A,DCHBP MOVEI A,6 DPB A,[300600,,DCHBP] ;SWITCH TO 6 BIT BYTES MOVEI A,3 ;CHARACTER COUNTER FOR HALF WORD MOVEM A,DCHCNT MOVEI A,373737 ;ESCAPE FROM CHARACTER MODE JRST ADBYTE DCHMAP: TDZ A,[-1,,777600] ;CLEAR THOSE RANDOM BITS TRZE A,100 ;TAKES ASCII IN A AND RETURNS 340 CODE SKIPA A,CTAB(A) MOVS A,CTAB(A) ;CONTROL CHARACTER TRNE A,200 POPJ P, ;DON'T CARE ABOUT CASE SKIPE DCHCAS ;SKIPS ON SHIFT OUT JRST [ TRNE A,100 ;ALREADY SHIFT IN POPJ P, ;YES PUSH P,[36] ;SWITCH TO SHIFT OUT JRST DCHM1] TRNN A,100 POPJ P, ;ALREADY SHIFT OUT PUSH P,[35] ;SWITCH TO SHIFT IN DCHM1: SETCMM DCHCAS ;SWITCH CASE EXCH A,(P) ;SHIFT CODE PUSHJ P,DCHPT1 ;OUTPUT THE SHIFT CODE JRST POPAJ ;OUT GOES THE CHARACTER CODE ;CTAB INDEXED BY 6 LOW ORDER BITS OF CHARACTER ;TABLE ENTRY: CONTROL,,NON-CONTROL ;1.7 SHIFT IN=1, SHIFT OUT=0 ;1.8 DON'T CARE=1 CTAB: 0,,100 ;NULL,,@ 50,,101 ;DOWN ARROW,,A 63,,102 ;ALPHA(BELL),,B 63,,103 ;BETA(BELL),,C 41,,104 ;AND,,D 43,,105 ;NOT,,E 63,,106 ;EPSILON(BELL),,F 63,,107 ;PI(BELL),,G 63,,110 ;LAMBDA(BELL),,H 240,,111 ;TAB(NOTHING),,I 233,,112 ;LF,,J 0,,113 ;VT(NOTHING),,K 0,,114 ;FF(NOTHING),,L 234,,115 ;CR,,M 57,,116 ;INF(CENTER DOT),,N 63,,117 ;DELTA(BELL),,O 45,,120 ;SUBSET,,P 44,,121 ;SUPERSET,,Q 63,,122 ;INTERSECTION(BELL),,R 63,,123 ;UNION(BELL),,S 63,,124 ;FOR ALL(BELL),,T 63,,125 ;THERE EXISTS(BELL),,U 63,,126 ;XOR(BELL),,V 63,,127 ;SWAP(BELL),,W 60,,130 ;_,,X 47,,131 ;FORWARD,,Y 43,,132 ;TILDE,,Z 63,,53 ;NEQ(BELL),,[ 63,,52 ;LEQ(BELL,,\ 63,,54 ;GEQ(BELL),,] 63,,46 ;EQUIV(BELL),,^ 42,,51 ;OR,,_ 240,,66 ;SPACE,,ACCENT GRAVE REPEAT 32,140+.RPCNT,,.RPCNT 173,,55 ;;,,OPEN CURLY 174,,62 ;LESS THAN,,VERTICAL BAR 175,,56 ;=,,CLOSE CURLY 176,,43 ;GREATER THAN,,TILDE 177,,52 ;?,,\ SIZTAB: REPEAT 5, DLWORD(3,0,0,5,17) REPEAT 2, DLWORD(3,0,0,6,17) DLWORD(3,0,0,7,17) PPFR34: SETZM DLPP SETZM DLPP6 MOVEI A,*2 MOVEM A,PPFBYT MOVEI A,PPHDL*2 MOVEM PPBCNT MOVE A,[222200,,PPBLK+PPHDL] MOVEM A,PPPC MOVE A,[000600,,PPBLK+PPHDL-1] MOVEM A,PPCHBP MOVEI A,3 MOVEM A,PCHCNT SETZM PCHCAS SETZM GLTFUL SETZM GLTLF MOVEI A,4 MOVEM A,PPGLSZ MOVEI A,5 MOVEM A,PPGLTS MOVEI A,1777 ;TOP OF SCREEN IN 340 COORDINATES MOVEM A,PPORG SETZM PPBLK MOVE A,[PPBLK,,PPBLK+1] BLT A,PPBLK+PPBKL-1 PUSHJ P,DPYP1 MOVEI A,333436 ;CR, LF, SHIFT OUT HRRM A,PPBLK+PPHDL-1 MOVSI A,373737 MOVEM A,PPBLK+PPHDL MOVE A,[-PPHDL-1,,PPBLK-1] ;BLKO POINTER TO PPBLK MOVEM A,DLPP MOVEM A,DLPP6 POPJ P, ;TTY OUTPUT GOES TO 340 DEFINE SWAPB(VAR1,VAR2) EXCH A,VAR1 EXCH A,VAR2 EXCH A,VAR1 TERMIN PPTY34: PUSH P,B PUSH P,A PUSHJ P,TTYOFF PUSHJ P,SWPGPP PUSHJ P,DCHOUT MOVE A,(P) TRZ A,600 ;CLEAR OUT THE GARBAGE CAIN A,12 PUSHJ P,PPLF POP P,A HRRZ B,DLPC ;LAST ACTIVE WORD IN BUFFER SUBI B,PPBLK-1 ;NUMBER OF ACTIVE WORDS IN BUFFER MOVNS B HRLI B,PPBLK-1 MOVSM B,DLPP ;BLKO POINTER TO PPBLK MOVSM B,DLPP6 POP P,B PUSHJ P,SWPGPP JRST TTYON SWPGPP: SWAPB(PPFBYT,DLFBYT) SWAPB(PPBCNT,DLBCNT) SWAPB(PPPC,DLPC) SWAPB(PPCHBP,DCHBP) SWAPB(PCHCNT,DCHCNT) SWAPB(PCHCAS,DCHCAS) POPJ P, PPLF: AOS B,GLTLF CAMGE B,PPGLSZ POPJ P, ;MORE LINES LEFT IN GLITCH SETZM DLPP ;DON'T DISPLAY TEXT FOR A WHILE SETZM DLPP6 SETZB A,GLTLF PUSHJ P,DCHP1 PPLF1: MOVEI A,0 HLRZ B,DCHBP CAIE B,600 JRST [ PUSHJ P,DCHP1 ;ALIGN GLITCHES ON FULLWORD WITH SHIFT OUT JRST PPLF1] AOS B,GLTFUL CAMGE B,PPGLTS POPJ P, ;STILL UNFILLED GLITCHES MOVE B,[600,,PPBLK+PPHDL-1] MOVEI C,0 PPLF2: ILDB A,B ;FLUSH THE FIRST GLITCH CAIE A,33 ;LINE FEED JRST PPLF2 ADDI C,1 CAMGE C,PPGLSZ ;END OF GLITCH? JRST PPLF2 ;NO ILDB A,B CAIE A,0 ILDB A,B CAIE A,0 .lose ;glitch must end with lf (so) 0 ADDI B,1 ;POINTS TO BEGINNING OF NEXT GLITCH HRLI B,PPBLK+PPHDL MOVS A,B ;SOURCE,,DESTINATION HRRZ C,B SUBI C,@DLPC MOVNS C MOVEI D,PPBLK+PPHDL(C) ;DESTINATION OF BLT HLRZ C,B SUBI C,(B) ADDM C,DCHBP ;UPDATE BYTE POINTERS ADDM C,DLPC ASH C,1 ;HALF WORDS ADDM C,DLBCNT MOVNS C ;MAKE C POSITIVE ADDM C,DLFBYT BLT A,(D) ;ZAP ADDI D,1 ;POINTS TO FIRST FREE WORD OF BUFFER SETZM (D) ;ZERO THE REST OF THE BUFFER HRLI D,1(D) MOVSS D BLT D,PPBLK+PPBKL-1 POPJ P, DPYP1: MOVE A,[DLWORD(1,0,0,5,17)] HRLM A,PPBLK MOVE A,[DLPOINT(0,1,0,0,0)] HRRM A,PPBLK DPYP2: MOVE A,[DLPOINT(1,3,0,0,0)] IOR A,PPORG HRLM A,PPBLK+1 POPJ P, CLR340: SETZM DLSIZE ;INITIALIZE 340 VARIABLES SETZM DLPG MOVE A,[DLPG,,DLPG+1] BLT A,DLPG+PGPPLN-1 ;CLEAR 340 PIECES OF GLASS POPJ P, INT340: HRRZ A,DLBFP SUBI A,1 HRLI A,002200 MOVEM A,DLPC ;BYTE POINTER INTO 340 DISPLAY LIST SETZM DLMODE MOVE A,[DLWORD(1,0,0,4,17)] ;POINT MODE, SIZE 0, AND BRIGHTEST PUSHJ P,CENT0 ;CENTER BEAM POPJ P, END340: MOVEI A,0 ;340 NO-OP PUSHJ P,ADBYTE PUSHJ P,ADBYTE TRNE C,1 PUSHJ P,ADBYTE ;MAKE DISPLAY LIST END ON FULL WORD MOVE A,DLBCNT LSH A,-1 MOVEM A,DLBCNT POPJ P, ;HERE TO CENTER THE BEAM MOVEI A,1 CAMN A,DLMODE JRST CENT1 PUSHJ P,GETPAR MOVE A,[DLWORD(1,0,0,4,0)] CENT0: PUSHJ P,ADBYTE ;SET SCALE 0, AND ENTER POINT MODE AOS DLMODE ;SET POINT MODE CENT1: MOVE A,[DLPOINT(0,1,0,0,1000)] PUSHJ P,ADBYTE ;X MOVE A,[DLPOINT(1,1,0,0,1000)] JRST ADBYTE ;Y STP340: SETZM DLSTOP .DSTOP POPJ P, STRT34: SKIPE SIXSW JRST [ MOVE A,[DLPP,,DLPP6] ;WE GOT THE PDP-6, DON'T DSTART BLT A,DLPP6+PGPPLN-1 JRST FLASH3] SKIPN DISPSW POPJ P, ;DON'T HAVE THE 340 EITHER .DSTART DLVIS .VALUE [ASCIZ /: No 340  /] FLASH3: SETOM DLSTOP ;TELL INTERRUPT LEVEL DISPLAY STARTED POPJ P, GETPAR: PUSH P,A ;GETS 340 INTO PARAMETER MODE SKIPN A,DLMODE JRST POPAJ ;ALREADY IN PARAMETER MODE SETZM DLMODE CAIN A,4 ;VECTOR MODE TAKES CARE OF ITSELF JRST POPAJ CAIN A,3 JRST GETP1 ;ESCAPE FROM CHARACTER MODE CAIE A,1 ;MUST BE POINT MODE .lose ;got into random mode LDB A,DLPC TRZ A,20000 ;ESCAPE TO PARAMETER MODE DPB A,DLPC JRST POPAJ GETP1: PUSH P,D PUSH P,E MOVE D,IIIX MOVE E,IIIY PUSHJ P,ITOD MOVE A,[DLWORD(1,0,0,4,0)] PUSHJ P,ADBYTE MOVE A,[DLPOINT(0,1,0,0,0)] IOR A,E ;SET THE Y PUSHJ P,ADBYTE MOVE A,D ;SET THE X, GET INTO PARAMETER MODE PUSHJ P,ADBYTE POP P,E POP P,D JRST POPAJ SVW134: MOVEI A,1 ;SET POINT MODE CAMN A,DLMODE JRST SVW0 ;ALREADY IN POINT PUSHJ P,GETPAR ;GET INTO PARAMETER MODE MOVE A,[DLWORD(1,0,0,0,10)] IOR A,IIIBRT ;BRIGHTNESS AOS DLMODE PUSHJ P,ADBYTE ;ENTER POINT MODE SVW0: MOVE D,IIIX MOVE E,IIIY PUSHJ P,ITOD ;CONVERT X AND Y TO 340 COORDINATES MOVE A,[DLPOINT(1,1,0,0,0)] IOR A,E PUSHJ P,ADBYTE ;FIRST THE Y CAIE B,1 SKIPA A,[DLPOINT(0,1,0,0,0)] ;INVISIBLE MOVE A,[DLPOINT(0,1,0,1,0)] ;VISIBLE IOR A,D SVW5: PUSHJ P,ADBYTE ;NOW THE X JRST POPAJ ;HERE TO DRAW VECTOR SVW234: MOVEI A,4 CAME A,DLMODE JRST [ PUSHJ P,GETPAR MOVEM A,DLMODE ;ENTER VECTOR MODE MOVE A,[DLWORD(4,0,0,4,10)] IOR A,IIIBRT PUSHJ P,ADBYTE JRST SVW4] LDB A,DLPC ;ALREADY IN VECTOR MODE TRZ A,400000 ;CLEAR ESCAPE BIT DPB A,DLPC SVW4: MOVEI A,200 ;SIGN BIT PUSHJ P,SGNMAG MOVE A,D DPB E,[101000,,A] TRO A,600000 ;TURN ON ESCAPE FROM MODE AND INTENSITY BITS JRST SVW5 ;DIVIDE AND CONQUER FOR VECTORS TOO LONG FOR 340 LVW234: SETZB A,C TRNE D,1 MOVEI A,1 TRNE E,1 MOVEI C,1 ASH D,-1 ASH E,-1 ADD A,D ADD C,E PUSH P,A PUSH P,C PUSHJ P,LVW1 POP P,E POP P,D JRST LVW1 subttl GT40 Routines ;GT40 OPCODES DPYJMP==160000 DPYNOP==164000 DPYSTP==173400 ;STOP DISPLAY AND CAUSE INTERRUPT DPYJSR==DPYSTP+1 ;CALL DPY SUBROUTINE DPYRTS==DPYSTP+2 ;RETURN FROM DPY SUBROUTINE SETPNT==114000 RPOINT==130000 SVWGT==104000 LVWGT==110000 CHARS==100000 DPYNRM==3724 ;NORMAL SET GRAPHIC MODE BITS ; INTENSITY 7 ; NO LIGHT PEN ; NO BLINK ; NO ITALICS ; SOLID LINE DBLINK==10 ; YES BLINK (IF ENABLED) STSNRM=171640 ;NORMAL A REGISTER SETTINGS ; ENABLE STOP INTERRUPTS ; DISABLE LIGHT PEN INTERRUPTS SYNC==4 ; SYNCS DPU WITH CLOCK ITALICS==20 ; CAUSE ITALICS LITEPN==200 ; ENABLE LIGHT PEN INTERRUPTS ESCHR==20 ;ESCAPE FROM CHARACTER MODE (^P) SESCHR==206 ;ESCAPE FOR LISP DISPLAY SLAVE FOR SIMLACS LODER==0 ;ENTER LODER XTRA==6 ;EXTRA BYTES IN BLOCK (SIZE, PIECE OF GLASS, CHECKSUM) BLKMRK==1 ;MARKS BEGINNING OF BLOCK DELBLK==2 ;LIST OF PIECES OF GLASS TO BE DELETED %BOOTJ==232 ; A SPECIAL IMLAC CODE WHICH NEEDES TO BE QUOTED. CHRGT: MOVEI C,3 CAMN C,DLMODE JRST CHRG1 MOVEM C,DLMODE MOVEI A,CHARS PUSHJ P,ADBYTE PUSHJ P,SETCBP ;SET CHARACTER BYTE POINTERS SETOM DCHCAS MOVEI A,17 ;SHIFT IN PUSHJ P,GCHP1 CHRG1: PUSHJ P,CHRSET ;SET TO READ 5 CHARACTERS FROM III INSTRUCTION CHRG2: ILDB A,IIIBP SKIPE A PUSHJ P,GCHPUT SOJG B,CHRG2 POPJ P, SETCBP: SETZM DCHCNT ;INITIALIZE CHARACTER VARIABLES MOVE C,DLPC MOVEI A,10 ;SWITCH TO 8 BIT BYTE SIZE DPB A,[300600,,C] MOVEM C,DCHBP ;FOR HIGH ORDER PDP11 BYTES IBP C ;LOSING GT40 MOVEM C,DCHBP+1 ;FOR LOW ORDER PDP11 BYTES POPJ P, GCHPUT: PUSHJ P,CHRPOS ;SALT AWAY CHARACTER INTO GT40 DISPLAY LIST PUSHJ P,GCHMAP ;DO THE BEST WE CAN FOR CONTROL CHARACTERS GCHP1: SOSL C,DCHCNT JRST GCHP2 PUSH P,A MOVEI A,0 PUSHJ P,ADBYTE MOVNS C,DCHCNT POP P,A GCHP2: IDPB A,DCHBP(C) IBP DCHBP(C) ;LOSING GT40 POPJ P, ;TRY TO MAP CONTROL CHARACTERS TO SOMETHING REASONABLE IN THE GT40 SET ; WE CAN'T ALWAYS WIN AND SOME SUBSTITUTIONS ARE VERY ARBITRARY! GCHMAP: TDZ A,[-1,,777600] ;ONLY 7 LOW ORDER BITS MOVNI C,1 ;ASSUME WE WANT SHIFT IN CAIL A,40 JRST GCHM1 ;YES, ITS UPPER CASE TRNE A,1 SKIPA D,CTAB40(A) MOVS D,CTAB40(A) HRRES D JUMPL D,GCHM1 ;ITS REALLY SHIFT IN MOVEI C,0 MOVE D,A GCHM1: CAMN C,DCHCAS POPJ P, PUSH P,A MOVEM C,DCHCAS MOVE A,1+[ 17 ;SHIFT IN 16](C) ;SHIFT OUT PUSHJ P,GCHP1 JRST POPAJ CTAB40: -1,,31 ;MAGIC 1,, 4 13,,33 25,,20 0,,-1 -1,,-1 -1,,-1 22,, 5 6,, 7 10,,11 32,,12 2,,24 26,,27 35,,34 15,,16 14,,36 ;HERE FOR SET POINT SVW1GT: PUSHJ P,LVWCHK JRST SVW1G0 ;RELATIVE SET POINT SUFFICES SVW1G5: MOVEI A,1 CAMN A,DLMODE JRST SVW1G1 MOVEM A,DLMODE MOVEI A,SETPNT PUSHJ P,ADBYTE SVW1G1: MOVE D,IIIX MOVE E,IIIY PUSHJ P,ITOD ;CONVERT TO GT40 COORDINATES MOVE A,D CAIN B,1 LVW2G2: IORI A,40000 ;MAKE VISIBLE PUSHJ P,ADBYTE MOVE A,E SVW1G3: PUSHJ P,ADBYTE JRST POPAJ ;HERE FOR RELATIVE SET POINT SVW1G0: MOVEI A,7 CAMN A,DLMODE JRST SVW1G4 EXCH A,DLMODE CAIN A,3 ;CHECK FOR CHARACTER MODE JRST SVW1G5 ;AND DO ABSOLUTE SET POINT IF NECESSARY MOVEI A,RPOINT PUSHJ P,ADBYTE SVW1G4: MOVEI A,100 ;SIGN BIT PUSHJ P,SGNMAG ;COMVERT TO SIGN MAGNITUDE MOVE A,D LSH A,7 IOR A,E CAIN B,1 IORI A,40000 ;VISIBLE JRST SVW1G3 ;HERE FOR SHORT VECTOR (III) SVW2GT: PUSHJ P,LVWCHK CAIA ;SHORT GT40 VECTOR SUFFICES JRST LVW2G0 MOVEI B,1 ;MAKES IT VISIBLE MOVEI A,4 CAMN A,DLMODE JRST SVW1G4 MOVEM A,DLMODE MOVEI A,SVWGT PUSHJ P,ADBYTE JRST SVW1G4 ;HERE FOR LONG VECTOR LVW2GT: ADDM D,IIIX ADDM E,IIIY LVW2G0: MOVEI A,5 CAMN A,DLMODE JRST LVW2G1 MOVEM A,DLMODE MOVEI A,LVWGT PUSHJ P,ADBYTE LVW2G1: MOVEI A,20000 PUSHJ P,SGNMAG MOVE A,D PUSH P,A ;RETURNS WITH A POPAJ JRST LVW2G2 ;INITIALIZE GT40 DISPLAY LIST POINTERS INTGT: MOVEI A,1 MOVEM A,DLMODE PUSHJ P,INTGT1 MOVEI A,SETPNT CAMN B,PGBLNK IORI A,DPYNRM+DBLINK ;BLINK IT PUSHJ P,ADBYTE MOVEI A,1000 PUSHJ P,ADBYTE JRST ADBYTE INTGT1: HRRZ A,DLBFP SUBI A,1 HRLI A,042000 MOVEM A,DLPC POPJ P, CLRGT: SYSCLV SCML,[TTYICH ? 1000,,0] JRST PPFRGT ;HERE TO SEND DISPLAY LIST TO GT40 OVER TTY, B HAS PIECE OF GLASS ENDGT: PUSH P,B ;PIECE OF GLASS CAMN B,PGBLNK JRST [ MOVEI A,CHARS+DPYNRM ;TURN OFF BLINKING PUSHJ P,ADBYTE JRST .+1] MOVEI A,DPYRTS PUSHJ P,ADBYTE PUSHJ P,INTGT1 ;SET UP THAT BYTE POINTER AGAIN PUSHJ P,SETCBP PUSHJ P,TTYOFF ;DON'T WANT SPURIOUS ECHO CHARACTERS MOVEI E,BLKMRK PUSHJ P,SETLOD ;SEND OUT ESCAPE TO ABSOLUTE LOADER, AND HEADER MOVE D,DLBCNT ASH D,1 ;# PDP11 BYTES PUSHJ P,GSWRD JUMPG D,.-1 MOVN A,E ;CHECKSUM MOVEM A,CKS ;FOR DEBUGGING PUSHJ P,PUTWRD PUSHJ P,FPUT ;PUSH OUT BUFFER AND PAD MOVE A,DLBCNT ;RETURN # PDP10 WORDS IN DISPLAY LIST ASH A,-1 MOVEM A,DLBCNT POP P,B ;PIECE OF GLASS JRST TTYON ;HERE TO ENTER LOADER AND SEND HEADER SETLOD: PUSH P,B ;PIECE OF GLASS PUSHJ P,SETBUF ;SET UP BUFFER POINTERS MOVEI A,ESCHR SKIPE GTYPE MOVEI A,SESCHR PUSHJ P,PUTCH1 MOVEI A,LODER PUSHJ P,PUTCHR MOVEI A,0 ;INITIALIZE CHECKSUM EXCH A,E PUSHJ P,PUTWRD MOVE A,DLBCNT ASH A,1 ;# PDP11 BYTES ADDI A,XTRA PUSHJ P,PUTWRD POP P,A JRST PUTWRD ;OUT GOES PIECE OF GLASS # ;READ 2 EIGHT BIT BYTES. PACK INTO 6 4 6 FORMAT FOR GT40'S AND OLD IMLACS. ;SET UP A BYTE BUFFER FOR SIOT GSWRD: PUSHJ P,GETBYT ANDI A,377 LSHC A,-44 SOSLE D PUSHJ P,GETBYT ;DON'T GET BYTE UNLESS THERE IS ON THERE SOS D AOSE A ;SKIPS ON END OF BLOCK SOS A ;GET IT BACK LSH A,10 ADDB A,B PUTWRD: MOVE B,A LSH A,-10 ;CHECK SUM FIRST ANDI A,377 ADD E,A MOVE A,B ANDI A,377 ADD E,A ; SKIPE GTYPE ; JRST PUT8 ; USE 8 BIT FORMAT ANDI A,77 ;NOW PUT OUT 3 CHARACTERS PUSHJ P,PUTCHR MOVE A,B LSH A,-6 ANDI A,17 PUSHJ P,PUTCHR MOVE A,B LSH A,-12 ANDI A,77 PUTCHR: IORI A,100 PUTCH1: IDPB A,TYOBP SOSLE TYOCNT POPJ P, MOVE A,TYOSIZ MOVEM A,DSPCNT MOVE A,TYOBP0 JRST DSPTYO PUT8: PUSHJ P,PUT8Q MOVE A,B LSH A,-10 ANDI A,377 PUSHJ P,PUT8Q POPJ P, PUT8Q: PUSH P,B CAIN A,%TDORS ; CHECK FOR CODES WHICH GET HANDLED BY SIMLAC WHICH JRST PUT8Q1 ; NEED TO BE QUOTED. CAIN A,%BOOTJ JRST PUT8Q1 CAIN A,%TDQOT JRST PUT8Q1 CAIGE A,%8BMAX ; CHECK FOR CODES 375 AND GREATER JRST PUT8Q2 MOVEI B,%8BMAX ; CONVENTION IS 375 QUOTES NEXT CHAR WHICH IS PUSHJ P,PUTCHQ ; 375-1+&3 SUBI A,%8BMAX AOJ A, JRST PUT8Q2 PUT8Q1: MOVEI B,%TDQOT ; QUOTE SPECIAL CODES PUSHJ P,PUTCHQ PUT8Q2: POP P,B JRST PUTCH1 PUTCHQ: PUSH P,A MOVE A,TYOCNT ; MAKE SURE THERE IS ENOUGH SPACE FOR TWO CODES CAIN A, 1 PUSHJ P,FPUT ; NO, FORCE BUFFER FIRST MOVE A,B PUSHJ P,PUTCH1 POP P,A POPJ P, SETBUF: MOVE A,TYORTL IMULI A,4 MOVEM A,TYOCNT MOVEM A,TYOSIZ MOVE A,[441000,,TYOBUF] MOVEM A,TYOBP0 MOVEM A,TYOBP POPJ P, FPUT: MOVE A,TYOSIZ SUB A,TYOCNT MOVEM A,DSPCNT MOVE A,TYOBP0 DSPTYO: SYSCLV SIOT,[DSPCH ? 5000,,400 ? A ? DSPCNT ] JRST SETBUF GETBYT: SOSGE C,DCHCNT JRST [ MOVNS C MOVEM C,DCHCNT JRST .+1] SOSGE DLPC JRST [ MOVNI A,1 POPJ P,] ILDB A,DCHBP(C) IBP DCHBP(C) POPJ P, ;HERE TO DELETE A PIECE OF GLASS DELIGT: PUSHJ P,TTYOFF SETZM DLBCNT MOVEI E,DELBLK ;BLOCK TYPE PUSHJ P,SETLOD MOVN A,E MOVEM A,CKS PUSHJ P,PUTWRD PUSHJ P,FPUT ; FORCE THE CRUFT OUT JRST TTYON ;ODDS AND ENDS PPFRGT: MOVEI A,20 ; CLEAR MAIN PROGRAM AREA PUSHJ P,STYO MOVEI A,103 PUSHJ P,STYO MOVEI A,20 ; HOME DOWN IN MAIN PROGRAM AREA PUSHJ P,STYO MOVEI A,132 PUSHJ P,STYO MOVEI A,20 ; ^PC CLEAR ECHO AREA PUSHJ P,STVTYO MOVEI A,103 JRST STVTYO SIZGT: POPJ P, POSGT==TVPOS PPTYGT==TVTYO STRTGT: POPJ P, .INSRT DECBOT LITTER: CONSTA STORAGE(IMPURE) VARS:: VARIABLES PAT: PATCH: BLOCK 100 PATCHE: 0 DEFINE REPORT STRING,VALUE PRINTX /STRING VALUE /TERMIN ;VARIABLES PERTAINING TO III SIMULATION. ;THEY GO AT THE END OF IMPURE SPACE TO REDUCE THE WORKING SET SIZE ;WHEN III SIMULATION IS NOT IN USE. ;VARIABLES WHICH DESCRIBE STATE OF 340 DLMODE: 0 ;MODE OF OPERATION ;0 PARAMETER ;1 POINT ;3 CHARACTER ;4 VECTOR ;5 VECTOR CONTINUE ;6 INCREMENT ;7 RELATIVE POINT DLSIZE: 0 ;SIZE DLINT: 0 ;INTENSITY DLFBYT: 0 ;NUMBER OF FREE BYTES LEFT IN DISPLAY LIST DLBCNT: 0 ;NUMBER OF BYTES IN DISPLAY LIST DLPC: 0 ;BYTE POINTER TO LAST BYTE IN DISPLAY LIST DLLIST: BLOCK PGPPLN ;340 DISPLAY CHAIN DLPP: 0 ;BLKO POINTER TO ACTIVE PIECE OF PAPER (MUST PRECEDE DLP6) DLPG: BLOCK PGPPLN ;340 PAGE POINTERS (BLKO FORMAT) DLBFP: 0 ;POINTER TO DISPLAY BUFFER DLBFL: 0 ;DISPLAY BUFFER SIZE DCHCAS: 0 ;CHARACTER MODE CASE ;0=SHIFT OUT, -1=SHIFT IN DCHCNT: 0 ;NUMBER FREE CHARACTERS LEFT IN THIS DISPLAY BYTE DCHBP: BLOCK 2 ;BYTE POINTER TO LAST CHARACTER IN DISPLAY LIST PGSG: 0 ;-1=PIECE OF GLASS SORTED LIST INVALID, ELSE # ENTRIES PGSORT: BLOCK PGPPLN ;PIECE OF GLASS SORTED LIST ;PIECE GLASS #,,POINTER TO 340 DISPLAY LIST-1 DPYTYP: 0 ;DPY TYPE WE ARE RUNNING WITH SIXSW: 0 ;-1=WE HAVE THE PDP-6 DISPSW: 0 ;-1=ITS RUNNING THE DISPLAY ;VARIABLES WHICH DESCRIBE STATE OF III DISPLAY IIIPC: 0 ;PROGRAM COUNTER IIIX: 0 ;CURRENT X IIIY: 0 ;CURRENT Y IIIBRT: 0 ;BRIGHTNESS ;1 DIMMEST, 7 BRIGHTEST IIISIZ: 0 ;CHARACTER SIZE ;1 SMALLEST, 7 LARGEST IIIFLG: 1 ;FLAG REGISTER ;1.8 CONTROL BIT ;1.7 LIGHT PEN FLAG ;1.6 EDGE OVERFLOW FLAG ;1.5 WRAP AROUND FLAG ;1.4 WRAP AROUND MASK ;1.3 LIGHT PEN MASK ;1.2 EDGE OVERFLOW MASK ;1.1 RUNNING FLAG (ALWAYS 1) IIIPG: BLOCK PGPPLN ;PIECES OF GLASS MAP(LENGTH,,FIRST WORD) ;IIIPG: PTRS TO EACH BLOCK OF STORAGE ASSOCIATED WITH A PIECE OF GLASS ;BLOCK-- -LENGTH OF III PRGM,,. ;(MAY BE OTHER THAN . IF NEEDS RELOCATION) ; ; IIIUPG: BLOCK PGLEN ;ORIGIN OF USER DISPLAY LIST IIIBP: 0 ;BYTE POINTER FOR CHARACTER MODE IIIPOS: 0 ; III PIECE OF PAPER VERTICAL POSITION ;VARIABLES USED BY TV VECTOR ROUTINES XOFF: 0 ;OFF SCREEN IN X YOFF: 0 ; " IN Y TVSTEP: 0 ;HORIZ STEP PER CHARACTER DX: 0 ;III DELTA X DY: 0 ;DELTA Y RATE: 0 ;DDA RATE WORD, BINARY POINT 2.9 TVLSH: LSHC D,. ; SHIFT FOR CHARACTER MODE TVPHAS: BLOCK PGLEN ; PHASE OF BLINKER, 0 MEANS PGLASS CLEAR NOW TVBLNK: BLOCK PGLEN ; THIS PG BLINKS IF -1 TVMODE: -1 ; 0 CURSOR -1 ; 1 FOLLOWING ANGLES -1 ; 2 B P S L -1 ; 3 BLINKER PAGE REPEAT 20+TVMODE-.,0 ;-1 IF THIS PGlass CAN BE ERASED BY XORING ;ELSE, SCREEN NEEDS TO BE CLEARED. TVFRSH: 0 ;-1 IF REDISPLAY NEEDED BECAUSE OF CLEAR DONE TVPURE: 0 ;0 IF IN TVSIM, -1 OTHERWISE (IMPURE BUGHALT) TVPG: 400000 ;PIECE OF GLASS WHILE PROCESSING UPGIOT ;PIECE OF PAPER VARIABLES PPFBYT: 0 ;NUMBER OF FREE HALF WORDS IN PPBLK PPBCNT: 0 ;NUMBER OF HALF WORDS IN PPBLK PPPC: 0 ;BYTE POINTER TO LAST HALF WORD IN PPBLK PPCHBP: 0 ;BYTE PONITER TO LAST DISPLAY CHARACTER IN PPBLK PCHCNT: 0 ;NUMBER FREE CHARACTERS LEFT IN CURRENT HALFWORD PCHCAS: 0 ;CHARACTER CASE CURPP: 0 ;CURRENTLY SELECTED PIECE OF PAPER PPGLSZ: 0 ;NUMBER LINES/GLITCH PPGLTS: 0 ;NUMBER GLITCHES PPORG: 0 ;TOP OF PIECE OF PAPER IN 340 COORDINATES GLTFUL: 0 ;NUMBER OF FILLED GLITHCES GLTLF: 0 ;NUMBER OF LINES IN THIS GLITCH SO FAR ;VARIABLES USED BY THE GT40 ROUTINES TYOBFL==3000 ;OUTPUT BUFFER LENGTH %8BMAX==375 ; MAX 8 BIT CODE CKS: 0 ;CHECKSUM SENT ON LAST BLOCK TYOCNT: 0 ;TYO BUFFER BYTE COUNTER TYOSIZ: 0 ; TYO BUFFER SIZE IN BYTES DSPCNT: 0 ; COUNT OF BYTES TO SIOT TYOBP0: 0 ; INITIAL VALUE OF TYOBP USED BY SIOT TYOBP: 0 ;BYTE POINTER INTO TYOBUF TYORTL: TYOBFL ;USED TO MAKE SIZE OF BUFFER SMALLER AT RUN TIME GTYPE: 0 ; -1 IF SIMLAC, ELSE GT40 OR ORDINARY IMLAC ;THIS SHOULD BE THE VERY LAST THING IN IMPURE SPACE, ;SINCE IT'S SO BIG AND SO RARELY USED. TYOBUF: BLOCK TYOBFL ;GT40 TYPEOUT BUFFER. TWO,[ DIRTY==<.-IMPURE+1777>/2000 STORAGE(PURE) CLEAN==<.-PURE+1777>/2000 REPORT Impure Pages =,\DIRTY REPORT Pure Pages =,\CLEAN ];TWO END GO