Trailing-Edge
-
PDP-10 Archives
-
BB-4172G-BM
-
4-sources/pat.mac
There are 35 other files named pat.mac in the archive. Click here to see a list.
;<4.UTILITIES>PAT.MAC.76, 3-Jan-80 15:26:37, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>PAT.MAC.75, 8-Nov-79 15:16:07, EDIT BY DBELL
;TCO 4.2568 - USE VARYING BYTESIZES FOR MAGTAPES SO EBCDIC TAPES WORK
;<4.UTILITIES>PAT.MAC.74, 7-Nov-79 10:51:17, EDIT BY DBELL
;TCO 4.2566 - GIVE GOOD ARGUMENT TO UFPGS SO FILOP FUNCTION 10 WORKS
;<4.UTILITIES>PAT.MAC.73, 27-Sep-79 13:51:36, EDIT BY DBELL
;TCO 4.2492 - MAKE MTCHR NOT FAIL IF THE MAGTAPE HAPPENS TO NOT BE OPEN
;<EKLUND>PAT.MAC.2, 10-Sep-79 16:28:22, EDIT BY EKLUND
;TCO 4.2451 - MAKE STACK SANE AGAIN ON QUOTA EXCEEDED INTERRUPTS
;<4.UTILITIES>PAT.MAC.71, 4-Sep-79 14:02:42, EDIT BY DBELL
;TCO 4.2437 - MAKE READ BACKWARDS WORK FOR MAGTAPES
;<EKLUND>PAT.MAC.7, 4-Sep-79 09:57:05, EDIT BY EKLUND
;TCO # 4.2435 v4(334) make REWIND of spooled card file work reasonably
;<4.UTILITIES>PAT.MAC.68, 8-Aug-79 10:42:33, EDIT BY HELLIWELL
;DON'T MOUNT DECTAPE UNLESS MUST GET JFN IN MTAPE CODE
;<YODER>PAT.MAC.2, 26-Jul-79 17:10:10, EDIT BY YODER
;TCO # 4.2350 v4(332) fix edit 331, which broke NUL:
;<4.UTILITIES>PAT.MAC.65, 15-Jun-79 13:45:29, EDIT BY YODER
;TCO # 4.2290 v4(331) make DIRCHK give non-skip return for NUL:
;<4.UTILITIES>PAT.MAC.64, 13-Jun-79 15:20:34, EDIT BY R.ACE
;[EDIT ON BEHALF OF STAN WHITLOCK]
;TCO # 4.2285 v4(327) make GETLCH return correct line characteristics, not 0
;<4.UTILITIES>PAT.MAC.63, 23-Apr-79 11:51:16, EDIT BY WHITLOCK
;TCO # 4.2239 v4(326) make MTCHR. return record length in LH of AC
;<4.UTILITIES>PAT.MAC.62, 1-Apr-79 21:03:35, EDIT BY GILBERT
;TCO 4.2231 v4(325) Reserve pages 764 up for DDT. Define MAXPAT==764000.
;<4.UTILITIES>PAT.MAC.61, 12-Mar-79 14:09:48, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>PAT.MAC.60, 2-Mar-79 16:26:39, EDIT BY MILLER
;TCO 4.2201. REMOVE CODE ADDED IN RELEASE 2 TO FIX MTA POSITIONING OPS
;<WHITLOCK..PA1050>PAT.MAC.59, 1-Mar-79 08:45:43, EDIT BY WHITLOCK
;TCO # 4.2200 v4(324) make edit 322 work with edit 320
;<WHITLOCK..PA1050>PAT.MAC.58, 26-Feb-79 13:06:29, EDIT BY WHITLOCK
;TCO # 4.2199 V4(323) make BREAK key act like 2 ^C if user is trapping ^C
;<WHITLOCK..PA1050>PAT.MAC.57, 26-Feb-79 12:13:55, EDIT BY WHITLOCK
;TCO # 4.2198 V4(322) speed up OUTSTR - use SOUT instead of BOUT loop
;<WHITLOCK..PA1050>PAT.MAC.56, 26-Feb-79 11:44:22, EDIT BY WHITLOCK
;TCO # 4.2197 v4(321) restore user's SFMOD on CONTinue
;<WHITLOCK..PA1050>PAT.MAC.55, 22-Feb-79 16:53:36, EDIT BY WHITLOCK
;TCO # 4.2196 v4(320) disable control char translation on TTY output
;<4.UTILITIES>PAT.MAC.54, 2-Feb-79 14:15:22, EDIT BY ALUSIC
;TCO # 4.2182 V4(317) ISSUE ERROR MSG AND HALT ON CHN 11 INT IF NOT UUO @IOERR
;<4.UTILITIES>PAT.MAC.53, 23-Jan-79 15:02:38, EDIT BY ALUSIC
;TCO # 4.2169 V4(316) FIX TRMOP FUNCTIONS .TONFC AND .TOWID AT TONFCS & TOWIDR.
;<4.UTILITIES>PAT.MAC.52, 27-Dec-78 11:59:42, EDIT BY HELLIWELL
;TCO # 4.2133 V4(315) FIX BUG IN REMAP WHEN MOVING CODE UP
;<4.UTILITIES>PAT.MAC.51, 13-Dec-78 14:47:28, EDIT BY ALUSIC
;TCO # 4.2121 V4(314) SET EOF POINTER TO REFLECT CORRECT # WDS AT MOVBUF+7
;<4.UTILITIES>PAT.MAC.50, 6-Dec-78 17:34:15, EDIT BY HURLEY
;FIX THE MISSING DATA ON THE "CREF" COMMAND. (EMPTY LISTINGS)
;MAKE UCL3 NOT CALL SETEOF IF THE DEVICE IS NOT A DISK (EG A LPT:)
;<4.UTILITIES>PAT.MAC.49, 17-Nov-78 17:18:47, EDIT BY HELLIWELL
;TCO # 4.2091 CHANGE "DSK:<SUBSYS>" TO "PS:<SUBSYS>"
;<4.UTILITIES>PAT.MAC.48, 17-Nov-78 09:52:29, EDIT BY ALUSIC
;TCO# 4.2090 SET USE BITS IN INPUT BUFFER HEADERS, FIXES FORTRAN MTA BACKSPACE
;<ALUSIC.SPR>PAT.MAC.1, 6-Nov-78 11:13:18, EDIT BY ALUSIC
;TCO# 4.2080 MAKE TTCL6 (GETLCH) RETURN 0 IF JOB IS DETACHED
;<4.UTILITIES>PAT.MAC.46, 29-Oct-78 14:13:03, EDIT BY HELLIWELL
;<4.UTILITIES>PAT.MAC.45, 29-Oct-78 13:13:44, EDIT BY HELLIWELL
;SOME MORE FIXES FOR HI SEG FREE POINTER OFF END OF HI SEG
;<4.UTILITIES>PAT.MAC.44, 29-Oct-78 12:32:43, EDIT BY HELLIWELL
;TCO 4.2073 ACCOUNT FOR HI SEG WITH LENGTH EXACT MULTIPLE OF PAGE DURING GETSEG
;<4.UTILITIES>PAT.MAC.43, 20-Oct-78 18:38:23, EDIT BY HELLIWELL
;TCO 4.2057 ADD GETTAB TABLE 100 FOR HI SEG ORIGIN ONLY.
;<4.UTILITIES>PAT.MAC.42, 19-Oct-78 11:00:22, EDIT BY ALUSIC
;TCO 4.2053 MAKE SLEEP WORK CORRECTLY-DELETE THIBR AT IOWAIT.
;<4.UTILITIES>PAT.MAC.41, 3-Oct-78 11:16:49, EDIT BY HURLEY
;TCO 4.2030 - CHANGE LINE FEED CCOC BITS TO BE 2 INSTEAD OF 3
;<4.UTILITIES>PAT.MAC.40, 21-Sep-78 10:36:37, EDIT BY HELLIWELL
;<4.UTILITIES>PAT.MAC.39, 21-Sep-78 10:29:59, EDIT BY HELLIWELL
;TCO # 4.2018 ADD GETTAB TABLE 5 (.GTKCT). RETURN RUNTIME * 20K
;<4.UTILITIES>PAT.MAC.38, 20-Sep-78 17:37:36, EDIT BY HELLIWELL
;TCO # 4.2017 DON'T COPY JOB DATA AREA TO HIGH SEG IF NOT WRITABLE
;<4.UTILITIES>PAT.MAC.37, 19-Sep-78 10:57:30, EDIT BY HELLIWELL
;TCO # 4.2014 IMPLEMENT GETTABS .GTRDV AND .GTRDI
;TCO # 4.2014 ADD CELLS LOWDEV AND LOWPPN AND MAKE SURE THEY ARE SETUP
;<4.UTILITIES>PAT.MAC.36, 23-Aug-78 08:12:34, EDIT BY MILLER
;CHANGE NAME OF .GTHSN TO GTHSNS
;<4.UTILITIES>PAT.MAC.35, 23-Aug-78 07:57:56, EDIT BY MILLER
;RESTORE TOPAGS AND TOPAGR TO THEIR OLD SELVES.
;<4.UTILITIES>PAT.MAC.34, 18-Aug-78 08:10:01, Edit by KONEN
;TCO 4.1987 - DON'T CLOBBER BYTE COUNT FOR NON-DISK FILES IN EXEC CLOSE
;<4.UTILITIES>PAT.MAC.33, 1-Aug-78 14:52:30, Edit by ALUSIC
;TCO #1964 CALL SETEOF AT UCL3+7 TO SET EOF IN FDB DURING CLOSE OUTPUT
;<4.UTILITIES>PAT.MAC.32, 27-Jul-78 08:09:39, EDIT BY MILLER
;MORE FIXES FOR XON/XOFF
;<4.UTILITIES>PAT.MAC.31, 26-Jul-78 18:51:42, EDIT BY MILLER
;CHANGE TOPAGR TO USE MTOPR TO FETCH THE BIT
;<4.UTILITIES>PAT.MAC.30, 26-Jul-78 18:40:51, EDIT BY MILLER
;CHANGE TOPAGS TO DO XON/XOFF PROPERLY
;<4.UTILITIES>PAT.MAC.23, 21-Jul-78 13:38:34, EDIT BY OSMAN
;CHECK .JIT20 (GETJI) INSTEAD OF LOOKING FOR /EXEC/
;<4.UTILITIES>PAT.MAC.22, 14-Jul-78 13:52:19, EDIT BY HURLEY
;FIXED IO ERROR INDICATION ON DATA ERRORS FROM THE DISK
;<3A.UTILITIES>PAT.MAC.18, 27-Jun-78 23:39:45, Edit by HELLIWELL
;<4.UTILITIES>PAT.MAC.20, 26-Jun-78 15:09:20, Edit by HELLIWELL
;SET TERMINAL MODE ON OPEN OF CONTROLLING TERMINAL
;<4.UTILITIES>PAT.MAC.19, 24-Apr-78 14:40:22, Edit by DBELL
;MAKE TMPBLK LARGER SO ENQ/DEQ CAN HAVE LARGER ARGUMENT BLOCKS
;<4.UTILITIES>PAT.MAC.18, 12-Apr-78 12:26:01, Edit by HELLIWELL
;FIX REMAP TO DEFAULT HI SEG ORIGIN PROPERLY
;<4.UTILITIES>PAT.MAC.17, 11-Apr-78 15:24:17, Edit by HELLIWELL
;ADD MISSING INSTRUCTION AT REMAP1+12
;<4.UTILITIES>PAT.MAC.16, 11-Apr-78 14:38:45, Edit by HELLIWELL
;FIX TYPO IN HI SEG ORIGIN EDIT
;<4.UTILITIES>PAT.MAC.15, 11-Apr-78 14:30:26, EDIT BY HURLEY
;TCO 1899 - FIX MAGTAPE BUFFER SIZE DEFAULTING TO USE JOB DEFAULTS
;<4.UTILITIES>PAT.MAC.14, 11-Apr-78 14:12:06, Edit by HELLIWELL
;FIX MANY BUGS HAVING TO DO WITH HI SEG ORIGIN, INCLUDING REWRITE OF REMAP UUO
;<4.UTILITIES>PAT.MAC.13, 7-Apr-78 16:49:20, EDIT BY HURLEY
;FIX TAPE REWINDS - BOT WAS NEVER BEING CLEARED AT GSTATS
;<4.UTILITIES>PAT.MAC.12, 7-Apr-78 12:37:46, Edit by HELLIWELL
;RETURN TO USER AFTER COMPTG (GTJFN) IF PARSE ONLY
;<4.UTILITIES>PAT.MAC.11, 7-Apr-78 11:27:15, Edit by HELLIWELL
;MUST COPY USER STRING TO STRNG1 BUFFER WHEN STPARS FAILS
;<4.UTILITIES>PAT.MAC.10, 6-Apr-78 16:06:44, Edit by HELLIWELL
;FIX COMPT. FUNCTION 3 TO REQUIRE 4 ARGS FOR PPN TO DIR (INCLUDES DEVICE)
;<4.UTILITIES>PAT.MAC.9, 6-Apr-78 15:38:48, Edit by HELLIWELL
;FIX COMPT. FUNCTION 2 (RENAME) TO REQUIRE ONLY 3 ARGS (2 MORE OPTIONAL)
;<4.UTILITIES>PAT.MAC.8, 6-Apr-78 14:29:40, Edit by HELLIWELL
;AT MTAPE7+6 MOUNT DECTAPE EVEN IF ALREADY HAVE JFN
;IN COMPTG, IF STPARS FAILS, USE USER'S ORIGINAL STRING INSTEAD OF GIVING ERROR RETURN
;IN COMPTG, AVOID DVCHR JSYS IF GJ%OFG ON FOR GTJFN (PARSE)
;UNLABLED EDIT:
;FIX SFMOD THAT USESE 770000 INSTEAD OF 170000
;<4.UTILITIES>PAT.MAC.5, 28-Feb-78 16:23:27, Edit by DBELL
;IMPLEMENT FUNCTION 10 OF FILOP. - UPDATE "RIBS"
;<4.UTILITIES>PAT.MAC.4, 28-Feb-78 15:55:57, Edit by BORCHEK
;fix enter returning error in wrong place
;<4.UTILITIES>PAT.MAC.3, 14-Feb-78 17:37:24, EDIT BY HURLEY
;CHANGED TM.ASC TO BE 1B29
;<4.UTILITIES>PAT.MAC.2, 29-Jan-78 18:09:54, Edit by BORCHEK
;DON'T SET INIT BIT FOR LPT AT DEVCHZ
;<4.UTILITIES>PAT.MAC.1, 23-Jan-78 12:01:39, EDIT BY HELLIWELL
;FIX PROTECTION TRANSLATION AT ULK2L, TEST FOR LEAST PROTECTION
;TTYSET NOW CALLED IN OPEN ROUTINE BECAUSE RFMOD CAN'T BE DONE UNTIL OPEN
TITLE PAT - 10/50 COMPATIBILITY FOR TOPS20
SEARCH MONSYM,MACSYM
IFNDEF .PSECT,<
.DIRECT .XTABM>
.GROUP==0 ;GROUP WHO LAST MODIFIED PROGRAM
.MAJOR==4 ;MAJOR VERSION NUMBER
.MINOR==0 ;MINOR VERSION LETTER
.EDIT==337 ;EDIT NUMBER
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
PATVER==:<BYTE (3).GROUP(9).MAJOR(6).MINOR(18).EDIT> ;EDIT NUMBER STORED IN PVLOC
SUBTTL DEFINITIONS AND ALLOCATION
COMMENT \
THIS CODE RESIDES IN A HIGH AREA OF USER CORE (CURRENTLY 700000).
IT IS LOADED FROM THE SSAVE FILE SYS:PA1050.EXE BY THE
MONITOR WHENEVER A FORK EXECUTES ITS FIRST 10/50 UUO (40-77, BUT NOT 0).
THE FIRST TIME, ENTRY IS VIA THE SECOND LOCATION OF THE ENTRY VECTOR.
THEREAFTER, 10/50 UUO'S RESULT IN AN IMMEDIATE TRANSFER TO
THIS CODE VIA THE FIRST LOCATION OF THE ENTRY VECTOR. WHEN
ANY 10/50 UUO IS EXECUTED, THE MONITOR MOVES LOCATION 40 TO
MONUUO (SPECIFIED BY FOURTH WORD OF ENTRY VECTOR), AND THE RETURN
PC TO MONUPC (SPECIFIED BY FIFTH WORD OF ENTRY VECTOR). THIS CODE
INTERPRETS THE UUO AND RETURNS DIRECTLY TO THE USER PROGRAM.
THIS CODE USES THREE OF THE RESERVED UUO'S (42-44) FOR INTERNAL
PURPOSES.
ASSEMBLY AND LOADING PROCEDURE:
@LOAD PAT
@START
@
THE START AFTER LOADING CAUSES THE CODE TO BE MOVED FROM ITS LOAD
LOCATION TO ITS RUNNING LOCATION IN HIGH CORE. THE SYMBOL
TABLE IS ALSO MOVED, AND THE POINTER ADJUSTED. AN SSAVE FILE
OF PAGES 700-777 SHOULD BE MADE TO BE USED FOR DEBUGGING.
TO PRODUCE THE SYSTEM FILE, START AT MAKEPF (MAKEPF$G). THIS WILL
WRITE A SSAVE FILE WITH WRITE PROTECTION INTO THE SPECIFIED FILE.
FOR DEBUGGING COMPATIBILITY PACKAGE, FIRST RESET, AND GET
THE TEN-50 PROGRAM TO BE USED FOR TESTING, IF ANY.
THEN, MERGE AN SSAVE FILE (WITH DDT AND SYMBOLS) OF THE
DEBUG VERSION OF PAT, TYPE DDT, THEN DEBUG$G TO SET UP THE
COMPATIBILITY VECTOR, PSI SYSTEM, AND TEMPORARY STORAGE.
\
SAMFRK==1 ;PAT IN SAME FORK WITH USER PROG
;THIS CODE AT PRESENT WILL NOT WORK FOR SAMFRK=0, BUT THERE ARE
;VESTIGES AND PARTIALLY IMPLEMENTED SECTIONS WHICH MAY BE MADE TO
;RUN THAT WAY SOME DAY. I.E., WITH PAT RUNNING THE 10/50 PROGRAM AS
;AN INFERIOR PROCESS.
;INTERNAL UUO'S
OPDEF CALL[40B8] ;10/50 CALL UUO
REPEAT 0,<
OPDEF UMOVE[42B8] ;NOTE - NOT COMPLETELY GENERAL.
OPDEF UMOVEM[43B8] ; E.G., CAN'T UMOVE TO EE,FF
OPDEF XCTUU[44B8] ;NOTE ALL XCT'S HAVE SAME OPCODE IF SAMFRK=1
OPDEF XCTUM[44B8]
OPDEF XCTMU[44B8]
>
DEFINE UMOVE (A,B)<
PUSHJ P,UXCT
MOVE A,B>
DEFINE UMOVEM (A,B)<
PUSHJ P,UXCT
MOVEM A,B>
DEFINE XCTUU (A)<
PUSHJ P,UXCT
A>
DEFINE XCTUM (A)<
PUSHJ P,UXCT
A>
DEFINE XCTMU (A)<
PUSHJ P,UXCT
A>
DEFINE XCTLB (A)<
PUSHJ P,LBXCT
A>
DEFINE XJSYS (INST) <
PUSHJ P,DOJSYS
INST>
DEFINE IJSYS (INST)<
JSP EE,INJSYS
INST>
;MACRO TO REFERENCE PAGE NUMBER WITHIN ADDRESS
DEFINE PAGEN (LOC)<POINT 9,LOC,26>
DEFINE TMSG (MSG)
< PUSHJ P,TMSGQ
XWD 440600,[SIXBIT @MSG/@]
>
IFNDEF FTSTAT,<FTSTAT==0> ;KEEP STATISTICS OF PA1050 USAGE
IFNDEF FTFILSER,<FTFILSER==0> ;USE FILSER FOR DEVICE DPA
MLON
SALL
;ACCUMULATOR DEFINITIONS
PF=0 ;PAT'S FLAG AC
A=1 ;FIRST AC'S ARE TEMPS AND JSYS ARGS
B=2
C=3
D=4
E=5
F=6
G=7
AA=10 ;CONTAINS DEVICE NUMBER DURING I/O UUO HANDLING
BB=11 ;HOLDS BASE OF I/O CHANNEL DATA BLOCK DURING ...
CC=12 ;HOLDS ADDRESS OF CURRENT RING BUFFER IN I/O
AC=13 ;AC NUMBER IN TEN-FIFTY UUO
CAC=14 ;CONTENTS OF THAT AC. LOADED ON ALL UUOS.
EE=15 ;EE AND FF ARE USED BY UMOVE AND UMOVEM WITHOUT SAVING
FF=16 ; IF USED, BE AWARE THAT THEY WILL BE CHANGED ON UMOVE'S
P=17
;FLAGS IN AC PF. LEFT HALF ARE PERMANENT (HOLD OVER USER PROG)
; RIGHT HALF ARE MEANINGFUL ONLY WITHIN A GIVEN UUO, CLEARED ON ENTRY
R.CLS==1 ;FLAG SET DURING CLOSE AND TESTED IN OUTPUT TO AVOID
;OUTPUTTING 0 LENGTH RECORDS.
R.DIRN==2 ;DIRECTION OF TRANSFER IN MTA, USET
R.RUNU==4 ;DISTINGUISH RUN UUO FROM GETSEG UUO
R.UEXT==10 ;EXTENDED LOOKUP OR ENTER FLAG
R.EXIT==20 ;ON FOR EXIT 1, ; OFF FOR EXIT 0, .
R.NOWC==40 ;DONT COMPUTE WORD COUNT FOR BUFFER. THERE IS DATA THERE
R.FERR==100 ;FATAL ERROR. PREVENTS PMAPPING PAT OUT OF EXISTANCE
R.KJFN==200 ;KEEP JFN IN CLOSE ROUTINE.
R.RHLT==400 ;RUN OR GETSEG UUO FOLLOWED BY HALT (DON'T RETURN)
R.SYS==1000 ;RUN UUO FROM SYS, SO DO SETNM
R.ENT==2000 ;DOING AN ENTER, SET PROTECTION FIELD
R.CMR==4000 ;CMRETN RETURN FOR STATISTICS GATHERING
R.CVF==10000 ;FLAG TO CAUSE CONTROL-V'S TO GO INTO ASCII STRINGS
R.CVC==20000 ;FLAG TO MARK THAT A PARTICULAR CHARACTER SHOULD BE QUOTED
R.EXP==40000 ;AN EXPUGE WAS DONE DURING THIS UUO, DONT DO ANOTHER
R.ILLJ==100000 ;DOING AN XJSYS, DONT TYPE ILL INST
R.SUIC==200000 ;COMMITTING SUICIDE
L.DBUG==1 ;DEBUGGING PAT ITSELF
L.ONCE==2 ;HAVE BEEN THRU ONCE CODE
L.INDF==4 ;INDICATE FF BY ^L REQUESTED AT EXEC LEVEL, SO DO SO.
L.GSTA==20 ;<SYSTEM>PA1050.STATISTICS WAS FOUND, DO GENERAL STATISTICS
L.LSTA==40 ;PA1050.STATISTICS WAS FOUND, DO LOCAL STATISTICS
L.FLSR==100 ;FILSER HAS BEEN LOADED INTO ADDRESS SPACE
L.TFA==200 ;TTY FORK FOR HIBERNATE IS NOW ACTIVE
L.NCCE==400 ;CONTROL-C CANNOT BE ENABLED
L.SMAL==1000 ;SMALL SYSTEM (LESS THAN 196K)
;CHARACTERS REFERENCED SYMBOLICALLY
C.CC==3 ;CONTROL-C CHARACTER
C.BELL==7 ;BELL CHARACTER
C.TAB==11 ;TAB
C.LF==12 ;LINE FEED
C.FF==14 ;FORMFEED CHARACTER
C.CR==15 ;CARRIAGE RETURN
C.EOF=="Z"-100 ;CONTROL-Z, END-OF-FILE FOR TTY
STDALT==33 ;10/50'S STANDARD ALTMODE CHARACTER
ALT1==175 ;NON-STANDARD ALTMODE
ALT2==176 ;ANOTHER NON-STANDARD ALTMODE
C.RTYP=="R"-100 ;RETYPE THE CURRENT LINE COMMAND
C.DELC==177 ;SINGLE-CHARACTER DELETE (RUBOUT)
C.DELL=="U"-100 ;LINE (BUFFER) DELETE (^U)
C.CNTV=="V"-100 ;CONTROL-V HARACTER FOR QUOTING
;DEVICE DESIGNATOR DEFINITIONS
DSK==0
DRM==1
MTA==2
DTA==3
PTR==4
PTP==5
DIS==6
LPT==7
CDR==10
CDP==11
TTY==12
PTY==13
NIL==15
PLT==17
;10/50 JOB AREA LOCATIONS
JOBPD1==45
JOBS41==122
.JBUUO=40
.JBERR=42
.JBREL=44
.JBDDT=74
.JBHSO=75
.JBPFI=114
.JBHRL=115
.JBSYM=116
.JBUSY=117
.JBSA=120
.JBFF=121
.JBREN=124
.JBAPR=125
.JBCNI=126
.JBTPC=127
.JBOPC=130
.JBCOR=133
.JBINT=134
.JBVER=137
.JBDA=140
.JBHSA==0
.JBH41==1
.JBHCR==2
.JBHRN==3
.JBHVR==4
.JBHNM==5
.JBHSM==6
; ==7
.JBHDA==10 ;NEEDED DURING ASSEMBLY
;FLAGS IN RH OF FLAGWD
IO.BIN==10 ;BINARY MODE
IO.FCS==100 ;FULL CHARACTER SET
IO.SUP==200 ;SUPPRESS ECHOING
IO.TEC==400 ;TRUTH IN ECHOING MODE
IO.IMP==400000 ;IO IMPROPER MODE
;FLAGS IN LH OF FLAGWD IN CHANNEL DATA TABLES (CHTABS)
RNDMF==1 ;FILE IS BEING READ RANDOMLY
MTABFS==1 ;MTA BUFFERS ARE SET UP
PTYCRF==2 ;LAST CHAR SENT TO PTY WAS A <CR>
MTALTW==2 ;LAST MAGTAPE TRANSFER WAS A WRITE
PTYCWF==4 ;PTY IS WAITING FOR ^C TO TAKE EFFECT
DTACLS==PTYCWF ;DTA JFN WAS CLOSED FOR ANOTHER CHANNEL TO RUN
MTADMS=PTYCWF ;DATA MODE WAS SET ON MTA
RDMFDF==10 ;READING MFD, SIMULATE WITH DIRST
RDUFDF==20 ;READING UFD, SIMULATE WITH GNJFN
UFDEOF==40 ;NO MORE FILES IN DIRECTORY DURING UFD SIMULATION
DTADMP==100 ;DTA HAS BEEN OPENED IN DUMP MODE
ENTERF==200
INBUFF==400
IOPENF==1000
LOOKPF==2000
OOPENF==4000
DTAMF==10000 ;DTA IS MOUNTED AND DIRECTORY WAS READ
MTARDB==DTAMF ;MAGTAPE READS ARE BACKWARDS
OUTBFF==20000
INFIRF==40000
OUFIRF==100000
INITF==200000
;FLAGS IN LH OF TYSTAT AND LH OF FLAGWD FOR TTY'S ONLY
TT.BIN==PTYCRF ;TTY IS IN BINARY MODE FLAG
TT.CTY==PTYCWF ;TTY IS CONTROLING TTY FOR THIS JOB
TT.ALT==RDMFDF ;USER WANTS NO ALT MODE CONVERSION
TT.GAG==RDUFDF ;DONT TYPE MESSAGES TO USER TTY
TT.XON==UFDEOF ;TTY IN TAPE MODE, NO LF AFTER CR
TT.BKE==DTADMP ;TTY BREAK ON EVERYTHING
;TTY MODE DEFINITIONS
TM.ECH==3B25 ;ECHO FIELD
TM.IOD==2B25 ;IMMEDIATE OR DEFERRED MODE
TM.WAK==17B23 ;ALL TTY WAKE BITS
TM.BKE==17B23 ;BREAK ON EVERYTHING
TM.FWK==14B23 ;FORMAT CONTROLS WAKE
TM.FCS==14B23 ;FORMAT AND NON-FORMAT CONTROLS
TM.GAG==1B26!1B27 ;ADVISE AND LINK
TM.ASC==1B29 ;ASCII OR BINARY
TM.ATE==3B29 ;(320) disable translation on output
;FLAGS FOR DEVICE CHARACTERISTICS
HASDIR==4 ;DEVICE HAS DIRECTORY
MTADEV==20 ;DEVICE IS MAGTAPE
DTADEV==100 ;DEVICE IS DECTAPE
PTRDEV==200 ;DEVICE IS PAPERTAPE READER
PTPDEV==400 ;DEVICE IS PAPERTAPE PUNCH
TTYDEV==1B32
DSKDEV==200000 ;DEVICE IS DISC
IFE SAMFRK,<
LOC 41
JSYS MYUU ;LOCAL UUO ROUTINE
RELOC
>
MAXERR==10 ;RETRIES WHEN READING MAGTAPE
USRLVL==3 ;LEVEL PERMITTED FOR COMPAT FUNCTION 6
USRMXC==0 ;MAXIMUM CHANNEL AVAILABLE FOR COMPAT 6
.HSLOC=400000 ;DEFAULT (NORMAL) HISEG LOCATION
DDTLOC=770000 ;START ADDRESS OF DDT
MAXPAT==764000 ;FIRST ADDRESS WE CAN'T USE
B18==400000 ;HANDY ABBREVIATION FOR SIGN BIT
TTYDSG==400000 ;TTY DESIGNATOR FORMAT
MAXIOL==7000 ;BIGGEST DUMP I/O LIST VIROS WILL BUY
MAXFRU==3 ;# OF ^C'S BEFORE BOMBING PAT
WHEEL==1B18 ;PROCESS CAPABILITY BIT
OPER==1B19 ;PROCESS CAPABILITY BIT
MAINT==1B21 ;PROCESS CAPABILITY BIT
PRIJFN==100 ;PRIMARY INPUT JFN
PROJFN==101 ;PRIMARY OUTPUT JFN
PPNLH==4 ;LH OF PPN RETURNED BY GETPPN AND GETTAB
MAXDIR==^D1000 ;# OF ILLEGAL DIR'S BEFORE EOF
STDPRT=005000,,0 ;STANDARD FILE PROTECTION
FDBCTL==1 ;FILE DESCRIPTOR BLOCK DEFINITIONS
FDBPRT==4
FDBVER==7
FDBBYV==11
FDBSIZ==12
FDBCRV==13
FDBWRT==14 ;LAST WRITE OF FILE
FDBREF==15
FDBDEL==1B3
DV.DSK==1B1 ;DEVICE CHARACTERISTICS BITS
DV.LPT==1B3 ;DEVICE CHARACTERISTICS BITS
;GET THE 10/50 UUO'S INTO THE SYMBOL TABLE FOR DEBUGGING PAT
DEFINE REDEF(A)<IRP A,<A=:EXP <A>>>
REDEF <CALL,INIT,CALLI,OPEN,TTCALL,RENAME,IN,OUT,SETSTS,STATO>
REDEF <GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT,CLOSE,RELEAS>
REDEF <MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER>
DEFINE SYSGET (X)<
MOVE A,[SIXBIT /X/]
SKIPN B,X ;HAVE WE GOTTEN THIS ALREADY?
SYSGT ;NO, GO GET IT
MOVEM B,X ;STORE IT FOR FUTURE USE
>
DEFINE SYSGTA (X)<
SKIPE A,X
JRST .+3
MOVE A,[SIXBIT/X/]
SYSGT
MOVEM A,X
>
;CORE ASSIGHMENTS
;FIRST FOR THE CODE.
PATLOC=:700000 ;PLACE WHERE COMPATIBILITY ACTUALLY RUNS
PATPAG==:PATLOC_<-^D9> ;AND AS A PAGE NUMBER TO GET THRU LOADER
FLSRLC=:600000 ;START ADR OF FILSER DATA BASE
FLSRPG==:FLSRLC_<-^D9> ;PAGE NUMBER OF START OF FILSER
LODORG==400000 ;WHERE THE LOADER WILL LEAVE "HI SEGMENT"
;STORAGE ALLOCATOR FOR TEMP STORAGE
DEFINE ALC(NAM,SIZ)
< NAM=:LC
LC==LC+SIZ
>
;VARIABLE STORAGE FOR PAT
PATVAR==731 ;STORAGE AREA FOR PAT VARIABLES
TMPPAG==PATVAR ;PAGE FOR TMPCOR DATA BASE FILE
IFE FTSTAT,<STATLP==TMPPAG ;NO STATISTICS PAGE
STATGP==TMPPAG> ;NO SYSTEM STATISTICS PAGE
IFN FTSTAT,<STATLP==TMPPAG+1 ;DEFINE STATISTICS PAGE
STATGP==STATLP+1> ;DEFINE SYSTEM WIDE STATISTICS PAGE
LC==<STATGP+1>_11 ;START OF TEMPORARY PAGES
IFN FTSTAT,<
STATLC==STATLP_11 ;ADDRESS OF LOCAL STAISTICS PAGE
STATGC==STATGP_11 ;ADDRESS OF SYSTEM WIDE STATISTICS PAGE
STATFW==ST.X_^D24!ST.Y_^D12!ST.Z ;FORMAT WORD
ST.X==4 ;LENGTH OF MISC TABLE
ST.Y==200 ;LENGTH OF CALLI TABLE
ST.Z==100 ;LENGTH OF GETTAB TABLE
ST.FMT==0 ;WHERE TO STORE FORMAT WORD
ST.TCL==1 ;1-20 IS FOR TTCALL'S
ST.UUO==21 ;21-60 IS FOR UUO'S
ST.VER==61 ;COMPATIBILITY PACKAGE VERSION #
ST.ONC==62 ;# OF TIMES THRU ONCE CODE
ST.UNI==63 ;# OF UNIMPLEMENTED CALLI'S EXECUTED
ST.UEI==64 ;# OF UNEXPECTED INTERRUPTS IN PAT
ST.CLI==61+ST.X ;61+X TO 60+X+Y IS FOR CALLI'S
;60+X+Y DOWN IS FOR NEGATIVE CALLI'S
ST.GTB==61+ST.X+ST.Y ;61+X+Y TO 60+X+Y+Z IS FOR GETTAB'S
ST.TIM==60+ST.X+ST.Y+ST.Z ;OFFSET FOR TIMMING STATISTICS
>
DEFINE STAT(A,B,C)
<IFN FTSTAT,<
TLNN PF,L.LSTA ;LOCAL STATISTICS WANTED?
JRST .+3 ;NO, DONT REFERENCE THE PAGE
AOS STATLC+C(A) ;EXECUTION COUNTER
ADDM B,STATLC+ST.TIM+C(A) ;INCREMENT TIME SPENT IN UUO
TLNN PF,L.GSTA ;GLOBAL STATISTICS WANTED?
JRST .+3 ;NO, DONT REFERENCE PAGE
AOS STATGC+C(A) ;SYSTEM WIDE COUNTER
ADDM B,STATGC+ST.TIM+C(A) ;SYSTEM STATISTICS FOR UUO TIMMINGS
>>
FILPAG==600 ;FILSER STARTS AT PAGE 600
FILEND==677 ;HIGHEST PAGE OF FILSER DATA BASE
TSLOC==LC
ALC CHTABS,0
ALC JFNTAB,1 ;ONLY NEEDS 7 BITS
ALC MAPTAB,1 ;MAPPING INFO FOR DISK FILES
ALC BUFHTB,1 ;OUTPUT AND INPUT BUFFER HEADERS
ALC FLAGWD,1 ;INTERNAL FLGS,,FILE STATUS
ALC DEVNUM,1 ;DEVICE DESIGNATOR OF THIS DEVICE,
; FILLED IN BY INIT
ALC DEVNAM,1 ;SIXBIT DEVICE NAME FROM USER
ALC FILNAM,1 ;SIXBIT FILE NAME FROM USER
ALC EXT,1 ;SIXBIT FILE EXT (3 CHARS) FROM USER
ALC DIRNUM,1 ;DIRECTORY NUMBER
ALC PROT,1 ;PROTECTION VALUE (VIROS STYLE)
ALC IOBYTP,1 ;POINTER TO NEXT WORD IN FILE
ALC NOMFDC,0 ;# OF ILLEGAL DIR NUMBERS PASSED OVER
ALC IOEOFP,1 ;POINTER TO EOF FOR DISK FILES
ALC MTADAT,0 ;MAGTAP INFORMATION (DEFSTR'S BELOW)
ALC MFDPT,1 ;DIRECTORY COUNT FOR MFD READING
NTABS==LC-CHTABS
ALC CHTABN,17*NTABS
ALC HIBWRD,1 ;LAST HIBERNATE FLAGS
ALC WAKEF,1 ;-1 = AN EVENT OCCURED FORCING HIBER TO WAKE UP
ALC IOWATF,1 ;WAITING FOR IO TO HAPPEN
ALC SAVMOD,1 ;SAVED TELETYPE MODE
ALC CHTEND,0 ;ABOVE HERE CLEARED BY CALLI 0.
;MAGTAP DEFSTRS
DEFSTR (MTADEN,MTADAT(BB),35,4) ;DENSITY
DEFSTR (MTADM,MTADAT(BB),31,4) ;DATA MODE
ALC JOB,1 ;TSS JOB #
ALC NJOBS,1 ;NUMBER OF JOBS
ALC HGHSGN,1 ;NUMBER OF THE HIGH SEG FOR THIS JOB
IFN FTFILSER,<
ALC TOPNBL,3 ;OPEN BLOCK FOR FILSER
>
ALC CCIENB,1 ;CONTROL-C INTERCEPT IS ENABLED
ALC CCIFLG,1 ;CONTROL-C INTERCEPT IS IN PROGRESS
ALC FRUSTC,1 ;NUMBER OF TIMES ^C HAS BEEN HIT
ALC FIRPTY,1 ;FIRST PTY IN TTYJOB TABLE (SETUP BY ONCE)
ALC TTINPT,1 ;PUTTER POINTER FOR TTCALL BUFFER
ALC TTOUPT,1 ;GETTER POINTER FOR TTCALL BUFFER
ALC TTCNT,1 ;BYTE COUNT,TTCALL INPUT BUFFER
ALC OTTCNT,1 ;NUMBER OF CHARS IN LAST LINE (FOR TTCALL 10)
TTMAXC==100*4 ;MAXIMUM # OF CHARS IN TTBUF
ALC TTBUF,100 ;TTCALL INPUT BUFFER
ALC TTBUFE,0 ;END OF TTBUF
ALC TTLINE,1 ;LINE PRESENT FOR TTCALL
ALC SVMOD,1 ;(321) save controlling TTY SFMOD for CONTinue
ALC DEVNM7,2 ;SEVEN BIT DEVICE NAME
ALC FILNM7,3 ;SEVEN BIT FILE NAME (LEAVE ROOM FOR ^V'S)
ALC EXT7,2 ;SEVEN BIT EXTENSION
ALC SEE,1 ;SAVE EE AND FF DURING MYUUO'S
ALC BUFFER,2
ALC IAC,20 ;AC'S ON INTERRUPT
ALC ASAVE,1 ;TEMPORARY STORAGE AT INTERRUPT LEVEL
IFN FTSTAT,<
ALC NCALLI,1 ;NUMBER OF THE CALLI UUO BEING DONE
>
ALC IOBPT,1 ;BYTE POINTER FOR IN AND OUT
ALC IOCNT,1 ;COUNT FOR IN AND OUT
TMPBKL==^D120 ;LENGTH OF TMPBLK
ALC TMPBLK,TMPBKL ;TEMP BLOCK, USED FOR ENQ/DEQ
BLLEN==30
ALC STRNG1,BLLEN ;TEMP STRING STORAGE (LARGE ENOUGH FOR GETJI BLOCK)
;ALSO USED AS STACK IN CSTART ROUTINES
ALC DIRNAM,12 ;STRING SPACE FOR A DIRECTORY NAME
ALC FDBB,22
ALC JBLOCK,14 ;FOR JFN ARG LIST
ALC RETSAV,1 ;RETURN SAVED BY PSEUDOINTERRUPT
ALC LV2SAV,1 ;LEVEL 2 PC SAVE WORD
ALC CNIWRD,1 ;SAVES OV EN AND FOV EN FOR APR CONI
ALC HSORG,1 ;ORIGIN OF HISEG (ADDRESS)
ALC JBREL,1 ;SAVED .JBREL
ALC JBHRL,1 ;SAVED .JBHRL
ALC JBDDT,1 ;COMPATIBILITY'S COPY OF .JBDDT
ALC LOWNAM,1 ;NAME OF JOB AS SET BY RUN OR SETNAM UUOS
ALC LOWDEV,1 ;DEVICE FROM WHICH LOW SEG CAME
ALC LOWPPN,1 ;PPN OF LOW SEG
ALC SEGNAM,1 ;NAME OF JOB'S HIGH SEGMENT
ALC SEGDEV,1 ;DEVICE FROM WHICH HIGH SEG CAME
ALC SEGPPN,1 ;PPN OF HIGH SEG
ALC USRENB,1 ;WHAT USER ASKED FOR ON LAST APRENB UUO
ALC DMPLST,2 ;MTA IO BY DUMP COMMANDS HERE
ALC STRRET,1 ;INDEX FOR COMPT. UUO TO RETURN GTJFN STRING AND POINTER
ALC MTDUMP,1 ;TEMP IN DUMP I/O
ALC SPDELC,1 ;TEMP IN DUMP I/O
ALC TMPJFN,1 ;JFN OF TMPCOR FILE
ALC FLSJFN,1 ;JFN OF FILSER DATA BASE FILE
ALC TTYFRK,1 ;FORK HANDLE FOR TTY HIBERNATE FORK
ALC TYSTAT,1 ;TTY STATUS (CONTROLLING TTY).
; SIGN IS ^O FLAG, RH IS INIT BITS
ALC CSTFLG,1 ;FLAG TO FORCE MRETN TO DO A START/REE
ALC UIFLAG,1 ;USER INTERRUPT PENDING FLAG
ALC UIIFLG,1 ;USER INTERRUPT IIC DONE FROM MRETN
ALC UITRAP,1 ;USER INTERRUPT TRAP ADDRESS
ALC UIACA,1 ;PLACE TO SAVE AN AC DURING USER INT
ALC LEVTAB,3 ;PSI LEVEL TABLE
USRSAV==LEVTAB+2 ;POINTER TO USER INTERRUPT PC
ALC CHNTAB,^D36 ;PSI CHANNEL TABLE
ALC JOBNAM,1 ;STORAGE AREA FOR SYSGET MACRO
ALC TICKPS,1
ALC SNAMES,1
ALC SSIZE,1
ALC SNBLKS,1
ALC SYSVER,1
ALC PTYPAR,1
ALC SYSTAT,1
ALC TTYJOB,1
ALC DWNTIM,1 ;CEASE TIME
ALC DMAPTB,NPPN ;TABLE OF DIRECTORY NUMBERS FOR UNMAPPING
ALC LSTUFD,1 ;LAST UFD READ
ALC LSTUFJ,1 ;JFN USED TO READ LAST UFD
ALC LSTUFP,1 ;POINTER INTO UFD
ALC LSTMFP,1 ;POINTER INTO MFD
ALC LSTMFN,1 ;LAST DIR NUM USED IN MFD READ
ALC NEWJFN,1 ;JFN TO BE RELEASED AT LOOKER
ALC USRMSK,1 ;MASK OF CHANNELS DEFINED BY USER
ALC MAPLST,1 ;BIT MASK OF AVAILABLE PREFAULTING PGS
ALC MAPTOT,1 ;# OF FILES THAT ARE BEING PREFAULTED
CLRTOP==LC-1 ;LAST LOCATION CLEARED ON FIRST ENTRY
ALC STIME,1 ;RUN TIME AT START OF UUO FOR STATISTICS
ALC ITIME,1 ;UPTIME IN MILLISECONDS FOR MSTIME UUO
ALC ECHINI,1 ;INITIAL ECHO SETTING
ALC TTWDTH,1 ;WIDTH OF LINE BEFORE TURNING OFF CR-LF
ALC ACS,20 ;USER'S AC'S AT TIME OF UUO.
ALC PFLAGS,1 ;STORAGE FOR PF AC WHILE USER RUNS.
ALC INPAT,1 ;IN PAT IF NON-0,IN USER PROG IF 0
ALC INFLSR,1 ;IN FILSER, CONTROL-C'S ARE NOT ALLOWED
ALC FDBTMP,1 ;ROOM TO MODIFY A WORD OF FDB
ALC MONUUO,1 ;COPY OF MONITOR 40
ALC MONUPC,1 ;USER PC SAVED BY MONITOR
ALC CSTCOD,1 ;^C START CODE: -1=ST,
; -2=REE, -3=DDT,, -4=CLOSE, +N=GOTO N
ALC CSTOPC,1 ;OLD PC WHERE ^C CONT WOULD HAVE GONE
ALC CLSDEV,1 ;LOC TO STORE DEV NAME TO BE CLOSED?
ALC EXITPC,1 ;PC TO CONTINUE AT IF USER CONTINUES AFTER MONRET
ALC SAVTIW,1 ;PLACE TO STORE OLD TERMINAL INT WORD
ALC RUNDEV,1 ;DEVICE SPECIFIED IN RUN UUO
ALC RUNNAM,1 ;NAME OF PROGRAM TO RUN
ALC RUNEXT,1 ;EXT OF PROG TO BE RUN
ALC RUNPPN,1 ;PPN OF PROG TO RUN
PDLL==40
ALC PDL,PDLL
FPDLEN==10
ALC FRKPDL,FPDLEN ;STACK FOR TTY FORK
IPDLL==10
ALC IPDL,IPDLL ;USED AT INTERRUPT LEVEL 1
ALC FORTY,1 ;PLACE TO STORE CONTENTS OF 40 AT TIME OF CALL
;THIS IS LAST SO THAT THE SECOND PAGE
;GETS CREATED ON THE FIRST UUO
TSTOP=LC ;END OF TEMP STORAGE. TRY TO KEEP
; THIS IN TWO PAGES. (REF IOMPGS)
NIOPGS==30 ;PAGES AVAILABLE FOR PREFAULTING
;THIS SHOULD BE DIVISIBLE BY NPLPGS
NPLPGS==4 ;NUMBER OF PRELOADED PAGES AT A TIME
IOMPGS==<<TSTOP>_-11>+1 ;MAPPED I/O USES 32. PAGES STARTING HERE
IOMEND==IOMPGS+NIOPGS ;FIRST FREE PAGE AFTER I/O AREA
NPATPG==<MAXPAT-PATLOC>_-11 ;# OF PAGES FOR PAT
IFL <MAXPAT-IOMEND>,<PRINTX ? PAT is too big -- reduce NIOPGS>
SUBTTL ENTRY VECTOR AND TOP-LEVEL OF UUO HANDLER
HISEG
PHSLOC==PATLOC+.JBHDA
PHASE PHSLOC
EVEC=PATLOC ;COPY TO PUBLISHED LOCATION
;**** CAUTION!
; THE ENTRY VECTOR STARTING AT KEVEC IS BLT'ED TO EVEC BY LINIT
; THEREFORE THERE MUST BE NOTHING SHOULD PRECEED KEVEC
KEVEC: JRST COMPAT ;0 - UUO'S NORMALLY ENTER VIA THIS
JRST PATINI ;1 - FIRST UUO ENTERS VIA THIS
EXP PATVER ;2 - VERSION OF PAT IS IN FIXED LOC 700002
MONUUO ;3 - MON 40 DUMPED HERE ON MON UUO
MONUPC ;4 - USER PC DUMPED HERE ON MON UUO
JRST MAKSHR ;5 - MAKE SHR VERSION OF SUBSYSTEM
EXP CCPSIN ;6 - CHANNEL FOR EXEC TO PSI ON FOR ^C REE
XWD CSTCOD,CSTOPC ;7 - WHERE TO STORE DATA FOR ^C ST SEQ.
XWD JBHRL,JBREL ;10 - POINTERS SO EXEC CAN DO CORE COMMAND
XWD LOWNAM,CLSDEV ;11 - LH = LOW SEG NAME FROM RUN OR SETNAM
; RH=PLACE FOR EXEC TO PUT DEV NAME OR JFN TO BE CLOSED
XWD DEBUG1,SEGNAM ;12 - LH = START ADR TO INITIALIZE PAT,
; RH = HIGH SEG NAME
XWD NTABS,JFNTAB ;13 - LH = LENGTH OF DATA BASE FOR EACH CHANNEL
; RH = ADR OF JFN FOR CHANNEL 0
EVECL==.-KEVEC ;LENGTH OF ENTRY VECTOR
CSTMCD==5 ;MAX VALUE OF CSTCOD KNOWN ABOUT
SJBSYM: BLOCK 1 ;PLACE FOR LINIT TO STASH .JBSYM
PVLOC: EXP PATVER ;VERSION NUMBER USED BY MAKEPF
;10/50 TYPE UUO'S ARRIVE HERE
PATINI: SETZM PFLAGS ;FIRST TIME ENTRY. CLEAR FLAG WORD.
COMPAT:
IFN FTFILSER,< SETZM INFLSR> ;CLEAR FILSER FLAG
SETZM FRUSTC ;INITIALIZE FRUSTRATION COUNTER
SETZM IOWATF ;CLEAR WAITING FLAG
MOVEM 17,ACS+17
MOVEI 17,ACS
BLT 17,ACS+16
SETOM INPAT ;MARK THAT ACS ARE SAVED
HLLZ PF,PFLAGS ;FLAGS TO AC FOR PAT'S FLAGS.
IFN FTSTAT,<
MOVEI A,1 ;GET RUN TIME IN 10 MICROSECOND INCREMENTS
TLNE PF,L.LSTA!L.GSTA ;DONT DO HPTIM IF NO STATISTICS BEING DONE
HPTIM
TLZ PF,L.GSTA!L.LSTA ;DONT DO ANY MORE STATISTICS
MOVEM A,STIME ;SAVE FOR USE AT END OF UUO
>
MOVE P,PATSTK ;SETUP LOCAL STACK
IFN SAMFRK,<
MOVE A,MONUUO
MOVEM A,FORTY ;PRESERVE 40 OVER MYUUO'S
BP: LDB AC,ACPTR ;GET AC FIELD OF UUO
MOVE CAC,ACS(AC) ;CONTENTS OF USER AC (MAY BE IRRELEV.)
MOVE A,MONUPC ;GET CALLING PC OF USER UUO
MOVEM A,JOBPD1 ;PUT IT IN 10/50'S STACK AREA
PUSH P,A ;AND ON PAT'S STACK
>
IFE SAMFRK,<
LDB AC,ACPTR ;GET AC FIELD OF UUO
UMOVE CAC,0(AC) ;CONTENTS OF USER AC (MAY BE IRRELEV.)
PUSH P,MONUPC
>
TLNN PF,L.ONCE ;FIRST TIME?
PUSHJ P,ONCE ;YES. GO SET UP PSI AND TEMP STORAGE
SETZM NEWJFN ;INITIALIZE THIS LOCATION
SKIPN CCIENB ;IS ^C INTERCEPT ALREADY SET
TLNE PF,L.NCCE ;NO, IS CONTROL-C ENABLING ALLOWED?
JRST COMPA1 ;NO, SO DONT DO IT
SKIPE A,.JBINT ;IS .JBINT NOW NON-ZERO
PUSHJ P,CHKCCI ;YES, CHECK TO SEE IF ^C INTERCEPT TO BE SET
COMPA1: LDB A,[POINT 9,FORTY,8] ;GET UUO NUMBER
CAIL A,40 ;SMALL NUMBERS ARE ILLEGAL
CAIL A,100 ;IS IT A GOOD ONE?
PUSHJ P,ITRAP ;NO GOOD.
JRST @COMUTB-40(A) ;WE ONLY WANT TO DO 40-77
COMUTB: EXP UCALL,UINIT,ITRAP,ITRAP,ITRAP,ITRAP,ITRAP,UCALLI
EXP UOPEN,UTTCLL,ITRAP,ITRAP,ITRAP,URENME,UIN,UOUT
EXP USETST,USTATO,UGETST,USTATZ,UINBUF,UOUTBF,UINPUT,UOUTPT
EXP UCLOSE,URELEA,UMTAPE,UUGETF,UUSETI,UUSETO,ULOOKP,UENTER
ACPTR: POINT 4,FORTY,12
PATSTK: IOWD PDLL,PDL ;LOCAL STACK
PSISTK: IOWD PDLL,PDL ;STACK WHILE ON LEVEL 1
;RETURN FROM 10/50 UUO
MRETN2:
AOS PDL ;SKIP RETURN
MRETN: MOVEM PF,PFLAGS ;SAVE FLAG AC
MOVE A,PDL ;GET USER PC
MOVEM A,JOBPD1 ;STORE FOR HIM TO SEE
HRRI A,1(A) ;SET UP FOR INTERRUPT RETURN
MOVEM A,MONUPC ;UPDATE RETURN ADDRESS
SKIPE A,CSTFLG ;CONTROL-C, START DONE?
JRST CSTMRT ;YES. GO PROCESS IT
MRETNA:
IFN FTSTAT,<
TLNE PF,L.LSTA!L.GSTA ;IF NOT TAKING STATISTICS, DONT CALL ROUTINE
PUSHJ P,DOSTAT ;GO DO SOME STATISTICS
>
MOVSI 17,ACS
BLT 17,17
SETZM INPAT ;ACS NOW RESTORED
SKIPN UIFLAG ;USER INTERRUPT PENDING
JRSTF @JOBPD1
SETZM UIFLAG ;CLEAR USER INTERRUPT FLAG
SETOM UIIFLG ;MARK THAT AN IIC IS BEING DONE
MOVEI A,.FHSLF ;INTERRUPT BACK UP TO LEVEL 3
MOVSI B,(1B0) ;CHANNEL 0 IS USER CHANNEL
IIC
PUSHJ P,BUGSTP ;SHOULD NEVER GET HERE
CSTMRT: SETZM CSTFLG ;CLEAR FLAG THAT START DONE.
SKIPE INFLSR ;WAS CONTROL-C TURNED OFF FOR FILSER?
CSTMR1: JRST [SETZM INFLSR ;YES, OK TO ALLOW CONTROL-C'S
SETZM CCIFLG ;CLEAR CONTROL-C FLAG
SETZM CCIENB ;MARK THAT CONTROL-C NOT DISABLED
MOVEI A,3 ; GET CONTROL-C CHANNEL
DTI ;DEACTIVATE IT
TMSG <^C> ;TYPE OUT ^C
HALTF ;AND EXIT
JRST MRETNA] ;RETURN IF CONTINUED
HLL A,JOBPD1 ;PRESERVE USER'S FLAGS
EXCH A,JOBPD1 ;PUT START ADR IN RETURN, GET UNUSED RET
MOVEM A,.JBOPC ;PUT THE RETURN IN OPC FOR USER
SKIPN CCIFLG ;IS THERE A ^C INTERCEPT IN PROGRESS?
JRST MRETNA ;NO, RETURN TO USER ADR
SETZM CCIFLG ;YES, CLEAR FLAG
SKIPN B,.JBINT ;GET POINTER TO INTERCEPT BLOCK
JRST CSTMR1 ;NOT SET UP, LET ^C TAKE
MOVE C,1(B) ;GET FLAGS
SKIPN 2(B) ;IS PC WORD ZERO?
TRNN C,ER.ICC ;AND, IS CONTROL-C STILL ENABLED?
JRST CSTMR1 ;NO, LET ^C THROUGH
MOVEM A,2(B) ;STORE INTERRUPTED ADDRESS
JRST MRETNA ;AND RETURN TO HIM
BAPOPJ: POP P,B
APOPJ: POP P,A
POPJ P,
CPOPJ2: AOS (P)
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P,
;COMMON RETURNS FROM UUO'S
RETZR1: TDZA A,A ;CLEAR AC A, THEN STOCT1 SKIP RET
RETZER: TDZA A,A ;CLEAR AC A, AND SKIP TO STOTAC
STOTC1: AOS PDL ;SET FOR SKIP RETURN
STOTAC:
IFN SAMFRK,< MOVEM A,ACS(AC)> ;STORE THE AC FOR USER
IFE SAMFRK,< UMOVEM A,0(AC)> ;STORE THE AC FOR THE USER
JRST MRETN ;AND RETURN FROM THE UUO
RETM11: AOS PDL ;SKIP RETURN A MINUS 1
RETM1: MOVNI A,1 ;RETURN A MINUS ONE
JRST STOTAC ;TO USER'S AC
;STATISTICS GATHERING ROUTINES
IFN FTSTAT,<
DOSTAT: MOVEI A,1 ;READ CLOCK AGAIN
HPTIM
POPJ P, ;JUST RETURN WITHOUT DOING STATISTICS
SUB A,STIME ;GET AMOUNT OF TIME TO DO UUO
MOVE B,A
LDB A,[POINT 6,FORTY,8] ;GET UUO OPCODE
STAT A,B,<ST.UUO-40> ;DO STATISTICS REPORTING
CAIN A,(TTCALL_-^D9) ;IS THIS A TTCALL UUO?
JRST STTTCL ;YES, GO COUNT IT
TRNE PF,R.CMR ;IS THIS A CMRETN RETURN
JRST STUNI ;YES, GO COUNT UNIMPLEMENTED CALLS
CAIE A,(CALLI_-^D9) ;CALLI UUO?
CAIN A,(CALL_-^D9) ;OR A CALL UUO?
SKIPA A,NCALLI ;YES, GET CALLI #
POPJ P, ;NO, THEN WE ARE DONE
TRNE A,200000 ;NEGATIVE CALLI?
HRRZI A,200(A) ;YES, GET OFFSET FROM 200
ANDI A,377777 ;CLEAR PHYSICAL ONLY BIT
TRNE A,777600 ;WITHIN BOUNDS?
POPJ P, ;NO, DO NO ACCOUNTING
STAT A,B,<ST.CLI> ;ACCOUNT!
CAIE A,41 ;GETTAB UUO?
POPJ P, ;NO, RETURN
HLRZ A,NCALLI ;GET TABLE #
TRNE A,777700 ;WITHIN BOUNDS?
POPJ P, ;NO, RETURN
STAT A,B,<ST.GTB> ;COUNT IT UP
POPJ P, ;FINALLY DONE
STTTCL: LDB A,ACPTR ;GET AC FIELD
STAT A,B,<ST.TCL>
POPJ P, ;RETURN
STUNI: MOVEI A,0
STAT A,B,<ST.UNI>
POPJ P,
>
;LOCAL UUO SERVICE
REPEAT 0,<
MYUU: MOVEM EE,SEE
MOVEM FF,SFF
IFN SAMFRK,<
MOVE EE,MONUPC
MOVEM EE,MYUUO ;PC TO UUO RETURN
>
LDB EE,[POINT 9,MY40,8]
SUBI EE,42 ;FIRST LOCAL UUO
CAIL EE,0 ;LOCAL UUO?
CAILE EE,2
JRST [ MOVE EE,SEE ;NO, MUST HAVE BEEN ^C, REENTER
JRST COMPT2] ;TREAT AS USER OP
JRST @.+1(EE)
EXP MMOVE,MMOVEM,MXCT
MXCT: HRRZ EE,MY40 ;PTR TO INST TO XCT
MOVEI EE,@(EE) ;COMPUTE EFFECTIVE ADDR
CAIGE EE,20
ADDI EE,ACS ;E IN ACS, OFFSET
HLL EE,@MY40
TLZ EE,37 ;FLUSH IND AND INDEX
XCT EE
JRST MUR1
AOS MYUUO ;FOR SKIP TYPE INSTRUCTIONS THAT DID
JRST MUR1
MMOVE: LDB EE,[POINT 4,MY40,12]
HRRZ FF,MY40 ;EFFECTIVE ADDR
CAIGE FF,20 ;AC?
ADDI FF,ACS ;YES, POINT TO SAVED AC'S
MOVE FF,(FF) ;FETCH OBJECT
MOVEM FF,(EE) ;PUT INTO PROPER AC
JRST MUR2
MMOVEM: LDB EE,[POINT 4,MY40,12]
MOVE EE,(EE)
HRRZ FF,MY40
CAIGE FF,20
ADDI FF,ACS
MOVEM EE,(FF)
JRST MUR2
MUR2: MOVE FF,SFF
MUR1: MOVE EE,SEE
JRSTF @MYUUO
> ;END OF REPEAT 0 CONDITIONAL
UXCT: MOVE EE,@0(P) ;GET INSTRUCTION TO BE EXECUTED
MOVEI FF,@EE ;GET EFFECTIVE ADDRESS
CAML FF,HSORG ;CHECK THE ADDRESS - IN HISEG?
CAMLE FF,JBHRL ;YES, IS THIS A LEGAL HIGH SEG ADDRESS?
CAMG FF,JBREL ;IS IT A LEGAL LOW SEG ADR
SKIPA ;IT IS LEGAL
PUSHJ P,ITRAP ;ILLEGAL, GO PRINT OUT MESSAGE
CAIL FF,20 ;IN THE AC'S?
POPJ P, ;NO, THEN WE CAN DO THIS INST DIRECTLY
HRRI EE,ACS(FF) ;GET OFFSET EFFECTIVE ADDR
UXCT1: TLZ EE,37 ;CLEAR INDEX AND INDIRECT BITS
AOS (P) ;SKIP OVER INST
XCT EE ;DO THE INST (MODIFIED)
POPJ P, ;NO SKIP
JRST CPOPJ1 ;SKIP RETURN
LBXCT: MOVE EE,@0(P) ;HERE TO XCT BYTE INSTRUCTIONS
MOVE FF,@EE ;GET POINTER WORD
MOVEI FF,@FF ;GET EFFECTIVE ADDRESS OF DESTINATION
CAML FF,HSORG ;IN HISEG?
CAMLE FF,JBHRL ;YES, IS IT LEGAL?
CAMG FF,JBREL ;LEGAL LOW SEG ADR?
SKIPA ;YES, LEGAL ADR
PUSHJ P,ITRAP ;ILLEGAL ADR, GO TYPE MESSAGE
CAIL FF,20 ;ADR IN THE ACS
POPJ P, ;NO, GO EXECUTE IT
HLL FF,@EE ;RESTORE P AND S FOR BYTE POINTER
TLZ FF,37 ;CLEAR INDIRECT AND INDEX BITS
HRRI FF,ACS(FF) ;MAKE IT POINT TO SAVED ACS
HRRI EE,FF ;MAKE EE USE FF AS POINTER
JRST UXCT1 ;GO DO INSTRUCTION
DOJSYS: TRO PF,R.ILLJ ;MARK THAT WE ARE IN AN XJSYS MACRO
XCT @0(P) ;XCT THE JSYS
AOS 0(P) ;SET UP FOR SKIP RETURN
;THIS INSTRUCTION IS SKIPED IF AN
; INTERRUPT OCCURED DURING THE JSYS
TRZ PF,R.ILLJ ;CLEAR FLAG FOR INTERRUPT LEVEL
JRST CPOPJ1 ;SKIP OVER JSYS INSTRUCTION ITSELF
INJSYS: SKIPN UIFLAG ;USER INTERRUPT PENDING?
SKIPE CSTFLG ;OR ^C INTERRUPT PENDING?
JRST [ SETZM IOWATF ;CLEAR WAITING FLAG
SOS PDL ;DECREMENT PC
JRST MRETN] ;EXIT TO USER
XCT 0(EE) ;DO THE JSYS
JRST 1(EE) ;NON-SKIP RETURN
JRST 2(EE) ;SKIP RETURN
INJSYE:
SUBTTL UUO PROCESSORS FOR INDIVIDUAL UUO'S
;10/50 CALL AND CALLI TABLES
;NOTE THAT NEGATIVE CALLIS AND 0-55 HAVE SIXBIT CALLS
; WHILE 56 UP DO NOT.
MXSIXB==55 ;MAXIMUM CALLI WHICH HAS A SIXBIT ARG
DEFINE MCALLI
<CC LIGHTS,LIGHTS
>
DEFINE PCALLI
<CC RESET,RESET
CC DDTIN,DDTIN
CC SETDDT,SETDDT
CC DDTOUT,DDTOUT
CC DEVCHR,DEVCHR
CC DDTGT
CC GETCHR,GETCHR
CC DDTRL
;10
CC WAIT
CC CORE,CORE
CC EXIT,EXIT
CC UTPCLR,UTPCLR
CC DATE,DATE
CC LOGIN,ILEGAL
CC APRENB,APRENB
CC LOGOUT,LOGOUT
;20
CC SWITCH,SWITCH
CC REASSI,REASSI
CC TIMER,TIMER
CC MSTIME,MSTIME
CC GETPPN,GETPPN
CC TRPSET,ILEGAL
CC TRPJEN,ILEGAL
CC RUNTIM,RUNTIM
;30
CC PJOB,PJOB
CC SLEEP,SLEEP
CC SETPOV
CC PEEK,RETZER
CC GETLIN,GETLIN
CC RUN,RUN
CC SETUWP,MRETN2
CC REMAP,REMAP
;40
CC GETSEG,GETSEG
CC GETTAB,GETTAB
CC SPY
CC SETNAM,SETNAM
CC TMPCOR,TMPCOR
CC DSKCHR,DSKCHR
CC SYSSTR,SYSSTR
CC JOBSTR,JOBSTR
;50
CC STRUUO,STRUUO
CC SYSPHY,SYSPHY
CC FRECHN
CC DEVTYP,DEVTYP
CC DEVSTS
CC DEVPPN,DEVPPN
CC SEEK
CC RTTRP
;60
CC LOCK
CC JOBSTS,JOBSTS
CC LOCATE
CC WHERE
CC DEVNAM,DVNAM.
CC CTLJOB,CTLJOB
CC GOBSTR,GOBSTR
CC ACTIVA
;70
CC DEACTI
CC HPQ
CC HIBER,HIBER
CC WAKE,WAKE
CC CHGPPN
CC SETUUO
CC DEVGEN
CC OTHUSR
;100
CC CHKACC,CHKACC
CC DEVSIZ,DEVSIZ
CC DAEMON
CC JOBPEK
CC ATTACH
CC DAEFIN
CC FRCUUO
CC DEVLNM
;110
CC PATH.,PATH
CC METER.
CC MTCHR.,MTCHR
CC JBSET.
CC POKE.
CC TRMNO.,TRMNO
CC TRMOP.,.TRMOP
CC RESDV.,RESDV
;120
CC UNLOK
CC DISK.
CC DVRST.
CC DVURS.
CC 124
CC 125
CC 126
CC 127
CC 130
CC 131
CC 132
CC 133
CC 134
CC 135
CC 136
CC 137
CC 140
CC 141
CC 142
CC 143
CC 144
CC 145
CC 146
CC COMPT.,COMPT.
;150
CC 150
CC ENQ,.ENQ
CC DEQ,.DEQ
CC ENQC,.ENQC
CC TAPOP,TAPOP
CC FILOP,FILOP
>
DEFINE CC (A,B)<
IFB <B>,<
JRST CMRETN ; A UNIMPLEMENTED
>
IFNB <B>,<
JRST B ; A HANDLER
>
>
MCLIT:
MCALLI ;TRANSFER TO NEGATIVE CALLI'S
NMCLI==.-MCLIT ;NUMBER OF MINUS CALLI'S
CALLTV: ;ADDRESS OF TABLE ENTRY FOR CALLI 0
PCALLI ;TRANSFERS FOR POSITIVE CALLI'S
NPCLI==.-CALLTV
;UUO'S
;CALL AND CALLI
UCALL: UMOVE A,@FORTY ;ARG TO CALL IN SIXBIT, NAME OF ROUTINE
MOVSI B,-<NPCAL+NMCAL> ;LENGTH OF TWO SIXBIT TABLES
CAMN A,CALLIT-NMCAL(B) ;THIS ENTRY IN NAME TABLE?
JRST [MOVEI B,-NMCAL(B) ;YES. GET CALLI NUMBER IT WOULD BE
JRST UCALL1] ;AND GO TO CALLI HANDLER
AOBJN B,.-2 ;NO, TRY NEXT NAME
CMRETN:
IFN FTSTAT,<
TRO PF,R.CMR ;MARK THAT AN UNIMPLEMENTED CALL WAS DONE
>
JRST MRETN ;MAKE A NO-OP.
UCALLI: HRRZ B,FORTY ;EFFECTIVE ADDR IS THE ARG
TRNE B,B18 ;EXTEND SIGN INTO PHYSICAL BIT.
TROA B,1B19 ;IT'S NEGATIVE.
TRZ B,1B19 ;ITS POSITIVE
MOVEI A,NPCLI+NMCLI ;TOTAL CALLI LENGTH. CATCHES NEGATIVE
; OUT OF RANGE TOO, BY HALF-WORD ARITHMETIC
CAIG A,NMCLI(B) ;OFFSET TO ACCOUNT FOR LEGAL NEGATIVE VALUES
JRST CMRETN ;LARGE ARGUMENTS ARE NO-OPS
UCALL1:
IFN FTSTAT,<
HRRM B,NCALLI ;SAVE CALLI # FOR ACCOUNTING
HRLM CAC,NCALLI ;SAVE GETTAB TABLE # ALSO
>
JRST @CALLTV(B) ;DISPATCH
SUBTTL UUOS FOR FILE OPERATIONS
;FILE STUFF
GSTATS: PUSHJ P,SETUP
MOVE C,FLAGWD(BB)
CAIN AA,PTY ;IS THIS A PTY?
JRST PTYSTS ;YES, GO GET PTY STATUS
HRRZ A,C
CAIE AA,MTA ;THIS A MTA?
POPJ P,
PUSHJ P,GST2 ;YES, GET CURRENT MTA STATUS
MOVEI B,4000 ;CLEAR BOT IN FLAGWD
ANDCAM B,FLAGWD(BB) ;THIS BIT IS ALWAYS CORRECT FROM GST2
IORB A,FLAGWD(BB) ;GET CONDITOINS ALREADY SET
HRRZS A
POPJ P,
;ROUTINE TO GET STATUS FOR MAGTAPE.
;RETURNS WITH GDSTS DATA IN B, UPDATED 10/50 STATUS IN A.
;IOBKTL ISN'T SET, DUE TO THE COMPLEXITY OF 1B23 OF VIROS GDSTS.
; THE CALLER IS LEFT TO DO THAT
GST2: HRRZ A,JFNTAB(BB) ;SEE IF JFN IS OPEN
GTSTS
JUMPL B,GST3 ;IF 1B0 = 1, THEN OPENED
MOVE B,[440000,,OF%RD] ;NOT OPENED, MUST OPEN IT FIRST
OPENF
JRST GST3 ;FAILED, GO GET WHATEVER POSSIBLE
GDSTS ;GET THE STATUS
TLO A,(CO%NRJ) ;NOW CLOSE THE JFN
CLOSF ;BUT KEEP IT FROM BEING RELEASED
JFCL
JRST GST4 ;ENTER COMMON CODE
GST3: HRRZ A,JFNTAB(BB) ;ARGUMENT TO GDSTS
GDSTS ;GET VIROS STATUS
GST4: MOVE C,FLAGWD(BB) ;OLD TEN FIFTY STATUS
TRZ C,707700 ;BITS WHICH MAY NEED UPDATING
MOVE A,B ;VIROS BITS TO A
TRZE A,MT%IRL ;ILLEGAL RECORD LENGTH?
TRO A,1B21 ;YES, TURN IT INTO TOPS10 BIT
ANDI A,767600 ;ONLY ONES TO KEEP ARE MATCHING HDW BITS
TRZE A,40000 ;SUPPRESS ERROR RETRY?
TRO A,100 ;YES, MOVE TO CORRECT PLACE
TLNN C,MTALTW ;LAST TRANSFER A WRITE?
TRZ A,MT%ILW ;NO, WE DONT WANT TO SEE WRITE LOCK BIT
IOR A,C ;ADD IN OLD STATUS AND IOBKTL
HRRZS A ;JUST RIGHT-HALF
POPJ P,0 ;RETURN
UGETST: PUSHJ P,GSTATS
UMOVEM A,@FORTY
JRST MRETN
USTATO: PUSHJ P,GSTATS
TDNE A,FORTY
JRST MRETN2 ;SKIP RETURN
JRST MRETN ;NOSKIP RETURN
USTATZ: PUSHJ P,GSTATS
TDNN A,FORTY
JRST MRETN2 ;SKIP RETURN
JRST MRETN ;NOSKIP RETURN
USETST: PUSHJ P,SETUP
HRRZ B,FORTY
HRRM B,FLAGWD(BB) ;SAVE MODE ETC
CAIN AA,MTA ;THIS A MTA?
JRST MTASET ;YES, GO SET UP PARITY AND DENSITY
MOVSI A,TTYDEV
TDNN A,DEVTBL(AA) ;TTY?
JRST MRETN ;NO, DONE
PUSHJ P,TTYSET ;SET UP NEW TTY MODE
JRST MRETN
TTYSET: MOVE A,JFNTAB(BB) ;GET JFN FOR THIS TTY
MOVE E,FLAGWD(BB) ;AND FLAGS
TLNN E,TT.CTY ;IS THIS THE CONTROLING TTY?
JRST TTSET1 ;NO
HRRM E,TYSTAT ;YES, SAVE THE NEW MODE
MOVE E,TYSTAT ;GET FLAGS
TTSET1: JRST TTYST0 ;GO SET UP NEW MODE
UOPEN: TLOA C,-1
UINIT: TLZ C,-1
PUSHJ P,SETUPG ;IS A DEVICE ALREADY INIT'ED?
JRST UINIT1 ;NO
PUSH P,C ;SAVE WHETHER OPEN OR INIT
PUSHJ P,URELR ;CALL RELEASE FOR THIS CHANNEL
POP P,C
UINIT1: JUMPL C,UOPEN1 ;WAS IT OPEN?
MOVE A,(P) ;A TO POINT AT FIRST OF THREE ARGS
AOS 0(P)
AOS 0(P) ;P TO POINT TO R1
MOVE C,FORTY ;MAY BE THE RESULT OF AN XCT
SOJA A,UOPEN2
UOPEN1: HRRZ A,FORTY ;EFFECTIVE ADR IS POINTER TO THREE ARGS
UMOVE C,(A)
UOPEN2: HRRZM C,FLAGWD(BB) ;TAKES CARE OF STATUS FOR NOW
UMOVE C,2(A)
MOVEM C,BUFHTB(BB) ;XWD OBUFH,IBUFH
UMOVE C,1(A) ;SIXBIT NAME FROM USER
CAMN C,[SIXBIT/PTY/] ;IS THIS A GENERIC PTY
PUSHJ P,GETPTY ;YES, GO GET A PHYSICAL PTY
MOVEM C,DEVNAM(BB) ;SAVE IT IN SIXBIT
PUSHJ P,DEV67 ;PUT IT IN DEVNM7
MOVE C,DEVNAM(BB) ;GET SIXBIT BACK
;FIND OUT WHAT DEVICE REALLY IS
;CHECK FOR LEGAL MODE
;SET BUFFER SIZE AND BYTE SIZE IN C
HRROI A,DEVNM7
STDEV ;GET DEVICE CHARACTERISTICS
TDZA B,B ;NOT A LEGAL DEVICE NAME, TRY SYS AND TTY
JRST UOPENE ;FOUND DEVICE, GO OPEN IT
CAMN C,[SIXBIT /SYS/]
JRST UOPENE ;CAN'T STDEV ON SYS
MOVSI B,TTY
CAMN C,[SIXBIT /TTY/]
JRST UOPENE
IFN FTFILSER,<
MOVE A,DEVNAM(BB) ;GET NAME
PUSHJ P,DPACHK ;SEE IF THIS IS A TOPS-10 PACK
JRST MRETN ;IT IS NOT, ERROR
MOVEM A,DEVNAM(BB) ;SAVE PACK NAME
JRST TOPEN ;GO DO THE OPEN
>
UOPENE: MOVEM B,DEVNUM(BB) ;SAVE DEVICE DESIGNATOR
PUSHJ P,UOPENF ;DO THE OPEN COMMON CODE
JRST MRETN ;FAILED
JRST MRETN2 ;OPEN WAS SUCCESSFUL
JRST UOPEN6 ;NOT A DISK, GO DO GTJFN NOW
UOPENF: MOVE E,FLAGWD(BB)
LDB AA,PDVNUM ;GET THE VIROS DEVICE TYPE NUMBER
CAIN AA,TTY ;IS THIS A TTY
PUSHJ P,[GJINF ;YES, GET CONTROLING TTY NUMBER
HRRZ A,DEVNUM(BB)
CAME A,D ;IS THIS THE CONTROLING TTY?
POPJ P, ;NO, JUST RETURN
HLL E,TYSTAT ;YES, GET CURRENT STATE FLAGS
TLO E,TT.CTY ;ADD CONTROLLING TERMINAL BIT
MOVEM E,FLAGWD(BB) ;STORE BITS FOR CHANNEL
MOVEI A,.CTTRM ;CONTROLLING TTY
JRST TTPSTS] ;GO SET TERMINAL MODE AND RETURN
MOVE C,DEVTBL(AA) ;GET LEGAL 10/50 MODE BITS
ANDI E,17 ;WHAT MODE
MOVEI D,1
ROT D,(E) ;PUT BIT IN 35-N
TRNN C,(D) ;IS MODE LEGAL FOR THIS DEVICE
POPJ P, ;NO ****NOT RIGHT. SHOULD BE ILLMOD***
CAILE E,14 ;BUFFERED?
JRST UOPEN4 ;NO
MOVSI C,004400 ;FIDDLE WITH MODE NUMBER TO GET BYTE SIZE
CAIGE E,10 ;MODE >=10?
MOVSI C,000700 ;NO, 7 BIT, NOT 36
MOVEI E,0
MOVE D,BUFHTB(BB)
TRNN D,-1 ;IS THERE AN INPUT HEADER?
JRST UOPNE1 ;NO
UOPNE0: UMOVEM E,(D)
UMOVEM C,1(D)
UMOVEM E,2(D)
UOPNE1: HLRZ D,D ;FIRST TIME LEFT HALF IS OUTPUT HEADER
JUMPN D,UOPNE0 ;EITHER NO OUT HDR OR SECOND TIME THRU
UOPEN4: MOVSI B,INITF ;CHANNEL INIT'ED
IORB B,FLAGWD(BB) ;MARK IT.
;**; Insert two lines at UOPEN4 + 1 1/2
CAIN AA,.DVNUL ;[332] NUL?
JRST CPOPJ2 ;[332] YES, FORGET ALL THIS
MOVE B,DEVTBL(AA)
TLNN B,DTADEV ;DECTAPE?
TLNE B,DSKDEV ;OR DSK?
JRST CPOPJ1 ;YES, CAN'T GTJFN YET.
MOVE B,DEVTBL(AA)
TLNN B,MTADEV ;IS IT A MAGTAPE?
JRST CPOPJ2 ;NO, ALL DONE
SETZM MTADAT(BB) ;INITIALIZE DATA WORD
MOVSI A,MTARDB ;GET READ BACKWARDS FLAG
ANDCAM A,FLAGWD(BB) ;AND CLEAR IT
MOVE A,DEVNUM(BB) ;GET DEVICE DESIGNATOR
TLO A,(1B3) ;SUPRESS READING DIRECTORY
MOUNT
JRST UOPNF ;MOUNT FAILED GO TRAP OR BOMB
JRST CPOPJ2 ;GIVE DOUBLE SKIP RETURN FOR NON-DISK DEVICES
UOPEN6: MOVS A,DEVNAM(BB) ;GET DEVICE NAME
CAIE A,'TTY' ;TTY?
JRST UOPEN7 ;NO
MOVEI A,PROJFN ;YES, USE PRIMARY
JRST UOPEN8 ;GO STORE JFN
UOPEN7: PUSHJ P,SETJBK ;SET UP JBLOCK
SETZM JBLOCK ; FOR GTJFN
MOVEI A,JBLOCK
HRROI B,STRNG1 ;GET POINTER TO MAIN STRING
GTJFN
JRST MRETN ;GIVE ERROR TO USER
UOPEN8: MOVEM A,JFNTAB(BB)
DVCHR ;GET CHARACTERISTICS
TXNN B,DV%AV ;AVAILABLE TO THIS JOB?
JRST UOPEN9 ;NO, GIVE FAILURE RETURN
CAIE AA,PTY ;IS THIS A PTY
JRST MRETN2 ;NO, THEN DONE
PUSHJ P,PTYSTF ;YES, GO START UP THE FORKS
SKIPA
JRST MRETN2
UOPEN9: PUSHJ P,URELJ ;GO RELEASE JFN AND CLEAR INIT BLOCK
JRST MRETN ;GIVE ERROR RETURN
UOPNF: PUSHJ P,MNTFAI ;SEE IF TRAP WAS SET UP
JFCL
PUSHJ P,ERROR ;NO, TYPE OUT ERROR (NO RETURN)
PDVNUM: POINT 6,DEVNUM(BB),17 ;NUMERIC DEVICE TYPE FROM DESIGNATOR
UINBUF: TLOA C,-1
UOUTBF: TLZ C,-1
PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF ;CHANNEL INIT'ED?
PUSHJ P,ERRCHN ;NO-YOU LOSE
MOVE CC,BUFHTB(BB)
TLNN C,-1 ;HEADER POINTER ALREADY IN RIGHT HALF?
HLRZ CC,CC ;OBUF,IBUF_0,OBUF
MOVSI B,INBUFF
TLNN C,-1
MOVSI B,OUTBFF
HRRZ C,FORTY ;NUMBER OF BUFFERS IN RING
CAIN C,0 ;DID USRE SPECIFY ZERO BUFFERS?
MOVEI C,2 ;YES, GIVE HIM TWO
PUSHJ P,IOBUF
JRST MRETN
IOBUF: IORM B,FLAGWD(BB)
PUSH P,C ;SAVE NUMBER OF BUFFERS WANTED
MOVE B,DEVTB2(AA) ;GET DEFAULT BUFFER SIZE
CAIE AA,LPT ;LINE PRINTER?
CAIN AA,CDR ;OR CDR?
JRST IOBUF1 ;YES, WATCH OUT FOR SPOOLED DEVICES
CAIE AA,MTA ;MAGTAPE?
JRST IOBUF2 ;NO
PUSHJ P,GETMBS ;GET THE MAGTAPE BUFFER SIZE
MOVE B,DEVTB2(AA) ;FAILED, USE THE STANDARD
MOVE B,A ;GET SIZE IN B
JRST IOBUF2
IOBUF1: HRRZ A,JFNTAB(BB) ;GET THE CHARACTERISTICS
DVCHR ;TO SEE IF IT IS SPOOLED
TLNE B,(1B3) ;ASSIGNABLE BIT = 0 MEANS SPOOLED
IOBUF3: SKIPA B,DEVTB2(AA) ;PHYSICAL DEVICE, USE STD BUFFER SIZE
MOVEI B,200 ;SPOOLED DEVICE, USE 200
IOBUF2: POP P,C ;GET BACK COUNT OF BUFFERS WANTED
UMOVE D,.JBFF ;WHERE TO START RING
MOVEI E,(D) ;SPARE COPY OF START
MOVEI G,3(B) ;TOTAL LENGTH OF EACH BUFFER
IMULI G,(C) ;TIMES NUMBER OF BUFFERS
ADDI G,(D) ;PLUS BEGINNING ADDRESS
CAILE G,PATLOC ;MUST BE BELOW COMPATIBILITY CODE
PUSHJ P,ERRARG
CAML G,JBREL ;IS THERE ENOUGH CORE NOW?
PUSHJ P,XPAND ;NO, GET SOME MORE
CAIGE D,20 ;.JBFF POINT INTO ACS?
PUSHJ P,ITRAP ;YES, ADDRESS CHECK
MOVSI F,400000 ;RING USE BIT
HRRI F,1(D) ;POINTER TO SECOND WORD OF FIRST BUFFER
UMOVEM F,(CC) ;GOES IN FIRST WORD OF HEADER
MOVSI F,1(B) ;SIZE+1 IN LH OF SECOND WORD OF EACH BUFFER
UIOBFL: HRRI F,1(D) ;POINTER TO SELF IN RIGHT HALF
ADDI F,3(B) ;PLUS LENGTH OF A COMPLETE BUFFER
CAIN C,1 ;EXCEPT THE LAST BUFFER
HRRI F,1(E) ;WHICH POINTS BACK TO THE FIRST
UMOVEM F,1(D) ;SET RING PTR TO XWD SIZE+1,NXTBUF+1
ADDI D,3(B) ;POINT BEYOND THIS BUFFER
SOJG C,UIOBFL ;BACK IF MORE BUFFERS TO SET UP
XCTUU <HRRM D,.JBFF> ;SET .JBFF BEYOND BUFFERS
POPJ P,
ULOOKP: PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
PUSHJ P,DIRCHK ;SKIP IF HAS DIRECTORY
JRST MRETN2 ;NO, NOP.
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;GET GENERIC NAME
CAIN A,'DPA' ;THIS A TOPS-10 DPA?
JRST TLKUP ;YES, DO ITS OWN LOOKUP
>
SETZM IOCNT ;CLOSE THIS CHANNEL
PUSHJ P,UCL1R ;CLOSE IT AND RELEASE JFN
MOVE B,DEVTBL(AA)
TLNN B,DTADEV ;DECTAPE
TLNE B,DSKDEV ;OR DSK?
JRST ULK6 ;YES- DO GTJFN NOW
SKIPN A,JFNTAB(BB) ;NO- MUST HAVE JFN ALREADY
PUSHJ P,ERRCHN
JRST ULK7
ULK6: CAIE AA,DTA ;IS THIS A DTA?
JRST ULK6B ;NO
MOVE A,FLAGWD(BB) ;GET OPEN BITS
TRNE A,100 ;OPENED IN NON-STANDARD MODE?
JRST MRETN2 ;YES, LOOKUP IS A NOP THAT SKIPS
PUSHJ P,DTAINI ;CLOSE ALL OTHER OPEN JFNS FOR THIS DTA
PUSHJ P,DTAMNT ;YES, GO MOUNT IT
JRST DTMNTF ;MOUNT FAILED, GO MENTION THIS FACT
ULK6B: PUSHJ P,LUKPAR
JRST ER1 ;BAD UFD SPECIFICATION
MOVE B,DEVTBL(AA) ;GET TYPE OF DEVICE
HLRZ A,EXT(BB) ;GET EXTENSION NAME
TLNE B,DSKDEV ;IS THIS A DISK?
CAIE A,(SIXBIT/UFD/) ;AND ARE WE LOOKING UP A UFD?
SKIPA ;NO TO ONE OF THE ABOVE QUESTIONS
PUSHJ P, ULKUFD ;YES, GO SIMULATE UFD READING
MOVSI A,100100 ;THIS GETS SKIPPED ON A SUCCESFUL ULKUFD RETURN
HRROI B,STRNG1 ;SET UP STRING POINTER
MOVEM A,JBLOCK ;SAVE FLAGS
MOVEI A,JBLOCK ;SET UP FOR LONG FORM GTJFN
GTJFN
JRST LOOKER
MOVEM A,JFNTAB(BB) ;ASSIGNED JFN
PUSHJ P,FILDIR ;UPDATE DIRNUM(BB)
ULK7: PUSHJ P,ULKOPN ;GO OPEN THE JFN
JRST LOOKER ;OPENF FAILED
JRST MRETN2 ;LOOKUP IS FINISHED
ULKOPN: MOVEI B,1B19 ;OPEN FOR INPUT
ULKOP0: PUSHJ P,OPENX
JRST [ CAIE A,OPNX8 ;NOT MOUNTED?
POPJ P,
JRST INMNTF] ;YES, GO COMPLAIN
ULKOP1: MOVSI B,IOPENF!LOOKPF
IORM B,FLAGWD(BB) ;DENOTE FILE OPEN SO CLOSE WILL REALLY CLOSE
SKIPN AA ;IS THIS THE DISK?
PUSHJ P,OPNDSK ;YES, GO SET UP EOF POINTER
MOVSI D,200000 ;MULTIPLE DIRECTORY DEVICE BIT
TDNN D,DEVTBL(AA) ;IS IT ONE OF THOSE?
JRST CPOPJ1 ;NO, ALL DONE FOR NOW
MOVSI D,RDUFDF ;READING THE UFD?
TDNE D,FLAGWD(BB)
JRST [ MOVSI F,(777B8) ;SET UFD PROTECTION TO LOWEST
JRST ULK2A] ;TEMPORARY ****
HRRZ A,JFNTAB(BB) ;SET UP JFN
MOVSI B,22 ;XWD 22,0 I.E. WHOLE FDB
MOVEI C,FDBB ;PSB BUFFER FOR FILE DESCRIPTOR BLOCK
GTFDB
ERJMP CPOPJ1
MOVE B,FDBB+FDBREF ;LAST REF DATE AND TIME
PUSHJ P,NODATE
ANDI D,7777 ;12 BITS ONLY
TRNE PF,R.UEXT ;EXTENDED LOOKUP?
JRST ULK8
XCTUU <HRRM D,1(G)> ;2 FOR MDD
XCTLB <DPB C,[POINT 3,1(G),23]> ;STORE 3 HIGH ORDER DATE BITS
JRST ULK2
ULK8: XCTUU <HRRM D,3(G)>
XCTLB <DPB C,[POINT 3,3(G),23]> ;STORE 3 HIGH ORDER DATE BITS
ULK2: SETZ F, ;INIT PROTECTION WORD
MOVE A,[POINT 6,FDBB+FDBPRT,17]
MOVE B,[POINT 3,F]
MOVEI E,3 ;SET UP FOR THREE PROTECTION FIELDS
ULK2L: ILDB D,A ;GET THE FIRST PROTECTION CLASS
MOVEI C,7 ;ASSUME HIGHEST PROTECTION
TRNE D,10 ;EXECUTE?
MOVEI C,6 ;YES, REDUCE PROTECTION
TRNE D,40 ;READ?
MOVEI C,5 ;YES, REDUCE PROTECTION
TRNE D,4 ;APPEND?
MOVEI C,3 ;YES, REDUCE PROTECTION
TRNE D,20 ;WRITE?
MOVEI C,0 ;YES, NO PROTECTION (0)
IDPB C,B ;STORE THIS FIELD IN F
SOJG E,ULK2L ;LOOP BACK FOR THREE TIMES
MOVE B,FDBB+FDBWRT ;CREATION DATE OF THIS VERSION
PUSHJ P,NODATE
IOR F,D ;ADD DATE,TIME TO PROT ALREADY IN F0-8
LDB B,[POINT 4,FDBB+FDBBYV,17] ;NOW GET MODE
DPB B,[POINT 4,F,12] ;RETURN MODE OF LAST OPEN TO USER
ULK2A: TRNE PF,R.UEXT ;EXTENDED LOOKUP
JRST ULK9
UMOVEM F,2(G) ;PROTECTION,0 MODE,TIME AND DATE
XCTLB <DPB C,[POINT 3,1(G),20]> ;STORE HIGH ORDER 3 DATE BITS
JRST ULK3
ULK9: UMOVE E,0(G) ;GET # OF ELEMENTS IN EXTENDED LIST
CAIGE E,4 ;SHOULD WE RETURN PROTECTION
JRST ULK3 ;NO
UMOVEM F,4(G)
XCTLB <DPB C,[POINT 3,3(G),20]> ;STORE HIGH ORDER 3 DATE BITS
ULK3: LDB B,[POINT 6,FDBB+FDBBYV,11] ;BYTE SIZE
SKIPN B ;IS B 0?
MOVEI B,^D36 ;YES, AVOID THE DIVIDE BY 0 AND USE 36
MOVEI A,^D36
IDIVI A,(B) ;NO OF BYTES IN A WORD
MOVE B,FDBB+FDBSIZ ;NO OF BYTES IN FILE
IDIVI B,(A) ;NO OF WORDS IN FILE
SKIPE C ;INTEGER WORDS
ADDI B,1 ;ROUND UP
TRNE PF,R.UEXT ;EXTENDED LOOKUP?
JRST ULK10
CAILE B,377777 ;<128K WORDS?
JRST ULK4 ;NOPE
MOVNI B,(B) ;YES, -NO OF WORDS
JRST ULK5
ULK4: TRNE B,177 ;EVEN NO OF BLOCKS?
ADDI B,200 ;NO, ROUND UP 1 BLOCK
ASH B,-7 ;CONVERT WORDS TO 128 WORD BLOCKS
ULK5: XCTUU <HRLZM B,3(G)>
JRST ULK11
ULK10: MOVE A,DIRNUM(BB) ;GET DIRECTORY NUMBER
PUSHJ P,PPNUNM ;CONVERT TO PPN
UMOVEM A,1(G) ;RETURN TO USER
CAIGE E,5 ;ENOUGH ROOM FOR WORD COUNT
JRST ULK11 ;NO
UMOVEM B,5(G) ;STORE WORD COUNT
MOVEI C,6(G) ;ZERO THE EXTENDED LOOKUP AREA
MOVEI B,6 ;STARTING AT ITEM 7
ULK10A: CAMLE B,E ;DONE?
JRST ULK10B ;YES
XCTUU <SETZM (C)> ;ZERO ELEMENT
AOS C
AOJA B,ULK10A ;LOOP BACK
ULK10B: CAIGE E,11 ;WANT SIZE IN BLOCKS?
JRST ULK11 ;NO
HRRZ A,FDBBYV+FDBB ;YES, GET SIZE IN PAGES
ASH A,2 ;MULTIPLY BY 4 TO GET BLOCKS
UMOVEM A,10(G) ;RETURN ALLOCATED BLOCKS
UMOVEM A,11(G) ;AND ACTUAL BLOCKS
CAIGE E,16 ;WANT .RBDEV?
JRST ULK11 ;NO
MOVE B,DEVNAM(BB) ;GIVE USER THE DEVICE NAME
UMOVEM B,16(G)
CAIGE E,25 ;WANT QUOTA'S
JRST ULK11 ;NO
MOVSI A,RDUFDF ;ARE WE READING A UFD
TDNN A,FLAGWD(BB)
JRST ULK10C ;NO, DONT GIVE THIS INFO
GJINF ;SEE IF THIS IS FOR CONNECTED DIR
CAME B,DIRNUM(BB) ;...
JRST ULK10C ;NO, CANNOT GET THIS INFO
SETO A, ;THE CONNECTED DIR
GTDAL ;GET DIR ALLOCAATION
LSH A,2 ;TURN PAGES INTO BLOCKS
UMOVEM A,22(G) ;STORE AS FCFS QUOTA LEFT
UMOVEM A,23(G) ;STORE LOGGED OUT QUOTA
HRROI A,[ASCIZ/DSK/] ;USE CURRENT CONNECTED STR
PUSHJ P,PAGUSE ;GET NUMBER OF PAGES IN USE
ASH A,2 ;TURN PAGES INTO BLOCKS
UMOVEM A,25(G) ;STORE BLOCKS
ULK10C: CAIGE E,26 ;WANT .RBAUT?
JRST ULK11 ;NO
HRROI B,STRNG1 ;NOW GET THE AUTHOR NAME
HRROI A,[ASCIZ/PS:</] ;BUILD THE STR/DIR NAME STRING
SETZ C,
SIN
MOVSI A,.GFAUT ;NOW ADD THE AUTHOR'S NAME
HRR A,JFNTAB(BB) ;FROM THE JFN
GFUST ;GET FILE USER NAME STRING
ERJMP ULK10D ;IF NONE, SKIP IT
MOVEI A,">" ;CLOSE THE STRING
IDPB A,B ;NOW HAVE "PS:<DIR>"
MOVEI A,0 ;FOLLOW IT WITH A NULL
IDPB A,B
HRROI A,STRNG1 ;NOW GET THE PPN
STPPN
ERJMP ULK10D
UMOVEM B,26(G) ;STORE IN ARRAY
ULK10D: CAIGE E,35 ;WANT .RBTIM?
JRST ULK11 ;NO
MOVE B,FDBB+FDBWRT ;GET DATE OF THIS VERSION
UMOVEM B,35(G) ;STORE
ULK11: JRST CPOPJ1
;THIS ROUTINE CALCULATES THE NUMBER OF PAGES CURRENTLY ALLOCATED
;IN THE CONNECTED DIRECTORY. IT IS CALLED BY:
; MOVE A,[POINT 7,[ASCIZ/STR/]]
; PUSHJ P,PAGUSE
;
; RETURNS +1 ALWAYS WITH A=NO OF PAGES
PAGUSE:
SETO A,
GTDAL ;GET QUOTA AND USED PAGES
MOVE A,B ;RETURN USED PAGES
POPJ P,
REPEAT 0,<
;OLD METHOD OF SCANNING THE DIRECTORY AND COUNTING
PUSH P,A ;SAVE STRING POINTER
PUSHJ P,JBKSET ;INITIALIZE THE GTJFN BLOCK
POP P,JBLOCK+2 ;PUT STRING POINTER TO DEVICE NAME IN
MOVSI A,100100 ;SET UP FLAGS
MOVEM A,JBLOCK
MOVEI A,JBLOCK ;SET UP FOR GTJFN
HRROI B,[ASCIZ/*.*.*/]
GTJFN ;GET A HANDLE
JRST [SETZ A, ;EMPTY DIR
POPJ P,] ;GO BACK
SETZ D, ;ACCUMULAOTR
PUSH P,A ;SAVE THE JFN
PAGU1: HRRZ A,0(P) ;THE JFN FOR GTFDB
MOVE B,[1,,11] ;ONE WORD .THE PAGE COUNT
MOVEI C,C ;RETURN IT IN C
GTFDB ;GET PAGE COUTN
ERJMP PAGU2
ADDI D,(C) ;ACCUMULATE IT
PAGU2: MOVE A,0(P) ;THE FULL JFN AGAIN
GNJFN ;NEXT!
SKIPA A,D ;ALL THROUGH
JRST PAGU1 ;GOT ANOTHER ONE
POP P,(P) ;CLEAR OUT STACK
POPJ P, ;RETURN
>
DATE: SETO B, ;TO REQUEST CURRENT TAD
PUSHJ P,NODATE
ANDI D,7777 ;12 BITS WORTH ONLY
LSH C,^D12 ;GET HIGH ORDER DATE BITS
IOR D,C ;PUT IN HIGH ORDER 3 BITS FOR DATE 75
MOVE A,D ;DATE TO A FOR RETURN TO USER
JRST STOTAC ; ..
;GET 12 BIT DATE INTO AC D AND HIGH ORDER THREE BITS INTO AC C
NODATE: SETZ D, ;NORMAL FLAGS
ODCNV ;GET YEAR, MONTH, DAY, ETC.
ERJMP [ SETO B, ;ERROR, GET TODAY'S DATE
JRST NODATE]
HRRZ A,D ;SAVE SECONDS SINCE MIDNIGHT
HLRZ D,B ;YEAR
SUBI D,^D1964 ;CONVERT TO 10/50 FORMAT, I.E. ...
IMULI D,^D12 ;(YEAR-1964)*12
ADDI D,0(B)
IMULI D,^D31 ;((YEAR-1964)*12+(MONTH-1))*31
HLRZ C,C
ADDI D,0(C) ; ... +DAY-1
LDB C,[POINT 3,D,23] ;GET HIGH ORDER THREE BITS FOR DATE-75
ANDI D,7777 ;12 BITS ONLY
IDIVI A,^D60 ;MINUTES
ANDI A,3777 ;ONLY 11 BITS WORTH
LSH A,^D12
IOR D,A
POPJ P,
OPENX:
IFN FTFILSER,<
HLRZ D,DEVNAM(BB) ;GET GENERIC NAME
CAIN D,'DPA' ;TOPS-10 PACK?
JRST CPOPJ1 ;YES, DO NOTHING
>
SETZM IOBYTP(BB) ;INITIALIZE POINTER TO START OF FILE
SETZM IOEOFP(BB) ;AND POINTER TO END OF FILE
MOVE D,FLAGWD(BB)
TLNE D,RDUFDF ;ARE WE READING A UFD?
JRST CPOPJ1 ;YES, SO DONT OPEN THE JFN
TLNE D,INITF ;IS IT INIT'ED?
SKIPN A,JFNTAB(BB) ;AND HAS IT A JFN?
PUSHJ P,ERRCHN ;NO
HRRZS A ;GET RH ONLY OF JFN
CAIE A,PRIJFN ;PRIMARY INPUT JFN?
CAIN A,PROJFN ;OR PRIMARY OUTPUT JFN?
JRST CPOPJ1 ;YES, DONT RE-OPEN IT
MOVE C,B ;SAVE MODE FOR OPENING
GTSTS
JUMPGE B,OPENX3 ;IS FILE ALREADY OPEN?
SKIPE MAPTAB(BB) ;ARE THERE PAGES MAPPED?
PUSHJ P,UNMAPP ;YES, GO UNMAP IT SO CLOSF WORKS
TLNE B,(1B1) ;YES.- OPEN FOR INPUT?
TRO C,1B19 ;YES- SAVE THAT INFO
TLNE B,(1B2) ;OPEN FOR OUTPUT?
TRO C,1B20 ;YES- SAVE THAT INFO
TXO A,CO%NRJ+CZ%NUD ;PRESERVE THE JFN
CLOSF ;AND CLOSE FILE
PUSHJ P,ERROR
PUSH P,C ;SAVE OPEN BITS
JUMPN AA,OPENX5 ;IF NOT A DSK, SKIPE THIS CHECK
MOVE B,[XWD 1,1] ;GET WORD INDICATION DELETION
MOVEI C,FDBTMP
HRRZ A,A
GTFDB
ERJMP OPENX5
MOVSI C,(1B3)
TDNN C,FDBTMP ;IS FILE DELETED?
JRST OPENX5 ;NO
HRLI A,FDBCTL+CF%NUD_-^D18 ;YES, UNDELETE IT
MOVSI B,(FDBDEL)
SETZ C,
CHFDB
OPENX5: POP P,C
HRRZ A,A
OPENX3: MOVE B,C ;NOW IT CAN BE OPENED
MOVEI C,17
ANDI C,(D) ;MODE
LDB AA,PDVNUM ;GET DEVICE TYPE NUMBER
MOVE D,DEVTBL(AA)
TLNE D,DTADEV ;IS THIS DUMP MODE TO DECTAPE?
CAIG C,14
SKIPA
JRST OPENX1 ;YES- OPEN IN DUMP MODE
TLNE D,MTADEV ;IS THIS A MAGTAPE?
JRST [ MOVSI D,MTABFS ;MARK THAT BUFFERS ARE NOT SET UP
ANDCAM D,FLAGWD(BB)
HRLI B,440000 ;YES, GET THE BYTE SIZE TO BE USED
CAIL C,15 ;IS THIS A DUMP MODE?
JRST OPENX1 ;YES, GO SET UP FOR DUMP MODE
JRST OPENX2] ;NO, OPEN IT FOR SIN/SOUT MODE
HRLI B,070000 ;NO- OPEN IN ASCII MODE
CAIN AA,CDR ;CARD READER?
JRST [ CAIN C,10 ;IMAGE MODE?
HRLI B,204000 ;YES, SET UP SPECIAL MODE
HRRZ A,JFNTAB(BB) ;GET THE DEVICE CHARACTERISTICS
PUSH P,B ;SAVE THE BYTE POINTER
DVCHR
MOVE A,B
POP P,B
TLNN A,(1B3) ;IS THIS THE SPOOLED CDR?
HRLI B,440000 ;YES, OPEN IN 36 BIT MODE
JRST OPENX2] ;GO DO OPENF
CAIN AA,PLT ;IS THIS A PLOTTER?
JRST [HRLI B,060000 ;YES, ASSUME 6-BIT BYTES
CAIL C,10 ;BINARY MODE?
HRLI B,440000 ;YES, USE 36-BIT WORDS
JRST OPENX2] ;GO OPEN PLOTTER
TLNE D,PTRDEV+PTPDEV ;IS PAPER TAPE?
JRST [ CAIGE C,10 ;YES, ASCII MODE?
JRST OPENX2 ;YES
HRLI B,100000 ;BYTE SIZE IS 8 IF IMAGE MODE
CAIL C,13
HRLI B,440000 ;36 IF BINARY MODE
DPB C,[POINT 4,B,9] ;PASS ALONG MODE
JRST OPENX2]
TLNN D,HASDIR ;UNLESS THIS IS A DIRECTORY DEVICE
CAIL C,10 ;OR BINARY MODE SPECIFIED
HRLI B,440000 ;IN WHICH CASE USE BINARY MODE
JRST OPENX2
OPENX1: HRLI B,447400 ;DUMP MODE
OPENX2: CAIN AA,PTY ;IS THIS A PTY?
HRRI B,1B19!1B20 ;YES, ALWAYS OPEN IT IN READ AND WRITE
HRRZ A,JFNTAB(BB)
TRO B,1B28 ;NEVER WAIT FOR DEVICES
OPENF
JRST OPENX4
JUMPE AA,CPOPJ1 ;IF THIS IS A DISK, GO SET UP POINTERS
CAIN AA,PTY ;IS THIS A PTY?
JRST OPNPTY ;YES, GO MARK THAT IT WAS OPENED
MOVE B,DEVTBL(AA)
TLNE B,MTADEV ;MAGTAPE?
PUSHJ P,MTASTS ;YES, SET MTA STATUS
MOVE B,DEVTBL(AA)
TLNE B,TTYDEV ;TTY?
PUSHJ P,TTYSET ;YES, SETUP MODES
JRST CPOPJ1
OPENX4: CAIE A,OPNX8 ;UNMOUNTED DEVICE?
POPJ P, ;NO, GIVE ERROR RETURN
MOVE B,DEVTBL(AA)
TLNN B,PTRDEV ;PAPERTAPE READER?
POPJ P,
MOVEI A,^D5000
DISMS ;GIVE THE OPERATOR ANOTHER 2 SEC.
HRRZ A,JFNTAB(BB)
JRST OPENX2 ;AND TRY AGAIN
OPNDSK: MOVE A,FLAGWD(BB) ;SEE IF A UFD OR MFD
TLNE A,RDUFDF!RDMFDF ;...
POPJ P, ;YES, DONT SET IOEOFP
PUSHJ P,GETEOF ;GET THE EOF FOR THIS FILE
MOVEM A,IOEOFP(BB) ;SAVE IT AWAY
POPJ P, ;AND RETURN
;ROUTINE TO GET THE EOF OF A FILE IN A
GETEOF: HRRZ A,JFNTAB(BB) ;GET JFN
MOVE B,[XWD 2,11] ;GET BYTE SIZE AND BYTE COUNT FROM FDB
MOVEI C,D ;INTO ACS B AND C
SETZB D,E ;INITIALIZE SIZE AND COUNT TO ZERO
GTFDB
ERJMP .+1 ;IGNORE ERROR
LDB D,[POINT 6,D,11] ;GET BYTE SIZE
SKIPG D ;DONT ALLOW 0
MOVEI D,^D36 ;IF FILE DOES NOT EXIST ASSUME 36 BIT BYTES
MOVEI B,^D36 ;CALCULATE THE # OF BYTES PER WORD
IDIVI B,(D)
IDIVI E,(B) ;NOW GET # OF WORDS IN THE FILE
SKIPE F ;ANY ROUND OFF
AOS E ;YES, COUNT PARTIAL WORD
MOVE A,E ;RETURN ANSWER IN A
POPJ P,
;0 - FILE NOT FOUND
;1 - DIRECTORY NOT FOUND
;2 - READ PROTECTED
LOKERP: SUB P,[3,,3] ;REMOVE NAME, EXT AND PPN FROM STACK
LOOKER: MOVE B,FLAGWD(BB) ;GET FLAGS
TLNE B,RDUFDF ;WAS THIS A FAILURE ON A UFD
JRST UFDEMT ;YES, IT MUST HAVE BEEN EMPTY
MOVSI C,-LKERLN ;SET UP TO SCAN TABLE OF ERROR CODES
TRNN PF,R.ENT ;IS THIS A LOOKUP UUO?
CAIE A,GJFX24 ;YES, IS THIS THE NO NEW FILES ERROR?
JRST LOOKLP ;NO, SCAN FOR ERROR CODE
JRST ER0 ;YES, RETURN ERROR CODE 0 (FILE NOT FOUND)
LOOKLP: HRRZ B,LKERTB(C) ;GET NEXT ERROR CODE FROM TABLE
CAME A,B ;IS THIS A MATCH?
AOBJN C,LOOKLP ;NO, TRY OTHER ERROR CODES
JUMPGE C,ER0 ;UNKNOWN CODE, RETURN 0
HLRZ B,LKERTB(C) ;GET TOPS-10 ERROR CODE TO BE RETURNED
LOOKR2: SKIPE A,NEWJFN ;IS THERE A JFN TO BE RELEASED
RLJFN ;YES, RELEASE IT
JFCL
SETZM NEWJFN ;CLEAR THIS LOCATION
HRRZ G,FORTY ;GET USER ARG LIST POINTER
TRNE PF,R.UEXT ;EXTENDED LOOKUP
JRST LOOKR3 ;YES, STORE FLAGS PROPERLY
XCTUU <HRRM B,1(G)> ;PUT ERROR NUMBER IN RH E+1
JRST MRETN
LOOKR3: XCTUU <HRRM B,3(G)> ;STORE FLAGS IN RH OF EXT WORD
JRST MRETN ;AND RETURN
ER0: TRZA B,-1
ER5: MOVEI B,5
JRST LOOKR2
ER1: MOVEI B,1
JRST LOOKR2
UFDEMT: MOVSI B,UFDEOF ;MARK THAT THE UFD WAS EMPTY
IORM B,FLAGWD(BB)
JRST ULK7 ;GO FINISH THE LOOKUP
LKERTB: XWD 1,GJFX17 ;NO SUCH DIR
XWD 2,GJFX24 ;NO NEW FILES
XWD 2,GJFX29 ;DEV NOT AVAILABLE
XWD 2,OPNX3 ;READ ACCESS NOT ALLOWED
XWD 2,OPNX4 ;WRITE ACCESS NOT ALLOWED
XWD 2,OPNX5 ;EXECUTE ACCESS NOT ALLOWED
XWD 2,OPNX6 ;APPEND ACCESS NOT ALLOWED
XWD 2,OPNX12 ;LIST ACCESS NOT ALLOWED
XWD 2,OPNX13 ;ILLEGAL ACCESS
XWD 2,OPNX15 ;NON-READ/WRITE ACCESS NOT ALLOWED
XWD 2,DELFX1 ;CANNOT DELETE BECAUSE OF LACK OF PRIVELEGES
XWD 2,CFDBX2 ;ILLEGAL TO CHANGE THESE FDB BITS
XWD 2,RNAMX3 ;ACCESS TO DESTINATION NOT ALLOWED
XWD 2,RNAMX8 ;ACCESS TO SOURCE NOT ALLOWED
XWD 3,OPNX1 ;ALREADY OPEN
XWD 3,OPNX9 ;FILE BUSY
XWD 4,GJFX27 ;OLD FILE NOT ALLOWED
XWD 6,OPNX16 ;FILE HAS BAD INDEX BLOCK
XWD 14,GJFX23 ;NO ROOM IN DIR
XWD 14,OPNX10 ;NO ROOM
XWD 14,OPNX23 ;QUOTA EXCEEDED
XWD 16,GJFX22 ;NO ROOM IN JSB
LKERLN==.-LKERTB
;TRANSLATE LOOKUP AND ENTER PARAMETERS TO STRINGS
LUKPAR: MOVSI G,RDUFDF!UFDEOF!DTADMP ;CLEAR BITS
ANDCAM G,FLAGWD(BB) ;...
SETZM EXT(BB) ;INITIALIZE A FEW FIELDS
SETZM PROT(BB)
SETZM DIRNUM(BB)
HRRZ G,FORTY ;POINTER TO PARAMETER BLOCK
UMOVE F,(G) ;NAME IN SIXBIT
TRZ PF,R.UEXT ;INITIALIZE EXTENDED LOOKUP FLAG
TLNN F,-1 ;IS LEFT HALF ZERO?
CAIGE F,3 ;AND RIGHT HALF >= 3?
JRST LUKPR1 ;NOT EXTENDED LOOKUP FORMAT
TRO PF,R.UEXT ;YES - INDICATE EXTENDED ENTER BLOCK
UMOVE D,2(G) ;GET FILE NAME
MOVEM D,FILNAM(BB)
JUMPE D,LUKPR2 ;IF NULL FILE NAME, DONT BELIEVE REST OF ARGS
UMOVE D,3(G) ;GET EXT
HLLZM D,EXT(BB)
UMOVE D,1(G) ;GET PPN
MOVE A,DEVNAM(BB) ;GET SIXBIT DEVICE NAME
PUSHJ P,GETDIR ;TRANSLATE IT TO DIRECTORY NUMBER
POPJ P, ;NO SUCH TRANSLATION
MOVEM D,DIRNUM(BB)
XCTLB <LDB D,[POINT 9,4(G),8]> ;GET PROTECTION VALUE
CAIGE F,4 ;WAS THIS SPECIFIED
MOVEI D,0 ;NO, USE STANDARD
PUSHJ P,GTPROT ;TRANSLATE TO VIROS STYLE PROTECTION
MOVEM D,PROT(BB)
JRST LUKPR2 ;GO SET UP JBLOCK
LUKPR1: MOVEM F,FILNAM(BB) ;NOT EXTENDED TYPE LOOKUP BLOCK
JUMPE F,LUKPR2 ;IF NO NAME, IGNORE OTHER ARGUMENTS
UMOVE D,1(G) ;GET EXT
HLLZM D,EXT(BB)
XCTUU <MOVE D,3(G)> ;GET PPN
MOVE A,DEVNAM(BB) ;GET SIXBIT DEVICE NAME FOR GETDIR
PUSHJ P,GETDIR ;GET DIRECTORY NUMBER
POPJ P, ;NO MAPPING
MOVEM D,DIRNUM(BB) ;STORE DIR NUM
XCTLB <LDB D,[POINT 9,2(G),8]>
PUSHJ P,GTPROT ;GET VIROS STYLE PROTECTION
MOVEM D,PROT(BB)
LUKPR2: AOS (P) ;INSURE A SKIP RETURN
SETJBK: PUSHJ P,JBKSET ;GO INITIALIZE JBLOCK
MOVE E,[POINT 7,STRNG1]
SKIPE D,DEVNAM(BB) ;ANY DEVICE NAME
PUSHJ P,JDEV ;YES, GO ADD THIS TO STRING
SKIPE B,DIRNUM(BB) ;ANY SPECIFIED DIRECTORY?
JRST [ HRROI A,STRNG1 ;YES, PUT STR:<DIR> IN MAIN STRING
DIRST
JRST .+1
MOVE E,A ;USE THIS NEW STRING POINTER
JRST .+1]
SKIPN D,FILNAM(BB) ;GET FILE NAME
JRST SETJB1 ;NONE, JUST EXIT
PUSHJ P,SIX27V ;ADD THIS TO STRING
MOVEI C,"." ;AND A "."
IDPB C,E ;OVERWRITE 0 AT END
MOVE D,EXT(BB) ;NOW ADD EXTENSION
PUSHJ P,SIX27V
MOVEI C,";" ;END WITH A ";"
IDPB C,E
SETJB1: MOVEI D,0
IDPB D,E ;END STRING WITH 0
POPJ P, ;RETURN
JBKSET: MOVE A,[XWD 377777,377777] ;NO FILES
MOVEM A,JBLOCK+1
SETZM JBLOCK+2 ;SYSTEM DEFAULTS ON EVERYTHING
MOVE A,[XWD JBLOCK+2,JBLOCK+3]
BLT A,JBLOCK+10
POPJ P,
;ROUTINE TO GET A DIR NUMBER FROM A PPN
;ACCEPTS IN A/ SIXBIT DEVICE NAME
; D/ PPN
;USES DEVNAM, DIRNAM, AND STRNG1 AS SCRATCH STRINGS
;RETURNS +1: NO TRANSLATION
; +2: DIRECTORY NUMBER IN D AND POINTER TO STRING
; CONTAINING DIR NAME IN AC A
GETDIR: SKIPG D ;NEGATIVE OR 0 PPN?
TDZA D,D ;YES, LEAVE AS 0
TLNE D,-1 ;PATH POINTER?
JRST GETDR0 ;NO
UMOVE D,2(D) ;YES, GET PATH PPN
GETDR0: JUMPE D,CPOPJ1 ;IF NONE SPECIFIED JUST RETURN
PUSH P,D ;SAVE THE PPN
MOVE D,A ;GET DEV NAME TRANSLATED INTO ASCII
HRROI E,DEVNM7 ;INTO DEVNM7
PUSHJ P,SIXTO7
POP P,D ;GET BACK PPN
PUSHJ P,PPNMAP ;SEE IF IT IS SPECIAL
SKIPA ;IT ISNT
JRST GETDR4 ;YES, STRING POINTER IS IN E
HRROI A,STRNG1 ;NOW GET DIR NUMBER
MOVE B,D ;GET PPN
HRROI C,DEVNM7
PPNST ;TRANSLATE THE PPN
ERJMP CPOPJ ;NONE
MOVE E,[POINT 7,STRNG1] ;GET POINTER TO STR/DIR STRING
GETDR4: MOVE B,E ;GET STRING POINTER
MOVX A,RC%EMO ;NO RECOGNITION
RCDIR
ERJMP CPOPJ ;NONE
TXNE A,RC%NOM!RC%AMB ;SUCCEED?
POPJ P, ;NO
MOVE D,C ;PUT DIRECTORY NUMBER IN D
MOVE A,[POINT 7,DIRNAM] ;NOW BUILD DIR NAME STRING IN DIRNAM
GETDR1: ILDB B,E ;GET A CHARACTER FROM STR/DIR STRING
JUMPE B,CPOPJ ;FAILED
CAIE B,"<" ;FOUND START OF DIR YET?
JRST GETDR1 ;NO, LOOP BACK UNTIL FOUND
GETDR2: ILDB B,E ;GET NEXT DIR NAME CHARACTER
JUMPE B,GETDR3 ;REACHED THE END
CAIN B,">" ;SEEN THE END?
JRST GETDR3 ;YES
IDPB B,A ;STORE IT IN DESTINATION
JRST GETDR2 ;LOOP BACK UNTIL THE END IS REACHED
GETDR3: MOVEI B,0 ;END WITH A NULL
IDPB B,A
MOVE A,[POINT 7,DIRNAM]
JRST CPOPJ1 ;RETURN SUCCESSFUL
GTPROT: SKIPN D ;DOES USER WANT DEFAULT
POPJ P, ;YES, LET SYSTEM SUPPLY DEFAULT
SETZ A, ;INITIALIZE ANSWER
MOVE C,[POINT 3,D,26]
MOVEI B,3 ;SET UP LOOP COUNTER
GTPRTL: ILDB E,C ;GET NEXT FIELD
MOVE E,PTAB(E) ;GET TRANSLATION
LSH A,6
IORI A,(E) ;ADD IN THIS FIELD
SOJG B,GTPRTL ;LOOP FOR THREE FIELDS
MOVE D,A
POPJ P,
PTAB: 76 ;0
76 ;1
76 ;2
56 ;3
56 ;4
52 ;5
12 ;6
02 ;7
JDEV: CAMN D,[SIXBIT/SYS/] ;DEVICE SYS?
JRST JDEV1 ;YES
JDEV0: PUSH P,E ;SAVE STRING POINTER IN E
MOVE E,[POINT 7,DEVNM7] ;GET POINTER TO DEVICE NAME BLOCK
MOVEM E,JBLOCK+2 ;STORE IN DEFAULT BLOCK
PUSHJ P,SIX27V ;TRANSLATE TO ASCIZ
POP P,E ;RESTORE MAIN STRING POINTER
POPJ P,
JDEV1: HRROI A,[ASCIZ/SYS/] ;CHECK FOR SYS AS A LOGICAL NAME
STDEV ;...
TDZA A,A ;NOT DEFINED
JRST JDEV0 ;USE SYS AS A DEVICE NAME
HRROI B,[ASCIZ/PS:<SUBSYS>/] ;GET SYSTEM DIRECTORY NUMBER
MOVX A,RC%EMO ;NO RECOGNITION
RCDIR
ERJMP JDEV2 ;FAILED
TXNE A,RC%NOM!RC%AMB
JDEV2: MOVEI C,0 ;FAILED, LEAVE NUMBER AS 0
MOVEM C,DIRNUM(BB) ;SET UP NEW DIRECTORY NUMBER
POPJ P, ;DEFAULT DEVICE TO DSK
;ROUTINE TO MAP PPN'S TO DIRECTORIES
;CALL:
; MOVE A,PPN
; MOVEI B,[ASCIZ/STR/]
; PUSHJ P,PPN2DR
; ERROR - NO CONVERSION
; SUCCESSFUL WITH DIR NUMBER IN A
PPN2DR: PUSH P,A ;SAVE ACS
PUSH P,B
MOVE D,A ;GET PPN
PUSHJ P,PPNMAP ;GO SEE IF IT IS SPECIAL
JRST PPN2D1 ;NO
POP P,0(P) ;NO LONGER NEED STR NAME
POP P,0(P) ;OR PPN
MOVE B,E ;SET UP TO TRANSLATE THIS STRING
JRST PPN2D2
PPN2D1: POP P,C ;GET POINTER TO STR NAME
POP P,B ;GET PPN
HRROI A,STRNG1 ;SET UP TO RECEIVE STR/DIR STRING
PPNST
ERJMP CPOPJ ;FAILED
HRROI B,STRNG1 ;NOW GET DIR NUMBER FROM STRING
PPN2D2: MOVX A,RC%EMO ;NO RECOGNITION
RCDIR
ERJMP CPOPJ ;FAILED
TXNE A,RC%NOM!RC%AMB
POPJ P, ;FAILED HERE TOO
MOVE A,C ;GET DIR NUMBER INTO A
JRST CPOPJ1 ;GIVE SUCCESSFUL RETURN
;ROUTINE TO GET DIR NUMBER IF HASH TABLE NOT AROUND
;CALL:
; MOVE D,PPN
; PUSHJ P,PPNMAP
; ERROR RETURN - NO MAPPING FOR THIS PPN
; NORMAL RETURN - ASCIZ POINTER TO DIRECTORY NAME IN E
PPNMAP: MOVSI C,-NPPN ;SET UP AOBJN COUNTER
CAME D,PMAPTB(C) ;IS THIS A MATCH
AOBJN C,.-1 ;NO, LOOP BACK
JUMPGE C,CPOPJ ;NO MATCH, GIVE NON-SKIP RETURN
MOVE E,SMAPTB(C) ;GET ASCIZ STRING POINTER TO DIR
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO MAP DIRECTORIES TO PPN'S
;CALL: MOVE A,DIRNUM
; PUSHJ P,PPNUNM
; RETURN HERE WITH PPN IN A, ALL OTHER ACS WERE SAVED
PPNUNM: PUSH P,D ;SAVE ALL ACS
PUSH P,C
PUSH P,B
PUSH P,A
JUMPE A,[GJINF ;IF 0 GIVE BACK OWN PPN
MOVE A,B
MOVEM A,0(P) ;PUT DIR NUM ON STACK
JRST .+1] ;AND CONTINUE ON
MOVSI D,-NPPN ;SET UP AOBJN POINTER
PPNLOP: SKIPN C,DMAPTB(D) ;HAS THIS ENTRY BEEN TRANSLATED YET
PUSHJ P,[MOVE B,SMAPTB(D) ;NO, GET DIRNUM FOR THIS ENTRY
MOVX A,RC%EMO ;NO RECOGNITION
RCDIR ;GET DIR NUMBER
ERJMP CPOPJ ;NO TRANSLATION
TXNE A,RC%NOM!RC%AMB
POPJ P, ;NO TRANSLATION
MOVEM C,DMAPTB(D) ;SAVE DIR NUMBER
POPJ P,]
CAMN C,0(P) ;IS THIS A MATCH
JRST [MOVE A,PMAPTB(D) ;YES, GET MAPPED PPN
POP P,(P) ;POP OFF A
JRST PPNDN1] ;CLEAN UP
AOBJN D,PPNLOP ;LOOP FOR ALL MAPPED PPN'S
POP P,A ;NO MATCH, USE THIS VALUE
STPPN ;GET A PPN FROM THIS DIR NUMBER
ERJMP BUGSTP ;NO ERRORS ALLOWED
MOVE A,B ;GET DIR NUMBER INTO A
PPNDN1: POP P,B ;RESTORE ACS
POP P,C
POP P,D
POPJ P, ;AND RETURN WITH PPN IN A
FILDIR: JUMPN AA,CPOPJ ;IS THIS A DSK?
HRROI A,DIRNAM ;YES, GET A DIR NUMBER FROM JFN
HRRZ B,JFNTAB(BB) ;JFN
MOVE C,[1B2!1B5!JS%PAF] ;GET STR:<DIR>
JFNS ;...
MOVX A,RC%EMO ;NOW GET DIR NUMBER
HRROI B,DIRNAM ;DIR STRING
RCDIR
ERJMP FILDR1 ;FAILED
TXNN A,RC%NOM!RC%AMB
MOVEM C,DIRNUM(BB) ;SAVE DIR #
FILDR1: MOVE A,JFNTAB(BB) ;RESTORE JFN
POPJ P,
DEFINE MAPPPN
< MAPGEN(<1,4>,<SUBSYS>)
MAPGEN(<1,2>,<OPERATOR>)
MAPGEN(<1,1>,<SYSTEM>)
>
DEFINE MAPGEN(A,B)
< XWD A>
PMAPTB: MAPPPN
NPPN=.-PMAPTB
DEFINE MAPGEN(A,B)
< POINT 7,[ASCIZ/PS:<B>/]>
SMAPTB: MAPPPN
UENTER: TRO PF,R.ENT ;MARK THAT AN ENTER IS BEING DONE
PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
CAIN AA,LPT ;LINE PRINTER?
JRST UENT1 ;YES, RELEASE THE JFN AND DO GTJFN AGAIN
PUSHJ P,DIRCHK ;DIRECTORY TYPE DEVICE?
JRST MRETN2 ;NO,NOP.
MOVE A,DEVTBL(AA) ;DEVICE BITS
TLNN A,DSKDEV ;A DISK?
JRST UENT1 ;NO
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;GET GENERIC NAME
CAIN A,'DPA' ;TOPS-10 DSK?
JRST TENTER ;YES, GO DO FILSER ENTER
>
MOVE A,FLAGWD(BB) ;YES. GET ITS ST@TUS
TLnn A,IOPENF ;FILE ALREADY OPEN FOR INPUT?
jrst uent1 ;no
pushj p,lukpar ;yes
jrst er1
JRST ENTR4 ;GO DO IT.
UENT1: SETZM IOCNT ;PREPARE FOR CLOSE
PUSHJ P,UCL1R ;CLOSE AND RELEASE JFN
MOVEI D,17
AND D,FLAGWD(BB)
CAIE AA,DTA ;IS THIS A DTA?
JRST ENTR3A ;NO
MOVE A,FLAGWD(BB) ;GET OPEN BITS
TRNE A,100 ;OPENED IN NON-STANDARD MODE?
JRST MRETN2 ;YES, ENTER IS A NOP THAT SKIPS
PUSHJ P,DTAINI ;YES, GO CLOSE OTHER OPEN JFNS FOR THIS DTA
PUSHJ P,DTAMNT ;GO MOUNT IT
JRST DTMNTF ;FAILED, GO COMPLAIN
ENTR3A: PUSHJ P,LUKPAR ;SET UP SAME PARAMETERS AS LOOKUP
JRST ER1 ;UNRECOGNIZABLE UFD
MOVE D,FILNAM(BB) ;GET SIXBIT FILE NAME
CAIE AA,LPT ;IF THIS IS A LPT, THEN NUL NAME ALLOWED
JUMPE D,ER0 ;ZERO FILE NAME FOR ENTER
MOVSI D,IOPENF
TDNE D,FLAGWD(BB) ;FILE OPENF FOR READING ALREADY?
PUSHJ P,ERRARG
MOVSI A,(GJ%FOU)
MOVEM A,JBLOCK ;STORE FLAGS
ENTR3B: MOVEI A,JBLOCK ;SET UP POINTER TO E-BLOCK
HRROI B,STRNG1
GTJFN
JRST [PUSHJ P,WARN ;ERROR - FIRST CHECK IF DIR FULL
JRST LOOKER ;UNKNOWN ERROR
JRST ENTR3B] ;DID AN EXPUNGE, TRY AGAIN
MOVEM A,JFNTAB(BB) ;SAVE GOTTEN JFN
MOVEM A,NEWJFN ;IF OPENF FAILS
PUSHJ P,FILDIR ;UPDATE DIRNUM(BB)
ENTR4: MOVE B,FLAGWD(BB) ;GET STATUS
TLNE B,IOPENF ;WRITE OR UPDATE?
SKIPA B,[OF%RD!OF%WR] ;UPDATE (READ/WRITE)
MOVX B,OF%WR ;WRITE
PUSHJ P,OPENX
JRST [CAIN AA,DTA ;IS THIS A DTA
JRST [ CAIE A,OPNX4 ;YES, WRITE LOCKED?
JRST .+1 ;NO, CALL WARN
PUSHJ P,ILLOUT ;TYPE OUT PROBLEM MESSAGE
HRRZ A,JFNTAB(BB)
JRST ENTR4] ;TRY AGAIN
PUSHJ P,WARN ;FAILURE, GO SEE IF QUOTA EXCEEDED
JRST LOOKER ;NOT QUOTA PROBLEMS, GO GIVE ERROR RET
JRST ENTR4] ;DID AN EXPUNGE SO TRY AGAIN
ENTFIN: PUSHJ P,SETDAT ;SET CREATION DATE AND TIME IF SPECIFIED
SKIPE A,DIRNUM(BB) ;IS THERE A PPN?
PUSHJ P,PPNUNM ;YES, GET THE PPN FROM IT
HRRZ G,FORTY ;GET POINTER TO ARG BLOCK
UMOVE F,(G) ;GET FIRST WORD
TLNN F,-1 ;ZERO LH?
CAIGE F,3 ;AND GREATER THAN 3?
TRZA PF,R.UEXT ;NO, THEN NOT EXTENDED FORMAT
TRO PF,R.UEXT ;YES, EXTENDED FORMAT BLOCK
TRNN PF,R.UEXT ;EXTENDED ARG BLOCK?
JRST [ UMOVEM A,3(G) ;NO
JRST ENTFI1] ;STORE PPN IN SHORT FORM BLOCK
UMOVEM A,1(G) ;EXTENDED BLOCK
UMOVE B,0(G) ;GET LENGTH OF BLOCK
MOVE A,DEVNAM(BB) ;GET DEVICE NAME
CAIGE B,16 ;USER WANT RIBDEV?
JRST ENTFI1 ;NO
UMOVEM A,16(G) ;YES
ENTFI1: MOVSI A,OOPENF!ENTERF
IORB A,FLAGWD(BB)
JUMPN AA,MRETN2 ;IF NOT A DSK, RETURN TO USER
TLNE A,LOOKPF ;SEE IF A LOOKUP WAS DONE
JRST [PUSHJ P,OPNDSK ;YES, DONT DIDDLE VERSION COUNT
JRST MRETN2] ;AFTER SETTING IOEOFP BACK UP
MOVSI G,-EXTLEN ;NOW SEE IF THE EXTENSION MATCHES
MOVS A,EXT(BB) ; ONE OF THE SPECIAL EXTENSIONS
ENTLOP: HLRZ B,EXTTAB(G) ;GET EXTENSION FROM TABLE
CAME A,B ;SEE IF THIS IS A MATCH
AOBJN G,ENTLOP ;NO MATCH, LOOP BACK
JUMPGE G,MRETN2 ;RAN OUT OF ENTRIES?
HRRZ A,JFNTAB(BB) ;SEE IF THIS IS VERSION 1
MOVE B,[XWD 1,FDBVER] ;TO SEE IF VERSION COUNT SHOULD BE SET
MOVEI C,D
GTFDB
ERJMP MRETN2
HLRZS D ;THIS IS THE VERSION NUMBER
CAIE D,1 ;IS IT 1
JRST MRETN2 ;NO, DONT DO ANYTHING SPECIAL
HRRZ C,EXTTAB(G) ;GET DEFAULT NUMBER OF VERSIONS TO KEEP
ROT C,-6 ;POSITION THEM INTO BITS 0-5
MOVSI B,770000 ;SET UP MASK
HRRZ A,JFNTAB(BB) ;GET JFN
HRLI A,FDBBYV+CF%NUD_^D18 ;AND OFFSET INTO FDB
XJSYS <CHFDB> ;SET NEW VERSION LIMIT
JFCL
JRST MRETN2
;TABLE OF SPECIAL EXTENSIONS
; LH - SIXBIT EXTENSION, RH - VERSIONS TO KEEP
EXTTAB: XWD 'LST',1
XWD 'REL',1
XWD 'CRF',1
XWD 'TMP',1
XWD 'OVR',1
XWD 'SYM',1
XWD 'TEM',1
XWD 'XPN',1
XWD 'BIN',1
XWD 'QUE',1
XWD 'QUF',1
XWD 'DIR',1
EXTLEN==.-EXTTAB
SETDAT: JUMPN AA,CPOPJ ;IF NOT A DSK, JUST RETURN
HRRZ G,FORTY ;GET POINTER TO DATA BLOCK
CAIN G,-1 ;NO BLOCK?
POPJ P, ;YES, JUST RETURN AND USE DEFAULT DATE
UMOVE F,(G) ;GET FIRST WORD
TLNN F,-1 ;ZERO LH?
CAIGE F,3 ;AND GREATER THAN 3?
TRZA PF,R.UEXT ;NO, THEN NOT EXTENDED FORMAT
TRO PF,R.UEXT ;YES, EXTENDED FORMAT BLOCK
TRNE PF,R.UEXT ;EXTENDED ENTER?
JRST [XCTLB <LDB A,[POINT 3,3(G),20]>
XCTLB <LDB B,[POINT 12,4(G),35]>
XCTLB <LDB D,[POINT 11,4(G),23]>
JRST SETDT1] ;YES, GET INFO FROM EXTENDED BLOCK
XCTLB <LDB A,[POINT 3,1(G),20]>
XCTLB <LDB B,[POINT 12,2(G),35]>
XCTLB <LDB D,[POINT 11,2(G),23]>
SETDT1: LSH A,^D12 ;GET HIGH ORDER BITS OF DATE
IOR A,B ;GET LOW ORDER BITS OF DATE
JUMPE A,SETDT2 ;IF NOT SPECIFIED, RETURN
IMULI D,^D60 ;TURN MINUTES INTO SECONDS FROM MIDNITE
IDIVI A,^D31 ;GET DAY OF THE MONTH IN B
HRLZ C,B ;STORE FOR JSYS
IDIVI A,^D12 ;GET MONTH AND YEAR
HRLI B,^D1964(A) ;GET ACTUAL YEAR
HRROI A,STRNG1 ;COLLECT DATE IN STRNG1
SETZ E, ;STANDARD FLAGS
XJSYS <ODTNC> ;GET DATE AND TIME
JRST SETDT2 ;IF ERROR, USE CURRENT DATE
HRROI A,STRNG1 ;NOW GET INTERNAL FORMAT
SETZ B, ;NO SPECIAL FLAGS
IDTIM
JRST SETDT2 ;FAILED, SO SET TODAYS DATE
SKIPA C,B ;SET UP TO CHANGE FDB
SETDT2: HRLOI C,377777 ;SET C VERY LARGE SO CAMGE FAILS
GTAD ;GET DATE
CAMGE A,C ;IS DATE SPECIFIED GREATER THAN TODAY
MOVE C,A ;YES, DONT ALLOW THAT
SETO B, ;ALL BITS IN WORD CHANGE
HRRZ A,JFNTAB(BB) ;GET FILE JFN
HRLI A,FDBWRT+CF%NUD_^D18 ;CREATION OF THIS VERSION
XJSYS <CHFDB> ;CHANGE IT
JFCL
POPJ P, ;AND RETURN
URENME: TRO PF,R.ENT ;PREVENT THE VERSION FIELD FROM BEING SET
PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
PUSHJ P,DIRCHK ;DIRECTORY DEVICE?
JRST MRETN2 ;NO
SKIPN JFNTAB(BB) ;SEE IF A FILE WAS PREVIOUSLY OPENED
JRST ER5 ;NO FILE PREVIOUSLY SELECTED
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;TOPS-10 DSK?
CAIN A,'DPA'
JRST TRENME ;YES, GO TO FILSER
>
SETZM IOCNT ;NOW DO A CLOSE (FOR LEVEL-D)
PUSHJ P,UCL1K ; CLOSE WITHOUT RELEASING JFN
PUSHJ P,FILDIR ;GET CORRECT DIRECTORY NUMBER
PUSH P,DIRNUM(BB) ;SAVE OLD DIRECTORY NUMBER
PUSH P,EXT(BB) ;SAVE OLD EXT
PUSH P,FILNAM(BB) ;AND FILE NAME
PUSHJ P,LUKPAR ;SET UP RENAME PARAMETERS
JRST [SUB P,[3,,3] ;REMOVE FILE NAME, EXT
JRST ER1] ;UNRECOGNIZABLE UFD
SKIPN FILNAM(BB) ;ZERO NAME?
JRST RENDEL ;YES, GO DELETE FILE
MOVSI A,600000
MOVEM A,JBLOCK ;STORE FLAGS FOR GTJFN
URENM1: MOVEI A,JBLOCK ;GET E-BLOCK ADDRESS
HRROI B,STRNG1
GTJFN
JRST [PUSHJ P,WARN ;SEE IF OVER QUOTA
JRST LOKERP ;NO, GIVE ERROR RETURN
JRST URENM1] ;GO TRY AGAIN
EXCH A,JFNTAB(BB) ;PUT NEW JFN IN
PUSH P,A ;SAVE JFN
PUSHJ P,FILDIR ;GET DIRECTORY
POP P,A ;GET JFN BACK
EXCH A,JFNTAB(BB) ;RESTORE OLD JFN
POP P,B ;GET OLD FILE NAME
POP P,C ;AND EXT
POP P,D ;AND DIRECTORY NUMBER
CAMN B,FILNAM(BB) ;FILE NAME THE SAME?
CAME C,EXT(BB) ;AND EXT THE SAME
JRST URENM2 ;NO GO RENAME
CAME D,DIRNUM(BB) ;HAS DIRECTORY CHANGED
JRST URENM2 ;YES GO RENAME
RLJFN ;NO. RELEASE THE JFN
JFCL ;IGNORE ANY ERRORS
PUSHJ P,URENA1 ;CHANGE FILE PARAMETERS ONLY
JRST LOOKER ;ERROR RETURN
JRST MRETN2
URENM2: PUSHJ P,URENAM ;GO DO THE RENAMING
JRST LOOKER ;IT FAILED
JRST MRETN2 ;SUCCESSFUL
URENAM: PUSH P,A
HRLI A,FDBPRT ;MAKE IT POSSIBLE TO RENAME THIS FILE
MOVEI B,770000 ;NOT PROTECTED FROM THIS USER
MOVEI C,770000
XJSYS <CHFDB> ;CHANGE THE PROTECTION
JRST [POP P,(P) ;FAILURE
POPJ P,]
HRR A,JFNTAB(BB) ;GET OLD JFN
XJSYS <CHFDB> ;CHANGE ITS PROTECTION ALSO
JRST [POP P,(P) ;FAILURE
POPJ P,] ;RETURN ERROR CODE
HRRZ A,JFNTAB(BB) ;OLD JFN
TLO A,(CO%NRJ) ;DON'T RELEASE IT
CLOSF ;BE SURE FILE IS CLOSED
JFCL
HRRZ A,JFNTAB(BB) ;OLD JFN
POP P,B ;NEW JFN
MOVEM B,NEWJFN ;IN CASE RNAMF FAILS, JFN WILL BE RELEASED
RNAMF
POPJ P, ;GIVE ERROR RETURN
MOVEM B,JFNTAB(BB) ;NEW JFN
URENA1: HRLI A,FDBPRT ;NOW SET THE DESIRED PROTECTION
HRR A,JFNTAB(BB) ;IN FDB
MOVEI B,-1 ;ONLY RH IS CHANGED
HRRZ C,PROT(BB) ;GET DESIRED PROT
SKIPE C ;IF 0 USE WHAT SYSTEM DEFAULTED
CHFDB
ERJMP CPOPJ ;MAY NOT BE ABLE TO CHANGE THE PROTECTION
PUSHJ P,SETDAT ;SET CREATION DATE AND TIME IF SPECIFIED
JRST CPOPJ1
RENDEL: SUB P,[3,,3] ;REMOVE NAME, EXT. AND PPN
HRRZ A,JFNTAB(BB) ;ZERO FILE NAME ON RENAME, IE DELETE
SETZ B, ;KEEP NO VERSIONS
DELNF ;MARK ALL FILES DELETED
JRST LOOKER ;ERROR OCCURED
SETZM JFNTAB(BB) ;INIT DATA BASE
GTSTS ;GET STATUS OF JFN
TLNN B,(1B0) ;OPEN?
JRST [ RLJFN ;NO, JUST RELEASE IT
JFCL ;
JRST MRETN2] ;SUCCESS
CLOSF ;FILE OPEN, CLOSE AND RELEASE
JFCL
JRST MRETN2 ;SUCCESS
UCLOSE: PUSHJ P,SETUPG
JRST MRETN ;NOTHING TO BE OPEN, RETURN IMMEDIATELY
MOVE A,FORTY ;MOVE CLOSE BITS
MOVEM A,IOCNT ;TO WHERE UCL1 WILL SEE THEM
PUSHJ P,UCL1K ;CLOSE, KEEPING JFN
JRST MRETN
UCL1K: TROA PF,R.KJFN ;KEEP THE JFN
UCL1R: TRZ PF,R.KJFN ;RELEASE THE JFN
TRO PF,R.CLS ;INDICATE CLOSE
MOVEI B,1
TDNE B,IOCNT ;CLOSE OUTPUT?
JRST UCL2 ;NO
PUSH P,IOCNT
PUSH P,FORTY
SETZM FORTY
MOVSI B,OOPENF
MOVEI A,17
AND A,FLAGWD(BB)
CAIG A,14 ;BUFFERED MODE?
TDNN B,FLAGWD(BB) ;AND OPEN FOR OUTPUT?
JRST UCL1 ;NO- ALL DONE
HLRZ CC,BUFHTB(BB) ;SEE IF THERE IS A BUFFER RING
JUMPE CC,UCL1 ;NO, DONT DO OUTPUT
UMOVE A,0(CC) ;GET FIRST WORD OF RING
TLZ A,377777 ;CLEAR UN DESIRED BITS
JUMPLE A,UCL1 ;IF VIRGIN OR ZERO, DONT DO OUTPUT
PUSHJ P,OUTTN ;IF OPEN FOR WRITING, DO LAST OUT
JFCL ;PITY
UCL1: POP P,FORTY
POP P,IOCNT
MOVSI B,OOPENF ;CHECK IF FILE OPENED
TDNN B,FLAGWD(BB)
SKIPN MAPTAB(BB) ;AND MAPPED PAGE?
JRST UCL1A ;NO
REPEAT 0,<
SKIPG A,JFNTAB(BB) ;NOW SET THE SIZE AND # OF WORDS
JRST UCL5 ;ONLY IF THERE IS A JFN
HRLI A,FDBSIZ ;BYTE COUNT
MOVNI B,1 ;ALL 36 BITS
MOVE C,IOEOFP(BB) ;SET EOF
XJSYS <CHFDB>
JFCL
HRLI A,FDBBYV ;
MOVSI B,7700
MOVSI C,(^D36B11) ;SIZE = 36 BITS
XJSYS <CHFDB>
JFCL
>
JRST UCL5 ;GO REMOVE PAGE
UCL1A: CAIN AA,MTA ;IS THIS A MTA?
PUSHJ P,CLSMTA ;YES, GO WRITE EOF
UCL2:
MOVEI B,2 ;CLOSING INPUT SIDE?
TDNN B,IOCNT ; ..
SKIPG MAPTAB(BB) ;YES. HAVE A PAGE MAPPED?
JRST UCL4 ;NO.
UCL5: PUSHJ P,UNMAPP ;GO UN MAP PAGE
UCL4: MOVE B,FLAGWD(BB)
MOVE A,IOCNT
TRNN A,1 ;CLOSING OUTPUT?
TLZN B,OOPENF ;WAS THIS OPENED?
JRST UCL6 ;NO, DONT SET PROTECTION
JUMPN AA,UCL6 ;DONT SET PROT IF NOT A DISK
TLNE B,IOPENF!LOOKPF ;WAS IT ALSO OPENED FOR READING?
JRST UCL6 ;YES, THEN DONT CHANGE PROT EITHER
MOVSI A,FDBPRT ;YES, SET PROT
HRR A,JFNTAB(BB) ;GET JFN
MOVEI B,-1 ;SET ONLY RH
HRRZ C,PROT(BB) ;GET DESIRED PROTECTION
JUMPE C,UCL4A ;IF NOT SET, USE SYSTEM DEFAULT PROT
TRNN A,-1 ;WAS THIS FILE CLOSED ALREADY?
JRST UCL4A ;YES, DONT CHANGE PROT
XJSYS <CHFDB> ;NO, OK TO CHANGE PROTECTION
JFCL
UCL4A: MOVE B,FLAGWD(BB) ;GET FLAGS AGAIN
MOVE A,IOCNT ;SET UP CLOSE BITS AGAIN
TLZ B,OOPENF ;CLEAR OUTPUT OPEN FLAG
UCL6: TRNN A,2 ;CLOSING INPUT?
TLZ B,IOPENF ;YES
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;SEE IF THIS IS A DPA
CAIN A,'DPA'
JRST TCLOSE ;YES, GO CLOSE IT WITH FILSER
>
SKIPLE A,JFNTAB(BB)
TLNE B,OOPENF+IOPENF ;BOTH SIDE NOW CLOSED?
JRST UCL3 ;NO
HRRZS A ;GET RH ONLY
CAIE A,PRIJFN ;PRIMARY INPUT JFN?
CAIN A,PROJFN ;OR PRIMARY OUTPUT JFN?
JRST UCL3 ;YES, DONT CLOSE IT
PUSH P,A ;SAVE JFN
CAIN AA,DSK ;DSK?
PUSHJ P,SETEOF ;YES, GO SET THE EOF
POP P,A
HRL A,IOCNT ;GET CLOSE BITS
TLNN A,40 ;FLUSH OUTPUT FILES?
TLZA A,-1 ;NO, CLEAR CLOSF BITS
HRLI A,(CZ%ABT) ;YES, SET ABORT BIT
TLO A,(1B0) ;SET SIGN BIT FOR CLOSF
CLOSF ;CLOSE IT
JFCL ;MULTIPLE CLOSE IS NOP
SKIPLE A,JFNTAB(BB) ;DON'T RELEASE JFN IF IT IS ZERO
TRNE PF,R.KJFN ;OR CALLER SAID KEEP IT
JRST UCL3
HRRZS A
PUSHJ P,SAVUFD ;IF THIS IS A UFD JFN SAV IT
SKIPA ;NOT A UFD
JRST UCL6A ;SAVED, DONT RELEASE IT
RLJFN
PUSHJ P,ERROR
UCL6A: SETZM JFNTAB(BB)
UCL3: CAIN AA,DTA ;DTA?
PUSHJ P,DTAMNT ;YES, GO LEAVE DTA MOUNTED
JFCL ;IGNORE ERROR RETURN
MOVEI A,2 ;B34
TDNN A,IOCNT ;OMIT INPUT SIDE?
PUSHJ P,CLOSEI ;NAH, CLOSE IT
MOVEI A,1 ;B35
TDNE A,IOCNT ;OUTPUT CLOSE?
POPJ P, ;NO, RETURN
CAIN AA,DSK ;IS THIS A DISK?
PUSHJ P,SETEOF ;SET EOF SIZES IN FDB
PUSHJ P,CLOSEO ;DO BUFFER HEADER STUFF
POPJ P,
SETEOF: MOVE B,FLAGWD(BB) ;CHECK IF DSK FILE
TLNE B,OOPENF ;WAS FILE OPENED
TLNE B,RDUFDF+RDMFDF ;YES, IS THIS NOT A DIRECTORY?
POPJ P, ;NO, DONT SET EOF ON DIRECTORY JFNS
SKIPG A,JFNTAB(BB) ;IS THERE A JFN
POPJ P, ;NO
HRLI A,FDBSIZ+CF%NUD_^D18 ;BYTE COUNT
MOVNI B,1 ;ALL 36 BITS
MOVE C,IOEOFP(BB) ;SET EOF
XJSYS <CHFDB>
JFCL
HRLI A,FDBBYV+CF%NUD_^D18
MOVSI B,7700
MOVSI C,(^D36B11) ;SIZE = 36 BITS
XJSYS <CHFDB>
JFCL
POPJ P,
UNMAPP: PUSH P,A
PUSH P,B
PUSH P,C ;SAVE ALL ACS USED
SKIPN B,MAPTAB(BB) ;ANY PAGES MAPPED?
JRST UNMAPD ;NO
HRLI B,.FHSLF ;YES, UNMAP THEM FROM THIS FORK
MOVE C,[PM%CNT+NPLPGS] ;ALL OF THEM IN ONE SWELL FOOP
SETO A,
PMAP
MOVSI A,(1B0) ;NOW FREE UP THIS SLOT
HRRZ B,MAPTAB(BB) ;GET PAGE NUMBER
MOVNI B,-IOMPGS(B) ;GET NEGATIVE PAGE OFFSET IN PAGE AREA
IDIVI B,NPLPGS ;GET BIT POSITION IN MAPLST
LSH A,0(B)
IORM A,MAPLST ;BLOCK IS NOW AVAILABLE
SETZM MAPTAB(BB) ;CLEAR POINTER TO IT
SOS MAPTOT ;COUNT DOWN NUMBER OF MAP SLOTS USED
UNMAPD: POP P,C ;RESTORE ACS
POP P,B
POP P,A
POPJ P,
;ROUTINE TO SAVE A UFD JFN (TO SPEED UP SCAN AND WILD)
;CALL: PUSHJ P,SAVUFD
; RETURN HERE IF JFN NOT SAVED
; RETURN HERE IF JFN WAS SAVED AND SHOULD NOT BE RELEASED
SAVUFD: PUSH P,A ;SAVE ALL ACS USED
MOVE A,FLAGWD(BB) ;GET FLAGS
TLNE A,RDUFDF ;IS THIS A UFD JFN
SKIPG A,JFNTAB(BB) ;GET JFN OF UFD
JRST APOPJ ;NOT A UFD JFN, RETURN TO RELEASE IT
EXCH A,LSTUFJ ;SAVE JFN OF UFD
HRRZS A
RLJFN ;RELEASE OLD JFN
JFCL
MOVE A,DIRNUM(BB) ;GET DIR NUM
MOVEM A,LSTUFD ;SAVE FOR LATER
MOVE A,IOBYTP(BB) ;GET POINTER WORD
MOVEM A,LSTUFP ;SAVE IT TOO
POP P,A ;RESTORE AC
JRST CPOPJ1 ;AND SKIP RETURN
CLOSEI: MOVSI B,IOPENF+INFIRF+LOOKPF
HRRZ A,BUFHTB(BB) ;PTR TO INPUT BUFFER HEADER
CLOSI2: TDNN B,FLAGWD(BB)
POPJ P,
TRO B,1B22 ;CLEAR EOF.
ANDCAB B,FLAGWD(BB)
ANDI B,17
CAIE A,0 ;IS THERE A BUFFER?
CAILE B,14 ;AND IN BUFFERED MODE?
POPJ P, ;NO
MOVSI B,400000 ;CLOSE A BUFFER RING
XCTUU <SKIPN (A)> ;HAS BUFFER RING BEEN SET UP?
POPJ P, ;NO
XCTUU <SETZM 2(A)> ;CLEAR BYTE COUNT
XCTUU <TDNE B,(A)> ;AND HAS IT BEEN USED?
POPJ P, ;NO, FORGET IT
XCTUU <IORB B,(A)>
MOVEI D,(B) ;EXTRA COPY FOR END TEST
MOVEI A,100 ;SET MAXIMUM # OF BUFFERS IN RING COUNT
BUFLP: MOVEI C,(B)
CAMLE C,JBREL ;ARE RING LINK POINTERS OK?
PUSHJ P,ERRARG ;NO, SMASHED SOMEHOW
MOVSI B,400000
XCTUU <ANDCAB B,(C)> ;CLEAR BUFFER USE BIT AND FETCH CHAIN POINTER
CAIE D,(B) ;BACK AROUND TO FIRST ONE IN RING?
SOJG A,BUFLP ;NO
POPJ P,
CLOSEO: MOVSI B,OOPENF+OUFIRF
HLRZ A,BUFHTB(BB)
JRST CLOSI2
DIRCHK: CAIN AA,.DVNUL ;NULL DEVICE?
POPJ P, ;YES, DIRECTORY NOT REQUIRED, RETURN
MOVE B,DEVTBL(AA) ;GET DEVICE BITS
TLNE B,HASDIR ;HAVE A DIRECTORY?
AOS 0(P) ;YES. SKIP RETURN
POPJ P,0 ;RETURN.
DEV67: MOVE D,DEVNAM(BB) ;GET THE SIXBIT NAME
HRROI E,DEVNM7 ;WHERE ASCIZ SHOULD GET PUT
JRST SIXTO7 ;CONVERT IT.
;SETUP ON ENTRY TO IO UUO'S
SETUP: PUSHJ P,SETUPG ;CALL CONDITIONAL SETUP ROUTINE
PUSHJ P,ERRCHN ;NOT OPEN. ERROR.
POPJ P,0 ;OK.
;CONVERSION FROM SIXBIT TO ASCIZ
;C - CLOBBERABLE
;D - SIXBIT THING TO CONVERT
;E - POINTER TO DESTINATION
SIXTO7: HRLI E,440700 ;ASSUME ALL ASCIZ'S START ON WORD BOUNDARY
SETZM 0(E) ;CLEAR DESTINATION WORD
SIX27E: TRZA PF,R.CVF ;CLEAR QUOTING FLAG
SIX27V: TRO PF,R.CVF ;MARK THAT CHARACTERS SHOULD BE QUOTED
JUMPE D,SIXT7B ;QUIT IF STRING EMPTY
SIXT7A: MOVEI C,0
ROTC C,6 ;PUT ONE CHAR INTO C
CAIGE C,'A' ;SEE IF CHARACTER SHOULD BE QUOTED
CAIG C,'9' ;A-Z AND 0-9 WONT GET QUOTED
SKIPA ;SO FAR OK
TRO PF,R.CVC ;QUOTE THIS CHAR
CAIG C,'Z' ;GREATER THAN Z
CAIGE C,'0' ;OR LESS THAN 0
TRO PF,R.CVC ;QUOTE THIS CHAR
TRZE PF,R.CVC ;THIS CHAR TO BE QUOTED
TRNN PF,R.CVF ;YES, QUOTE FLAG ON?
JRST SIXT7C ;NO, DONT QUOTE ANYTHING
PUSH P,C ;SAVE CHARACTER
MOVEI C,C.CNTV ;GET QUOTE CHAR
IDPB C,E ;STORE IT
POP P,C ;GET CHARACTER BACK
SIXT7C: ADDI C,40 ;OFFSET
IDPB C,E ;STORE AWAY
JUMPN D,SIXT7A ;ANY MORE CHARS IN THING?
SIXT7B: PUSH P,E ;SAVE BYTE POINTER BEFORE STORING 0
IDPB D,E ;STORE A ZERO TERMINATOR
POP P,E ;RESTORE UPDATED BYTE POINTER FOR CALLER
POPJ P,
SETUPG: TLNE AC,770000 ;SIXBIT NAME?
JRST SETUPD ;YES, GO SEARCH FOR NAME
MOVE BB,AC ;CHANNEL NUMBER
IMULI BB,NTABS
SETUPF: LDB AA,PDVNUM ;GET NUMERIC DEVICE TYPE
CAIL AA,MAXDEV ;IS THIS A KNOWN DEVICE?
POPJ P, ;NO
SKIPE DEVNAM(BB) ;SOMETHING OF A CROCK.
AOS 0(P)
POPJ P,
SETUPD: MOVEI BB,0 ;SCAN FOR DEVICE NAME
SETUPL: CAMN AC,DEVNAM(BB) ;FOUND IT YET?
JRST SETUPF ;YES
ADDI BB,NTABS ;NO, STEP TO NEXT CHANNEL
CAIG BB,17*NTABS ;REACHED THE END YET?
JRST SETUPL ;NO, LOOP BACK FOR ALL CHANNELS
POPJ P, ;RETURN UNSUCCESSFUL
UUSETO: TROA PF,R.DIRN ;FLAG USETO VS USETI
UUSETI: TRZ PF,R.DIRN ;USETI VS USETO
PUSHJ P,SETUP
CAIN AA,DTA ;IS IT DECTAPE?
JRST DTASET ;YES
JUMPN AA,MRETN ;ONLY ALLOWED FOR DISK AND DTA
MOVSI A,RNDMF ;MARK THAT FILE IS RANDOM
IORB A,FLAGWD(BB) ;THEN SEE IF SUPER USETI/O
TLNN A,LOOKPF!ENTERF ;IS THIS A SUPER USETI OR USETO
JRST SUSET ;YES, GO HANDLE IT
TLNE A,RDUFDF ;IS THIS A UFD WE ARE ADVANCING?
JRST UUFDST ;YES IT IS.... ARGH!
HRRZ B,FORTY ;BUFFER NUMBER
CAIN B,-1 ;IS THIS A SPECIAL CASE?
JUMPE AA,UUSET3 ;YES, GO SET POINTER TO END OF FILE
SOJGE B,.+2
SETZ B,
IMUL B,DEVTB2(AA) ;BUFFER SIZE
TRNN PF,R.DIRN ;OUTPUT?
CAMGE B,IOEOFP(BB) ;NO. INPUT BEYOND EOF?
JRST UUSET1 ;NO
PUSH P,B ;SAVE POSITION
PUSHJ P,PTRGET ;GET EOF VALUE
JRST [ POP P,B
JRST MRETN] ;FAILED
POP P,B ;GET BACK NEW POSITION
CAMGE B,IOEOFP(BB) ;IS IT BEYOND THE EOF?
JRST UUSET1 ;NO
UUSET3:
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;IS THIS A DPA?
CAIN A,'DPA' ;...
PUSHJ P,TUSET ;YES, GO DO FUNCTION
>
PUSHJ P,PTRGET ;GET NEW EOF
JRST MRETN
SKIPE B,IOEOFP(BB) ;GET THE END OF FILE
SOS B ;IF NOT ZERO, DECREMENT IT
TRZ B,177 ;MAKE B = POINTER TO EOF MINUS ONE BLOCK
TRNE PF,R.DIRN ;IS THIS A USETO
JRST UUSET1 ;YES, GO STORE VALUE
MOVE B,IOEOFP(BB) ;NO, GET EOF
MOVEM B,IOBYTP(BB) ;MARK IT
HRRZ A,JFNTAB(BB) ;NOW SET THE NEW FILE POINTER
SFPTR
JFCL
UUSETE: MOVEI A,1B22 ;INPUT, EOF FLAG SET
IORM A,FLAGWD(BB)
JRST MRETN
UUSET1: MOVEI C,1B22 ;CLEAR EOF BIT
ANDCAM C,FLAGWD(BB) ; IN CASE IT WAS ON
IFN FTFILSER,<
HLRZ C,DEVNAM(BB) ;IS THIS A TOPS-10 PACK?
CAIN C,'DPA'
JRST UUSET2 ;YES, DONT DO SFPTR
>
HRRZ A,JFNTAB(BB) ;GET JFN OF FILE
SFPTR
JFCL ;IGNORE ERROR
UUSET2: MOVEM B,IOBYTP(BB) ;STORE NEW BYTE POINTER
CAMLE B,IOEOFP(BB) ;IS THIS A NEW END OF FILE?
MOVEM B,IOEOFP(BB) ;YES, UPDATE EOF POINTER
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;IS THIS A DPA?
CAIN A,'DPA' ;...
PUSHJ P,TUSET ;YES, GO DO FUNCTION
>
JRST MRETN
SUSET:
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;GET GENERIC NAME
CAIE A,'DPA' ;IS THIS A TOPS-10 PACK
JRST BUGSTP ;NO, SUPER USETI/O IS ILLEGAL
SETZM IOBYTP(BB) ;MAKE SURE EOF DOESNT HAPPEN
HRLOI A,377777 ;GET LARGE NUMBER FOR EOF POINTER
MOVEM A,IOEOFP(BB)
JRST TDOUUO ;GO DO UUO
>
IFE FTFILSER,<
JRST BUGSTP ;NOT ALLOWED
>
FILOP: XCTUU <HLRZ AC,0(CAC)>
TRZ AC,400000 ;CLEAR OUT PRIVILEGED BIT
PUSHJ P,SETUP ;SET UP TO POINT TO CHNTAB
XCTUU <HRRZ A,0(CAC)> ;GET FUNCTION CODE
CAIN A,11 ;USETI
JRST FILOP1
CAIN A,12 ;USETO
JRST FILOP2
CAIE A,10 ;UPDATE RIB?
JRST CMRETN ;NO, ALL OTHERS NOT IMPLEMENTED
JUMPN AA,MRETN2 ;IF NOT A DISK, SUCCESS
MOVE A,FLAGWD(BB) ;GET FLAGS
TLNN A,ENTERF ;WRITING TO FILE?
JRST MRETN2 ;NO, SUCCESSFUL RETURN
HRLZ A,JFNTAB(BB) ;GET JFN AND PAGE TO START AT
MOVEI B,-1 ;MAXIMUM NUMBER OF PAGES (MINUS 1!!)
UFPGS ;WRITE ALL PAGES TO THE DISK
PUSHJ P,ERROR ;SHOULDN'T FAIL
PUSHJ P,SETEOF ;SET END OF FILE POINTER
JRST MRETN2 ;SKIP RETURN
FILOP1: TRZA PF,R.DIRN ;INPUT
FILOP2: TRO PF,R.DIRN ;OUTPUT
JUMPN AA,CMRETN ;IF NOT A DISK, RETURN ERROR
MOVSI A,RNDMF ;MARK THAT THE ACCESS IS RANDOM
IORB A,FLAGWD(BB) ;GET FLAGS
TLNN A,RDUFDF ;READING A UFD?
TLNN A,LOOKPF!ENTERF ;OR NO LOOKUP OR ENTER BEEN DONE YET?
JRST CMRETN ;YES, GIVE ERROR
UMOVE B,1(CAC) ;GET BLOCK NUMBER
IMUL B,DEVTB2(AA) ;TURN IT INTO # OF WORDS
TRNN PF,R.DIRN ;USETI?
CAMGE B,IOEOFP(BB) ;YES, IS IT PAST THE EOF?
SKIPA ;NO
JRST CMRETN ;YES, GIVE ERROR RETURN
MOVEI C,1B22 ;TURN OFF EOF IF IT WAS ON
ANDCAM C,FLAGWD(BB)
HRRZ A,JFNTAB(BB) ;NOW SET THE FILE POINTER
SFPTR ;TO THE DESIRED BYTE
PUSHJ P,ERROR ;SHOULD NEVER FAIL
MOVEM B,IOBYTP(BB) ;STORE THE NEW BYTE POINTER
CAMLE B,IOEOFP(BB) ;IS THIS A NEW EOF?
MOVEM B,IOEOFP(BB) ;YES, REMEMBER THAT FACT
JRST MRETN2 ;ALL DONE
PTRGET: PUSHJ P,DIRCHK ;DIRECTORY DEVICE?
POPJ P,0 ;NO. NO-OP
MOVE A,FLAGWD(BB) ;CHANNEL FLAGS
TLNE A,DTADMP ;IS THIS A DTA DOING DUMP MODE STUFF
JRST PTRGT2 ;YES, GO HANDLE SPECIAL CASE
TLNE A,LOOKPF!ENTERF ;MUST BE LOOKED UP OR ENTERED
TLNN A,OOPENF!IOPENF ;AND OPEN FOR INPUT OR OUTPUT
POPJ P, ;ERROR
JUMPE AA,PTRGT1 ;IF DISK, RETURN IOEOFP(BB)
HRRZ A,JFNTAB(BB)
;NOTE - FOLLOWING IN PLACE OF SIZEF WHICH FAILS IF FILE NEVER CLOSED.
RFPTR ;WHERE ARE WE IN FILE?
POPJ P,
PUSH P,B ;SAVE IT
SETO B, ;REQUEST CURRENT EOF
SFPTR ; ..
POPJ P,
RFPTR ;FIND WHERE THAT IS
POPJ P,
EXCH B,0(P) ;SAVE ANSWER
SFPTR ;RESTORE TO WHERE WE WERE AT CALL
POPJ P,
POP P,B ;RETURN THE LENGTH OF FILE
AOS(P) ;SKIP RETURN
POPJ P,
PTRGT1: HRRZ A,JFNTAB(BB) ;GET CURRENT POINTER TO THE EOF
MOVE B,[XWD 1,.FBBYV] ;GET BYTE SIZE
MOVEI C,D ;INTO D
GTFDB
ERCAL ERROR
SIZEF ;GET SIZE OF FILE
PUSHJ P,ERROR
LDB D,[POINT 6,D,11] ;GET BYTE SIZE
SKIPG D ;MUST BE NON-ZERO
MOVEI D,^D36 ;IF ZERO, USE 36
MOVEI C,^D36 ;NOW GET BYTES PER WORD
IDIVI C,(D) ;...
IDIVI B,(C) ;NOW GET # OF WORDS IN THE FILE
SKIPE C ;ROUNDED UP
AOS B ;IF NECESSARY
CAML B,IOEOFP(BB) ;DO NOT SAVE EOF IF IT IS LOWER
MOVEM B,IOEOFP(BB) ;SAVE EOF POINTER
JRST CPOPJ1
PTRGT2: MOVEI B,1102*200 ;RETURN THE # OF WORDS ON A DTA
JRST CPOPJ1
;IN, OUT, INPUT, OUTPUT
UOUT: PUSHJ P,OUTT
MOVE A,FLAGWD(BB)
TRNE A,742000 ;DATA ERRS OR EOT?
JRST UIOSK1
JRST UIOSK
UIN: PUSHJ P,INN
MOVE A,FLAGWD(BB)
TRNE A,762000 ;DATA ERRS, EOF, OR EOT?
UIOSK1: AOS 0(P)
UIOSK: JRST MRETN
UINPUT: PUSHJ P,INN
JRST MRETN
UOUTPT: PUSHJ P,OUTT
JRST MRETN
;IN AND INPUT OPERATORS
INN: PUSHJ P,SETUP
MOVE A,FLAGWD(BB)
JUMPN AA,INN0 ;IS THIS THE DISK?
TLNE A,LOOKPF ;YES, WAS A LOOKUP DONE
JRST INN0 ;YES
MOVEI A,IO.IMP ;NO, SET IO IMPROPER MODE
IORM A,FLAGWD(BB) ;IN FLAG REGISTER
POPJ P, ;AND RETURN
INN0: TLNE A,IOPENF ;OPEN FOR INPUT?
JRST INN3 ;YES
CAIN AA,TTY ;IS THIS A TTY
JRST INNTTO ;YES, OPEN IT FOR BOTH READ AND WRITE
MOVEI B,1B19
PUSHJ P,OPENX ;OPEN IT FOR INPUT
JRST INMNTF ;OPEN FAILED, SEE IF NEEDS MOUNTING
MOVSI A,IOPENF!LOOKPF
INN1: IORM A,FLAGWD(BB) ;MARK THAT FACT
PUSHJ P,SETDES ;GO SET UP NEW DEVICE DESIGNATOR WORD
PUSHJ P,SETUP ;SET UP DEVICE DESIGNATOR IN CASE IT CHANGED
JUMPN AA,INN ;IF NOT A DISK, TRY AGAIN
PUSHJ P,OPNDSK ;IF DISK FILE, SET UP THE COUNTS
JRST INN ;GO TRY AGAIN
INNTTO: MOVEI B,1B19!1B20 ;READ AND WRITE
PUSHJ P,OPENX
JRST INMNTF ;FAILED
MOVSI A,IOPENF!OOPENF ;MARK THAT OPENED FOR BOTH
JRST INN1
INMNTF: PUSHJ P,MNTFAI ;SEE IF TRAP SET UP
JFCL
PUSHJ P,ILLINP ;NO GO TYPE APPROPRIATE MESSAGE
JRST INN ;TRY AGAIN
INN3: ANDI A,17 ;GET MODE INITED IN.
CAIL A,15 ;IS IT A BUFFERED MODE?
JRST INDMP ;NO, DUMP MODE
HRRZ CC,BUFHTB(BB) ;BUFFER HEADER
HRRZ A,FORTY
CAIE A,0 ;SPECIFYING NEW RING?
HRRM A,0(CC) ;YES, STORE ADDRESS
MOVSI A,INFIRF ;FIRST TIME FLAG
TDNE A,FLAGWD(BB) ;IS IT?
SKIPG (CC) ;OR BUFFERS ALREADY SET UP
SKIPA ;YES, GO SET UP SIZE ETC.
JRST INN2 ;NO
IORB A,FLAGWD(BB) ;YES, BUT NOT NEXT TIME ...
MOVSI A,IOPENF
MOVSI B,INBUFF
MOVEI C,2 ;TWO BUFFERS
XCTUM <HRRZ D,0(CC)> ;GET RH ONLY
SKIPN D ;BUFFERS SET UP ALREADY?
PUSHJ P,IOBUF ;NO SET UP A TWO BUFFER RING
SKIPGE A,(CC) ;DON'T ADVANCE BUFFER THE FIRST
JRST INN2B
INN2: MOVSI A,400000 ;CLEAR USE BIT OF CURRENT BUFFER
ANDCAB A,@(CC) ;ALSO GET POINTER TO NEXT BUFFER
INN2B: HRRZM A,(CC)
TRZ PF,R.DIRN ;MARK THAT INPUT IS BEING DONE
PUSHJ P,INIBUF ;ZERO BUFFER AND SET UP PTR AND COUNT
HRRZ A,JFNTAB(BB)
PUSHJ P,@INDSPT(AA) ;SETUP SHOULD SET UP AA WITH DEVICE NUMBER
PUSHJ P,SETIBF ;COMPUTE COUNT AND SET UP NEW PTR
MOVE B,0(CC) ;CURRENT BUFFER ADDRESS
HRRZ A,FLAGWD(BB) ;FILE STATUS
UMOVEM A,-1(B) ;STORE STATUS AT BEGINNING OF BUFFER
POPJ P,
INDSPT: INDSK ;DSK
ITRAP ;DRM
INMTA ;MTA
INDTA ;DTA
INBYT ;PTR
ITRAP ;PTP
ITRAP ;DSP
ITRAP ;LPT
INCDR ;CDR
INBYT ;FE
INTTY ;TTY
INPTY ;PTY
INTTY ;TTR
INBYT ;NUL
INBYT ;NET
ITRAP ;PLT
INBYT ;DLX
ITRAP ;CDP
INBYT ;DCN
INBYT ;SRV
NINDSP==.-INDSPT
IF2 <IFN <NINDSP-MAXDEV>,<PRINTX INPUT DISPATCH TABLE "INDSPT" NEEDS FIXING>>
INDMP: CAIN AA,DTA ;IS THIS A DTA
PUSHJ P,DTAINI ;YES, CLOSE ANY OPEN JFNS FOR THIS DTA
HRRZ A,JFNTAB(BB) ;JFN
CAIN AA,DSK ;DEVICE DISK?
JRST INDM2 ;YES- SIMULATE DUMPI BY SIN
HRRZ B,FORTY ;NO- USE DUMPI
CAIGE B,20 ;IN THE AC'S?
ADDI B,ACS ;YES. POINT TO THEM
TRZ PF,R.DIRN ;DIRECTION IS INPUT (FOR MTA)
MOVE C,DEVTBL(AA) ;IS IT A MAGTAPE?
TLNE C,MTADEV ; ..
JRST MTALP1 ;YES. TREAT SEPARATELY
INDM1: DUMPI
JRST INDMER ;ERROR. SEE IF FIXABLE.
INDM3: POPJ P,
INDM2: HRRZ D,FORTY ;COMMAND LIST POINTER
INCML: CAIGE D,20 ;IN THE ACS?
ADDI D,ACS ;YES. POINT TO STORED ACS
MOVE C,(D) ;COMMAND LOOP
JUMPE C,INDM3 ;DONE ON ZERO COMMAND
TLNE C,-1 ;ZERO LEFT HALF MEANS GOTO
JRST INDM4
MOVE D,C
JRST INCML ;GET NEW COMMAND
INDM4: MOVE B,FLAGWD(BB) ;IS THIS A UFD WE ARE READING
TLNE B,RDUFDF
JRST INDUFD ;YES, GO DO GNJFN'S
TRZ PF,R.DIRN ;MARK THAT WE ARE DOING INPUT
HRRZM C,IOBPT ;SET UP IO POINTER
HLROS C ;GET WORD COUNT
MOVNM C,IOCNT ;STORE AS POSITIVE COUNT OF WORDS TO TRANSFER
PUSH P,D ;SAVE COUNTER
PUSHJ P,MOVBUF ;GO TRANSFER THE BUFFER
JRST [ POP P,D ;RESTORE STACK
JRST INDM4B] ;EOF
POP P,D ;RESTORE COUNTER
MOVE B,IOBYTP(BB) ;GET FINAL BYTE POINTER
TRZE B,177 ;MAKE SURE IT ENDED ON A 200 WORD BOUNDRY
JRST [ ADDI B,200 ;IT DIDNT, SO MAKE IT BE ON A BLK BOUND
IFN FTFILSER,<
HLRZ A,DEVNAM(BB)
CAIN A,'DPA' ;CHECK FOR TOPS-10 PACK
JRST .+1 ;IF YES, DO NOT DO THE SFPTR
>
HRRZ A,JFNTAB(BB)
SFPTR ;SET NEW POINTER
PUSHJ P,ERROR
JRST .+1]
MOVEM B,IOBYTP(BB) ;STORE NEW BYTE POINTER
SKIPG B,IOCNT ;WAS THIS TRANSFER COMPLETED
AOJA D,INCML ;YES, GO GET THE NEXT COMMAND TO DO
AOS IOBPT
SETZM @IOBPT ;NO, ZERO THE REST OF THE BUFFER AREA
SOJG B,.-2
AOJA D,INCML ;GO SEE IF THROUGH
INDM4B: MOVEI A,1B22 ;YES. REALLY EOF.
IORM A,FLAGWD(BB) ;SET 10/50 EOF BIT
JRST INDM3 ;DONE.
;SET BUFFER FOR USER AFTER INPUT
SETIBF: MOVE B,IOCNT ;BYTES NOT XFERRED LAST TIME
LDB C,[POINT 6,IOBPT,11] ;BYTE SIZE OF XFER
XCTLB <LDB D,[POINT 6,1(CC),11]> ;USER'S BYTE SIZE
CAIN C,0(D) ;SAME?
JRST SETIB1 ;YES
CAIG C,0(D) ;XFER SIZE BIGGER?
JRST SETIB2 ;NO
SKIPE D ;IF 0 DONT DO DIVIDE
IDIVI C,0(D) ;XFER SIZE BIGGER, GET RATIO
IMUL B,C ;NUMBER USER-SIZE BYTES NOT XFER'D
SETIB1: MOVN C,B ;B NOW HAS NUMBER NOT XFERRED
XCTUU <ADDB C,2(CC)> ;ACTUAL BYTES XFERRED TO USER
MOVE B,C ;BYTES
MOVEI C,^D36 ;BITS PER WORD
XCTLB <LDB D,[POINT 6,1(CC),11]> ;USER'S BITS PER BYTE
SKIPE D ;IF 0 DONT DIVIDE
IDIVI C,(D) ;BYTES PER WORD
IDIVI B,(C) ;WORDS
SKIPE C ;AND FRACTION THEREOF
ADDI B,1
MOVE C,0(CC) ;CURRENT BUFFER ADDRESS
TRNE PF,R.NOWC ;SHOULD THE WORD COUNT BE STORED?
JRST SETIB3 ;NO, SO DONT STORE IT
XCTMU <HRRM B,1(C)> ;STORE THE WORD COUNT WITH BUFFER
SETIB3: MOVSI A,HASDIR+MTADEV ;SEE IF 36-BIT DEVICE
TDNE A,DEVTBL(AA) ;IF NOT, THEN BUFFER WAS ALREADY ZEROED
SKIPN IOCNT ;DID BUFFER GET COMPLETELY FILLED
JRST SETIB4 ;YES, JUST RETURN
XCTUM <HLRZ C,0(C)> ;GET SIZE OF BUFFER PLUS ONE
ANDI C,377777 ;CLEAR USE BIT
SUBI C,1(B) ;GET REMAINING WORDS IN BUFFER
AOS B,IOBPT ;GET POINTER TO NEXT WORD IN BUFFER
HRLS B ;SET UP SOURCE WORD FOR BLT
SETZM 0(B) ;ZERO THE FIRST WORD
ADDI C,-1(B) ;GET POINTER TO END OF BUFFER
HRRI B,1(B) ;GET DESTINATION
CAIL C,0(B) ;BLOCK OF MORE THAN ONE WORD IN LENGTH?
BLT B,0(C) ;YES, ZERO BLOCK
SETIB4: MOVSI A,400000 ;BUFFER USE BIT (BF.IOU)
XCTUU <IORM A,@(CC)> ;SET IN BUFFER HEADER
POPJ P, ;RETURN
SETIB2: IDIVI D,0(C) ;BUT OTHERWISE, THIS FIXES UP
IDIV B,D ;BYTE COUNT
JRST SETIB1
;ROUTINE TO INPUT FROM DSK VIA PMAP SINCE SIN IS SLOWER.
INDSK: MOVE B,FLAGWD(BB) ;GET FLAGS FOR THIS CHANNEL
TLNE B,RDUFDF ;ARE WE READING A UFD
JRST INUFD ;YES, GO SIMULATE IT
TRZ PF,R.DIRN ;MARK THAT WE ARE DOING INPUT
MOVEI A,200 ;ALWAYS DO 200 WORDS FOR DISK
EXCH A,IOCNT
PUSH P,A ;SAVE ORIGINAL COUNT FOR LATER
PUSHJ P,MOVBUF ;GO MOVE A BUFFER
JRST [POP P,A ;EOF WAS SEEN
JRST INTY8A]
POP P,A ;GET ORIGINAL IOCNT
MOVE B,IOCNT ;GET NEW IOCNT
ADDI A,-200(B) ;GET IOCNT REFLECTING # OF WORDS RECEIVED
HRRZM A,IOCNT ;STORE FOR CLEAN UP ROUTINE
JRST INTTY9 ;OK RETURN
INDON1: AOS IOCNT
JRST INTTY9
INTTY8: PUSHJ P,CRLF ;TYPE CRLF ECHO
INTY8A: MOVEI A,1B22 ;EOF FLAG IN STATUS WORD
IORM A,FLAGWD(BB)
INTTY9: MOVSI A,400000 ;BUFFER USE FLAG
XCTUU <IORM A,@(CC)>
LDB A,[POINT 6,IOBPT,11] ; GET BYTE SIZE
CAIE A,7 ;WAS THIS AN ASCII TRANSFER
JRST INTTY7 ;NO, DONT CLEAR REST OF WORD
MOVE A,IOCNT
IDIVI A,5 ;DOES IT END ON WORD BOUNDARY?
JUMPE B,INTTY7 ;YES, ALL DONE.
MOVE A,B
SETZ B,
FILWD: XCTLB <IDPB B,IOBPT> ;FILL REST OF LAST WORD WITH ZEROES
SOS IOCNT
SOJG A,FILWD
INTTY7: POPJ P,
CRLF: PUSH P,A ;TYPE OUT A CRLF
HRROI A,[ASCIZ/
/]
CPSOUT: PSOUT
JRST APOPJ
OUTT: PUSHJ P,SETUP
MOVE B,FLAGWD(BB)
TLNE B,OOPENF ;OPEN FOR OUTPUT?
JRST OUTTN ;YES
SKIPN JFNTAB(BB) ;DOES IT HAVE JFN?
TLNN B,OUFIRF ;OR IS IT FIRST TIME THROUGH?
TLNN B,INITF ;AND IS IT INIT'ED?
PUSHJ P,ERRCHN ;NO- ERROR
SKIPN JFNTAB(BB) ;DOES IT HAVE JFN?
JRST OUTTN ;NO, DON'T OPEN IT YET
CAIN AA,TTY ;IS THIS A TTY
JRST OUTTTO ;YES, OPEN IT FOR BOTH R+W
MOVEI B,1B20
PUSHJ P,OPENX ;OPEN FOR OUTPUT
JRST OUTMTF ;OPEN FAILURE, GO SEE IF IT WAS A MOUNT
MOVSI A,OOPENF
OUTT0: IORM A,FLAGWD(BB) ;AND MARK IT
REPEAT 0,< ;DONT DO THIS UNLESS PMAPING TO DISK
PUSHJ P,SETDES ;GO SET NEW DEVICE DESIGNATOR WORD
>
JRST OUTT
OUTTTO: MOVEI B,1B19!1B20 ;OPEN FOR BOTH READ AND WRITE
PUSHJ P,OPENX
JRST OUTMTF
MOVSI A,IOPENF!OOPENF
JRST OUTT0
OUTMTF: PUSHJ P,MNTFAI ;SEE IF USER WANTS TO TRAP THIS
JFCL
PUSHJ P,ILLOUT ;NO TYPE A MESSAGE AND BOMB
JRST OUTT ;TRY AGAIN
OUTTN: MOVEI A,17
AND A,FLAGWD(BB) ;MODE
CAIL A,15 ;IS IT A BUFFERED MODE?
JRST OUTDMP ;NO
HLRZ CC,BUFHTB(BB) ;OUTPUT BUFFER HEADER POINTER
JUMPE CC,CPOPJ ;IF NO BUFFER HEADER, IGNORE CLOSE
HRRZ A,FORTY
CAIE A,0 ;NEW RING?
JRST [HRRM A,0(CC) ;YES, STORE ADDRESS
MOVSI A,400000 ;CLEAR IOUSE BIT
ANDCAM A,0(CC)
JRST .+1]
MOVSI A,OUFIRF ;FIRST TIME THROUGH FLAG
TDNE A,FLAGWD(BB) ;IS IT?
SKIPGE 0(CC) ;OR BUFFER NOT SETUP?
SKIPA ;YES, DO DUMMY OUTPUT
JRST OUTT2 ;NO
IORM A,FLAGWD(BB) ;YES
MOVEI C,2
MOVSI B,OUTBFF ;OUTBUF DONE FLAG
XCTUU <SKIPN 0(CC)> ;OUTPUT BUFFERS SETUP?
PUSHJ P,IOBUF ;NOT YET
XCTUU <SKIPGE A,(CC)> ;HAS USER SET UP HIS OWN BUFFERS?
JRST OUTT9 ;NO, GO FIX UP FIRST BUFFER FOR HIM
OUTT2: PUSHJ P,SETOBF
HRRZ A,JFNTAB(BB) ;GET DESTINATION
SKIPN IOCNT ;ALWAYS OUTPUT IF NON-ZERO
TRNN PF,R.CLS ;IF ZERO, DON'T OUTPUT IF CLOSE
PUSHJ P,@OUTLST(AA)
MOVE B,0(CC) ;CURRENT BUFFER ADDRESS
HRRZ A,FLAGWD(BB) ;FILE STATUS
MOVEM A,-1(B) ;STORE LATTER IN BEGINNING OF FORMER
XCTUU <MOVE A,@(CC)> ;ADVANCE THE BUFFER
OUTT9: XCTUU <HRRZM A,(CC)>
TRO PF,R.DIRN ;MARK THAT OUTPUT IS BEING DONE
PUSHJ P,INIBUF
POPJ P,
OUTLST: EXP OUTDSK ;DSK
EXP ITRAP ;DRM
EXP OUTMTA ;MTA
EXP OUTDTA ;DTA
EXP ITRAP ;PTR
EXP OUTBYT ;PTP
EXP ITRAP ;DSP
EXP OUTBYT ;LPT
EXP ITRAP ;CDR
EXP OUTBYT ;FE
EXP OUTTTY ;TTY
EXP OUTPTY ;PTY
EXP ITRAP ;TTR
EXP OUTBYT ;NUL
EXP OUTBYT ;NET
EXP OUTBYT ;PLT
EXP OUTBYT ;DLX
EXP OUTBYT ;CDP
EXP OUTBYT ;DCN
EXP OUTBYT ;SRV
NOUTDS==.-OUTLST
IF2 <IFN <MAXDEV-NOUTDS>,<PRINTX DISPATCH TABLE "OUTLST" NEEDS FIXING>>
OUTDMP: MOVSI A,OUFIRF ;MARK THAT OUTPUT WAS DONE
IORM A,FLAGWD(BB) ;SO CLOSE KNOWS
CAIN AA,DTA ;DTA?
PUSHJ P,DTAINI ;YES, CLOSE ANY OPEN JFNS FOR THIS DTA
HRRZ A,JFNTAB(BB) ;JFN
CAIN AA,DSK ;DISK DEVICE TYPE?
JRST OUTDM2 ;YES- SIMULATE DUMPO BY SOUT
HRRZ B,FORTY ;NO- USE DUMPO
CAIGE B,20 ;POINTER IN AC'S?
ADDI B,ACS ;YES. POINT TO STORED ACS
TRO PF,R.DIRN ;DIRECTION IS OUTPUT.
MOVE C,DEVTBL(AA)
TLNE C,MTADEV ;MAG TAPE?
JRST MTALP1 ;YES. GO TO MAG TAPE HANDLER
OUTDM1: DUMPO
JRST OUDMER ;LOST. SEE IF RECOVERABLE
OUTDM3: POPJ P,
OUTDM2: HRRZ D,FORTY ;COMMAND LIST POINTER
OUTCML: CAIGE D,20 ;IN THE ACS?
ADDI D,ACS ;YES. POINT TO STORED ACS
MOVE C,(D) ;COMMAND LOOP
JUMPE C,OUTDM3 ;DONE ON ZERO COMMAND
TLNE C,-1 ;ZERO LEFT HALF MEANS GOTO
JRST OUTDM4 ;NO,REAL IO WORD
MOVE D,C
JRST OUTCML
OUTDM4: TRO PF,R.DIRN ;MARK THAT OUTPUT IS IN PROGRESS
HRRZM C,IOBPT ;STORE POINTER TO BUFFER IN USER AREA
HLROS C ;GET NEG WORD COUNT
MOVNM C,IOCNT ;STORE AS POSITIVE IOCNT
HRRZ A,JFNTAB(BB) ;GET JFN IN CASE AN SFPTR IS DONE
MOVE B,IOBYTP(BB) ;GET CURRENT POSITION TO START WRITING
CAMLE B,IOEOFP(BB) ;NEED TO UPDATE FILE POINTER TO NEXT BLK
SFPTR ;YES, ALWAYS START ON A BLOCK BOUNDRY
JFCL
PUSH P,D ;SAVE THE COUNTER
PUSHJ P,MOVBUF ;MOVE THE BUFFER
JFCL ;SHOULD NEVER GET HERE
POP P,D ;RESTORE COUNTER
MOVE B,IOBYTP(BB) ;SEE IF TRANSFER ENDED ON A BLOCK BOUNDRY
ANDI B,177
JUMPE B,OUDM4D ;IF 0, THEN DONT FILL WITH ZEROS
HRROI C,-200(B) ;GET NEG # OF ZEROS TO BE WRITTEN
HRRZ A,JFNTAB(BB) ;GET JFN OF FILE
MOVE B,IOBYTP(BB) ;FIRST, GET THE BYTE POINTER SET UP
SFPTR
ERCAL ERROR
MOVSI B,(POINT 0,0,0) ;GET POINTER TO A SOURCE OF ZEROS
SOUT ;FILL WITH ZEROS
REPEAT 0,< ;PMAP METHOD OF DISK TRANSFERS
MOVEI A,IOMPGS(AC) ;GET CURRENT POINTER INTO OUTPUT PAGE
LSH A,11
MOVE B,IOBYTP(BB)
ANDI B,777
ADDB B,A ;GET START OF FREE AREA IN OUTPUT BUF
TRON A,177 ;GET END OF 200 WORD BLOCK
JRST OUDM4D ;BLOCK ENDED ON A 200 WORD BOUNDRY
HRLS B ;GET BLT WORD
HRRI B,1(B) ;TO ZERO REST OF OUTPUT BLOCK
SETZM -1(B) ;CLEAR FIRST WORD
CAIL A,0(B) ;ANY MORE TO DO
BLT B,0(A) ;YES, BLT ZEROS THROUGH AREA
>
OUDM4D: PUSHJ P,FIXEOF ;GO FIX UP THE EOF IF IT NEEDS IT
MOVE C,IOBYTP(BB) ;GET THE BYTE POINTER AGAIN
TRZN C,177 ;WAS THIS AN EVEN BLOCK TRANSFER?
AOJA D,OUTCML ;YES, GO DO NEXT COMMAND
ADDI C,200 ;NO, MAKE IT AN EVEN 200
MOVEM C,IOBYTP(BB)
AOJA D,OUTCML ;GO DO NEXT COMMAND
IFN SAMFRK,<
OUTBYT: MOVE 2,IOBPT
MOVN 3,IOCNT
JUMPGE 3,CPOPJ ;IT'S POSSIBLE THERE'S NOTHING TO DO
SOUT
MOVEM 2,IOBPT
SETZM IOCNT
POPJ P,
>
OUTDSK: MOVE A,IOBYTP(BB) ;GET NEW END OF DATA
ADD A,IOCNT ;FOR EOF CALCULATION
PUSH P,A ;SAVE FOR AFTER TRANSFER
IFN FTFILSER,<
HLRZ B,DEVNAM(BB) ;THIS GOING TO A TOPS-10 PACK?
CAIN B,'DPA' ;IF YES, THEN LEAVE COUNT ALONE
JRST OUTDS1 ;YES, LEAVE ACTUAL COUNT FOR FILSER
>
MOVEI A,200 ;ALWAYS TRANSFER 200 WORDS FOR DISK
MOVEM A,IOCNT ;...
OUTDS1: TRO PF,R.DIRN ;OUTPUT IN PROGRESS
PUSHJ P,MOVBUF ;SEND OUT THE BUFFER
JFCL
POP P,A ;GET POSSIBLE NEW EOF POSITION
CAMLE A,IOEOFP(BB) ;IS THERE A NEW EOF
PUSHJ P,UPDEOF ;YES, UPDATE THE EOF
POPJ P,
;ROUTINE TO UPDATE THE EOF FOR A CHANNEL
FIXEOF: MOVE A,IOBYTP(BB) ;GET THE NEW BYTE POINTER
CAMG A,IOEOFP(BB) ;SEE IF EOF NEEDS UPDATING
POPJ P, ;NO, JUST RETURN
UPDEOF: MOVEM A,IOEOFP(BB) ;STORE THE NEW EOF
MOVE A,FLAGWD(BB) ;SEE IF THIS FILE IS A NEW FILE
TLNN A,IOPENF!LOOKPF ;IF FILE WAS LOOKED UP, THEN DO THE SFPTR
POPJ P, ;OTHERWISE, NO NEED TO SET EOF POINTER
HRRZ A,JFNTAB(BB) ;GET THE JFN
MOVE B,IOEOFP(BB) ;GET THE NEW EOF POINTER
SFPTR ;SET THE NEW POSITION
ERCAL ERROR
POPJ P, ;RETURN
;MOVE A BUFFER TO OR FROM THE FILE
;PRESERVE AC D ALWAYS
MOVBUF:
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;IS THIS A DPA?
CAIN A,'DPA' ;...
JRST TMOVB ;YES, GO DO UUO INSTEAD
>
PUSHJ P,MAPINP ;GO TRY TO MAP IN THE PAGE
SKIPE MAPTAB(BB) ;IS THERE A MAPPED AREA?
JRST MOVBFP ;YES, GO BLT DATA FROM THERE
TRNE PF,R.DIRN ;IN OR OUT?
SKIPA A,[SOUT] ;OUT
MOVE A,[SIN] ;IN
PUSH P,A ;SAVE JSYS TO BE EXECUTED
MOVE C,IOEOFP(BB) ;(314)GET EOF
SUB C,IOBYTP(BB) ;(314)GET # OF WORDS LEFT IN FILE
TRNN PF,R.DIRN ;(314)ONLY CARE IF INPUT
CAML C,IOCNT ;(314) NOT ENOUGH WORDS TO SATISFY REQUEST?
MOVE C,IOCNT ;(314)OK TO USE FULL COUNT
JUMPLE C,APOPJ ;(314)NO MORE WORDS EOF RETURN TAKEN
MOVNS C ;(314)C= NEG NUMBER OF WORDS TO TRANSFER
MOVE B,IOBPT ;AND POINTER TO USER AREA
HRLI B,(POINT 36,0,35) ;MAKE SURE IT IS A LEGAL BYTE POINTER
PUSH P,C ;SAVE COUNT
MOVN A,C ;GET ADDRESS OF WORD BEYOND BUFFER
ADDI A,1(B) ;SIN ZERO'S 1 WORD AFTER BUFFER
PUSH P,0(A) ;SAVE WORD
PUSH P,A ;AND ITS ADDRESS
HRRZ A,JFNTAB(BB) ;GET JFN
XCT -3(P) ;DO THE TRANSFER
POP P,A ;GET BACK ADR OF WORD AFTER BUFFER
POP P,0(A) ;RESTORE WORD AFTER BUFFER
POP P,A ;GET BACK ORIGINAL COUNT
POP P,(P) ;CLEAN UP STACK
SUB C,A ;CALCULATE # OF WORDS TRANSFERED
JUMPE C,CPOPJ ;IF NONE TRANSFREED, EOF
ADDM C,IOBYTP(BB) ;UPDATE FILE POINTER
SUB C,IOCNT ;UPDATE IOCNT
MOVNM C,IOCNT ;THOSE WORDS NOT TRANSFERED
MOVEM B,IOBPT ;AND UPDATED POINTER
JRST CPOPJ1 ;EXIT SUCCESSFULLY
MOVBFP: MOVE B,IOBYTP(BB) ;GET CURRENT POINTER
ANDI B,777 ;GET WORD WITHIN PAGE
SUBI B,1000 ;GET NEG # OF WORDS LEFT IN PAGE
MOVE C,IOEOFP(BB) ;GET EOF
SUB C,IOBYTP(BB) ;GET # OF WORDS LEFT IN FILE
TRNN PF,R.DIRN ;ONLY CARE IF INPUT
CAML C,IOCNT ;IS THERE NOT ENOUGH WORDS TO SATISFY REQUEST
MOVE C,IOCNT ;OK TO USE FULL COUNT
CAMGE C,IOCNT ;NEAR THE END OF FILE?
JRST [ PUSH P,B ;SAVE ACS
PUSH P,C
PUSHJ P,GETEOF ;YES, SEE IF THE EOF CHANGED
POP P,C
POP P,B
CAMG A,IOEOFP(BB)
JRST .+1 ;EOF DID NOT CHANGE
MOVEM A,IOEOFP(BB) ;STORE NEW EOF
JRST MOVBFP] ;GO TRY AGAIN WITH NEW EOF
JUMPLE C,CPOPJ ;NO MORE WORDS, EOF RETURN TAKEN
MOVNS C ;C = NEG # OF WORDS TO TRANSFER
CAMLE B,C ;ENOUGH WORDS IN PAGE?
JRST MOVB1 ;NO, DO THIS IN CHUNKS
MOVB2: MOVE A,IOBYTP(BB) ;GET POSITION WITHIN OF FILE
IDIVI A,NPLPGS*1000 ;GET POSITION WITHIN MAPPED AREA INTO B
HRRZ A,MAPTAB(BB) ;GET THE START OF THE MAPPED AREA
LSH A,11 ;MAKE IT AN ADDRESS
ADDI A,(B) ;THIS IS DESTINATION ADDRESS
HRL A,IOBPT ;NOW GET ADDRESS OF USER BUFFER
ADD A,[XWD 1,0]
TRNN PF,R.DIRN ;DOING OUTPUT?
MOVSS A ;YES, REVERSE THE DIRECTION OF A
ADDM C,IOCNT ;COUNT DOWN IOCNT
MOVN B,C ;GET POS WORD COUNT
ADDM B,IOBPT ;UPDATE IOBPT
ADDM B,IOBYTP(BB) ;AND FILE POINTER
ADDI B,(A) ;GET END OF TRANSFER ADDRESS
MOVINS: BLT A,-1(B) ;TRANSFER THE DATA
ERJMP MOVBE ;IF FAILED, GO SEE IF SPARSE FILE
MOVINE: JRST CPOPJ1
MOVB1: MOVE C,B ;DO ONLY WHAT IS LEFT IN THIS PAGE
PUSHJ P,MOVB2
JFCL
JRST MOVBUF ;LOOP BACK FOR REST
MOVBE: PUSH P,A ;SAVE THE ACS
PUSH P,B
TRNE PF,R.DIRN ;DOING AN INPUT?
JRST MOVBE1 ;NO, GO TRY AGAIN
MOVEI A,.FHSLF ;GET LAST ERROR
GETER
HRRZS B ;ONLY WANT THE ERROR CODE
CAIE B,ILLX01 ;ILLEGAL READ?
JRST MOVBE1 ;NO, GO DO BLT AGAIN ONLY LET IT TRAP
POP P,B ;RESTORE ARGUMENTS
POP P,A ;GIVE THE USER PROGRAM ZEROES
SETZM (A) ;ZERO FIRST WORD OF BUFFER
HRLS A ;SET UP BLT POINTER TO PROPAGATE ZERO
HRRI A,1(A) ;SET UP DESTINATION ADR
CAILE B,(A) ;ENOUGH ROOM FOR BLT?
BLT A,-1(B) ;YES, GIVE REST OF ZEROES TO USER
JRST CPOPJ1 ;RETURN
MOVBE1: POP P,B ;THIS IS AN UNKNOWN ERROR
POP P,A ;SO DO THE BLT AGAIN
BLT A,-1(B) ;BUT LET THE ERROR CAUSE A TRAP
JRST CPOPJ1 ;SO QOUTA AND DATA ERRORS WORK RIGHT
;ROUTINE TO MAP IN THE NEXT 4 PAGES OF A FILE
MAPINP: SKIPN MAPTAB(BB) ;IS THERE A MAPPED AREA?
JRST MAPIN0 ;NO, GO TRY TO SET ONE UP
MOVE A,IOBYTP(BB) ;NOW SEE IF WE ARE ON A BOUNDRY
IDIVI A,NPLPGS*1000
IMULI A,NPLPGS ;GET FIRST PAGE OF THE SECTION
HLRZ B,MAPTAB(BB) ;GET FIRST MAPPED PAGE OF FILE
CAMN A,B ;HAVE THE RIGHT AREA MAPPED
POPJ P, ;YES, NO NEED TO GO FURTHER
MAPIN0: SKIPN MAPTAB(BB) ;IS THERE A MAP SLOT YET
JRST [ PUSHJ P,GETIOP ;NO, GO GET ONE
JRST MAPIN1 ;NONE LEFT
MOVEM A,MAPTAB(BB)
JRST .+1]
MOVE A,IOBYTP(BB) ;GET PAGE OF FILE TO PRELOAD
IDIVI A,NPLPGS*1000 ;GET ADDRESS OF FIRST PAGE TO MAP
IMULI A,NPLPGS*1000
LSH A,-11 ;GET PAGE NUMBER OF FIRST MAPPED PAGE
HRLM A,MAPTAB(BB) ;SAVE PAGE # OF MAPPED FILE PAGE
HRL A,JFNTAB(BB) ;SET UP FOR PMAP
HRLI B,.FHSLF ;MAP INTO THIS FORK
HRR B,MAPTAB(BB) ;GET PAGE NUMBER TO MAP INTO
MOVE C,[PM%CNT!PM%RD+NPLPGS]
MOVE D,FLAGWD(BB) ;SEE IF PRELOADING IS TO BE DONE
TLNN D,RNDMF ;DOING RANDOM ACCESS?
TRNE PF,R.DIRN ;NO, INPUT?
SKIPA ;NO, DO NOT PRELOAD ANY PAGES
TXO C,PM%PLD ;YES, THEN PRELOAD THE PAGES
TLNE D,OOPENF ;OPENED FOR WRITE?
TXO C,PM%WR ;YES, TURN ON WRITE BIT
PMAP ;PREFAULT THE PAGES
ERJMP MAPIN1 ;IF FAILED, GO USE SIN
POPJ P, ;AND RETURN
MAPIN1: SKIPN MAPTAB(BB) ;IS THERE A MAPPED AREA
POPJ P, ;NO, DO NOT NEED TO DO ANYTHING
PUSHJ P,UNMAPP ;YES, UNMAP THE PAGES
HRRZ A,JFNTAB(BB)
MOVE B,IOBYTP(BB)
SFPTR ;SET THE BYTE POINTER UP CORRECTLY
ERJMP MAPIN2 ;PROBLEM - INVESTIGATE...
POPJ P, ;NOW GO USE SEQUENTIAL IO
MAPIN2: CAIE A,DESX8 ;FILE NOT ON DISK?
PUSHJ P,ERROR ;NO, SOME OTHER ERROR
POPJ P, ;NO FILE! JUST RETURN
GETIOP: TLNN PF,L.SMAL ;SMALL SYSTEM?
JRST GETIO0 ;NO, ALWAYS PREFAULT IF POSSIBLE
MOVE A,MAPTOT ;HOW MANY FILES ARE OPEN ALREADY?
CAIL A,5 ;REACHED ARBITRARY LIMIT YET?
POPJ P, ;YES, DO NOT PREFAULT ANY MORE
GETIO0: MOVE A,MAPLST ;FIND A FREE MAP SLOT
JFFO A,GETIO1 ;IF ANY
POPJ P, ;NONE LEFT
GETIO1: MOVSI A,400000 ;NOW SET UP A MASK
MOVN C,B
LSH A,0(C)
ANDCAM A,MAPLST ;MARK THIS SLOT IN USE
AOS MAPTOT ;COUNT UP THE NUMBER OF SLOTS IN USE
IMULI B,NPLPGS ;CALCULATE THE PAGE # OF THE SLOT
ADDI B,IOMPGS
MOVE A,B ;RETURN THE ANSWER IN A
JRST CPOPJ1 ;SKIP RETURN WHEN SUCCESSFUL
;PREPARE FULL BUFFER FOR EMPTYING
SETOBF: MOVEI B,17
AND B,FLAGWD(BB) ;MODE
XCTUU <HLLZ C,1(CC)> ;GET BYTE SIZE BITS
XCTUU <HRRZ D,1(CC)> ;FETCH RH OF BYTE POINTER
UMOVE E,(CC)
SUBI D,1(E) ;PTR TO ZERO'TH WORD OF DATA
MOVEI A,1B31
TDNE A,FLAGWD(BB) ;USER WANTS TO SPECIFY OWN COUNT?
JRST [UMOVE D,1(E) ;YES, GET COUNT
JRST .+1]
MOVEI F,0(D) ;SAVE UN-MULTIPLIED COUNT
LDB A,[POINT 6,C,11] ;BYTE SIZE
PUSH P,B ;SAVE B OVER DIVIDE
PUSH P,A ;PUSH SIZE
MOVEI A,44 ;WORD LENGTH
SKIPE 0(P) ;IN CASE CLOBBERED
IDIV A,0(P) ;BYTES PER WORD
POP P,B ;DISCARD BYTE SIZE
POP P,B ;RESTORE B
IMULI D,0(A) ;BYTE COUNT IN THOSE WORDS
MOVEI C,1(E) ;CONSTRUCT BYTE POINTER FOR XFER
MOVSI E,HASDIR+MTADEV ;USUAL CHECK FOR WORD TRANSFERS
HRLI C,0700 ;TRANSFER 7-BIT UNLESS
CAIGE B,10 ;MODE IS BINARY, OR
TDNE E,DEVTBL(AA) ;DEVICE HAS DIRECTORY OR IS MAGTAPE
HRLI C,4400 ;IN WHICH CASE TRANSFER 36-BIT
MOVEM C,IOBPT
TLNE C,4000 ;IF 36-BIT XFER,
MOVE D,F ;USE UN-MULTIPLIED COUNT
MOVEM D,IOCNT ;LEAVE COUNT FOR XFER ROUTINE
LDB C,[POINT 6,IOBPT,11] ;GET BYTE COUNT FROM IOBPT
XCTLB <LDB B,[POINT 6,1(CC),11]> ;GET USER'S BYTE COUNT
CAMG B,C ;IS IOCNT WRONG
POPJ P, ;NO, RETURN
IDIVI B,(C) ;YES, CORRECT IT
IMULI D,(B) ;GET # OF BYTES PER WORD
MOVEM D,IOCNT ;STORE CORRECT VALUE
POPJ P,
SETDES: MOVSI A,'TTY' ;SET NEW DEVICE DESIGNATOR WORD
CAMN A,DEVNAM(BB) ;UNLESS IT IS THE TTY
POPJ P, ;TTY, JUST RETURN
HRRZ A,JFNTAB(BB) ;GET JFN
DVCHR ;GET NEW DEVICE CHARACTERISTICS WORD
MOVEM A,DEVNUM(BB) ;SAVE NEW DEVICE TYPE IN CASE SPOOLED DEV
POPJ P,
;PREPARE EMPTY BUFFER
INIBUF: MOVEI D,17
AND D,FLAGWD(BB) ;MODE
MOVSI E,HASDIR+MTADEV ;SEE IF 36-BIT XFER POSSIBLE
HRRZ B,A ;CHECK IF A POINTS TO ACS
CAIGE B,20 ;THIS WOULD BE ILLEGAL
PUSHJ P,ITRAP ;DONT ALLOW THIS, BLT WILL KILL PAT AC'S
XCTUU <SETZM 1(A)> ;ZERO THE BUFFER
MOVSI B,1(A)
HRRI B,2(A)
HLRZ C,(A) ;SIZE OF DATA AREA+1.
ANDI C,377777 ;CLEAR RING USE BIT
CAIG C,1 ;SHOULD BE NONZERO BUFFER SIZE
PUSHJ P,ERRARG
SUBI C,1
PUSH P,C ;SAVE FOR LATER USE
ADDI C,1(A)
CAIGE D,10 ;BINARY MODE?
TDNE E,DEVTBL(AA) ;36-BIT DEVICE?
TRNE PF,R.DIRN ;YES, IS THIS INPUT?
SKIPA ;NO, CLEAR BUFFER
JRST INIB1 ;DONT HAVE TO CLEAR INPUT BUFFER FOR 36 BIT TRANSFER
XCTUU <BLT B,(C)>
INIB1: XCTUU <HLLZ B,1(CC)> ;GET SIZE BITS
TLZ B,770077
HRRI B,1(A)
UMOVEM B,1(CC) ;INITIALIZE BYTE POINTER
LDB C,[POINT 6,B,11] ;BYTE SIZE
MOVEI A,44 ;WORD SIZE
PUSH P,B ;SAVE B OVER DIVIDE
SKIPE C ;IN CASE OF JUNK IN HEADER
IDIVI A,0(C) ;BYTES PER WORD
POP P,B ;RESTORE B
IMUL A,0(P) ;BYTES IN BUFFER
UMOVEM A,2(CC) ;INIT BYTE COUNT
CAIN AA,MTA ;MAGTAPE?
JRST INIBMT ;YES, SPECIAL HANDLING
POP P,A ;BUFFER LENGTH
HRLI B,0700 ;7-BIT UNLESS...
CAIGE D,10 ;BINARY MODE, OR
TDNE E,DEVTBL(AA) ;DIRECTORY DEVICE OR MAGTAPE
HRLI B,4400 ;IN WHICH CASE 36-BIT
CAIN AA,CDR ;IS THIS A CDR?
JRST [ CAIE D,10 ;YES, IS IT IN BINARY MODE
JRST .+1 ;NO
HRLI B,1400 ;YES, USE MODE 10
MOVEM B,IOBPT ;STORE THE BYTE POINTER
IMULI A,3 ;GET THE NUMBER OF BYTES PER BUFFER
JRST INIB2] ;GO STORE IT
MOVEM B,IOBPT
TLNN B,4000 ;SMALL BYTES?
IMULI A,5 ;YES, 5 PER WORD
INIB2: MOVEM A,IOCNT
POPJ P,
INIBMT: POP P,IOCNT ;SET WORD COUNT
MOVEM B,IOBPT ;REMEMBER POINTER (WITHOUT BYTE SIZE)
HRRZ A,JFNTAB(BB) ;GET READY
RFBSZ ;READ CURRENT BYTE SIZE
MOVEI B,^D36 ;FAILED, ASSUME WORDS
DPB B,[POINT 6,IOBPT,11] ;FILL IN BYTE SIZE
MOVEI A,^D36 ;HOW MANY BITS IN A WORD
IDIV A,B ;COMPUTE HOW MANY BYTES IN A WORD
IMULM A,IOCNT ;CONVERT WORD COUNT TO BYTE COUNT
POPJ P, ;DONE
URELEA: PUSHJ P,SETUPG
JRST MRETN ;NOTHING TO RELEASE
IFN FTFILSER,<
HLRZ A,DEVNAM(BB) ;IS THIS A DPA?
CAIN A,'DPA'
JRST TRELEA ;YES, DO A FILSER RELEASE
>
PUSHJ P,URELR ;DO THE RELEASE
JRST MRETN
URELR: SKIPN DEVNAM(BB)
POPJ P,
LDB AA,PDVNUM ;GET DEVICE TYPE CODE
SETZM IOCNT
PUSHJ P,UCL1K ;CLOSE FILE, KEEPING JFN
URELJ: SKIPG JFNTAB(BB) ;IS THERE A JFN
JRST UREL2 ;NO, DONT RELEASE IT
HRRZ A,JFNTAB(BB)
CAIE A,PRIJFN ;REAL JFN?
CAIN A,PROJFN ; ..
JRST UREL3 ;NO
PUSHJ P,SAVUFD ;IF A UFD SAVE JFN
RLJFN
JFCL ;MAY FAIL BECAUSE FILE MAPPED ON ANOTHER CHANNEL
UREL2: HLLZS FLAGWD(BB) ;CLEAR INIT BITS.
SETZM CHTABS(BB)
MOVSI A,CHTABS(BB)
HRRI A,CHTABS+1(BB)
BLT A,CHTABS+NTABS-1(BB)
POPJ P,
UREL3: HLLZ E,TYSTAT ;GET JUST LEFT HALF OF STATUS
PUSHJ P,TTPSTS ;GO SET UP NEW TTY STATUS
JRST UREL2
;SOME DEVICE TYPE THINGS
DSKCHR: HLRZ F,CAC ;GET LENGTH OF ARG BLOCK
CAIG F,0 ;IS IT NON-ZERO
MOVEI F,1 ;ASSUME ONE WORD
IFN FTFILSER,<
UMOVE A,0(CAC) ;GET DEVICE NAME
PUSHJ P,DPACHK ;SEE IF IT IS A TOPS-10 PACK
SKIPA ;NO
JRST TDOUUO ;YES, GO CALL FILSER
>
UMOVE D,0(CAC) ;GET USER ARGUMENT
PUSHJ P,CHKDSK ;SEE IF THIS IS A DSK
JRST MRETN ;NO, GIVE ERROR RETURN
CAIGE F,2 ;WANT ANY VALUES RETURNED?
JRST DSKCH3 ;NO, JUST RETURN THE AC FLAGS
HRROI A,DEVNM7 ;GET POINTER TO STR
PUSHJ P,PAGUSE ;GET PAGES IN USE
PUSH P,A ;SAVE ANSWER
HRROI A,DEVNM7 ;GET POINTER TO STR AGAIN
HRROI B,STRNG1 ;BUILD STR: STRING
SETZ C,
SIN
MOVEI C,":" ;TACK ON A COLON
IDPB C,B
MOVEI C,0 ;FOLLWED BY A NULL
IDPB C,B
MOVX A,RC%EMO ;NOW GET A DIR #
HRROI B,STRNG1
RCDIR
ERJMP DSKCH1
TXNE A,RC%NOM!RC%AMB ;FOUND ONE?
JRST DSKCH1 ;NO
MOVE A,C ;GET DIR # IN A
GTDAL ;GET QUOTA
POP P,B ;GET PAGES LEFT
SUB A,B ;CALCULATE PAGES LEFT IN QUOTA
ASH A,2 ;TURN PAGES INTO BLOCKS
UMOVEM A,1(CAC) ;STORE IT
DSKCH1: HRROI A,DEVNM7 ;GET STR NAME AGAIN
STDEV ;GET A DEVICE DESIGNATOR
JRST DSKCH2 ;FAILED
MOVE A,B ;GET DESIGNATOR INTO A
GDSKC ;GET FREE BLOCKS LEFT
LSH B,2 ;CHANGE PAGES TO BLOCKS
CAIGE F,3
JRST DSKCH3
UMOVEM B,2(CAC)
CAIGE F,4
JRST DSKCH3
UMOVEM B,3(CAC) ;STORE BLKS LEFT ON STR AND UNIT
DSKCH2: CAIGE F,5 ;CHECK ARG LIST LENGTH
JRST DSKCH3 ;NOT LONG ENOUGH FOR STRUCTURE NAME
UMOVE E,0(CAC) ;GET DEVICE NAME AGAIN
UMOVEM E,4(CAC) ;STORE STR NAME
CAIGE F,16 ;LONG ENOUGH FOR PHYSICAL NAME
JRST DSKCH3 ;NO, JUST RETURN
UMOVEM E,14(CAC) ;STORE LOGICAL NAME AS "DSK"
UMOVEM E,15(CAC) ;AND PHYSICAL NAME AS "DSK" TOO.
DSKCH3: SETZ A, ;SET UP ANSWER
XCTUM <MOVS B,0(CAC)> ;GET DEVICE NAME AGAIN
CAIE B,'DSK' ;IS THIS DSK?
MOVSI A,2 ;NO, SAY THAT IT IS NOT GENERIC DSK
JRST STOTC1 ;RETURN ANSWER
CHKDSK: HRROI E,DEVNM7 ;MAKE IT ASCIZ
PUSHJ P,SIXTO7 ;...
HRROI A,DEVNM7 ;NOW GET DEVICE DESIGNATOR
STDEV
POPJ P,
TLNE B,77777 ;IS THIS A DISK?
POPJ P, ;NO
JRST CPOPJ1 ;YES
GETCHR:
DEVCHR: PUSH P,AC ;SAVE AC FOR STOTAC
TLNE CAC,-1 ;DEVICE NAME OR CHANNEL NUMBER?
JRST DEVCH0 ;SIXBIT DEVICE NAME
CAILE CAC,17 ;LEGAL CHANNEL NUMBER
JRST DEVCHZ ;NO, GIVE ERROR RETURN
MOVEI AC,(CAC) ;GET CHANNEL NUMBER
PUSHJ P,SETUPG ;GET INDEX INTO NAME TABLE
JRST DEVCHZ ;NO DEVICE ON THIS CHANNEL, RETURN 0
MOVE D,DEVNAM(BB) ;GET DEVICE NAME FROM TABLE
JRST DEVCH3 ;GO GET CHARACTERISTICS
DEVCH0: MOVEI AC,0 ;SET UP TO SEE IF THIS IS ALREADY INITED
DEVCLP: PUSHJ P,SETUPG ;IS THERE A DEVICE ON THIS CHANNEL?
JRST DEVCH2 ;NO
CAMN CAC,DEVNAM(BB) ;IS IT SAME AS ARGUMENT
JRST DEVCH1 ;YES, GO GET ITS CHARACTERISTICS
DEVCH2: CAIGE AC,17 ;CHECKED ALL CHANNELS YET
AOJA AC,DEVCLP ;NO
SETO BB, ;MARK THAT THIS IS NOT INITED
DEVCH1: MOVE D,CAC ;SIXBIT DEVICE NAME
DEVCH3: PUSHJ P,DVCHR1 ;CALL COMMON ROUTINE
JFCL ;NONEXISTENT DEVICE
JUMPL BB,DVCHZ1 ;IF NOT INITED, STORE THIS ANSWER
TXNE A,DV.DSK ;IS THIS A DISK?
JRST DVCHZ1 ;THIS IS THE DSK, DONT SET INITED BIT
TXNE A,DV.LPT ;IS THIS A LPT?
JRST DVCHZ1 ;THIS IS THE LPT, DONT SET INITED BIT
TROA A,1B19 ;MARK THAT THIS DEVICE WAS INITED
DEVCHZ: MOVEI A,0 ;RETURN A ZERO
DVCHZ1: POP P,AC ;RESTORE AC FOR STOTAC
JRST STOTAC ;AND STORE THE RESULT
JRST STOTAC ;RETURN AC A TO USER
DEVSIZ: UMOVE D,1(CAC) ;GET THE SIXBIT ARG DEVICE NAME
PUSHJ P,DVCHR1 ;GET ITS CHARACTERISTICS
JRST RETM11 ;NO SUCH DEV. RETURN A MINUS 1
HLRZ C,B ;GET THE VIROS DEVICE TYPE
ANDI C,777 ; ..
CAILE C,MAXDEV ;KNOWN DEVICE?
MOVEI C,0 ;NO, USE DSK
UMOVE F,0(CAC) ;AND THE MODE WORD
MOVE D,F ;GET MODE
ANDI D,17 ;JUST THE MODE FIELD
MOVNI A,2 ;ANSWER IF ILLEGAL
MOVEI E,1 ;BIT FOR MODE
LSH E,(D) ;TO BIT POSITION
TDNN E,DEVTBL(C) ;LEGAL?
JRST STOTC1 ;NO. RETURN THE -2
CAIL D,15 ;OK. IS MODE DUMP?
JRST RETZR1 ;YES. SKIP RETURN A ZERO
HRRZ A,DEVTB2(C) ;NO. BUFFERED. GET BUFFER SIZE
CAIE C,LPT ;LPT?
CAIN C,CDR ;OR CDR?
TLNE B,(1B3) ;YES, IS IT SPOOLED?
SKIPA ;NO
MOVEI A,200 ;YES, USE 200 WORD BUFFERS
CAIN C,DTA ;IS THIS A DECTAPE?
TRNN F,100 ;AND IN MODE 100?
SKIPA ;NO
MOVEI A,200 ;YES, BUFFER SIZE IS REALLY 200 WORDS
CAIE C,MTA ;MAGTAPE?
JRST DEVSI1 ;NO, ALL DONE
PUSHJ P,GETMBS ;YES, GET THE MAGTAPE BUFFER SIZE
MOVE A,DEVTB2+MTA ;FAILED, USE THE DEFAULT
DEVSI1: ADD A,[2,,3] ;LH IS TWO BUFFERS, RH IS SIZE WITH HDR
JRST STOTC1 ;RETURN THAT AS ANSWER, SKIP.
DEVTYP: MOVE D,CAC ;GET ARGUMENT IN CASE SIXBIT
TLNE CAC,-1 ;DEVICE NAME?
JRST DVTYP1 ;YES.
CAILE CAC,17 ;LEGAL CHANNEL NUMBER?
JRST MRETN ;NO
MOVEI A,(CAC) ;YES
IMULI A,NTABS ;GET TABLE OFFSET
MOVE CAC,DEVNAM(A) ;GET DEVICE NAME
SKIPE D,DEVNAM(A) ;A DEVICE THERE?
DVTYP1: PUSHJ P,DVCHR1 ;YES. GET THE BITS FROM VIROS DVCHR TO B
JRST RETZR1 ;ERROR. SKIP RETURN WITH A ZERO
HLRZ D,B ;GET THE VIROS INDEX
ANDI D,777 ; ..
MOVE A,DVTYPT(D) ;GET FIXED BITS
HLRZ C,C ;GET JOB NUMBER
CAIN C,-1 ;FREE?
MOVEI C,0 ;YES
JUMPN C,DVTYP3 ;IS THERE A JOB NUMBER
MOVE C,JOB ;LOAD C WITH TSS JOB #
MOVEI D,17 ;SCAN ALL 17 CHANNELS
MOVEI E,0 ; LOOKING FOR THIS DEVICE INITED
DVTYP2: CAMN CAC,DEVNAM(E) ;FOUND IT YET?
JRST DVTYP3 ;YES, GO SAY THIS JOB HAS THE DEVICE
ADDI E,NTABS ;UPDATE CHANNEL INDEX
SOJGE D,DVTYP2 ;LOOP BACK FOR 20 TIMES
MOVEI C,0 ;NOT FOUND RETURN 0
DVTYP3: DPB C,[POINT 9,A,26] ;PUT IN ANSWER
TLNE B,(1B5) ;AVAILABLE?
TLO A,(1B12) ;YES
TLNN B,(1B3) ;IS THIS A SPOOLED DEVICE?
TLO A,(1B13) ;YES, SET APPROPRAITE BIT
JRST STOTC1 ;SKIP RETURN WITH ANSWER
;COMMON ROUTINE FOR DEVCHR, DEVSIZ
DVCHR1: SETZ C, ;INITIALIZE TSS JOB #
MOVE E,DEVTBL ;CHARACTERISTICS FOR DSK
MOVSI B,0 ;INDEX IS 0 IF DISK (SYS)
CAMN D,[SIXBIT /SYS/] ;DEVICE SYS?
JRST DEVC1 ;YES, USE CHARS FOR DSK
MOVE E,CONTTY ;PREPARE CONSOLE TTY BITS
MOVSI B,(<TTY>B17+DV%AS) ;ASSIGNABLE TTY
CAMN D,[SIXBIT /TTY/] ;THAT WHAT HE WANTS?
JRST DEVC1 ;YES. RETURN THEM
PUSH P,D ;SAVE DEVICE NAME
MOVEI E,BUFFER ;PLACE TO PUT ASCIZ STRING OF DEVICE
PUSHJ P,SIXTO7
MOVEI E,0
MOVNI B,1 ;MINUS ONE FLAG IF NOT FOUND BY DVCHR
HRROI A,BUFFER ;ARGUMENT FOR STRING TO DEVICE
STDEV ;GET THE DEVICE TYPE
JRST DEVC3 ;NONE, CHECK TOPS-10 PACK
POP P,D ;CLEAR OUT STACK
MOVE A,B ;TO RIGHT AC
DVCHR ;GET THE BITS
HLRZ D,B
ANDI D,777 ;DEVICE NUMBER
CAILE D,MAXDEV ;KNOWN DEVICE?
MOVEI D,0 ;NO, USE DSK
MOVE E,DEVTBL(D) ;10/50 DEVICE CHARACTERISTICS
TLNE B,(1B5) ;IS THE THING AVAILABLE TO THIS JOB?
TLOA E,40 ;YES
TRO E,1B19 ;NO, MARK IT INITED BY ANOTHER JOB
TLNE B,(1B6) ;ASSIGNED?
TRO E,1B18 ;YES. SET ASSCON IN 10/50 MODE WORD
DEVC1: AOS 0(P) ;SKIP RETURN
DEVC2: MOVE A,E ;CHARACTERISTICS IN A FOR
POPJ P,0 ;CALLER TO RETURN TO USER
DEVC3: POP P,A ;GET DEVICE NAME
IFE FTFILSER,<
JRST DEVC2 ;NO DEVICE
>
IFN FTFILSER,<
PUSHJ P,DPACHK ;SEE IF TOPS-10 PACK
JRST [SETZB C,E ;NO
JRST DEVC2]
MOVE E,DEVTBL ;YES, RETURN SAME AS DSK
SETZB B,C
JRST DEVC1
>
;10/50 DEVICE CHARACTERISTICS
CONTTY: XWD 030053,400403 ;BITS FOR A CONTROLLING TTY
DEVTBL: XWD 201047,177777 ;DSK A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
XWD 0,0 ;DRM
XWD 000023,154403 ;MTA DITTO DSK
XWD 001107,154403 ;DTA DITTO DSK
XWD 000202,014403 ;PTR A,AL,I,B,IB
XWD 000401,014403 ;PTP DITTO PTR
XWD 002001,020000 ;DSP ID ONLY
XWD 040001,000403 ;LPT A,AL,I
XWD 100002,010403 ;CDR A,AL,I,B
XWD 100001,014003 ;FE A,AL,B,IB
DEVTTY: XWD 000053,000403 ;TTY A,AL,I
XWD 000013,000003 ;PTY
XWD 000053,000003 ;TTR
XWD 757777,177777 ;NUL
XWD 000047,014403 ;NET
XWD 000001,014403 ;PLT
XWD 201047,177777 ;DLX A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
XWD 100001,014003 ;CDP A,AL,B,IB
XWD 201047,177777 ;DCN A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
XWD 201047,177777 ;SRV A,AL,I,B,IB,DR,D (ALL MODES FOR DSK)
MAXDEV==.-DEVTBL ;MAXIMUM KNOWN DEVICE
XLIST
LIT
LIST
;THE FOLLOWING ROUTINES ALL HAVE CONVERSIONS TO AND FROM SECONDS
RUNTIM: MOVEI E,^D1000 ;GET DESIRED UNITS IN E
JUMPE CAC,RUNTM9 ;JOB ZERO MEANS SELF
TRZE CAC,400000 ;IS THIS A REQUEST FOR HIGH PRECISION TIMING?
JRST RUNTMH ;YES, CAN DO THIS JOB ONLY
RUNTM0: HRRZ A,CAC ;GET JOB NUMBER
MOVE B,[-1,,D] ;GET RUNTIME FOR THIS JOB
MOVEI C,.JIRT ;INTO AC D
GETJI
MOVEI D,0 ;IF ILLEGAL, ASSUME 0
SKIPGE A,D ;IS THE JOB RUNNING?
MOVEI A,0 ;NEGATIVE NUMBER SAYS NO SUCH JOB
RUNTM2: MOVE C,A ;SAVE RUNTIM
SYSGTA (<TICKPS>) ;GET TICKS PER SECOND
EXCH A,C
CAMN C,E ;ALREADY CORRECT UNITS?
JRST RUNTM8 ;YES
RUNTM1: PUSHJ P,CONVRT ;GO CONVERT TIME TO CORRECT UNITS
RUNTM8: JRST STOTAC ;RETURN TO USER'S AC
RUNTM9: MOVNI 1,5
RUNTM ;GET RUN TIME FOR THIS JOB
JRST RUNTM2
RUNTMH: SKIPE CAC ;THIS JOB?
CAMN CAC,JOB ;...
SKIPA A,[1] ;YES, CAN DO HPTIM JSYS
JRST RETZER ;NO, GIVE USER 0 INTSEAD
HPTIM ;GET MICRO SECOND TIME
JRST RETZER ;NOT IMPLEMENTED
IDIVI A,12 ;TURN INTO 10 MICRO SEC INTERVAL
JRST STOTAC ;AND RETURN IT TO USER
;CONVERT TIME TO DESIRED UNITS
;CALL: MOVE A,TIME
; MOVE C,CURRENT UNITS
; MOVE E,DESIRED UNITS
; PUSHJ P,CONVRT
; RETURN HERE WITH NEW TIME IN A
CONVRT: FLTR E,E
FLTR C,C
FLTR A,A
CAMGE C,E ;IS THE VALUE IN SMALLER UNITS THAN FINAL ANS?
JRST CONVR3 ;NO
FDVR C,E ;DIVIDE THE LARGER FUDGE FACTOR BY THE SMALLER
CONVR2: FDVR A,C ;NOW DIVIDE BY THE FF
FIXR A,A
POPJ P,
CONVR3: FMPR A,E ;THIS RESULT SHOULD FIT
JRST CONVR2
PJOB: MOVE A,JOB ;GET JOB NUMBER
JRST STOTAC ;RETURN IT TO USER
TIMER: MOVEI E,^D60 ;CLOCK TICKS (60THS) SINCE MIDNIGHT
SETO B, ;TO REQUEST CURRENT TIME
SETZ D, ;NORMAL FLAGS
ODCNV
MOVEI A,0(D) ;SECONDS SINCE MIDNIGHT
MOVEI C,1 ;UNITS (SECONDS)
JRST RUNTM1 ;NO, GO CONVERT TO PROPER UNITS AND RETURN
MSTIME: TIME ;READ TIME SINCE LOAD IN MS
MOVE F,A ;SAVE TIME FOR LATER
ADD A,ITIME ;ADD IN TIME FROM MIDNIGHT TO LOAD TIME
IDIV A,[^D24*^D60*^D60*^D1000] ;CONVERT TO MODULO ONE DAY
MOVE A,B ;GET TIME SINCE LATEST MIDNIGHT
SETO B, ;NOW GET ACTUAL TIME SINCE MIDNIGHT
SETZ D, ;...
ODCNV
ERJMP STOTAC ;IF FAILED, USE PREVIOUSLY CALCULATED ANSWER
MOVEI B,^D1000 ;CONVERT SECONDS TO MILLISECONDS
IMULI B,0(D)
CAMG B,A ;HAS CLOCK DRIFTED?
JRST STOTAC ;NO
PUSH P,B ;YES, SAVE TIME
SUB B,F ;GET NEW BASE TIME
MOVEM B,ITIME ;STORE NEW BASE
POP P,A ;GET BACK ANSWER
JRST STOTAC ;RETURN IT TO USER
GETPPN: GJINF
MOVE A,B ;DIRECTORY NUMBER AS A PPN
PUSHJ P,PPNUNM ;GO GET PPN UNMAPPING
JRST STOTAC ;RETURN IT
;10/50 STANDARD BUFFER SIZE FOR EACH DEVICE
DEVTB2: EXP 200,0,200,177,40,40,0,200,33,32,20,20,20,200,100,43,20,32,200,200
;TABLE OF BITS FOR DEVTYP CALLI
DVTYPT: 400003,,0 ;DSK
0 ;DRM
7,,2 ;MTA
400003,,1 ;DTA
6,,4 ;PTR
5,,5 ;PTP
0 ;DSP
5,,7 ;LPT
2,,10 ;CDR
3,,14 ;FE
13,,3 ;TTY
13,,12 ;PTY
13,,3 ;TTR
3,,0 ;NIL
3,,14 ;NET
1,,13 ;PLT
3,,14 ;DLX
1,,11 ;CDP
3,,14 ;DCN
3,,14 ;SRV
CORE: SKIPE CAC ;0 ARG GIVES FREE CORE, ERROR RETURN
PUSHJ P,COREUU
SKIPA
AOS 0(P) ;OK RETURN, R2
MOVEI A,PATLOC ;RETURN HOW MUCH HE CAN HAVE
TLNE PF,L.FLSR ;FILSER MAPPED IN?
MOVEI A,FLSRLC ;YES, GET START OF FILSER AREA INSTEAD
LSH A,-^D10 ;IN K
JRST STOTAC ;RETURN IT IN THE AC
COREUU: TLNN CAC,-1 ;ANY CHANGE TO HIGH SEGMENT?
JRST COREU4 ;NO
HLRZ B,CAC
TRO B,777
CAIL B,PATLOC ;TOO LARGE?
POPJ P, ;YES, GIVE ERROR RETURN
TLNN PF,L.FLSR ;FILSER MAPPED IN?
JRST COREU1 ;NO
CAIL B,FLSRLC ;YES, TOO LARGE?
POPJ P, ;YES, GIVE ERROR RETURN
COREU1: SKIPE C,JBHRL ;ANY HIGH SEG?
JRST CORU1A ;YES, USE CURRENT END
MOVE C,JBREL ;GET CURRENT LOW SEG END
TRO C,777 ;END OF PAGE
ADDI C,1 ;BEGIN NEXT
CAIGE C,.HSLOC ;ABOVE DEFAULT
MOVEI C,.HSLOC ;NO, USE DEFAULT
MOVEM C,HSORG ;SET HI SEG ORIGIN
SOS C ;LAST WORD USED
CORU1A: CAMGE B,HSORG ;NEGATIVE HISEG LENGTH?
JRST FLUSHI ;YES
CAMLE B,C ;MORE THAN BEFORE?
JRST COREU3 ;YES
COREU2: PUSH P,A ;SAVE UUO ARG
MOVEI A,(C) ;GET OLD WORD SIZE
PUSHJ P,SHRINK ;REMOVE PAGES IF NEEDED.
POP P,A ;AND RESTORE AC ARG
JRST COREU3 ;ON TO CHECK LOW SEG.
FLUSHI: HRRZ A,JBHRL ;OLD HIGH SEG SIZE
MOVE B,HSORG
SOS B ;NEW SIZE IS ZERO
PUSHJ P,SHRINK ;SHRINK THE HIGH SEGMENT
SETZ B,
COREU3: HRRZM B,JBHRL
XCTUU <HRRM B,.JBHRL>
SKIPN JBHRL ;ANY HIGH SEG LEFT
PUSHJ P,CLRHSN ;NO, CLEAR HIGH SEG NAME
COREU4: TRNN CAC,-1 ;ANY CHANGE TO LOW SEG?
JRST CPOPJ1 ;NO
CORU10: HRRZ B,CAC
TRO B,777
SKIPE JBHRL ;IS THERE A HIGH SEG?
CAMGE B,HSORG ;DOES USER WANT TO EXPAND INTO HIGH SEG?
SKIPA ;NO
POPJ P, ;DONT LET HIM OVERWRITE THE HIGH SEG.
HRRZ C,JBREL
CAIL B,PATLOC ;ARG OK?
POPJ P,
TLNN PF,L.FLSR ;FILSER MAPPED IN?
JRST CORU11 ;NO
CAIL B,FLSRLC ;ARG STILL OK?
POPJ P, ;NO, ERROR
CORU11: HRRZM B,JBREL
XCTUU <HRRM B,.JBREL> ;NEW .JBREL
HRRZ B,JBREL ;NEW .JBREL
CAIG B,(C) ;MORE THAN BEFORE?
JRST COREU7 ;NO
REPEAT 0,<
MOVSI D,1(C)
HRRI D,2(C)
SETZM 1(C)
CAIGE B,(D)
JRST COREU9
XCTUU <BLT D,(B)>
>
JRST COREU9
COREU7: MOVEI A,0(C) ;NEW LOW SEG
PUSHJ P,SHRINK ;ADJUST SEGMENT SIZE
COREU9: JRST CPOPJ1
;SHRINK A SEGMENT. A/ OLD WORDS TOP, B/ NEW WORDS TOP.
SHRINK: JUMPE A,CPOPJ ;IN CASE OLD VALUE MISSING
CAIG A,(B) ;OLD REALLY BIGGER?
POPJ P,0 ;NO. RETURN.
PUSH P,A ;BE TRANSPARENT
PUSH P,B
PUSH P,D
MOVEI D,(A) ;COPY OLD SIZE
LSH D,-11 ;CONVERT TO PAGE NUMBERS
LSH B,-11
SETO A, ;REMAP FROM NULL-SPACE
MOVEI C,0(D) ;CALCULATE COUNT OF PAGES TO BE DELETED
SUBI C,0(B) ;...
TLO C,(1B0) ;DO A MULTIPLE PMAP
HRLI B,.FHSLF ;THIS FORK
HRRI B,1(B) ;START AT CORRECT PAGE
PMAP ;PAGE TO REMOVE
POP P,D ;RESTORE ACS.
JRST BAPOPJ ;AND RETURN.
XPAND: PUSH P,CAC ;CORE UUO WANTS ARG IN CAC
HRRZ CAC,G ;PHONY UP A CORE UUO FOR LOW SEG.
PUSH P,B
PUSH P,C
PUSH P,D
PUSHJ P,CORU10 ;EXPAND CORE TO GET IT
PUSHJ P,ERROR ;ERROR RETURN- COULDN'T
POP P,D
POP P,C
POP P,B
POP P,CAC ;RESTORE I/O CALL CAC
POPJ P, ;OK- ALL DONE.
SUBTTL TTCALL AND OTHER TERMINAL HANDLING UUO'S
;TTCALL UUO, DISPATCH BY AC FIELD.
;AC VALUES ARE:
;0=INCHRW 1=OUTCHR 2=INCHRS 3=OUTSTR 4=INCHWL 5=INCHSL 6=GETLCH
;7=SETLCH 10=RESCAN 11=CLRBFI 12=CLRBFO 13=SKPINC 14=SKPINL
;15=IONEOU 16=CPOPJ 17=CPOPJ
UTTCLL: MOVE E,TYSTAT ;CARRY AROUND TTY STATUS BITS IN E
MOVEI A,PRIJFN ;INITIALIZE JFN OF TTY
PUSHJ P,@TTCLTB(AC) ;CALL TTCALL ROUTINE
JRST MRETN ;NON-SKIP RETURN
JRST MRETN2 ;SKIP RETURN
TTCLTB: EXP TTCL0,TTCL1,TTCL2,TTCL3,TTCL4,TTCL5,TTCL6,TTCL7
EXP TTCL10,TTCL11,TTCL12,TTCL13,TTCL14,TTCL15
EXP MRETN,MRETN ;16 AND 17 NOT IMPLEMENTED
TBOUND: HRRZ C,FORTY ;ARG MUST NOT BE BETWEEN 20 AND 137
CAIGE C,.JBPFI
CAIGE C,20
POPJ P,
PUSHJ P,ERRARG
;TTCALL ROUTINES TO INPUT CHARACTERS
;TTCALL 0, - INPUT A CHARACTER AND WAIT (CHARACTER MODE)
TTCL0: PUSHJ P,NOCTRO ;TURN OFF CONTROL-O
PUSHJ P,TBOUND ;SEE IF ARGUMENTS ARE IN BOUNDS
TLO E,TT.BKE ;BREAK ON ANYTHING
PUSHJ P,TTPSTS ;GO SET UP NEW MODE FOR PRIMARY TTY
TTCL0A: PUSHJ P,TTPGET ;GO GET A CHARACTER AND WAIT IF NONE
TTXIT: UMOVEM B,@FORTY ;STORE CHARACTER INTO USER'S AREA
POPJ P, ;AND RETURN
;TTCALL 2, - INPUT A CHARACTER AND SKIP (CHARACTER MODE)
TTCL2: PUSHJ P,NOCTRO ;CLEAR CONTROL-O
PUSHJ P,TBOUND ;MAKE SURE ARG IS IN BOUNDS
TLO E,TT.BKE ;SET UP TO BREAK ON EVERYTHING
TTCL2A: PUSHJ P,TTPSTS ;GO SET UP NEW MODE
PUSHJ P,TTFILL ;GO PULL IN A CHARACTER IF ONE READY
POPJ P, ;NO CHARACTER, GIVE NON-SKIP RETURN
AOS 0(P) ;SET UP SKIP RETURN
JRST TTCL0A ;GO GET THE CHARACTER
;TTCALL 4, - INPUT A CHARACTER AND WAIT (LINE MODE)
TTCL4: PUSHJ P,NOCTRO ;CLEAR CONTROL-O
PUSHJ P,TBOUND ;SEE IF ARG IS IN BOUNDS
TLZ E,TT.BKE ;CLEAR BREAK ON EVERYTHING FLAG
PUSHJ P,TTPSTS ;GO SET UP NEW MODE
JRST TTCL0A ;GO READ IN A CHARACTER
;TTCALL 5, - INPUT A CHARACTER AND SKIP (LINE MODE)
TTCL5: PUSHJ P,NOCTRO ;CLEAR CONTROL-O FLAG
PUSHJ P,TBOUND ;SEE IF ARG IS IN BOUNDS
TLZ E,TT.BKE ;CLEAR BREAK ON EVERYTHING MODE
JRST TTCL2A ;GO SEE IF A CHARACTER IS THERE
DDTIN: HRRZ A,CAC ;GET USER BUFFER ADDRESS
MOVEI B,21 ;CHECK IT FOR BOUNDRIES
PUSHJ P,ADRCKB ;BOTH ENDS OF THE BUFFER
MOVEI A,PRIJFN ;DDTIN ALWAYS REFERS TO CONTROLING TTY
MOVE E,TYSTAT ;GET STATUS OF TTY
PUSHJ P,NOCTRO ;CLEAR CONTROL-O
TLO E,TT.BKE ;SET BREAK ON ANYTHING
PUSHJ P,TTPSTS ;SET STATUS FOR CONTROLING TTY
MOVE D,CAC ;GET START OF BUFFER
HRLI D,(POINT 7,0) ;MAKE A BYTE POINTER INTO USER BUFFER
MOVEM D,IOBPT
MOVEI F,21*5-1 ;KEEP COUNT OF CHARACTERS STORED
DDTIN1: PUSHJ P,TTPGET ;GET A CHARACTER
XCTLB <IDPB B,IOBPT> ;STORE IT IN USER BUFFER
PUSHJ P,TTFILL ;SEE IF ANY MORE
SKIPA ;NO
SOJG F,DDTIN1 ;YES, LOOP BACK FOR ALL CHARACTERS IN BUFFER
MOVEI B,0 ;ALWAYS CLOSE WITH A NULL
XCTLB <IDPB B,IOBPT>
JRST MRETN ;AND RETURN
;ROUTINES TO FILL THE INTERNAL BUFFER FOR THE CONTROLING TTY
;TTFILL - READS IN ANY WAITING CHARACTERS UP TO FIRST BREAK CHAR
; WILL NOT BLOCK IF THERE ARE NO CHARACTERS
TTFILL: SKIPE TTLINE ;IS THERE A LINE IN THE BUFFER
JRST CPOPJ1 ;YES, THEN RETURN
TLNE E,TT.BKE!TT.BIN ;IN BREAK ON EVERYTHING MODE?
SKIPG TTCNT ;YES, IS THERE A CHARACTER READY?
SKIPA A,[PRIJFN] ;NO, SEE IF ONE IN MONITOR BUFFER
JRST CPOPJ1 ;YES, SKIP RETURN
SIBE ;ANY CHARACTERS READY TO BE READ IN
JRST [PUSHJ P,TTFLW0 ;YES, GO READ IN ONE
JRST TTFILL] ;AND LOOP BACK
POPJ P, ;NO, DONT BLOCK
;TTFILW - READS IN ONE CHARACTER AND PUTS IT INTO THE INTERNAL BUFFER
; THIS ROUTINE WILL BLOCK IF NO CHARACTER IS READY
TTFILW: PUSHJ P,TTFLW0 ;GO WAIT FOR A CHARACTER TO BE TYPED
PUSHJ P,TTFILL ;ANY CHARACTERS READY YET?
JRST TTFILW ;NO, MAY HAVE BEEN ^R, ^U, OR RUBOUT
POPJ P,
TTFLW0: TDNE E,[TT.BIN!TT.BKE,,IO.FCS]
JRST TTFLWB ;CANNOT USE RDTXT, USE BIN
MOVE A,[PRIJFN,,PROJFN] ;SET UP FOR RDTXT JSYS
MOVE B,TTINPT ;GET POINTER INTO BUFFER
MOVE C,[RD%TOP!RD%RIE!RD%BRK!RD%JFN!RD%BBG+TTMAXC]
SUB C,TTCNT ;GET NUMBER OF CHARACTERS LEFT IN BUF
MOVE F,TTCNT ;SAVE THE COUNT FOR LATER
TLNE E,TT.XON ;IS TTY TAPE ON?
TLO C,(RD%CRF) ;GET LF INSTEAD OF CR-LF
MOVE D,[POINT 8,TTBUF] ;POINTER TO START OF BUFFER
PUSHJ P,DORDTX ;DO THE RDTXT JSYS
MOVNI D,-TTMAXC(C) ;GET COUNT OF CHARACTERS IN BUFFER
HRRZM D,TTCNT ;STORE NEW COUNT
MOVEM B,TTINPT ;SAVE NEW PUTTER POINTER
TLNN C,(RD%BTM) ;WAS THERE A BREAK CHARACTER TYPED?
JRST [TRNN C,-1 ;DID COUNT RUN OUT?
JRST TTFLW1 ;YES, CAUSE BREAK
CAME F,TTCNT ;NO, WERE ANY CHARACTERS READ IN?
POPJ P, ;YES, RETURN TO CALLER
MOVEI A,PRIJFN ;NO, WAIT FOR ONE
PUSHJ P,TTYBIN ;READ IN A CHARACTER
BKJFN ;BACK UP OVER THIS CHAR
PUSHJ P,BUGSTP
JRST TTFLW0] ;GO LET RDTXT DO ITS THING
MOVEI A,C.CR ;SEE IF IN TTY TAPE MODE
TLNE E,TT.XON
JRST [PBOUT ;ECHO CR
DPB A,TTINPT ;CHANGE LF TO CR
JRST .+1]
TTFLW1: MOVEI A,PROJFN ;CLEAR CONTROL-O
PUSHJ P,NOCTRO
JRST TTBRK
TTFLWB: PUSHJ P,TTYBIN ;GO DO THE BIN
PUSHJ P,TTPUTC ;GO STORE THIS CHARACTER
CAIE B,C.BELL ;IS THIS A BELL?
CAIL B,175 ;OR RUBOUT OR ALTMODE?
JRST TTBRK ;YES, THEN SET BREAK CHAR SEEN
CAIN B,C.EOF ;IS THIS A CONTROL-Z
JRST TTBRK ;YES, SET BREAK
CAIE B,C.DELL ;CONTROL-U?
CAIN B,STDALT ;OR ALTMODE?
JRST TTBRK ;YES, SET BREAK
CAIGE B,C.CR ;FORMATTING CHARACTER?
CAIGE B,C.LF ; NOT INCLUDING CR
POPJ P, ;NO, DONT SET BREAK
JRST TTBRK ;YES, SET BREAK
;ROUTINES TO GET CHARACTERS
;TTPGET - GET A CHARACTER FROM THE CONTROLING TTY AND PERFORM CONVERSION IF DESIRED
; THIS ROUTINE WILL WAIT FOR A CHARACTER IF NONE THERE
TTPGET: PUSHJ P,TTFILL ;GO SEE IF ANY CHARACTERS THERE
PUSHJ P,TTFILW ;NO, WAIT FOR ONE
PUSHJ P,TTGETC ;GO GET THE CHARACTER
TLNE E,TT.BIN!TT.ALT ;SHOULD ALTMODES BE CONVERTED?
POPJ P, ;NO, SO DONT
CAIE B,ALT1 ;IS IT AN ALTMODE
CAIN B,ALT2 ;OR ANOTHER ALTMODE
MOVEI B,STDALT ;YES, MAKE ALL ALTMODES THE SAME
POPJ P, ;AND RETURN
TTBRK: SETOM TTLINE ;NOW THERE IS A LINE IN MY BUFFER
PUSH P,A ;SAVE A
MOVE A,TTCNT ;SAVE COUNT OF CHARS IN LINE
MOVEM A,OTTCNT ;FOR TTCALL 10 (RESCAN)
JRST APOPJ
TTBINI: PUSHJ P,TTYSST ;SET TTY STATUS
MOVE A,[POINT 8,TTBUF] ;GET START OF BUFFER
MOVEM A,TTINPT ;SET UP GETTER
MOVEM A,TTOUPT ;AND PUTTER
SETZM TTCNT
SETZM TTLINE
SETZM OTTCNT
POPJ P,
TTGTC0: PUSHJ P,TTFILW ;GET A CHARACTER
TTGETC: SKIPG TTCNT ;MAKE SURE THERE IS A CHAR
JRST TTGTC0 ;NO, GO WAIT FOR A CHARACTER
SOS TTCNT ;COUNT DOWN COUNTER
ILDB B,TTOUPT ;GET CHAR
PUSH P,A ;SAVE A
SKIPLE TTCNT ;ANY CHARACTERS LEFT?
JRST TTGTC1 ;YES
MOVE A,[POINT 8,TTBUF] ;INITIALIZE THE POINTERS
MOVEM A,TTOUPT
MOVEM A,TTINPT
SETZM TTLINE ;NO MORE LINE IN BUFFER
TTGTC1: TRNN E,IO.BIN ;IN BINARY MODE?
ANDI B,177 ;NO, TRUNCATE TO 7 BITS
JRST APOPJ ;RESTORE A AND RETURN
TTPUTC: PUSH P,A ;SAVE A
MOVE A,TTCNT ;GET CURRENT COUNT
CAILE A,TTMAXC ;IS THE BUFFER FULL?
PUSHJ P,BUGSTP ;YES, THIS IS WORTHY OF A HALT
IDPB B,TTINPT ;STORE CHAR IN BUFFER
AOS A,TTCNT ;UPDATE COUNTER
CAIL A,TTMAXC-5 ;BUFFER ALMOST FULL?
PUSHJ P,TTBRK ;YES, PRETEND THAT A LINE IS THERE
JRST APOPJ ;RESTORE A AND RETURN
TTCL1: MOVEI A,PROJFN ;OUTPUT A SINGLE CHAR
PUSHJ P,TTCLRB ;CLEAR BINARY MODE IF ON
UMOVE B,@FORTY
PUSHJ P,TTYBOU ;OUTPUT CHARACTER, CHECKING ^L, ^O
POPJ P,
TTCL15: MOVEI A,PROJFN ;OUTPUT ONE IMAGE CHARACTER.
RFMOD ;SO SWITCH TTY TO BINARY TO DO IT.
PUSH P,B ;SAVE PREVIOUS MODE
TRZ B,3B29 ;BINARY
SFMOD
UMOVE B,@FORTY ;GET USER'S CHARACTER
PUSHJ P,TTYBO1 ;SEND IT
POP P,B ;RESTORE PREVIOUS MODE
SFMOD ; ..
POPJ P,
TTYBOU: ;ROUTINE TO OUTPUT A BYTE TO TTY
CAIN A,PRIJFN ;OUTPUT TO PRIMARY INPUT SOMEHOW?
MOVEI A,PROJFN ;YES. MAKE IT OUTPUT.
CAIN B,C.FF ;FORMFEED?
JRST TTYBOF ;YES. GO CHECK INDICATE FLAG
CAIN B,STDALT ;ESCAPE (33)
JRST TTYBOI ;YES GO SEND 33 INSTEAD OF $
;ELSE FALL INTO OUTPUTTER
TTYBO1: BOUT ;ORDINARY. OUTPUT IT.
POPJ P,0 ;AND RETURN
TTYBOF: TLNN PF,L.INDF ;FORMFEED. SEND OR INDICATE?
JRST TTYBO1 ;SEND.
HRROI B,[ASCIZ /^L
/] ;INDICATION. NOTE CLOBBERS B AND C
MOVEI C,0 ;STRING LENGTH COUNTER
SOUT ;STRING TO TTY (JFN IN A)
POPJ P,0 ;AND RETURN
TTYBOI: PUSH P,B ;SAVE CHARACTER
RFMOD ;SWITCH TTY TO BINARY
PUSH P,B ;SAVE PREVIOUS MODE
TRZ B,3B29 ;SET BINARY
SFMOD
MOVE B,-1(P) ;GET CHARACTER BACK
PUSHJ P,TTYBO1 ;SEND IT
POP P,B ;GET PREVIOS MODE
SFMOD ;RESTORE IT
POP P,B ;REMOVE CHARACTER FROM STACK
POPJ P, ;RETURN
;ROUTINE TO INITIALIZE TTY ON RESET OR RESTART
TTYSST: MOVEI A,PRIJFN
MOVE E,TYSTAT ;GET TTY FLAGS
PUSH P,C ;SAVE AC
PUSHJ P,TTCLRB ;CLEAR BINARY MODE FIRST
POP P,C ;RESTORE AC
SETOM TTWDTH ;(316)FREE CRLF NOT SET (TRMOP .TONFC)
POPJ P,
;ROUTINE TO SET THE STATUS FOR THE TTY
;TTYSTS - ROUTINE TO CALL IF NOT THE CONTROLING TTY
TTPSTS: CAMN E,TYSTAT ;SEE IF A CHANGE IS DESIRED IN TTY STATE
POPJ P, ;NO, DONT DO ANY JSYS'S
MOVEM E,TYSTAT ;YES, STORE NEW STATUS BITS
JRST TTYST0 ;GO CHANGE THE MODE
TTYSTS: MOVE A,JFNTAB(BB) ;GET JFN OF TTY
TLNE E,TT.CTY ;IS THIS THE CONTROLING TTY?
JRST TTPSTS ;YES, GO LET THE OTHER ROUTINE DO THIS
CAMN E,FLAGWD(BB) ;SAME AS THE LAST TIME?
POPJ P, ;YES, THEN THERE IS NO NEED TO CHANGE
MOVEM E,FLAGWD(BB) ;NO, STORE NEW MODE
TTYST0: RFMOD ;READ IN MODE OF TTY
trz b,tm.wak!TM.ECH!tm.iod ;initialize mode word
trnn e,io.sup ;echo on?
ior b,echini ;yes, set up echo mode
tlne e,tt.bin ;binary mode desired?
TRZA B,TM.ATE ;(320) YES, SET BINARY MODE
TRO B,TM.ATE ;(320) NO, SET ASCII MODE/no output translation
tlne e,tt.bin!tt.bke ;break on everything mode?
tro b,tm.bke ;yes, set the correct bits
trne e,io.fcs ;full character set?
tro b,tm.fcs ;yes, set break on all controls
tro b,tm.fwk ;always set break on format controls
sfmod ;set the mode
tdne e,[tt.bin,,io.tec] ;want truth in echoing?
jrst ttyst2 ;yes, go set up echo mode for this
move b,fcoc2 ;get first half of control bits
tlne pf,l.indf ;user want to simulate form feeds
trc b,3b25 ;no, indicate forms by ^l
move c,fcoc3 ;get other control bits
tdnn e,[tt.bke,,io.fcs] ;want echo of ^r OR ^W?
tlz c,(3b1!3B11) ;NO, ^R MEANS RETYPE LINE, ^W IS WORD DEL
tlne e,tt.xon ;user in tape mode?
trz c,3b27 ;yes, dont echo eol
sfcoc ;set the bits
popj p,
ttyst2: move b,selfec ;echo controls as self
move c,b ;all of them
sfcoc
popj p,
;ECHO BYTES FOR CONTROL CHARACTERS:
; 00 MEANS IGNORE, DISCARD.
; 01 MEANS INDICATE BY ^X
; 10 MEANS SEND AND ACCT (SIM IF NECESSARY ONLY)
; 11 MEANS SIMULATE AND ACCT
; @,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q
FCOC2: BYTE (2) 0,1,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1
; R,S,T,U,V,W,X,Y,Z,[ \ ] ^ _
FCOC3: BYTE (2) 1,1,1,0,1,1,1,1,1,3,1,1,1,2
SELFEC: BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
DDTOUT: PUSHJ P,DDTOU1 ;GO DO OUTPUT
JRST MRETN ;AND EXIT
DDTOU1: MOVE D,CAC ;ADDRESS OF STRING TO TYPE OUT
TLOA D,-1 ;MAKE STRING POINTER, SKIP TO OUTPUT
TTCL3: HRRO D,FORTY
TRNN D,-20 ;IN THE USERS AC'S?
HRRI D,ACS(D) ;YES. MOVE POINTER
MOVEI A,PROJFN ;JFN FOR "TTY"
MOVE E,TYSTAT ;SET UP STATUS WORD FOR TTY
PUSHJ P,TTCLRB ;CLEAR BINARY MODE IF ON
;**; INSTEAD OF DOING BOUT'S TO CHECK FOR ALTMODE AND ^L DURING
;**; AN OUTSTR, SET UP THE CCOC WORD TO DO THEM CORRECTLY AND
;**; DO A SOUT.
;**; BUT SFMOD set to TM.ATE means ^L will always come out FF on SOUT
;**; (regardless of TERM INDICATE) so pre-scan output & do BOUT loop if
;**; ^L is present
MOVE C,D ;(324) don't clobber string ptr for later
HRLI C,440700 ;(324) scan string in bytes
ILDB B,C ;(324) get a byte
JUMPE B,TTCL3A ;(324) NULL means end & no ^L so use SOUT
CAIE B,C.FF ;(324) is it an ^L?
JRST .-3 ;(324) no, get next byte
HRLI D,440700 ;(324) string contains ^L so BOUT loop
ILDB B,D ;(324) get a byte
JUMPE B,CPOPJ ;(324) quit on first NULL
PUSHJ P,TTYBOU ;(324) output, checking ^O, indicate ^L
JRST .-3 ;(324) loop till end of string
TTCL3A: ;(324)
RFCOC ;(322) GET CCOC WORDS
PUSH P,B ;(322) SAVE THEM ON THE STACK
PUSH P,C ;(322)
TRZ C,3B19 ;(322) TURN OFF ALTMODE BITS
TRO C,2B19 ;(322) AND MAKE ALTMODE CODE 2 (SEND)
TRZ B,3B25 ;(322) TURN OFF ^L BITS
TLNN PF,L.INDF ;(322) SEND OR INDICATE ^L?
TROA B,2B25 ;(322) SEND
TRO B,1B25 ;(322) INDICATE
SFCOC ;(322) SET THE CCOC WORDS
HRRO B,D ;(322) GET BYTE PTR TO STRING
SETZ C, ;(322) THE STRING IS ASCIZ
SOUT ;(322) PRINT IT
POP P,C ;(322) RESTORE THE CCOC WORDS
POP P,B ;(322)
SFCOC ;(322) TO WHAT THEY USED TO BE.
JRST CPOPJ ;(322) RETURN
TTCL11: MOVEI A,PRIJFN ;CLEAR INPUT BUFFER
CFIBF
PUSHJ P,TTBINI ;AND CLEAR MY BUFFER
POPJ P,
TTCL12: MOVEI A,PROJFN ;CLEAR OUTPUT BUFFER
PUSHJ P,TTCLRB ;CLEAR BINARY MODE IF ON
CFOBF
POPJ P,
TTCL13: PUSHJ P,NOCTRO ;CLEAR CONTROL O FLAG
MOVEI A,PRIJFN ;SKIP IF CHAR AVAIL FOR INPUT
SKIPG TTCNT ; ANY CHAR IN MY BUFFER?
SIBE
JRST CPOPJ1 ;YES. SKIP RETURN.
POPJ P, ;NO
TTCL14: PUSHJ P,NOCTRO ;CLEAR CONTROL O FLAG
XCTUM <HLRZ B,@MONUPC> ;GET INSTRUCTION AFTER TTCALL 14,
CAIN B,(JFCL) ;IS THIS A CLEAR CONTROL-O CALL?
JRST MRETN2 ;YES, JUST RETURN
PUSHJ P,TTFILL ;NO, TRY TO GET ONE
JFCL
SKIPE TTLINE ;ONE THERE NOW?
AOS (P) ;YES, SET UP FOR SKIP RETURN
TLNE PF,L.DBUG ;DEBUGGING?
POPJ P, ;YES, DONT DO RESCAN SINCE DDT EATS LINE
JRST TTRLIN ;GO PUT ALL CHARACTERS BACK INTO RESCAN BUFFER
TTRLIN: SKIPG C,TTCNT ;ANY CHARACTERS TO BE GOTTEN
POPJ P, ;NO, DONT DO ANYTHING
MOVE D,[POINT 7,STRNG1] ;SET UP A TEMPORARY STRING
PUSHJ P,TTGETC ;GET A CHARACTER IN B
IDPB B,D ;STORE IT IN THE STRING
SOJG C,.-2 ;LOOP FOR ALL AVAILABLE CHARACTERS
MOVEI B,0 ;END STRING WITH NULL
IDPB B,D
HRROI A,STRNG1 ;NOW PUT STRING IN INPUT BUFFER
RSCAN
JRST TRLIN1 ;OPPS, GO PUT THE LINE BACK IN INTERNAL BUFFER
SETZ A, ;AND MAKE IT AVAILABLE TO JOB
RSCAN
JFCL
POPJ P,
TRLIN1: MOVE D,[POINT 7,STRNG1]
TRLIN2: ILDB B,D ;GET NEXT CHAR FROM TEMP STRING
JUMPE B,CPOPJ ;IF ZERO, THEN WE ARE THRU
PUSHJ P,TTPUTC ;PUT CHARACTER INTO INTERNAL BUFFER
JRST TRLIN2 ;LOOP FOR ALL CHARACTERS
TTCL6: PUSHJ P,TBOUND
UMOVE D,0(C)
JUMPGE D,TTCL6A ;SPECIFIC TTY ASKED FOR
PUSH P,A ;
SETO A, ;(327) CHECK TO SEE IF THIS JOB IS DETACHED
MOVE B,[-2,,E] ;E/JOBNO, F/TERMNO, -1=DETACHED
SETZ C, ;FIRST TWO WORDS
GETJI
JFCL ;TRY AS USUAL IF THIS FAILS
POP P,A
JUMPGE F,TTCL6D ;THERE IS A TTY, GO FIND OUT ABOUT IT
SETZ C, ;DETACHED, RETURN 0 TO CALLER
JRST TTCL6E ;
TTCL6D: DVCHR ;GET THE TRUE POOP ON TTY
HRLI C,0 ;CLEAR LEFT HALF. JUST LINE NUMBER
TTCL6B: CAML C,FIRPTY ;IS THIS A PTY LINE?
TLO C,(1B0) ;YES, REMEMBER THAT
SKIPL TTLINE ;IS THERE A LINE NOW?
SIBE ;OR EVEN A CHARACTER?
TLO C,(1B11) ;YES, MARK THAT FACT
MOVEI A,-1 ;CONTROLING TERMINAL
RFMOD ;GET TERMINAL CHARACTERISTICS
TRNE B,3B33 ;SHUFFLE BETWEEN VIROS AND 1050 BITS
TLO C,(1B5) ;HALF DUPLEX BIT
TLNE B,(1B2) ;TABS?
TLO C,(1B14) ;TABS.
TLNE B,(1B3) ;LOWERCASE?
TRNE B,1B31 ;RAISE?
TLZA C,(1B13) ;NO LOWERCASE
TLO C,(1B13) ;LOWERCASE
TLNE E,TT.XON ;PAPER TAPE MODE ON?
TLO C,(1B16) ;YES
TRNE E,IO.SUP ;NO ECHO IN INIT FLAGS?
TLO C,(1B15) ;YES.
TTCL6C: TRO C,200000 ;SET UNIVERSAL I/O INDEX #
TTCL6E: UMOVEM C,@FORTY ;RETURN THE ANSWER TO USER
POPJ P, ;END OF UUO
TTCL6A: ANDI D,177777 ;CLEAR UNIVERSAL I/O INDEX BITS
DVCHR ;GET TTY CHARACTERISTICS
HRLI C,0 ;GET JUST LINE #
CAMN C,D ;IS THIS OUR LINE BEING ASKED ABOUT
JRST TTCL6B ;YES
MOVE C,D ;GET LINE # TO BE CHECKED
CAML C,FIRPTY ;IS THIS A PTY LINE?
TLO C,(1B0) ;YES, REMEMBER THAT
HRRZ A,D ;SET UP TTY DEVICE DESIGNATOR
TRO A,400000 ;...
JRST TTCL6C ;GO GET CHARACTERISTICS
TTCL7: PUSHJ P,TBOUND ;CHECK ARGUMENT
RFMOD ;GET CHARACTERISTICS OF TERMINAL
UMOVE C,0(C) ;GET USER'S DESIRED BITS
TLNE C,(1B13) ;WANT LOWER CASE?
TLOA B,(1B3) ;YES.
TLZA B,(1B3) ;NO.
TRZA B,1B31 ;YES, CLEAR CONVERSION BIT ALSO
TRO B,1B31 ;NO, SET CONVERSION FROM LOWER TO UPPER CASE
TLNE C,(1B14) ;WANT TABS?
TLOA B,(1B2) ;YES
TLZ B,(1B2) ;NO
TLNE C,(1B15) ;WANT ECHO?
TROA E,IO.SUP ;YES. TURN IT ON.
TRZ E,IO.SUP ;CLEAR NO-ECHO IN INIT
TLNE C,(1B16) ;TAPE MODE ON?
TLOA E,TT.XON ;YES, SET FLAG IN STATUS WORD
TLZ E,TT.XON ;NO, CLEAR FLAG
SFMOD ;GIVE TO MONITOR
STPAR ;SET THOSE BITS NOT CONTROLED BY SFMOD
JRST TTPSTS ;GO SET UP NEW MODE, AND RETURN
TTCL10: SKIPG B,OTTCNT ;WAS THERE A LINE TYPED IN?
JRST TCL10A ;NO, GIVE SKIP RETURN
MOVEM B,TTCNT ;YES, SET UP TTCNT
PUSHJ P,TTBRK ;GO SET UP TTPNT AND TTLINE
POPJ P,
TCL10A: SETZ A, ;DO THE RESCAN
RSCAN ;ONLY IF FIRST TIME THROUGH
JFCL ;DONT CARE IF NOT IMPLEMENTED
MOVEI A,PRIJFN ;SET UP JFN AGAIN
PUSHJ P,TTFILL ;GO READ IN CHARACTERS IF ANY
JFCL
HRROI A,[0] ;NOW CLEAR THE RESCAN BUFFER
RSCAN
JFCL ;DONT CARE AGAIN IF NOT IMPLEMENTED
SKIPLE TTCNT ;ANY CHARACTERS READY
POPJ P, ;YES, THERE IS DATA THERE
MOVE A,FORTY ;SEE IF USER WANTS SKIP RETURN
TRNE A,1 ;IF BIT 35 IS ON,
JRST CPOPJ1 ; THEN SKIP RETURN
POPJ P,
INTTY: MOVE A,JFNTAB(BB) ;GET JFN OF TTY
MOVE E,FLAGWD(BB) ;AND FLAGS FOR TTY
TLNE E,TT.CTY ;IS THIS THE CONTROLING TTY
MOVE E,TYSTAT ;YES, GET CORRECT FLAGS
PUSHJ P,NOCTRO ;CLEAR CONTROL-O
TLZ E,TT.BKE ;CLEAR BREAK ON EVERYTHING
TRNE E,IO.BIN ;IN BINARY MODE?
PUSHJ P,TTSETB ;YES, GO SET TT.BIN
TRNN E,IO.BIN ;IN BINARY MODE?
PUSHJ P,TTCLRB ;NO, CLEAR BINARY MODE
PUSHJ P,TTYSTS ;SET UP TTY STATUS MODE
TLNE E,TT.CTY ;IS THIS THE CONTROLING TTY?
JRST INCTY ;YES, HANDLE IT SPECIALLY
TDNE E,[TT.BIN!TT.BKE,,IO.FCS]
JRST INTTYB ;CANNOT USE RDTXT, USE BIN
MOVE A,JFNTAB(BB) ;GET JFN OF TTY
HRLS A ;IN BOTH HALVES
MOVE B,IOBPT ;GET POINTER TO USER'S BUFFER
MOVE C,IOCNT ;AND COUNT OF CHARACTERS IN BUFFER
HRLI C,(RD%TOP!RD%JFN)
PUSHJ P,DORDTX ;GO READ IN A LINE
MOVEM B,IOBPT ;STORE UPDATED BYTE POINTER
HRRZM C,IOCNT ;AND COUNT OF CHARACTERS LEFT IN BUFFER
JRST INTTY9 ;RETURN TO USER
INTTYB: SOSGE IOCNT ;ANY MORE ROOM IN BUFFER
JRST INDON1 ;NO
MOVE A,JFNTAB(BB) ;GET JFN
PUSHJ P,TTYBIN ;GET A CHARACTER
INTTB1: IDPB B,IOBPT ;STORE IT IN THE BUFFER
TLNE E,TT.BIN ;IN BINARY MODE?
JRST INTTB2 ;YES
CAIN B,C.EOF ;END OF FILE?
JRST INTTY8 ;YES, GO SET EOF
INTTB2: HRRZ A,DEVNUM(BB) ;GET UNIT NUMBER
TRO A,400000 ;MAKE TTY DEV DESIGNATOR
SIBE ;ANY MORE CHARACTERS?
JRST INTTYB ;YES, GO READ THEM IN
JRST INTTY9 ;NO, RETURN TO USER
INCTY: SOSGE IOCNT ;ANY MORE ROOM?
JRST INDON1 ;NO
PUSHJ P,TTPGET ;GET A CHARACTER FROM CONTROLING TTY
IDPB B,IOBPT ;STORE IT IN BUFFER
TLNE E,TT.BIN ;BINARY MODE
JRST INCTY1 ;YES, DONT TRANSLATE ^Z
CAIN B,C.EOF ;CONTROL-Z?
JRST INTTY8 ;YES, SET EOF
INCTY1: SKIPLE TTCNT ;ANY MORE CHARACTERS
JRST INCTY ;YES, LOOP BACK FOR THEM
JRST INTTY9 ;NO, RETURN TO USER
DORDTX: IJSYS (RDTXT) ;READ IN A LINE
PUSHJ P,BUGSTP ;ERROR, SHOULD NEVER HAPPEN
POPJ P, ;RETURN TO CALLER
TTYBIN: CAIN A,PROJFN ;IS IT PRIMARY OUTPUT?
MOVEI A,PRIJFN ;YES. MAKE PRIMARY INPUT.
SKIPE CSTFLG ;^C BEEN TYPED
JRST CCTRAP ;YES, DONT GO INTO INPUT WAIT
IJSYS (BIN) ;GET THE CHAR FROM TTY
NOCTRO: TLNN E,TT.CTY ;IS THIS THE CONTROLING TTY
POPJ P, ;NO, CONTROL-O NO SUPPORTED ON OTHER LINES
PUSH P,B ;SAVE CHARACTER
RFMOD ;GET MODE WORD
TLZE B,(1B0) ;IS CONTROL-O IN EFFECT?
SFMOD ;YES, CLEAR IT
POP P,B ;RESTORE CHARACTER
POPJ P, ;RETURN
;ASCII OUTPUT ROUTINES
OUTTTY: LDB B,[POINT 4,FLAGWD(BB),35] ;IO MODE
CAIL B,10 ;BINARY?
JRST OUTTTB ;YES.
MOVE E,FLAGWD(BB) ;SET UP MODE WORD
TLNE E,TT.CTY ;IS THIS THE CONTROLING TTY?
MOVE E,TYSTAT ;YES, GET CORRECT FLAG WORD
PUSHJ P,TTCLRB ;CLEAR BINARY MODE IF ON
TLNN E,TT.CTY ;IS THIS THE CONTROLING TTY
MOVEM E,FLAGWD(BB) ;NO, STORE NEW FLAG WORD
OUTTTL: SOSGE IOCNT ;COUNT DOWN THE BYTES
POPJ P,0 ;NO MORE IN BUFFER
XCTLB <ILDB B,IOBPT> ;GET ANOTHER BYTE FROM USER BUFFER
SKIPE B ;DONT OUTPUT NULLS
PUSHJ P,TTYBOU ;OUTPUT THE BYTE, CHECK ^O, INDICATE.
JRST OUTTTL ;LOOP FOR MORE FROM BUFFER
OUTTTB: RFMOD ;GET FILE MODE
PUSH P,B ;SAVE IT
TRZ B,3B29 ;SET TO BINARY FOR OUTPUT
SFMOD ; ..
OUTTBL: SOSGE IOCNT ;COUNT OF BYTES
JRST OUTTTX ;DONE
XCTLB <ILDB B,IOBPT> ;GET A BYTE
PUSHJ P,TTYBO1 ;DO THE BOUT AT COMMON PC
JRST OUTTBL ;LOOP THRU BUFFER
OUTTTX: POP P,B ;GET BACK OLD TTY MODE
SFMOD
POPJ P,0
OUTASC: SOSGE IOCNT ;COUNT BYTES
POPJ P, ;NO MORE IN BUFFER
XCTLB <ILDB B,IOBPT> ;FETCH BYTE FROM BUFFER, PTR IN HEADER
JUMPE B,OUTASC ;IGNORE NULLS
BOUT ;OUTPUT TO FILE.
JRST OUTASC
;ROUTINES FOR SETTING AND CLEARING BINARY MODE STATE
; CALL WITH JFN IN A
TTCLRB: TLZN E,TT.BIN ;IN BINARY MODE?
POPJ P, ;NO, DO NOTHING
TLNN E,TT.CTY ;IS THIS THE CONTROLING TTY?
POPJ P, ;NO, DONT STORE TERMINAL INTERRUPT WORD
PUSH P,A ;SAVE JFN
MOVNI A,5 ;FOR WHOLE JOB...
SKIPE B,SAVTIW ;GET OLD TERMINAL INTERRUPT WORD
STIW ;RESTORE IT
SETZM SAVTIW ;CLEAR OLD INTERRUPT WORD
POP P,A ;RESTORE JFN
JRST TTPSTS ;GO SET UP NEW STATUS MODE
TTSETB: TLOE E,TT.BIN ;BINARY MODE ALREADY IN EFFECT?
POPJ P, ;YES, DO NOTHING
TLNN E,TT.CTY ;IS THIS THE CONTROLING TTY
POPJ P, ;DONT STORE TERMINAL INT WORD
PUSH P,A ;SAVE JFN
PUSHJ P,SETCCE ;ENABLE TO INTERRCEPT CONTROL C'S
JRST TTSTB1 ;CONTROL-C ENABLING IS NOT ALLOWED
MOVNI A,5 ;GET TIW FOR WHOLE JOB
RTIW
MOVEM B,SAVTIW ;SAVE THIS STATE
SETZ B,
STIW ;TURN OFF ALL INTERRUPT WORDS
TTSTB1: POP P,A ;RESTORE JFN
JRST TTPSTS ;GO SET UP NEW MODE
;THE COMPT. UUO
;THIS UUO ALLOWS FILE WITH NAMES LONGER THAN 6 CHARACTERS TO BE
;CREATED AND READ FROM TOPS-10 PROGRAMS THROUGH THE COMPATIBILITY
;PACKAGE.
;CALLING SEQUENCE:
; MOVE AC,[COUNT,,ADR]
; CALLI AC,147
; ERROR RETURN (AC UNCHANGED MEANS USE NORMAL FILE UUOS
; OTHERWISE AC CONTAINS AN ERROR CODE)
; SUCCESSFUL RETURN
COMPT.: HLRE C,CAC ;GET COUNT
JUMPL C,CMPTE1 ;IT MUST BE POSITIVE
XCTUM <HRRE A,0(CAC)> ;GET THE FUNCTION CODE
JUMPLE A,CMPTE1 ;FIRST LEGAL FUNCTION IS 1
CAILE A,COMPTL ;SEE IF WITHIN DEFINED BOUNDS
JRST CMPTE1 ;NO, RETURN ERROR CODE
HLRZ B,COMPTT-1(A) ;GET REQUIRED ARGUMENT COUNT
CAMLE B,C ;DOES USER HAVE ENOUGH ARGUMENTS?
JRST CMPTE1 ;NO
HRRZ A,COMPTT-1(A) ;GET DISPATCH
JRST (A) ;AND DO SO
COMPTT: 10,,COMPT1 ;FUNCTION 1, OPEN, LOOKUP, AND ENTER
3,,COMPT2 ;FUNCTION 2, RENAME
3,,COMPT3 ;FUNCTION 3, PPN TO DIRECTORY
3,,COMPT4 ;FUNCTION 4, RUN
3,,COMPT5 ;FUNCTION 5, JFNS
2,,COMPT6 ;FUNCTION 6, SET UP PSI CHANNEL
3,,COMPT7 ;FUNCTION 7, ERSTR
1,,COMP10 ;FUNCTION 10, GET JFN OF CHANNEL
0,,COMP11 ;FUNCTION 11, COMMIT SUICIDE AND RETURN
COMPTL==.-COMPTT ;END OF DEFINED FUNCTIONS
COMPT1: XCTUM <HLRZ AC,0(CAC)> ;GET THE CHANNEL NUMBER
CAILE AC,17 ;CHECK IT FOR LEGALITY
JRST CMPTE1 ;MUST BE AN AC FIELD
UMOVE A,7(CAC) ;GET POINTER TO LOOKUP BLOCK
HRRM A,FORTY ;PUT IN FORTY FOR SETDAT
PUSHJ P,SETUPG ;SET UP BB
SKIPA ;THIS CHANNEL NOT ALREADY INITED
PUSHJ P,URELR ;ALREADY INITED, RELEASE THIS CHANNEL
XCTUM <HRRZ A,4(CAC)> ;GET THE MODE
HRRZM A,FLAGWD(BB) ;INITIALIZE FLAGS
XCTUM <HRR A,5(CAC)> ;GET POINTER TO INPUT BUFFER HEADER
XCTUM <HRL A,6(CAC)> ;GET POINTER TO OUTPUT BUFFER HEADER
MOVEM A,BUFHTB(BB) ;STORE OBUF,,IBUF
CMPT1C: MOVEI A,10 ;ADDR+10 AND 11 ARE GTJFN RETURN LOCS
PUSHJ P,COMPTG ;DO A GTJFN FOR USER
JRST [JUMPE A,MRETN ;TOPS-10 PACK
JRST CMPTE2] ;GO RETURN ERROR CODE
MOVEM A,JFNTAB(BB) ;SAVE JFN
UMOVE B,1(CAC) ;GET GTJFN BITS
TLNE B,(1B17) ;SHORT OR LONG FORM?
JRST CMPT1A ;SHORT, HAVE FLAGS
UMOVE B,(B) ;LONG, GET FLAGS
CMPT1A: TLNE B,(1B12) ;GJ%OFG? (PARSE)
JRST CMPT1D ;IF PARSE ONLY, RETURN TO USER NOW
DVCHR ;GET DEVICE DESIGNATOR
MOVEM A,DEVNUM(BB) ;SAVE DEVICE DESIGNATOR
PUSHJ P,UOPENF ;GO DO OPEN STUFF
JRST [MOVE A,JFNTAB(BB) ;ERROR, RELEASE JFN
RLJFN
JFCL
SETZM JFNTAB(BB)
JRST MRETN] ;GIVE ERROR RETURN
JRST CMPT1B ;DISK OR DTA
CAIE AA,PTY ;IS IT A PTY?
JRST CMPT1B ;NO
PUSHJ P,PTYSTF ;GO INITIALIZE THE PTY
SKIPA ;ERROR
JRST MRETN2 ;OK, RETURN TO USER
PUSHJ P,URELJ ;CLEAN UP AFTER ERROR
JRST MRETN
CMPT1B: HRROI A,STRNG1 ;GET DEVICE NAME
HRRZ B,JFNTAB(BB) ;GET JFN
MOVSI C,(1B2) ;GET DEVICE NAME
JFNS
PUSHJ P,SEVN26 ;MAKE IT SIXBIT
MOVEM A,DEVNAM(BB) ;STORE IT FOR DEVCHR AND OTHER UUO'S
HRROI A,STRNG1 ;NOW GET EXT
HRRZ B,JFNTAB(BB) ;FOR ENTER
MOVSI C,(1B11)
JFNS
PUSHJ P,SEVN26 ;GET SIXBIT EXT
MOVEM A,EXT(BB) ;NEEDED BY ENTFIN
TRO PF,R.UEXT ;MARK THAT THIS IS AN EXTENDED CALL
MOVE A,JFNTAB(BB) ;GET JFN
UMOVE G,7(CAC) ;SET UP POINTER TO ARGUMENT BLOCK
UMOVE B,3(CAC) ;GET OPEN BITS
JUMPE B,CMPT1L ;IF 0 ASSUME LOOKUP WITHOUT OPEN
TRNN B,1B19 ;WANT TO READ THE FILE?
JRST CMPT1F ;NO. GO CHECK ENTER.
PUSHJ P,ULKOP0 ;YES, GO DO LOOKUP STUFF
SKIPA ;ERROR DURING LOOKUP
JRST CMPT1F ;SEE IF ENTER IS ALSO BEING DONE
UMOVE B,3(CAC) ;GET BACK OPEN BITS AGAIN
TRNE B,1B20 ;WANT TO ENTER FILE?
CAIE A,OPNX2 ;GOT A FILE NOT FOUND ERROR?
JRST CMPTE2 ;NO. GIVE ERROR MSG.
JRST CMPT1G ;YES. DO OPEN ANYHOW.
CMPT1F: UMOVE B,3(CAC) ;GET BACK OPEN BITS.
TRNN B,1B20
JRST MRETN2 ;NO, THEN ALL DONE
CMPT1G: PUSHJ P,OPENX ;GO DO THE OPENING
JRST [PUSHJ P,WARN ;ERROR DURING OPEN, SEE IF OVER QUOTA
JRST CMPTE2 ;NO, RETURN ERROR CODE TO USER
HRRZ A,JFNTAB(BB)
RLJFN ;RELEASE JFN
JFCL
SETZM JFNTAB(BB)
JRST CMPT1C] ;GO TRY AGAIN
JRST ENTFIN ;GO SET DATE AND FINISH UP
CMPT1D: SETOM DEVNAM(BB) ;THIS WILL ALLOW COMPT. UUOS LATER
JRST MRETN2 ;RETURN SUCCESS
CMPT1L: PUSHJ P,ULKOP1 ;DONT OPEN JFN
JRST CMPTE2 ;ERROR DURING OPENF
JRST MRETN2
COMPT2: HLLOS FORTY ;NO LOOKUP BLOCK POINTER
XCTUM <HLRZ AC,0(CAC)> ;SET UP CHANNEL NUMBER
PUSHJ P,SETUP ;SET UP AA AND BB
MOVEI A,3 ;ADDR+3 AND 4 ARE GTJFN RETURN LOCS
PUSHJ P,COMPTG ;DO THE GTJFN
JRST [JUMPE A,MRETN ;TOPS-10 PACK
JRST CMPTE2] ;STORE ERROR CODE
PUSHJ P,URENAM ;GO DO THE RENAME
JRST CMPTE2 ;FAILED
JRST MRETN2 ;SUCCESSFUL
COMPT4: PUSHJ P,RRESET ;RESET ALL CHANNELS
TRO PF,R.RUNU ;MARK THAT A RUN IS BEING DONE
MOVEI A,4 ;ADDR+4 AND 5 ARE GTJFN RETURN LOCS
PUSHJ P,COMPTG ;DO GTJFN
JRST [JUMPE A,MRETN ;TOPS-10 PACK
XCTUM <HLRZ B,@MONUPC>
CAIN B,(JRST 4,) ;IS NEXT INST A HALT?
JRST RUNFA1 ;YES, GO TYPE OUT MESSAGE
JRST CMPTE2] ;RETURN ERROR CODE
MOVEM A,JFNTAB ;SAVE JFN
HRROI A,STRNG1 ;GET NEW PROGRAM NAME
HRRZ B,JFNTAB
MOVSI C,(1B8) ;JUST ITS NAME
JFNS
PUSHJ P,SEVN26 ;TRANSLATE IT TO SIXBIT
MOVE B,A ;PUT NAME IN B
SETZM MTDUMP ;CLEAR OFFSET
;****** NEXT INSTRUCTION TO KEEP PROGRAMS WORKING
;****** UNTIL PAT FIGURES OUT WHAT TO DO ABOUT OFFSETS
AOS MTDUMP ;DO START+1 IF NO OFFSET GIVEN
;******
HLRZ C,CAC ;GET COUNT
CAIGE C,4 ;GIVING AN OFFSET?
JRST CMPRUN ;NO, GO DO RUN
UMOVE C,3(CAC) ;GET OFFSET
MOVEM C,MTDUMP ;STORE OFFSET
JRST CMPRUN ;ENTER RUN CODE
COMPTG: MOVEM A,STRRET ;SAVE INDEX FOR RETURNING GTJFN INFO
CMPTG3: UMOVE A,1(CAC) ;GET AC1 BITS FOR GTJFN
TLNN A,(1B17) ;SHORT OR LONG FORM?
JRST [UMOVE A,(A) ;LONG FORM, GET FLAGS
JRST .+1]
TLNE A,(1B16) ;STRING POINTER IN AC2?
JRST [UMOVE A,1(CAC) ;NO, SET UP FOR STRAIGHT GTJFN
UMOVE B,2(CAC)
JRST CMPTG1] ;GO DO GTJFN
UMOVE A,2(CAC) ;GET STRING POINTER
PUSHJ P,STPARS ;GO SET UP DECODED STRING IN STRNG1
PUSHJ P,CMPTG5 ;ERROR PARSING, USE ORIGINAL STRING
UMOVE A,1(CAC) ;GET AC1 BITS
HRROI B,STRNG1 ;USE TRANSLATED STRING AS MAIN STRING
CMPTG1: GTJFN ;GET A JFN FOR THIS FILE
JRST [PUSHJ P,WARN ;SEE IF DIRECTORY FULL
JRST CMPTG2 ;NO, FIXUP POINTERS AND RETURN ERROR TO USER
JRST CMPTG3] ;YES, GO TRY AGAIN
AOS (P) ;GIVE SUCCESSFUL RETURN WITH JFN IN A
;RETURN GTJFN STRING AND POINTER TO IT
CMPTG2: PUSH P,A
PUSH P,B
PUSH P,C
HLRZ B,CAC ;GET COUNT OF ARGS
SUB B,STRRET ;COMPARE WITH RETURN LOC OFFSET
CAIGE B,2 ;2 ARGS TO RETURN
JRST CMPTG4
MOVE B,CAC
ADD B,STRRET ;GET POINTER TO USER ARG
UMOVE B,(B) ;GET IT
JUMPE B,CMPTG4 ;DON'T RETURN IF 0
LDB A,-1(P) ;GET CHARACTER POINTER POINTS AT
PUSH P,A ;SAVE IT
SETZ A,
DPB A,-2(P) ;CLOBBER IT TO A NULL
MOVE A,CAC
ADD A,STRRET ;CALC INDEX OF USERS RETURN STRING POINTER
UMOVE A,(A) ;GET STRING POINTER
HRROI B,STRNG1 ;THIS IS STRING WE WILL RETURN
SOUT ;ADVANCE USER POINTER TO CHARACTER IN QUESTION
IBP A ;MAKE IT POINT AT CHARACTER
MOVEI B,1(CAC)
ADD B,STRRET ;WHERE TO RETURN POINTER
UMOVEM A,(B) ;GIVE IT TO USER
POP P,A
DPB A,-1(P) ;PUT ORIGINAL CHAR BACK
MOVE A,CAC
ADD A,STRRET ;CALC INDEX OF USERS RETURN STRING POINTER
UMOVE A,(A) ;GET STRING POINTER
HRROI B,STRNG1
SETZ C,
SOUT ;THIS TIME MOVE WHOLE STRING
MOVE B,CAC
ADD B,STRRET
UMOVEM A,(B) ;RETURN END OF STRING TO USER
CMPTG4: POP P,C
POP P,B
POP P,A
POPJ P, ;FIXUP POINTERS HERE LATER
CMPTE1: MOVEI A,-1 ;SET UP ERROR RETURN
CMPTE2: LDB AC,ACPTR ;SET AC UP AGAIN
JRST STOTAC
CMPTG5: UMOVE A,2(CAC) ;GET USER STRING POINTER
HRROI B,STRNG1
SETZ C,
SIN ;MOVE USER STRING TO BUFFER
POPJ P, ;GO DO GTJFN WITH IT
;THIS ROUTINE PARSES A FILE NAME TYPED IN AND RETURNS A VIROS
;FILE SPEC IN STRING1.
;FIRST DEFINE SOME PARAMETERS
SP0==0 ;STACK OFFSET FOR MAIN STRING PONTER
CNT0==-1 ;COUNT OF CHARACTERS IN MIN STRING
SP1==-2 ;POINTER TO STRING AFTER PPN
SPD==-3 ;STRING POINTER TO DEVICE
CNTD==-4 ;COUNT OF CHARACTERS IN DEVICE
DESIG==-5 ;DEVICE DESIGNATOR
CELLS==6 ;WORDS OF STACK SPACE NEEDED
STPARS: TLC A,-1 ;SEE IF -1 IN LEFT HALF
TLCN A,-1
HRLI A,(POINT 7,0) ;YES, SET IT UP CORRECTLY
MOVE C,A ;SAVE STRING POINTER
MOVEI B,CELLS ;WORDS OF STACK NEEDED
PUSH P,[0] ;RESERVE IT
SOJG B,.-1 ;GET EM ALL
MOVEM A,SPD(P) ;SAVE POTERNTIAL DEVICE POINTER
LOKDEV: ;LOOK FO DEVICE FIELD
ILDB B,A ;GET NEXT BYTE
CAIN B,":" ;THIS IT?
JRST DIRLOK ;YES. GO PROCESS IT
SOS CNTD(P)
SKIPE B ;AT STRING END?
JRST LOKDEV ;NO. DO MORE LOOKING
SETZM CNTD(P) ;YES. BLOT OUT DEVICE COUNT
MOVE A,C ;AND RESTORE POINTER
;THIS CODE LOOKS FOR THE PPN OR DIRECTORY NUMBER
DIRLOK: MOVEM A,SP0(P) ;PREFIXING STRING STRT
DIRLK: ILDB B,A ;GET NEXT BYTE
CAIE B,"<" ;START OF PPN FIELD?
CAIN B,"[" ;OR THIS TOO?
JRST COPY0 ;YES. GO FIND IT ALL
JUMPE B,WHOLE ;NO; ATSTRING END?
SOS CNT0(P) ;NO. BUMP COUNT OF THIS FILED
JRST DIRLK ;AND GO DO MORE
COPY0: MOVE C,[POINT 7,DIRNAM]
FND1: ILDB B,A ;GET PPN TO STRNG2 FOR ANALYSIS
JUMPE B,FOUND1 ;IF AT END WE GOT IT
CAIE B,">" ;FIELD TERMINATOR?
CAIN B,"]" ;""""
JRST FOUND ;YES. AT THE END
CAIE B,15 ;CARRAIGE RETURN AND
CAIN B,12 ;LINE FEED MAY ALSO END PPN
JRST FND12 ;
IDPB B,C ;SAVE BYTE
JRST FND1 ;AND DO ALL OF PNNN
FND12: ADD A,[070000,,] ;BACKUP BYTE POINTER
FOUND: MOVEM A,SP1(P) ;SAVE TERMINATING STRING START
FOUND1: SETZ B,
IDPB B,C ;TIE OFF DRECTORY OR PPNM
MOVE C,SPD(P) ;NOW GET STR:<DIR> INTO STRNG1
MOVE B,[POINT 7,STRNG1]
FOUND2: ILDB A,C ;GET A CHARACTER
IDPB A,B ;STORE IT INTO STRNG1
CAIE A,">" ;FINISHED?
CAIN A,"]" ;...
JRST FOUND3 ;YES
JUMPN A,FOUND2 ;IF NOT NULL, LOOP BACK
FOUND3: MOVEI A,0 ;TIE OFF STRING
IDPB A,B
;NOW ANALYZE DIR OR PPN NAME IN STRNG1 AND DETERMINE ITS VIROS
;DIRECTORY NUMBER
MOVX A,RC%EMO ;NO RECOGNITION
HRROI B,STRNG1 ;GET POINTER TO STR:<DIR>
RCDIR ;GET DIR NUMBER
ERJMP NODIR0 ;FAILED, GO SEE IF PPN
TXNE A,RC%NOM!RC%AMB
JRST NODIR0 ;FAILED IN ANOTHER WAY
MOVE A,C ;GET DIR NUMBER INTO A
;WAS A LEGAL DIRECTORY. CAN BUILD FILE NAME NOW
DODIR: MOVE B,[POINT 7,STRNG1]
MOVE D,A ;SAVE DIR NUMBER
FAKES: EXCH A,B ;SET UP FOR DIRST
MOVE D,A ;SAVE BYTE POINTER
DIRST ;GET STR:<DIR>
MOVE A,D ;FAILED, GET BACK STRING POINTER
MOVE B,A ;GET STRING POINTER INTO B
JRST WHOLE1 ;SKIP NEXT DEVCPY CALL
WHOLE: MOVE B,[POINT 7,STRNG1]
SETZ D, ;NO DIRECTORY
JSP E,DEVCPY ;COPY DEVICE IF NOT ALREADY DONE
WHOLE1: MOVE A,SP0(P) ;PREFIXING STRING
SKIPE C,CNT0(P) ;ANYTHING THERE?
SIN ;YES. DO IT
MOVE A,SP1(P) ;TERMINATING STRING
JUMPE A,FNAL ;IF NONE THERE, DONE
SETZ C, ;UNTIL THE END
SIN
SETZ A,
FNAL: IDPB A,B ;FINAL CHARACTER
MOVE A,DESIG(P) ;RETURN DEVICE DESIGNATOR
SUB P,[CELLS,,CELLS] ;FAST POP
JRST CPOPJ1 ;AND DONE
;COPY DEVICE NAME IF PERTINENT
DEVCPY: HRROI A,[ASCIZ /DSK/] ;DEFAULT DEVICE
PUSH P,B
STDEV ;GET DESIG OF DSK
JFCL ;MUST BE A DSK
POP P,A
MOVEM B,DESIG(P) ;STASH AWAY DESIGNATOR
MOVE B,A
SKIPN C,CNTD(P) ;A COUNT?
JRST 0(E) ;NO. GO BACK
SETZM CNTD(P) ;WILL BE NONE FROM NOW ON
MOVE A,SPD(P) ;POINTER
SIN ;COPY IT
PUSH P,B ;SAEV B AGAIN
SETZ A,
IDPB A,B ;TIE OFF DEVICE STRING
HRROI A,STRNG1
STDEV ;GET DESIG OF THIS DEVOCE
JRST UHOH ;NOT A REAL DEVICE
POP P,A
MOVEM B,DESIG(P) ;RETURN DEVICE DEVICE DESIG
MOVE B,A
MOVEI A,":" ;PUT : BACK ON FOR DEVICE NAME
IDPB A,B
JRST 0(E) ;AND GO BACK
UHOH: MOVE A,STRNG1 ;NOT A REAL DEVICE. SEE IF SYS
TRZ A,377 ;CLEAR OUT CRUFT IN LAST CHARACTER SLOT
CAME A,[ASCIZ /SYS/] ;WELL, IS IT?
JRST NOSYS ;NOPE.
POP P,B ;GET ABCK SP
MOVE B,[POINT 7,STRNG1] ;GO BACK TO START OF BUFFER
SKIPE D ;DEVICE OUT THERE?
JRST DEVCPY ;ALREADY A DIRECTORY. JYST FAKE IT
MOVX A,RC%EMO ;NO RECOGNITION
MOVE D,B ;SAVE B
HRROI B,[ASCIZ /PS:<SUBSYS>/] ;SYS IS SUBSYS BY DEFAULT
RCDIR
TXNE A,RC%NOM!RC%AMB ;IS IT THERE?
MOVEI C,0 ;NO
MOVE B,D
MOVE D,C ;DIR NUMBER TO D
JRST FAKES ;AND FAKE OUT EVERYBODY
NOSYS: POP P,(P) ;THROW AWAY POINTER
IFN FTFILSER,< ;DONT DO DPA'S IF NO FILSER
SETZ A, ;COLLECT SIXBIT DEVICE NAME HERE
MOVE B,[POINT 6,A]
MOVE C,[POINT 7,STRNG1]
BGLOOP: ILDB D,C ;GET BYTE
JUMPE D,CALIT ;IF AT THE END GO LOOK FOR DPA
SUBI D,40 ;MAKE IT SIXBIT
IDPB D,B ;STASH IT AWAY
TLNE B,770000 ;PUT IN SIX?
JRST BGLOOP ;NO. GO GOBBLE MORE
CALIT: PUSHJ P,DPACHK ;SEE IF A DPA
> ;END OF FTFILSER CONDITIONAL
SKIPA A,[0,,GJFX16] ;NO. BAD
SETZ A, ;YES. GOOD
SUB P,[CELLS,,CELLS]
POPJ P, ;DONE
;WAS NOT A VIROS DIRECTORY NAME. TRY A PPN
NODIR0: PUSH P,[0]
PUSH P,[0] ;FOR PPN STORAGE
HRROI A,DIRNAM
MOVEI C,10 ;OCTAL NUMBERS
NIN ;GET A NUMBER
JRST [LDB B,A ;GET TERMINATOR
CAIE B,"-" ;DEFAULT?
JRST DO2 ;NO, USE NULL FOR FIRST
IBP A ;ADVANCE OVER "-"
JRST DFLT] ;YES
MOVEM B,(P) ;SAVE CONVERTED NUMBER
DO2: LDB B,A ;GET TERMINATOR
CAIE B,"," ;LEGAL SEPERATOR?
JRST ERR ;NO
NIN ;NEXT NUMBER
CAIA ;DON'T STORE B IF NO NUMBER READ
MOVEM B,-1(P) ;SAVE VALUE
DFLT: LDB B,A ;GET TERMINATOR
JUMPN B,ERR ;LOSE IF WHOLE STRING NOT EATEN
GJINF ;GET DIR
MOVE A,B ;CONNECTED
PUSHJ P,PPNUNM ;CONVERT IR
POP P,B ;GET TOP VALUE
SKIPE B ;ANYTHING THER4?
HRLI A,(B) ;YES. USE IT
POP P,B ;NEXT VALUE
SKIPE B
HRRI A,(B) ;USE THIS IF THERE
MOVE B,SPD(P) ;GET POINTER TO STR:<DIR>
SKIPN CNTD(P) ;IS THERE A DEVICE STRING?
HRROI B,[ASCIZ/DSK:/] ;NO, ASSUME DSK:
PUSHJ P,PPN2DR ;GO GET A DIR NUMBER FROM PPN
JRST ERR1 ;NO CONVERSION
JRST DODIR ;MADE IT. GO OFF
ERR: SUB P,[2,,2]
ERR1: MOVE A,SP0(P)
MOVEM A,SP1(P)
SETZM CNT0(P)
JRST WHOLE
COMPT3: XCTUM <SKIPN A,1(CAC)> ;GET PPN IF ANY
JRST CMPT3A ;NONE
CAIGE C,4 ;FOR THIS DIRECTION, MUST HAVE 4 ARGS
JRST CMPTE1 ;ELSE ARG ERROR
UMOVE D,3(CAC) ;GET POINTER TO STR NAME STRING
HRROI E,DEVNM7 ;GET OUTPUT STRING POINTER
PUSHJ P,SIXTO7 ;CONVERT SIXBIT DEV NAME TO ASCIZ
HRROI B,DEVNM7 ;NOW CONVERT PPN TO DIR NUMBER
UMOVE A,1(CAC) ;GET PPN AGAIN
PUSHJ P,PPN2DR ;GET DIR NUMBER
JRST CMPT3E ;NONE
MOVE B,A ;NOW TURN IT INTO A STRING
UMOVE A,2(CAC) ;GET STRING POINTER
DIRST
JRST CMPT3E ;ERROR
UMOVEM A,2(CAC) ;STORE UPDATED STRING POINTER
JRST MRETN2 ;ALL DONE
CMPT3A: UMOVE B,2(CAC) ;GET STRING POINTER
MOVX A,RC%EMO ;NO RECOGNITION
RCDIR ;GET DIR NUMBER
ERJMP CMPT3E ;FAILED
TXNE A,RC%NOM!RC%AMB ;FOUND ONE?
JRST CMPT3E ;NO
UMOVEM B,2(CAC) ;STORE UPDATED STRING POINTER
MOVE A,C ;GET DIR NUMBER IN A
PUSHJ P,PPNUNM ;GET A PPN FROM DIR NUMBER
UMOVEM A,1(CAC) ;RETURN PPN IN ARG BLOCK
JRST MRETN2
CMPT3E: MOVEI A,1
JRST STOTAC ;GIVE NON-SKIP RETURN WITH ERROR 1
COMPT5: XCTUM <HLRZ AC,0(CAC)> ;SET UP CHANNEL NUMBER
CAILE AC,17 ;LEGAL CHANNEL NUMBER?
JRST CMPTE1 ;NO
PUSHJ P,SETUP ;SET UP BB AND AA
UMOVE A,1(CAC) ;GET STRING POINTER
SKIPG B,JFNTAB(BB) ;GET JFN
JRST MRETN ;NO JFN, GIVE ERROR RETURN
HRRZS B ;CLEAR OUT WILD CARD FLAGS
UMOVE C,2(CAC) ;GET FLAGS
JFNS ;DO THE JFN
JRST MRETN2 ;SUCCESSFUL
;COMPAT FUNCTION 6 - SET UP A PSI CHANNEL
;ACCEPTS IN ARG/ LEVEL # ,, LOCATION TO TRAP TO
; ARG+1/ PSI CHANNEL # ,, ADR OF PLACE TO STORE PC
; ARG = 0 MEANS REMOVE PSI CHANNEL IN ARG+1
COMPT6: XCTUM <HRRZ A,1(CAC)> ;GET TRAP ADDRESS
PUSHJ P,ADRCHK ;MAKE SURE IT IS A LEGAL ADDRESS
XCTUM <HRRZ A,2(CAC)> ;GET ADRESS OF PC STORAGE WORD
PUSHJ P,ADRCHK ;CHECK IT TOO
XCTUM <HLRZ C,2(CAC)> ;GET PSI CHANNEL NUMBER
CAILE C,USRMXC ;IS IT LEGAL?
JRST RETZER ;NO, GIVE ERROR RETURN
MOVN B,C ;SET UP MASK
MOVSI D,400000
LSH D,(B)
XCTUM <HLRZ B,1(CAC)> ;GET LEVEL NUMBER
JUMPE B,CMPT6R ;IF ZERO, REMOVE PSI CHANNEL
CAIE B,USRLVL ;LEGAL LEVEL #
JRST RETZER ;NO, GIVE ERROR RETURN
IORM D,USRMSK ;ADD THIS CHANNEL TO THOSE TURNED ON
CMPT6A: MOVEM A,LEVTAB-1(B) ;STORE PC ADDRESS WORD
UMOVE B,1(CAC) ;GET BACK CHNTAB WORD AGAIN
HRRZM B,UITRAP ;SAVE TRAP ADDRESS
HRRI B,USRINT ;SET UP TRAP ADDRESS
MOVEM B,CHNTAB(C) ;STORE IN CHNTAB
PUSHJ P,SETPSI ;GO SET UP NEW PSI SETTINGS
JRST MRETN2 ;AND EXIT
CMPT6R: ANDCAM D,USRMSK ;TURN OFF THIS CHANNEL
JRST CMPT6A ;GO CLEAN UP
;COMPAT FUNCTION 7 - CONVERT ERROR NUMBER TO STRING
;ACCEPTS IN ARG+1/ DESTINATION STRING POINTER
; ARG+2/ COUNT,,ERROR #
COMPT7: UMOVE A,1(CAC) ;GET STRING POINTER
XCTUM <HRRZ B,2(CAC)> ;GET ERROR #
HRLI B,.FHSLF ;CURRENT FORK
XCTUM <HLLZ C,2(CAC)> ;GET COUNT
MOVN C,C
ERSTR
JRST CMPTE1 ;RETURN -1 FOR NO MESSAGE
JFCL ;ASSUME TRUNCATED STRING, AND JUST RETURN
UMOVEM A,1(CAC) ;RETURN UPDATED STRING POINTER
JRST MRETN2 ;SUCCESSFUL
;FUNCTION 10 - GET JFN OF A CHANNEL
COMP10: XCTUU <HLRZ A,0(CAC)> ;GET CHANNEL #
TRZ A,777760 ;MAKE SURE IN RANGE
IMULI A,NTABS ;CONVERT TO TABLE ADDRESS
HRRZ A,JFNTAB(A) ;GET THE JFN NOW ON THIS FILE
JUMPE A,STOTAC ;RETURN NON-SKIP IF NULL
JRST STOTC1 ;AND SKIP IF OK.
;FUNCTION 11 - PMAP OURSELF OUT OF THE WATER AND RETURN TO USER
COMP11: TRO PF,R.SUIC ;THREATEN SUICIDE
JRST EXIT2 ;PULL THE TRIGGER
SUBTTL ONCE AND OTHER RARE ROUTINES
MLON
;FIRST TIME INITIALIZATION
ONCE: MOVE A,20 ;REFERENCE PAGE 0 TO CREATE IT IF NEEDED
MOVE A,[XWD TSLOC,TSLOC+1]
SETZM -1(A)
BLT A,CLRTOP
MOVSI PF,L.DBUG ;CLEAR ALL FLAGS BUT THIS ONE
ANDM PF,PFLAGS ; ..
MOVSI PF,L.ONCE ;AND SET THIS ONE, BEEN THRU ONCE CODE
IORB PF,PFLAGS ;AND LOAD FLAGS INTO AC.
PUSHJ P,SETPSI ;SET UP PSEUDO INTERRUPT SYSTEM
PUSHJ P,SETJDA ;SET UP JOB DATA AREA
PUSHJ P,SETHSN ;GO SET UP HI SEG NAME, DEV, AND PPN
PUSHJ P,SETLSN ;SAME FOR LOW SEG
MOVEI A,PROJFN ;CONTROLLING TERMINAL
RFMOD ;GET STARTING ECHO CHARACTERISTICS
ANDI B,TM.ECH ;FOR TTYSTS ROUTINE
MOVEM B,ECHINI
MOVSI E,TT.CTY!TT.ALT ;SET CONTROLING TTY BIT IN STATUS WORD
RFCOC ;SEE WHAT ECHOING OF CONTROLS IS SET AT
TRNN B,4000 ;HAS USER REQUESTED ^L BE INDICATED?
TLO PF,L.INDF ;YES. CARRY THAT DATUM AROUND IN FLAGS
PUSHJ P,TTPSTS ;ALSO SET UP CORRECT MODE
PUSHJ P,TTBINI ;GO INITIALIZE TTCALL BUFFER
MOVSI A,400000 ;INITIALIZE MAPLST
ASH A,-<NIOPGS/NPLPGS-1> ;TURN ON ALL ALL AVAILABLE SLOTS
MOVEM A,MAPLST ;STORE AVAILABLE SLOT MASK
MOVE A,[SIXBIT/NCPGS/] ;SEE IF THIS IS A SMALL SYSTEM
SYSGT ;GET # OF USER PAGES
CAIG A,^D130*2 ;IS THIS GREATER THAN 130 K CORE?
TLO PF,L.SMAL ;NO, MARK THIS AS A SMALL SYSTEM
SYSGTA (<PTYPAR>) ;GET FIRST PTY # IN TTYJOB TABLE
HRRZM A,FIRPTY ;STORE FOR LATER USE
MOVE A,[SIXBIT/JOBRT/] ;GET NJOBS
SYSGT
HLRO A,B ;LH = NEG NUMBER OF JOBS
MOVNM A,NJOBS ;STORE NJOBS
MOVNM A,HGHSGN
GJINF ;GET TSS JOB #
MOVEM C,JOB
ONCE3: SETO B, ;NOW GET TIME SINCE MIDNIGHT
SETZ D, ;...
ODCNV
MOVEI E,0(D) ;SAVE FOR FUTURE USE
TIME ;GET TIME SINCE LOAD
SETO B, ;BACK TO GETTING TIME SINCE MIDNIGHT
SETZ D,
ODCNV
CAIE E,0(D) ;MAKE SURE CLOCK DIDNOT TICK JUST THEN
JRST ONCE3 ;IT DID, GO TRY AGAIN
IMULI E,^D1000 ;CONVERT SECONDS TO MILLISECONDS
SUB E,A ;GET ACTUAL TIME IN MILLISECONDS
MOVEM E,ITIME ;STORE IT FOR USE WITH MSTIME UUO
IFN FTSTAT,<
MOVSI A,100001 ;GET THE STATISTICS FILE
HRROI B,[ASCIZ /PA1050.STATISTICS/]
GTJFN
JRST NOSTAT ;HASN'T BEEN MADE ON SYS
PUSH P,A ;SAVE JFN
MOVEI B,302000 ;OPEN THAWED, READ, WRITE
OPENF
JRST [POP P,A ;CAN'T OPEN IT. RELEASE JFN
RLJFN ; ..
JFCL ;REALLY CAN'T. IGNORE.
JRST NOSTAT] ;AND SKIP THIS
POP P,A ;GET THE JFN
MOVSI A,(A) ;PAGE 0 OF THE FILE
MOVE B,[.FHSLF,,STATLP] ;STATISTICS PAGE IN THIS FORK
MOVSI C,140000 ;R/W ACCESS
PMAP ;MAKE THEM EQUIVALENT
HLRZS A ;GET JFN
CLOSF ;CLOSE THE JFN
JFCL
TLO PF,L.LSTA ;MARK THAT STATISTICS FILE WAS FOUND
MOVE A,PVLOC ;LOAD UP THIS VERSION NUMBER
MOVEM A,ST.VER+STATLC ;STORE FOR STATISTICS GATHERER
MOVE A,[STATFW] ;GET FORMAT WORD
MOVEM A,ST.FMT+STATLC ;STORE IN FILE
NOSTAT: MOVSI A,100001 ;GET THE STATISTICS FILE
HRROI B,[ASCIZ /<SYSTEM>PA1050.STATISTICS/]
GTJFN
JRST NOSTA1 ;HASN'T BEEN MADE ON SYS
PUSH P,A ;SAVE JFN
MOVEI B,302000 ;OPEN THAWED, READ, WRITE
OPENF
JRST [POP P,A ;CAN'T OPEN IT. RELEASE JFN
RLJFN ; ..
JFCL ;REALLY CAN'T. IGNORE.
JRST NOSTA1] ;AND SKIP THIS
POP P,A ;GET THE JFN
MOVSI A,(A) ;PAGE 0 OF THE FILE
MOVE B,[.FHSLF,,STATGP] ;STATISTICS PAGE IN THIS FORK
MOVSI C,140000 ;R/W ACCESS
PMAP ;MAKE THEM EQUIVALENT
HLRZS A ;GET JFN BACK
CLOSF ;CLOSE IT
JFCL
TLO PF,L.GSTA ;MARK THAT GLOBAL STATISTICS LILE WAS FOUND
MOVE A,PVLOC ;GET PAT VERSION NUMBER
MOVEM A,ST.VER+STATGC ;STORE FOR ANALYSIS PROGRAM
MOVE A,[STATFW] ;GET FORMAT WORD
MOVEM A,ST.FMT+STATGC ;STORE IN FILE
NOSTA1: MOVEI A,1 ;READ HIGH PRECISION CLOCK
HPTIM ;GET RUNTIME IN MICROSECOND UNITS
TLZ PF,L.GSTA!L.LSTA ;NO SENSE IN DOING ANY MORE HPTIM'S
MOVE B,A
SUB B,STIME ;CALCULATE TIME TO DO ONCE STUFF
MOVEM A,STIME ;DONT ADD THIS TO FIRST UUO TIME
MOVEI A,0 ;COUNT UP TIMES THAT PAT HAS BEEN STARTED
STAT A,B,<ST.ONC>
> ;END OF STATISTICS OPENER
MOVEM PF,PFLAGS ;STASH PF IN CORE ON EXIT FROM ONCE
POPJ P,0 ;AND RETURN FROM ONCE-ONLY ROUTINE
;DEBUG$G AFTER LOADING SETS UP SO SYSTEM'S PAT WONT BE LOADED.
DEBUG1: TDZA A,A ;ENTRY FLAG
DEBUG: MOVEI A,1
MOVE P,PATSTK ;SET UP A STACK POINTER
PUSH P,A ;SAVE ENTRY FLAG
SETOM INPAT ;FLAG FOR UUO PROCESSOR
MOVSI PF,L.DBUG ;SET FLAG NOT TO GRAB ^C INT
IORB PF,PFLAGS ;IN CORE AND AC FLAG WORDS
PUSHJ P,ONCE ;SET UP TEMP STORAGE AND PSI SYS
PUSHJ P,SETCV ;SET COMPATIBILITY VECTOR
SETZM INPAT ;NOT PROCESSING IN PAT NOW
POP P,A ;GET ENTRY FLAG
SKIPE A ;FROM EXEC?
JRST DDTLOC ;GO TO DDT
HALTF ;YES. STOP
SETCV: MOVEI A,.FHSLF ;THIS FORK
MOVE B,[XWD EVECL,EVEC] ;SIZE AND LOCATION OF COMPAT VECTOR
MOVE C,[XWD MONUUO,MONUPC] ;PLACE FOR MONITOR TO STASH UUO, PC
SCVEC ;SET COMPATIBILITY VECTOR
POPJ P,0 ;RETURN
;ROUTINE TO SET UP JOB DATA AREA
SETJDA: MOVEI A,140 ;GIVE USER AT LEAST 140 WORDS
HRRZM A,JBREL ;SO UMOVE .JBREL DOESNT FAIL
UMOVE A,.JBREL
JUMPN A,SETJD1 ;SETUP?
HRRZ A,.JBCOR ;GET JOB CORE
JUMPN A,SETJD1 ;USE THIS AS .JBREL
PUSHJ P,HSOCHK ;COMPUTE HI SEG ORIGIN
JRST [ PUSHJ P,SETVES ;FOUND IT, SETUP .JBDAT FROM VESTIG
UMOVE A,.JBREL ;SHOULD NOW HAVE GOODIES
JRST SETJD1]
MOVE A,[.FHSLF,,.HSLOC/1000] ;NO, IS THERE A READABLE PAGE 400?
RPACS
TLNE B,(1B2)
PUSHJ P,SETVES ;YES,SETUP JOB DATA AREA FROM VESTIG
MOVEI C,PATPAG-1 ;SCAN MAP TO FIND HIGHEST USED PAGE
TLNE PF,L.FLSR ;IS FILSER MAPPED IN?
MOVEI C,FLSRPG-1 ;YES, START AT FIRST PAGE UNDER FILSER
MOVSI A,.FHSLF
HRRI A,0(C)
RPACS
TLNN B,(1B2) ;IS PAGE READABLE?
SOJG C,.-3 ;NO
MOVEI A,0(C) ;THIS IS HIGHEST PAGE
LSH A,^D9
HRRZ B,.JBCOR ;HIGHEST LOAD ADDRESS
CAIGE A,0(B) ;MAX OF THAT AND HIGHEST PAGE
MOVEI A,0(B)
SETJD1: TRO A,777 ;EVEN PAGES
TLNE PF,L.FLSR ;IS FILSER MAPPED IN
CAIGE A,FLSRLC ;YES, SEE IF FILSER IS OVERLAPPED
CAIL A,PATLOC ;WITHIN BOUNDS
PUSHJ P,CORBUG ;NO, TYPE OUT MESSAGE AND HALT
UMOVEM A,.JBREL
HRRZM A,JBREL
UMOVE A,JOBS41 ;SAVED CONTENTS OF 41
XCTUU <SKIPE 41> ;41 NEEDS SETUP?
JRST SETJD2
UMOVEM A,41 ;YES
SETJD2: XCTUU <HRRZ A,.JBHRL>
JUMPE A,SETJD3 ;SKIP SETUP IF NO HIGHSEG
TRO A,777 ;EVEN PAGE
TLNE PF,L.FLSR ;IS FILSER MAPPED IN
CAIGE A,FLSRLC ;YES, SEE IF FILSER IS OVERLAPPED
CAIL A,PATLOC ;WITHIN BOUNDS
PUSHJ P,CORBUG ;NO, TYPE OUT MESSAGE AND HALT
HRRZM A,JBHRL
SETJD3: PUSHJ P,HSOCHK ;TRY TO CALC HI SEG ORIGIN
JFCL ;IF IT LOSES, IT LOSES
POPJ P,
;COMPUTE BEST GUESS FOR HI SEGMENT ORIGIN
HSOCHK: XCTUM <SKIPN A,.JBHSO> ;ORIGIN SPECIFIED IN LOW SEG?
JRST HSOCK1 ;NO
LSH A,9 ;YES, MAKE IT ADDRESS
JRST HSOCK2
HSOCK1: XCTUM <HRRZ A,.JBHRL> ;GET HI SEG END FROM LOW SEG
JUMPE A,HSOCK3 ;JUMP IF NONE
XCTUU <HLRZ B,.JBHRL> ;GET HI SEG FREE POINTER
SUBI A,-1(B) ;SUBTRACT FROM HI SEG END
TRZ A,777 ;FORCE PAGE BOUNDARY
HSOCK2: CAMG A,JBREL ;IS DESIRED HI SEG ORIGIN LEGAL?
JRST HSOCK3 ;NO
MOVEM A,HSORG ;YES, USE IT
POPJ P, ;INDICATE BEST GUESS OK
HSOCK3: MOVE A,JBREL ;GET END OF LOW SEG
TRO A,777 ;FORCE TO END OF PAGE
ADDI A,1 ;MAKE IT NEXT PAGE
CAIGE A,.HSLOC ;IS IT ABOVE DEFAULT HI SEG ORIGIN?
MOVEI A,.HSLOC ;NO, USE DEFAULT
MOVEM A,HSORG ;STORE HI SEG ORIGIN
JRST CPOPJ1 ;INDICATE BEST GUESS FAILED
;COPY VESTIGAL JOB DATA AREA FROM HISEG TO LOSEG
SETVES: MOVSI B,-NVSTIG
MOVE A,HSORG
HRLI A,B ;CONSTRUCT INDIRECT WORD HISEG(B)
SETVS0: UMOVE C,@A
JRST @VESTIG(B)
SETVS1: AOBJN B,SETVS0
XCTUM <HRRZ B,.JBHRL>
TLNE PF,L.FLSR ;IS FILSER MAPPED IN?
CAIGE B,FLSRLC ;YES, DONT LET IT BE OVERLAPPED
CAIL B,PATLOC ;WITHIN BOUNDS
PUSHJ P,CORBUG ;NO, TYPE OUT MESSAGE AND BOMB
HRRZM B,JBHRL
POPJ P,
VESTIG: [UMOVEM C,.JBSA
JRST SETVS1]
[UMOVEM C,41
JRST SETVS1]
[UMOVEM C,.JBCOR
XCTUU <HRRZM C,.JBREL>
JRST SETVS1]
JRST [ XCTUU <HRRZM C,.JBREN>
HLR C,C ;REL TOP OF HIGH SEG
HRRI C,-1(C) ;ACCOUNT FOR EXACT MULTIPLE OF PAGE
TRO C,777 ;ROUND TO TOP OF PAGE
ADD C,HSORG ;INCLUDE HISEG ORIGIN
TLNE C,-1 ;HAD ANYTHING?
UMOVEM C,.JBHRL ;YES, STORE IT
JRST SETVS1]
[UMOVEM C,.JBVER
JRST SETVS1]
NVSTIG==.-VESTIG
;ROUTINE TO READ IN GETJI INFO. PASS IT GETJI AC1 ARG. IT
;SETS UP THE REST
;SKIPS/NON-SKIPS PER GETJI. ON NON-SKIP, GETJI STUFF IN AC1 (PRESUMABLY
;ERROR CODE)
DGETJI: SETZM STRNG1+.JISRM ;WE DON'T WANT SESSION REMARK
MOVE B,[-BLLEN,,STRNG1] ;TELL GETJI HOW MANY ENTRIES AND WHERE TO PUT 'EM
MOVEI C,0 ;START WITH FIRST ENTRY
GETJI ;DO IT
RET ;NON-SKIP ON ERROR
JRST CPOPJ1 ;SKIP ON SUCCESS STORY
;ROUTINE WHICH SKIPS IF JOB IS IN "USER" MODE INSTEAD OF "MONITOR"
;MODE. THIS ROUTINE ASSUMES THE GETJI DATA BLOCK HAS BEEN SET UP
;(BY CALLING DGETJI). NO AC'S ARE CLOBBERED
SKPUSR: SAVEAC <A,B,C,D>
SKIPE STRNG1+.JIT20 ;TOPS20 EXEC MODE?
RET ;YES, NON-SKIP
JRST CPOPJ1 ;NO, SKIP
;SUBROUTINE SETPSI TO SET UP THE PSEUDO INTERRUPT SYSTEM, AND
; SET FOR ^O AS AN INTERRUPT.
SETPSI: MOVEI A,.FHSLF ;THIS FORK
DIR ;DISABLE INTERRUPT SYSTEM
MOVE B,[XWD PSITAB,LEVTAB] ;COPY PURE TABLES TO
SKIPN LEVTAB ; IMPURE AREA, FIRST TIME ONLY.
BLT B,CHNTAB+^D35 ;FIRST TIME. COPY IT.
MOVE B,[XWD LEVTAB,CHNTAB] ;TELL MONITOR WHERE THEY ARE
SIR ; ..
MOVSI A,3 ;SET UP TO ENABLE ^C IF DESIRED
HRRI A,CCIPSN ;^C CHANNEL #
SKIPN CCIENB ;(323) ^C interrupt enabled?
JRST EDONE ;(323) no
;**; if user is trapping control-C, also trap BREAK (or ATTN) key
;**; which is equivalent to a NULL
ATI ;(323) enable ^C
HRLI A,.TICBK ;(323) enable BREAK (ie, NULL)
ATI ;(323)
EDONE: ;(323)
MOVEI A,.FHSLF ;THIS FORK
MOVE B,ONCHNS ;CHANNELS ALWAYS DESIRED
MOVE C,USRENB ;THOSE USER MAY WANT
TRNE C,1B19 ;PDL OV?
TLO B,(1B9) ;YES
TRNE C,1B23!1B22 ;ILL MEM REF, NXM?
TDO B,[EXP 1B16!1B17!1B18]
; TRNE C,1B26 ;CLOCK FLAG
; TLO B,(1B14) ;TIME OF DAY? *** NOT YET IMPL
TRNE C,1B29 ;FOV?
TLO B,(1B7) ;YES
TRNE C,1B32 ;AR OV?
TLO B,(1B6) ;YES.
SKIPE CCIENB ;^C INTERCEPT ENABLED
TRO B,1B<CCIPSN> ;YES, TURN ON THIS CHANNEL
TDO B,USRMSK ;TURN ON CHANNELS FOR USER (COMPT. 6)
AIC ;TURN ON THOSE CHANNELS
ANDCA B,ALLCHN ;TURN OFF UNSELECTED ONES FROM ABOVE
DIC ; ..
EIR ;AND ENABLE THE INTERRUPT SYSTEM
POPJ P,0 ;RETURN FROM SETPSI
ONCHNS: EXP <1B<CCPSIN>>!<1B<CCIPSN>>!<3B<IOCHN+1>>!1B11!1B12!1B15!1B19!1B20!1B22!<1B<TTYCHN>> ;^O,IO ERR, ILL INST, NXPAGE
;AND MASK OF ALL THAT MIGHT WANT TO BE ON
ALLCHN: EXP <1B<CCPSIN>>!<1B<CCIPSN>>!<3B<IOCHN+1>>!77B5!1B6!1B7!1B9!1B11!1B15!7B18!1B19!1B20!1B22!<1B<TTYCHN>>
CLRPSI: MOVEI A,.FHSLF ;THIS FORK
CIS ;CLEAR WAITING INTS
DIR ;DISABLE INT SYSTEM
SETO B, ;ALL CHANNELS
DIC ;DISABLE ALL CHANNELS
SETZ B, ;INITIALIZE TERMINAL INTERRUPT WORD
STIW
CLRCCI: MOVEI A,3 ;CLEAR ^C INTERCEPT
SKIPE CCIENB ;ONLY IF ENABLED
DTI
SETZM CCIENB ;MARK THAT IT IS NOT SET
POPJ P,0 ;AND RETURN FROM CLRPSI
CLRALL: PUSHJ P,CLRPSI ;CLEAR INTERRUPT SYSTEM
MOVEI A,.FHSLF ;THIS FORK
SETZB C,B ;CLEAR COMPATIBILITY VECTOR
SCVEC ;SO WILL GET NEW ONE AFTER LOADING
;AND NOT CONFUSE NON-1050 PROGRAMS
POPJ P,
PSITAB:
;LEVTAB
EXP RETSAV ;STORAGE FOR CHANNEL 1 PC
EXP LV2SAV ;STORAGE FOR LEVEL 2 PC
0
;CHNTAB
0 ;CHANNEL 0
0 ;CHANNEL 1
0 ;CHANNEL 2
0 ;CHANNEL 3
0 ;CHANNEL 4
0 ;CHANNEL 5
XWD 1,OVINT ;OVERFLOW ON CHANNEL 6
XWD 1,FOVINT ;FLOATING OVERFLOW ON CHANNEL 7
0 ;CHANNEL 8
XWD 1,PDLINT ;PDL OVERFLOW ON CHANNEL 9
0 ;EOF ON CHANNEL 10
XWD 1,IOERR ;IO DATA ERROR (11)
XWD 1,QUOINT ;QUOTA EXCEEDED INTERRUPTS (12)
IOCHN==.-PSITAB-3 ;PTY CHANNELS
XWD 1,PTYINT ;CHANNEL 13 RESERVED FOR PTY HUNGRY
XWD 1,PTYINT ;CHANNEL 14 RESERVED FOR PTY OUTPUT READY
XWD 1,INSINT ;ILLEGAL INST, CH 15
XWD 1,MEMINT ;CHANNEL 16 ILLEGAL READ
XWD 1,MEMINT ;CHANNEL 17 ILLEGAL WRITE
XWD 1,MEMINT ;CHANNEL 18 ILLEGAL EXECUTE
TTYCHN==.-PSITAB-3
XWD 1,TTYINT ;CHANNEL 19 SUBSIDIARY FORK TERMINATION
;TTY FORK INTERRUPTS HERE
XWD 1,MACHSZ ;CHANNEL 20 MACHINE SIZE ERROR
0 ;CHANNEL 21 TRAP TO USER
XWD 1,NXPINT ;CHAN 22, NONEXISTENT PAGE
0 ;CHANNEL 23
0 ;CHANNEL 24
0 ;CHANNEL 25
0 ;CAHNNEL 26
0 ;CHANNEL 27
0 ;CHANNEL 28
0 ;CHANNEL 29
0 ;CHANNEL 30
CCPSIN==.-PSITAB-3 ;CHANNEL FOR REENTER HANDLER
XWD 1,CSTART ;CHANNEL 31
CCIPSN==.-PSITAB-3 ;CHANNEL 32 IS FOR ^C INTERCEPT
XWD 1,CCIINT
0 ;CHANNEL 33
0 ;CHANNEL 34
0 ;CHANNEL 35 IS FOR WATCH; LEAVE 0
WATCHN==1B35
IFN .-PSITAB-^D36-^D3,<PRINTX PSITAB LENGTH WRONG>
SUBTTL ENVIRONMENT STUFF. SAVGET.
RUN: PUSHJ P,RRESET ;RELEASE ALL THE CHANNELS
TROA PF,R.RUNU ;DENOTE GETSEG, NOT RUN
GETSEG: TRZ PF,R.RUNU ;DENOTE RUN, NOT GETSEG
PUSHJ P,JBKSET ;SET UP JBLOCK FOR GTJFN
PUSHJ P,REL0 ;RELEASE CHANNEL 0
HLRZM CAC,MTDUMP ;STASH THE CCL OFFSET
UMOVE A,@PDL ;GET RETURN INSTRUCTION
LSH A,-30 ;SEE IF IT'S A HALT
CAIN A,2542 ; ..
TRO PF,R.RHLT ;YES. REMEMBER THAT.
MOVEI AA,1(CAC) ;POINTER TO NAME IN ARG LIST
UMOVE D,-1(AA) ;DEVICE NAME
MOVEM D,RUNDEV ;SAVE DEV NAME FOR LATER
HRROI E,DEVNM7
MOVEM E,JBLOCK+2
CAME D,[SIXBIT /SYS/] ;PROGRAM FROM SYS?
JRST RUN11 ;NO
TRO PF,R.SYS ;YES, REMEMBER THAT
HRROI A,[ASCIZ/SYS/] ;SEE IF SYS IS A REAL DEV
STDEV ;OR MAYBE A LOGICAL NAME
SKIPA D,[ASCIZ/PS/] ;IT IS NOT, MAKE IT PS:<SUBSYS>
JRST RUN11 ;IT IS, GO USE IT DIRECTLY
MOVEM D,DEVNM7
HRROI D,[ASCIZ /SUBSYS/]
MOVEM D,JBLOCK+3
MOVSI D,'PS ' ;SET UP DEVICE NAME
MOVEM D,RUNDEV
MOVE D,[1,,4] ;AND PPN
MOVEM D,RUNPPN
JRST RUN12
RUN11: HRLI E,(POINT 7,0) ;GET LEGAL STRING POINTER
PUSHJ P,SIX27V ;PUT IN DEVICE NAME FROM USER
UMOVE D,3(AA) ;PPN FROM USER
MOVEM D,RUNPPN ;SAVE PPN
JUMPE D,RUN11A ;SELF IF .LE. 0
PUSHJ P,PPNMAP ;GET MAPPED DIRECTORY
JRST RUN11B ;NO MAPPING
MOVEM E,JBLOCK+3 ;STORE DIRECTORY POINTER WORD
TRO PF,R.SYS ;MARK CAME FROM SYS DIRECTORY
JRST RUN12 ;CONTINUE...
RUN11B: UMOVE A,-1(AA) ;GET STR NAME
PUSHJ P,GETDIR ;GET ASCII TRANSLATION
RUN11A: SETZM A ;NO. TRY IN OWN DIRECTORY
MOVEM A,JBLOCK+3 ;STORE POINTER IF ANY
;FALL THRU
RUN12: MOVSI A,100000
MOVEM A,JBLOCK
UMOVE D,(AA)
MOVEM D,RUNNAM ;SAVE NAME OF PROGRAM TO RUN
MOVE E,[POINT 7,STRNG1] ;GET MAIN STRING
PUSHJ P,SIX27V
MOVEI A,"." ;FOLLOW NAME WITH A DOT
IDPB A,E ;IN MAIN STRING
MOVE G,E ;SAVE UPDATED STRING POINTER IN G
RUN12A: XCTUU <HLLZ D,1(AA)> ;GET EXTENSION
JUMPE D,RUN19 ;NONE THERE- TRY DEFAULTS
TRNN PF,R.RUNU ;GETSEG?
JRST RUN19 ;YES. IGNORE SUPPLIED EXT.
PUSHJ P,RUN15 ;USE GIVEN EXT
JRST RUN13 ;SUCCESS- FOUND IT
JRST RUNFAI ;FAILED, GO RETURN TO USER
;HERE FOR DEFAULT EXTENSION(S)
RUN19: PUSHJ P,RUN10 ;TRY FOR .EXE
JRST [ TRNN PF,R.RUNU ;FOUND .EXE - GETSEG OR RUN?
JRST RUN13 ;GETSEG. JUST HIGH PART.
PUSHJ P,SETHN1 ;SET UP NEW NAME
JRST RUN18] ;RUN. LOAD WHOLE THING.
PUSHJ P,RUN09A ;TRY NEXT FOR .SAV
JRST RUN13 ;FOUND A .SAV
PUSHJ P,RUN08 ;TRY TO GET EXTENSION .SHR
JRST RUN13 ;SUCCESS
PUSHJ P,RUN09 ;NO GOOD- TRY FOR .HGH
JRST RUN13 ;SUCCESS
RUNFAI: XCTUM <HLRZ A,@MONUPC> ;GET INST AFTER UUO
CAIE A,(JRST 4,) ;IS IT A HALT
JRST RETZER ;NO, RETURN TO USER
RUNFA1: TMSG <$? PA1050: > ;YES, TYPE "FILE.EXT NOT FOUND"
HRROI A,STRNG1
PSOUT ;TYPE OUT NAME.EXE
TMSG < NOT FOUND.$>
JRST EXITM1 ;GO EXIT
;HERE AFTER GTJFN SUCCEEDS
RUN13: MOVEM A,JFNTAB
PUSHJ P,SETHN1 ;SET UP NEW NAME
TRNE PF,R.RUNU ;RUN UUO? (NOT GETSEG)
JRST RUN23 ;YES
LDB B,[PAGEN HSORG] ;GET FIRST PAGE OF CURRENT HISEG
MOVEI C,PATPAG ;GET COUNT OF PAGES TO BE DELETED
TLNE PF,L.FLSR ;FILSER MAPPED IN?
MOVEI C,FLSRPG ;YES, GO ONLY TO START OF FILSER
SUB C,B ;COMPUTE COUNT OF PAGES TO DELETE
HRLI B,.FHSLF ;NOTE THIS FORK
SETO A,
TLO C,(1B0) ;MARK THAT THERE IS A COUNT IN THE RH OF C
PMAP ;AWAY GOES THE HIGH SEG
HRLI A,.FHSLF ;NOW GET THE NEW HIGH SEG INTO THIS FORK
HRR A,JFNTAB ;CHANNEL 0 HAS JFN
TRO A,1B19 ;MARK THAT THIS IS A BOUNDED GET
LDB B,[PAGEN HSORG] ;START AT FIRST HISEG PAGE
HRLZ B,B
HRRI B,PATPAG-1 ;END AT PAT
TLNE PF,L.FLSR ;FILSER MAPPED IN?
HRRI B,FLSRPG-1 ;YES, GO ONLY TO START OF FILSER
GET
JRST RUN24 ;OK, GO FINISH UP
RUN18: MOVEM A,JFNTAB
RUN23: UMOVE B,0(AA) ;GET SIXBIT PROGRAM NAME
CMPRUN: PUSH P,B ;SAVE NEW PROGRAM NAME
PUSH P,.JBERR ;AND ERROR COUNT
PUSHJ P,CLRCOR ;CLEAR CURRENT CORE IMAGE
MOVE A,JFNTAB ;GET JFN OF PROGRAM TO BE RUN AGAIN
HRLI A,.FHSLF ;CURRENT FORK, THIS JFN
TRO A,1B19 ;DO A BOUNDED GET
MOVEI B,PATPAG-1 ;FROM 0 TO PAT
TLNE PF,L.FLSR ;FILSER MAPPED IN?
MOVEI B,FLSRPG-1 ;YES, GO ONLY TO START OF FILSER
GET
MOVEI A,.FHSLF ;THIS FORK
GEVEC ;GET ENTRY VECTOR
HLRZ A,B ;GET LEFT HALF
CAIN A,(JRST) ;IS THIS A TOPS10 STYLE ENTRY VECTOR?
JRST RUN23A ;YES, DONT SET .JBSA
XCTUU <HRRM B,.JBSA> ;STORE STARTING ADDRESS
RUN23A: POP P,.JBERR ;RESTORE ERROR COUNT
POP P,A ;NAME OF PROGRAM
MOVEM A,LOWNAM ;SAVE THE NEW PROGRAM NAME
MOVE B,A ;START WITH SAME NAME FOR BOTH
TRNN PF,R.SYS ;FROM SUBSYS DIRECTORY?
MOVE A,[SIXBIT/(PRIV)/] ;NO, SET SUBSYS NAME TO PRIV
SETSN ;YES. UPDATE SYSTEM TABLES
JFCL ;IGNORE ERROR RETURN
PUSHJ P,CHKRHN ;GO CLEAR HIGH SEG NAME IF NONE
RUN24: HRRZ A,JFNTAB
RLJFN ;TRY TO RELEASE JFN
JFCL ;WON'T RELEASE IF SSAV FILE
TRNE PF,R.RUNU ;WAS THIS A RUN UUO?
JRST RUN21 ;YES
MOVE B,HSORG ;ALLOW ACCESSING OF VESTIGAL AREA
ADDI B,10
HRRZM B,JBHRL ;FOR FOLLOWING UMOVE
MOVE B,HSORG
UMOVE B,3(B) ;GET NEW HISEG LENGTH
HLR B,B
HRRI B,-1(B) ;ACCOUNT FOR EXACT MULTIPLE OF PAGE LENGTH
TRO B,777 ;ROUND TO PAGE
ADD B,HSORG
TLNN B,-1 ;IS NON-0?
SETZ B, ;NO
HRRZM B,JBHRL
UMOVEM B,.JBHRL
JRST RUN14
RUN21: PUSHJ P,SETJDA ;SET UP LOW CORE STUFF
RUN14: HRRZ A,JBHRL ;GET HIGH SEG CORE ASSIGNMENT
SKIPN A ;IF NONE CLEAR HIGH SEG NAME
PUSHJ P,CLRHSQ ;CLEAR THE HIGH SEG NAME QUIETLY
SETZ BB,
PUSHJ P,UREL2 ;RELEASE CHANNEL 0
MOVEI A,.FHSLF ;NOTIFY EXEC OF NAME CHANGE
MOVEI B,WATCHN
IIC ;WE WONT GET INTERRUPT SINCE CHANNEL NOT ON
TRNN PF,R.RUNU ;WAS IT A RUN UUO?
JRST MRETN2 ;RETURN SKIPPING FROM GETSEG
MOVE A,RUNDEV ;SET UP USER ACS
MOVEM A,ACS+11 ;DEVICE NAME
MOVE A,RUNNAM
MOVEM A,ACS+0 ;PROGRAM NAME
MOVE A,RUNEXT
MOVEM A,ACS+17 ;EXTENTION
MOVE A,RUNPPN
MOVEM A,ACS+7 ;PPN
UMOVE A,.JBSA ;RUN GOES OFF TO PROG START ADR
ADD A,MTDUMP ;PLUS USER'S CCL OFFSET
UMOVEM A,.JBSA ;UPDATE .JBSA BY OFFSET
;;;IF OFFSET OVER 1, MEDDLING...
HRRZM A,(P)
JRST MRETN
RUN08: MOVSI D,(SIXBIT/SHR/)
JRST RUN15
RUN09: MOVSI D,(SIXBIT/HGH/)
JRST RUN15
RUN09A: MOVSI D,(SIXBIT/SAV/)
JRST RUN15
RUN10: MOVSI D,(SIXBIT/EXE/)
RUN15: MOVE E,G ;GET MAIN STRING POINTER
PUSHJ P,SIX27V
MOVEI A,JBLOCK
HRROI B,STRNG1 ;STRNG1 HAS FILE.EXT TO BE RUN
GTJFN
JRST CPOPJ1 ;FAILED, GO TRY OTHER EXTENSIONS
POPJ P, ;SUCCESSFULLY GOT JFN
RUN20: SETZ BB,
PUSHJ P,UREL2 ;RELEASE CHANNEL 0
JRST MRETN ;TAKE ERROR EXIT
CLRCOR: SETO A, ;CLEAR CORE IMAGE
MOVSI B,.FHSLF
TLNE PF,L.FLSR ;FILSER MAPPED IN?
SKIPA C,[PM%CNT+FLSRPG] ;YES, FROM 0 TO 577
MOVE C,[PM%CNT+PATPAG] ;FROM 0 TO 677
PMAP
POPJ P,
SETHSN: SETZM SEGNAM ;INIT NAME
SETZM SEGDEV
SETZM SEGPPN
SKIPN JBHRL
POPJ P,
LDB A,[PAGEN HSORG]
MOVE B,A
LDB C,[PAGEN JBHRL]
SUBI B,1(C)
HRL A,B ;MAKE AOBJN POINTER FOR PAGES
PUSHJ P,GETSN ;GET NAME,DEV,PPN FROM PAGES
MOVEM A,SEGNAM
MOVEM B,SEGDEV
MOVEM C,SEGPPN
POPJ P,
SETLSN: LDB A,[PAGEN JBREL]
MOVNI A,1(A)
HRLZ A,A
PUSHJ P,GETSN
MOVEM A,LOWNAM
MOVEM B,LOWDEV
MOVEM C,LOWPPN
POPJ P,
GETSN: PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
GETSN1: PUSH P,A
HRLI A,.FHSLF ;CHECK READ ACCESS OF HIGH SEG
RPACS
TLNE B,(1B5) ;PAGE EXIST?
TLNE B,(1B10) ;PRIVATE PAGE?
JRST GETSN2 ;NOT FILE PAGE, TRY NEXT
RMAP ;REMAP PAGE TO GET ITS HANDLE
CAMN A,[-1] ;UNACCESSIBLE?
JRST GETSN2 ;YES
HLRZ F,1 ;GET HANDLE
MOVSI C,1000 ;GET NAME OF HIGH SEG
PUSHJ P,GTHSNS ; USING THE JFNS JSYS
MOVEM A,-1(P) ;STORE FOR RETURN
MOVSI C,100000 ;GET DEVICE
PUSHJ P,GTHSNS ; USING JFNS
MOVEM A,-2(P) ;STORE DEVICE NAME
MOVE C,[1B2!1B5!1B35] ;GET STR:<DIR>
MOVE B,F ;...
HRROI A,STRNG1 ;INTO STRNG1
JFNS
ERJMP GETSN2
MOVX A,RC%EMO ;CONVERT DIRECTORY TO NUMBER
HRROI B,STRNG1 ; INSTEAD OF STRING
RCDIR
ERJMP GETSN2
TXNE A,RC%NOM!RC%AMB ;FOUND ONE?
JRST GETSN2 ;LOSE
MOVE A,C ;YES, GET DIR NUMBER INTO A
PUSHJ P,PPNUNM ;GET UNMAPPING OF PPN
MOVEM A,-3(P) ;STORE PPN (I.E. DIRECTORY #)
POP P,(P) ;WIN, FLUSH AOBJN POINTER
GETSN3: POP P,A ;NAME
POP P,B ;DEV
POP P,C ;PPN
POPJ P,
GETSN2: POP P,A
AOBJN A,GETSN1
JRST GETSN3
CHKRHN: LDB A,[PAGEN HSORG]
HRLI A,.FHSLF ;CHECK READ ACCESS OF HIGH SEG
RPACS
TLNE B,(1B5) ;PAGE EXIST?
TLNE B,(1B10) ;YES, PRIVATE?
JRST CLRHSQ ;NO PAGE OR PRIVATE
POPJ P, ;LEAVE NAME AS IS
SETHN1: PUSH P,A ;SAVE ALL ACS USED
UMOVE A,0(AA) ;GET SIXBIT NAME FROM USER CALL
MOVEM A,SEGNAM ;STORE IT
TRNE PF,R.RUNU ;RUN UUO? (NOT GETSEG)
MOVEM A,LOWNAM ;STORE IT
UMOVE A,-1(AA) ;GET DEVICE FROM WHENCE IT CAME
MOVEM A,SEGDEV ;STORE DEV
TRNE PF,R.RUNU ;RUN UUO? (NOT GETSEG)
MOVEM A,LOWDEV ;STORE DEV
UMOVE A,3(AA) ;GET PPN THAT USER USED
MOVEM A,SEGPPN ;SAVE IT TOO
TRNE PF,R.RUNU ;RUN UUO? (NOT GETSEG)
MOVEM A,LOWPPN ;SAVE IT TOO
JRST APOPJ ;RESTORE ACS AND RETURN
CLRHSQ: TDZA C,C ;DONT TELL WATCHERS ABOUT THIS
CLRHSN: MOVE C,SEGNAM ;SAVE CURRENT NAME
SETZM SEGNAM ;CLEAR HIGH SEG NAME
SETZM SEGDEV ;AND HIGH SEG DEVICE
SETZM SEGPPN ;AND PPN
MOVEI A,.FHSLF ;IF NAME CHANGED INFORM WATCHERS
MOVEI B,WATCHN
SKIPE C ;BUT ONLY IF THERE WAS A HIGH SEG BEFORE
IIC
POPJ P, ;AND RETURN
;CALLI 0 RESET HANDLER
RESET:
IFN FTFILSER,<
TLNE PF,L.FLSR ;HAS FILSER BEEN LOADED?
PUSHJ P,TRESET ;YES, GO CLEAN UP OPEN FILES
>
PUSHJ P,RRESET ;RESET ALL CHANNELS WITHOUT CLOSING
JRST MRETN ;ALL DONE
;ROUTINE TO RESET EVERYTHING WITHOUT CLOSING OPENED FILES
RRESET: SETZB AC,BB ;SET UP TO RELEASE ALL JFNS
RS3: SKIPG A,JFNTAB(BB) ;IS THERE A JFN FOR THIS CHANNEL?
JRST RS2 ;NO
HRRZS A ;ONLY WANT RIGHT HALF OF JFN
CAIE A,PRIJFN ;PRIMARY JFN?
CAIN A,PROJFN
JRST RS2 ;YES, DONT CARE ABOUT THESE
SKIPE MAPTAB(BB) ;IS THERE A PAGE MAPPED?
PUSHJ P,UNMAPP ;YES, UNMAP THE PAGE
RS2: ADDI BB,NTABS ;STEP TO NEXT CHANNEL
CAIGE AC,17 ;DONE ALL OF THEM?
AOJA AC,RS3 ;NO,LOOP BACK TILL DONE
MOVE A,[CZ%ABT!.FHSLF] ;NOW CLOSE ALL FILES
CLZFF ;DELETING ALL FILES BEING CREATED
MOVE 1,[XWD CHTABS,CHTABS+1]
SETZM -1(1)
BLT 1,CHTEND-1 ;CLEAR FILE DATA AREA
XCTUU <HLRZ A,.JBSA>
XCTUU <MOVEM A,.JBFF>
PUSHJ P,TTYSST ;GO SET TTY STATUS
PUSHJ P,SETPSI ;SET UP THE PSI SYSTEM
POPJ P, ;RETURN
;ROUTINE TO SIMULATE RESDV UUO
RESDV: JUMPL CAC,RETM1 ;NEGATIVE CHANNEL IS ILLEGAL
CAILE CAC,17 ;CHECK FOR LEGAL CHANNEL #
JRST RETM1 ;NOT LEGAL, RETURN -1
MOVE BB,CAC
IMULI BB,NTABS ;GET INDEX INTO DEVICE TABLES
SKIPG A,JFNTAB(BB) ;IS THERE A FILE OPEN HERE?
JRST RESDV1 ;NO
SKIPE MAPTAB(BB) ;ANY MAPPED PAGES HERE?
PUSHJ P,UNMAPP ;YES, GO UNMAP THEM
MOVX A,CZ%ABT ;NOW CLOSE AND ABORT THE FILE
HRR A,JFNTAB(BB) ;GET JFN BACK
CLOSF
HRRZ A,JFNTAB(BB) ;FAILED, TRY TO RELEASE THE JFN
RLJFN
JFCL
RESDV1: SETZM CHTABS(BB) ;NOW ZERO THE STORAGE AREA
HRLI A,CHTABS(BB) ;NOW SET UP THE BLT
HRRI A,CHTABS+1(BB)
BLT A,CHTABS+NTABS-1(BB)
JRST MRETN2 ;AND GIVE THE SUCCESS RETURN
IRESET: PUSHJ P,CLRUFD ;CLEAR UFD JFN IF SAVED
SETZM USRENB ;CLEAR USER-REQUESTED INTERRUPTS
PUSHJ P,SETPSI ;AND ADJUST PSI SYSTEM ACCORDINGLY
MOVEI A,PRIJFN ;SET UP JFN FOR TTY
MOVE E,TYSTAT ;AND MODE
PUSHJ P,NOCTRO ;CLEAR CONTROL-O FLAG
MOVEI BB,NTABS ;CHANNEL 1
MOVEI AC,1 ;PUT CHANNEL # IN AC
PUSHJ P,URELR ;RELEASE IT
ADDI BB,NTABS
CAIE BB,20*NTABS
AOJA AC,.-3 ;NEXT CHANNEL
REL0: SETZB BB,AC ;CHANNEL 0
PUSHJ P,URELR ;RELEASE IT
POPJ P,
CLRUFD: SKIPN A,LSTUFJ ;IS THERE A SAVED UFD JFN
POPJ P, ;NO
HRRZS A ;YES, RELEASE IT
RLJFN
JFCL
SETZM LSTUFJ ;CLEAR SAVED JFN
POPJ P,
;CLOSE COMMAND
CLSCMD: MOVEM 17,ACS+17 ;SAVE ALL ACS
MOVEI 17,ACS
BLT 17,ACS+16
SETOM INPAT ;ACS NOW SAVED
MOVE P,PATSTK ;GET PUSH DOWN LIST
HLLZ PF,PFLAGS ;AND FLAGS
SKIPE CAC,CLSDEV ;ANY SPECIFIC DEV TO CLOSE?
JRST CLSCM1 ;YES, GO DO IT
PUSHJ P,IRESET ;NO, CLOSE THEM ALL
JRST CLSDON ;AND CLEAN UP
CLSCM1: SETZB AC,BB ;INIT ACS
CLSCM2: HRRZ B,JFNTAB(BB) ;GET THE JFN
CAME CAC,B ;IS THIS THE JFN TO BE CLOSED?
CAMN CAC,DEVNAM(BB) ;OR IS THIS A DEV TO BE CLOSED
PUSHJ P,URELR ;YES, GO CLOSE IT
ADDI BB,NTABS ;INCREMENT INDEX
CAIGE AC,17 ;CHECKED ALL CHANNELS?
AOJA AC,CLSCM2 ;NO, LOOP BACK
CLSDON: MOVEM PF,PFLAGS ;SAVE FLAGS
MOVSI 17,ACS ;AND THEN RESTORE ACS
BLT 17,17
SETZM INPAT ;AND LEAVE PAT
HALTF
;ROUTINE TO DO A -5 TYPE OF CLOSE - JUST UNMAP THE FILE PAGES
; AND SET THE EOF PROPERLY
;THIS ROUTINE IS CALLED BY THE EXEC
UNMCMD: MOVEM 17,ACS+17 ;SAVE ALL ACS
MOVEI 17,ACS
BLT 17,ACS+16
SETOM INPAT ;ACS NOW SAVED
MOVE P,PATSTK ;GET PUSH DOWN LIST
HLLZ PF,PFLAGS ;AND FLAGS
SETZB AC,BB ;SET UP FILE ACS
UNMCM1: PUSHJ P,UNMAPP ;UNMAP THE PAGES
LDB AA,PDVNUM ;GET DEVICE TYPE CODE
CAIN AA,DSK ;DISK?
PUSHJ P,SETEOF ;YES, SET THE EOF
ADDI BB,NTABS ;STEP TO THE NEXT JFN
CAIGE AC,17 ;STEPPED THRU THEM ALL YET?
AOJA AC,UNMCM1 ;NO, LOOP BACK FOR THE NEXT ONE
MOVEM PF,PFLAGS ;SAVE FLAGS
MOVSI 17,ACS ;AND THEN RESTORE ACS
BLT 17,17
SETZM INPAT ;AND LEAVE PAT
HALTF
;THE TMPCOR UUO AND ITS ROUTINES
;THE TMPUUO CODE WAS LIFTED DIRECTLY FROM THE TOPS-10 MONITOR
;AC DEFINITIONS FOR TOPS-10 ACS
S=PF
T1=A
T2=B
T3=C
T4=D
J=E
F=F
M=G
P1=AA
P2=BB
P3=CC
P4=AC
TMPBL==4 ;BLOCK SIZE FOR DATA
TMPBKS==<1000/<TMPBL+1>>-1 ;NUMBER OF DATA BLOCKS
TMPSZ==TMPBKS*TMPBL ;AMOUNT OF DATA STORAGE AVAILABLE
TMPBKJ==TMPBKS ;BLOCKS PER JOB
TMPSZJ==TMPBKJ*TMPBL ;DATA SPACE PER USER
JBTTMP=TMPPAG_11
TMPTAB=TMPPAG_11+2
;PRARG BLOCK FORMAT:
;0: NUMBER OF FILES
;1: ADR OF FIRST FILE
;2: ADR OF SECOND FILE
; .
; .
;N: ADR OF N'TH FILE
;N+1: XWD NAME , LEN ;FIRST FILE NAME AND LENGTH
; FIRST FILE DATA
; ETC.
TMPCOR: SKIPE TMPJFN ;READ IN TMPCOR YET?
JRST PRATM1 ;YES, GO USE IT
MOVE A,[.PRARD,,.FHSLF] ;GET PROCESS ARGUMENTS
MOVEI B,JBTTMP
MOVEI C,1000 ;MAX OF ONE PAGE
PRARG
JUMPLE C,NOPRA ;NO PROCESS ARGUMENTS SET, USE FILE
SETOM TMPJFN ;MARK THAT PRARG WAS SUCCESSFUL
PRATM1: SKIPL TMPJFN ;IS PRARG IN EFFECT
JRST NOPRA ;NO, GO USE FILE
HLRZ A,CAC ;GET CODE
CAILE A,5 ;LEGAL CODE
JRST CMRETN ;NO, BOMB OUT
JRST @PRATAB(T1) ;DISPATCH
PRATAB: RETZR1 ;SIZE IS ALWAYS 0
PRARDF ;READ FILE
PRARDF ;READ AND DELETE
RETZER ;WRITE
PRADIR ;READ DIR
PRADIR ;READ AND DELETE DIR
;READ AND READ AND DELETE
PRARDF: XCTUU <HLLZ A,0(CAC)> ;GET FILE NAME
PUSHJ P,PRASRC ;SEARCH FOR THE NAME
JRST RETZER ;NOT FOUND
UMOVE D,1(CAC) ;GET POINTER TO BUFFER
HRRZ C,0(A) ;GET LENGTH OF FILE
UMOVEM C,0(AC) ;STORE LENGTH IN AC
TLNN CAC,1 ;DELETE FILE?
SETZM 0(A) ;YES, DELETE THIS ENTRY
JUMPE D,PRARDD ;IF USER DOESNT WANT ANY, GO EXIT
PRARDL: SOJL C,PRARDD ;IF DONE, GO EXIT
AOS A ;STEP POINTER TO FILE AREA
MOVE B,0(A) ;GET NEXT WORD OF FILE
UMOVEM B,1(D) ;STORE IT IN USER BUFFER
AOBJN D,PRARDL ;LOOP BACK FOR ALL WORDS
PRARDD: JRST MRETN2 ;DONE
;ROUTINE TO SEARCH FOR A NAME
;ACCEPTS IN A/ NAM,,0
PRASRC: JUMPE A,CPOPJ ;IF NULL NAME, RETURN FAILURE
MOVN D,JBTTMP ;GET NUMBER OF FILES
HRLZS D ;SET UP AOBJN COUNTER
JUMPE D,CPOPJ ;IF NONE, EXIT
PRASR1: MOVE C,JBTTMP+1(D) ;GET NEXT ARG POINTER
HLLZ B,JBTTMP(C) ;GET FILE NAME
CAMN A,B ;FOUND THE ONE WE WANT?
JRST PRASR2 ;YES
AOBJN D,PRASR1 ;NO, LOOP BACK TIL FOUND
POPJ P, ;NOT FOUND
PRASR2: MOVEI A,JBTTMP(C) ;FOUND IT, RETURN ADR OF BLOCK
JRST CPOPJ1
;ROUTINE TO READ THE DIRECTORY
PRADIR: HRRZ A,JBTTMP ;GET NUMBER OF FILES
XCTUU <SETZM 0(AC)> ;START WITH 0 FILES
JUMPE A,MRETN2 ;IF NONE, RETURN
TLNE CAC,1 ;DELETE DIR?
SETZM JBTTMP ;YES
UMOVE D,1(CAC) ;GET USER BUFFER
JUMPE D,MRETN2 ;USER WANT ANY?
PRADIL: SKIPE C,JBTTMP+1(A) ;GET NEXT ARG
SKIPN B,JBTTMP(C) ;GET NAME AND LENGTH OF FILE
JRST PRADI1 ;NOT THERE
UMOVEM B,1(D) ;STORE NAME AND LEN IN USER BUFFER
XCTUU <AOS 0(AC)> ;COUNT UP NUMBER OF FILES STORED
AOBJP D,MRETN2 ;RAN OUT OF SPACE YET?
PRADI1: SOJG A,PRADIL ;LOOP BACK FOR ALL NAMES
JRST MRETN2 ;DONE
NOPRA: SKIPE A,TMPJFN ;HAS THE TMP FILE BEEN OPENED YET?
JRST TMPCR1 ;YES, DONT OPEN IT NOW
HRROI A,STRNG1 ;MAKE A FILE NAME FOR THIS TMPCOR FILE
MOVE B,JOB ;IT SHOULD BE "XXXTMPCOR-DATA-BASE.TMP"
MOVE C,[XWD 140003,12] ;GET JOB # INTO ASCIZ WITH LEADING 0'S
NOUT
JRST MRETN ;JOB NUMBER TO BIG ( >999 )
MOVE B,[POINT 7,[ASCIZ/TMPCOR-DATA-BASE.TMP;T/]]
ILDB C,B ;ADD REST OF FILE NAME TO STRING
IDPB C,A
JUMPN C,.-2 ;LOOP BACK UNTIL NULL SEEN
MOVSI A,110001 ;NOW SEE IF FILE ALREADY EXISTS
HRROI B,STRNG1
GTJFN
JRST NOTMPF ;FILE NOT THERE, GO CREATE IT
MOVE B,[XWD 440000,300000]
OPENF ;OPEN FILE FOR READ AND WRITE ACCESS
JRST MRETN ;FAILED, CANNOT DO TMPCOR UUO
HRRZM A,TMPJFN ;SAVE THIS JFN FOR ALL SUBSEQUENT UUOS
HRLZS A ;NOW PMAP FILE INTO CORE
RPACS ;SEE IF PAGE EXISTS
TLNN B,(1B5) ;...
JRST NOTMP1 ;NOT THERE, GO INITIALIZE IT
MOVSI B,.FHSLF ;INTO THIS FORK
HRRI B,TMPPAG ;INTO PRESERVED PAGE FOR TMPCOR
MOVSI C,140000 ;READ AND WRITE ACCESS
PMAP
TMPCR0: HRRZ T1,TMPJFN ;CLOSE JFN OF TMPCOR
CLOSF ;SO IT GOES AWAY ON EXIT
JFCL
TMPCR1: MOVEI J,1 ;ALWAYS BE JOB 1
MOVE T1,CAC ;GET CONTENTS OF USERS AC
MOVE M,FORTY ;GET UUO
MOVEM PF,PFLAGS ;PRESERVE FLAGS
PUSHJ P,TMPUUO ;GO DO UUO
SKIPA
AOS (P) ;SUCCESSFUL
MOVE PF,PFLAGS ;RESTORE FLAGS
JRST MRETN ;RETURN
NOTMPF: MOVSI A,410001 ;NO TMP FILE, SO WE WILL CREATE ONE
HRROI B,STRNG1 ;GET POINTER TO NAME
GTJFN ;OPEN A NEW TMP FILE
JRST [PUSHJ P,WARN ;IF OVER QUOTA OR DIR FULL WARN USER
JRST MRETN ;GIVE ERROR RETURN
JRST NOTMPF] ;DID AN EXPUNGE, TRY AGAIN
IFN 0,<;DON'T DELETE TMPCOR
HRLI A,FDBCTL ;SET THE DELETED BIT IN FDB
MOVSI B,(FDBDEL)
MOVSI C,(FDBDEL) ;MAKE FILE BE DELETED SO IT WONT BE IN
XJSYS <CHFDB> ; DIRECTORY
JFCL
>;END IFN 0
HRRZS A ;RESTORE JFN
MOVE B,[XWD 440000,300000]
PUSH P,A ;SAVE JFN
OPENF ;OPEN IT FOR READING AND WRITING
JRST [PUSHJ P,WARN ;WARN USER IF OVER QUOTA
JRST MRETN ;THEN GIVE ERROR RETURN
POP P,A ;GET BACK JFN
RLJFN ;RELEASE IT
JFCL
JRST NOTMPF] ;DID AN EXPUNGE, TRY AGAIN
HRLZS A ;NOW PMAP FILE INTO CORE
NOTMP1: MOVSI B,.FHSLF ;INTO THIS FORK
HRRI B,TMPPAG ;INTO PRESERVED PAGE FOR TMPCOR
MOVSI C,140000 ;READ AND WRITE ACCESS
PMAP
MOVEI A,TMPPAG_11+4 ;GET START OF TMPCOR SPACE
HRLI A,TMPSZ ;GET AMOUNT OF DATA SPACE AVAILABLE
MOVEM A,TMPTAB ;INITIALIZE TABLE
HRLZI A,TMPSZJ ;GET DATA SPACE PER USER
HRRI A,TMPBKS ;AND NUMBER OF BLOCKS ALLOWED
MOVEM A,TMPTAB+1 ;SAVE IN TABLE
HLLZ B,TMPTAB+1 ;GET FILE LIMIT PER USER
MOVEM B,JBTTMP+1 ;SAVE IN JBT TABLE
MOVE A,TMPTAB ;GET START OF SPACE
MOVEM A,JBTTMP ;STORE
HRRZ B,TMPTAB+1 ;GET COUNT OF BLOCKS
TMPIN1: ADDI A,TMPBL+1 ;LINK ALL BLOCKS TOGETHER
HRRZM A,-TMPBL-1(A)
SOJG B,TMPIN1 ;LOOP FOR ALL BLOCKS
HLLZS -TMPBL-1(A) ;ZERO LAST LINK
POP P,A ;RESTORE JFN
HRLI A,FDBSIZ+CF%NUD_^D18 ;CHANGE FDB TO HAVE A 1 PAGE FILE
MOVNI B,1 ;SET UP EOF POINTER
MOVEI C,1000 ;ONE PAGE LONG
XJSYS <CHFDB>
JFCL
HRLI A,FDBBYV+CF%NUD_^D18 ;NOW SET UP BYTE SIZE
MOVSI B,7700 ;..
MOVSI C,(^D36B11) ;36 BIT BYTES
XJSYS <CHFDB>
JFCL
HRRZM A,TMPJFN ;SAVE JFN OF TMPCOR FILE
JRST TMPCR0 ;NOW GO PMAP FILE IN
UUOERR: MOVE PF,PFLAGS ;GET THE CORRECT FLAGS
PUSHJ P,BUGSTP ;BOMB THE JOB
GETWD1: HRRI M,1(M) ;INCREMENT M
GETWDU: TLZ M,37
PUSH P,PF ;SAVE AC
MOVE PF,PFLAGS ;IN CASE ARG OUT OF BOUNDS
UMOVE T1,@M ;GET VALUE
POP P,PF ;RESTORE PF
POPJ P,
PUTWD1: HRRI M,1(M) ;INCREMENT M
PUTWDU: TLZ M,37
PUSH P,PF ;SAVE AC
MOVE PF,PFLAGS ;SET UP FLAGS IN CASE OF ADRCHK ERROR
UMOVEM T1,@M ;STORE WORD
POP P,PF ;RESTORE PF
POPJ P,
; TITLE TMPUUO -- TEMPORARY FILE STORAGE UUO - V010
; SUBTTL TONY LAUCK 11 APR 72
; XP VTMPUU,10 ;PUT VERSION NUMBER IN GLOB AND MAP
REPEAT 0,<
TEMPORARY FILE STORAGE FOR JOB UUO.
THE "TMPCOR" UUO IS USED TO ENABLE A JOB TO LEAVE SEVERAL SHORT
FILES IN CORE FROM THE RUNNING OF ONE USER PROGRAM OR CUSP TO THE
NEXT. THESE FILES MAY BE REFERRED TO BY A THREE CHARACTER FILE NAME,
AND ARE UNIQUE TO EACH JOB, I.E. A JOB CAN ONLY REFERENCE ITS OWN
FILES. ALL FILES ARE ALWAYS DELETED WHEN A JOB IS KILLED.
EACH FILE APPEARS TO THE USER AS ONE DUMP MODE BUFFER. THE ACTUAL SIZE OF A
TEMPORARY FILE, THE NUMBER OF TEMPORARY FILES A USER CAN HAVE,
AND THE TOTAL CORE SPACE A USER CAN TIE UP ARE PARAMETERS DETER-
MINED AT MONGEN TIME. ALL TEMPARARY FILES RESIDE IN A FIXED AREA
IN THE MONITOR, BUT THE SPACE IS DYNAMICALLY ALLOCATED AMOUNG
DIFFERENT JOBS AND THE SEVERAL DIFFERENT FILES OF ANY GIVEN JOB.
THE PRIMARY PURPOSE OF THE TEMPORARY STORAGE SYSTEM IS FOR SHORT
CONTROL FILES, E.G. CCL FILES, TO LIVE IN CORE, THEREBY SPEEDING
UP RESPONSE TIMES AND REDUCING DISK OPERATIONS. ACCORDINGLY,
SHOULD A PROGRAM ATTEMPT TO WRITE A FILE WHEN THERE IS
INSUFFICIENT SPACE, EITHER IN THE ENTIRE BUFFER AREA OR BECAUSE
THE USER HAS EXCEEDED HIS QUOTA, THE UUO GIVES AN ERROR RETURN.
THE CUSP CAN THEN WRITE THE DATA AS A SHORT DISK FILE.
SIMILARLY, SHOULD A PROGRAM FAIL TO FIND A FILE UPON READING IT,
IT WILL GET AN ERROR RETURN AND CAN THEN LOOKUP A SHORT DISK FILE.
IT IS VERY IMPORTANT TO REALIZE THE TEMPORARY NATURE OF THESE
FILES. FOR EXAMPLE, UPON WRITING, THE OLD FILE IS DELETED BEFORE
CHECKING FOR SPACE FOR A NEW VERSION. THE OLD FILE COULD BE LOST WITHOUT
A NEW ONE REPLACING IT. ALSO, THERE CAN BE NO GUARANTEE THAT FILES
WILL FIT IN CORE.
THE TMPCOR UUO IS NOT INTENDED TO REPLACE A FUTURE, MORE
GENERAL, DEVICE INDEPENDENT SERVICE ROUTINE FOR "CORE". HOWEVER,
THE SPACE TAKEN UP BY DEVICE DATA BLOCKS, ETC., IN THAT MORE
GENERAL ROUTINE WOULD REPRESENT UNNECESSARY OVERHEAD FOR EXTREMELY
SHORT DATA, SUCH AS CCL COMMAND FILES.
>
REPEAT 0,<
FORMAT OF TEMPORARY FILE STORAGE UUO.
CALL AC, [SIXBIT /TMPCOR/] ;CALLI INDEX=44
;ERROR RETURN
;NORMAL RETURN
C(AC) MUST ALWAYS BE SET UP BY THE USER PROGRAM PRIOR TO EXECUTING
THE UUO. IT IS CHANGED BY THE UUO AND RETURNS A VALUE THAT DEPENDS
ON THE PARTICULAR FUNCTION PERFORMED.
C(AC) = XWD CODE,BLOCK
BLOCK: XWD NAME,0 ;NAME IS FILE NAME
IOWD BUFLEN,BUFFER ;USER BUFFER AREA (ZERO FOR NO BUFFER)
>
REPEAT 0,<
CODE-0 -- GET FREE SPACE
THE IS THE ONLY FORM OF THE TEMP UUO THAT DOES NOT USE A TWO
WORD PARAMETER BLOCK. C(AC) WOULD ORDINARLY BE SET TO ZERO FOR THE
GET FREE SPACE UUO. THE USER PROGRAM ALWAYS GETS A NORMAL RETURN
(UNLESS THE SYSTEM DOES NOT HAVE THE TEMP UUO). C(AC) IS SET TO
THE NUMBER OF WORDS OF FREE SPACE AVAILABLE TO THE USER.
CODE=1 -- READ FILE
IF THE SPECIFIED FILE NAME IS NOT FOUND, C(AC) IS SET TO THE
NUMBER OF FREE WORDS OF SPACE AVIALABLE FOR TEMP FILES, AND THE
ERROR RETURN IS TAKEN.
IF THE FILE IS FOUND, C(AC) IS SET TO THE LENGTH OF THE
FILE IN WORDS, AND AS MUCH OF THE FILE AS WILL FIT IS COPIED INTO
THE USERS BUFFER. THE USER CAN CHECK FOR TRUNCATION BY COMPARING
C(AC) WITH BUFLEN UPON SUCCESSFUL RETURN FROM THE TEMP UUO.
CODE=2 -- READ AND DELETE FILE
THIS IS THE SAME AS CODE=1, EXCEPT THAT IF A FILE WAS FOUND
IT IS ALSO DELETED AND ITS SPACE RECLAIMED.
>
REPEAT 0,<
CODE=3 -- WRITE FILE
IF THERE IS ALREADY A FILE OF THE SPECIFIED NAME, IT IS
DELETED AND ITS SPACE IS RECLAIMED.
THE REQUESTED SIZE OF THE FILE IS SPECIFIED BY BUFLEN.
IF THERE IS NOT ENOUGH SPACE TO WRITE THE ENTIRE FILE, NOTHING
IS WRITTEN, C(AC) IS SET TO THE NUMBER OF FREE WORDS OF SPACE
AVAILABLE TO THE USER, AND THE ERROR RETURN IS TAKEN.
IF THERE IS ENOUGH SPACE, THE FILE IS WRITTEN. C(AC) IS SET TO
THE AMOUNT OF SPACE LEFT AFTER THE FILE HAS BEEN WRITTEN AND THE
NORMAL RETURN IS TAKEN. FILES ARE ALWAYS FILLED UP WITH ZEROS TO THE
NEXT EVEN MULTIPLE OF THE BLOCK LENGTH (TMPBL).
THIS EVEN LENGTH IS READ BACK IN.
CODE=4 -- READ DIRECTORY
THE ERROR RETURN IS NEVER TAKEN.
C(AC) IS SET TO THE NUMBER OF DIFFERENT FILES IN THE JOB'S
TEMPORARY FILE AREA. IN ADDITION, AN ENTRY IS MADE FOR EACH FILE
IN THE USER BUFFER AREA UNTIL THERE IS NO MORE SPACE OR ALL FILES HAVE
BEEN LISTED. THE USER PROGRAM CAN CHECK FOR TRUNCATION BY COMPARING
C(AC) UPON RETURN WITH BUFLEN.
DIRECTORY ENTRY FORMAT
XWD NAME,SIZE ;NAME=FILE NAME, SIZE =FILE LENGTH IN WORDS.
CODE=5 -- READ AND CLEAR DIRECTORY
THIS IS THE SAME AS CODE=4 EXCEPT THAT ANY FILES IN THE JOB'S
TEMPORARY STORAGE AREA ARE ALSO DELETED AND THEIR SPACE RECLAIMED.
THIS UUO IS EXECUTED BY THE LOGOUT CUSP.
>
REPEAT 0,<
IMPLEMENTATION
MASTER DIRECTORY
THIS IS A TABLE JOBN+1 ENTRIES LONG.
JBTTMP: XWD FREE,IDLE
JBTTM1: XWD SPACE,LINK
.
.
.
MREE = NO. OF FREE BLOCKS IN MONITOR BUFFER AREA
IDLE = LINK TO FIRST FREE BLOCK OR 0 IF NO FREE BLOCKS
SPACE = NO OF FREE BLOCKS REMAINING IN JOBS QUOTA
LINK = LINK TO FIRST BLOCK OF FIRST FILE OF JOB, 0 IF NONE.
IDLE BLOCK FORMAT
XWD 0,LINK
REPEAT TMPBL, <0
>
LINK = LINK TO NEXT BLOCK ON IDLE CHAIN, 0 IF NO MORE.
USER BLOCK FORMAT
XWD NAME,LINK
BLOCK TMPBL ;USER DATA OR ZERO FILL.
NAME = USER FILE NAME.
LINK = LINK TO NEXT BLOCK IN THIS FILE OR NEXT FILE OF THIS USER
IF A FILE IS SEVERAL BLOCKS LONG, EACH BLOCK HAS THE FILE NAME.
A LINK OF 0 INDICATES NO MORE DATA IN THE FILE, AND NO MORE FILES
FOR THIS USER.
THEREFORE, A FILE ENDS WHEN ITS LAST BLOCK HAS A ZERO LINK, OR
WHEN IT LINKS TO A FILE OF DIFFERENT NAME.
MONITOR BUFFER AND PARAMETERS
TMPBUF: BLOCK TMPBKS*<TMPBL+1> ;BUFFER AREA FOR ALL FILES.
TMPBKS IS THE NUMBER OF BLOCKS THE STORAGE AREA IS COMPUTED.
IT IS COMPUTED BY MACRO DURING THE ASSEMBLY OF COMMON.
TMPBL IS A PARAMETER IN S.MAC.
>
REPEAT 0,<
FACTORS AFFECTING SYSTEM
1. MONITOR MUST INITALIZE THE TEMP FILES ON RESTART.
A) CLEAR ENTIRE BUFFER AREA
B) SET FREE COUNT TO TOTAL NUMBER OF 5 WORD BLOCKS
C) LINK ALL BLOCKS ON IDLE CHAIN
D) SET ALL USERS SPACE TO THEIR QUOTA AND LINKS TO 0
2. LOGOUT MUST DO A CLEAR OF USERS DIRECTORY
3. PIP SHOULD CLEAR USERS DIRECTORY ON A DEL *.TMP COMMAND
4. PIP SHOULD READ AND WRITE TEMP FILES. DEVICE TMP:?
5. ALL CCL CUSPS MUST BE CHANGED TO DO TEMP UUO.
>
; ENTRY TMPUUO
; INTERN TMPUUO,TMPTAB
; EXTERN CPOPJ,CPOPJ1,STOTAC,GETWDU,UUOERR,JBTTMP,GETWD1,PUTWD1
;TMPTAB: 0 ;FREE DATA SPACE,ADDRESS OF TABLE
; 0 ;USER QUOTA,NUMBER OF BLOCKS
TMPUUO:
; PUSHJ P,SAVE4## ;SAVE P1-P4
AOS (P) ;SET FOR GOOD RETURN
MOVE P4,T1 ;GET USERS AC
TLNN P4,-1 ;IS CODE = 0?
JRST TMPSP ;YES, SO JUST RETURN SPACE LEFT
HRR M,P4 ;SETUP M TO GET FIRST WORD OF BLOCK
PUSHJ P,GETWDU ;GET FIRST WORD
HLLZ S,T1 ;SAVE FILE NAME
PUSHJ P,GETWD1 ;GET SECOND WORD
HLRE F,T1 ;GET USER'S BUFFER LENGTH
MOVNS F
HRR M,T1 ;USER'S BUFFER ADDRESS
HLRZS P4 ;GET CODE
CAILE P4,TMPDL ;CHECK IF IT IS LEGAL
JRST UUOERR ;NO
JRST @TMPDIS-1(P4) ;DISPATCH TO APPROPRIATE ROUTINE
TMPDIS: JRST TMPREA
JRST TMPREA
JRST TMPWR
JRST TMPDIR
JRST TMPDIR
TMPDL== .-TMPDIS
;ROUTINE TO READ, OR READ AND DELETE A TEMPORARY FILE
TMPREA: PUSHJ P,TMPSRC ;FIND FILE
JRST TMPSPB ;NONE, SO RETURN SPACE
SETZ T3, ;ZERO USER COUNT
TMPRE1: HRLI P1,-TMPBL ;SET COUNT TO NO WORDS IN BLOCK
TMPRE2: SOJL F,TMPR2A ;COUNT DOWN USER BUFFER SPACE
MOVE T1,1(P1)
PUSHJ P,PUTWD1 ;IF SPACE, COPY 1 WORD
TMPR2A: ADDI T3,1 ;ADD TO USER COUNT
AOBJN P1,TMPRE2 ;GO ON WITH BUFFER IF MORE WORDS
SUBI P1,TMPBL ;GET BACK TO START OF BLOCK
TRNN P4,1 ;SHOULD WE DELETE?
PUSHJ P,TMPDEL ;DELETE THIS BLOCK
PUSHJ P,TMPCHA ;CHAIN TO NEXT BLOCK IN FILE
JRST TMPRE1 ;FOUND, GO HANDLE IT
TMPRE3: SETZ T1,
TMPFLL: SOJL F,STOT3 ;FILL REST OF USERS BUFFER
PUSHJ P,PUTWD1 ;WITH ZEROS, THEN GIVE HIM COUNT
AOJA T4,TMPFLL
;ROUTINE TO CHAIN TO NEXT BLOCK OF A FILE
TMPCHA: HRRZ P1,(P1) ;CHAIN TO NEXT BLOCK
HLLZ P3,(P1) ;GET FILE NAME
CAMN P3,S ;MATCH?
JUMPN P1,CPOPJ ;YES, IS THERE A BLOCK?
JRST CPOPJ1 ;NO, SKIP RETURN
;ROUTINE TO FIND A FILE
TMPSRC: MOVEI P2,JBTTMP(J) ;GET ADDRESS OF FIRST LINK
TMPSR1: HRRZ P1,(P2) ;CHAIN FORWARD
JUMPE P1,CPOPJ ;NONE, FILE NOT FOUND
HLLZ T2,(P1) ;GET FILE NAME
CAMN T2,S ;MATCH?
JRST CPOPJ1 ;YES, SKIP RETURN
HRRZ P2,P1 ;SAVE OLD POINTER
JRST TMPSR1 ;AND KEEP ON LOOKING
;ROUTINE TO DELETE A BLOCK
TMPDEL: HRRZ P3,(P1) ;LINK AROUND BLOCK
HRRM P3,(P2)
HRRZ P3,JBTTMP ;LINK OLD BLOCK TO IDLE
MOVEM P3,(P1)
HRRM P1,JBTTMP ;LINK START OF IDLE CHAIN TO BLOCK
HRRZ P1,P2 ;RESTORE P1 FOR TMPCHA
MOVSI P3,TMPBL ;UPDATE FREE COUNTERS
ADDM P3,JBTTMP
ADDM P3,JBTTMP(J)
POPJ P,
;ROUTINE TO WRITE A FILE FOR USER
TMPWR: PUSHJ P,TMPSRC ;SEE IF THERE WAS AN OLD FILE
JRST TMPWR2 ;NO
TMPWR1: PUSHJ P,TMPDEL ;DELETE A BLOCK
PUSHJ P,TMPCHA ;CHAIN TO NEXT BLOCK
JRST TMPWR1 ;THERE WAS ONE, GO ON
TMPWR2: PUSHJ P,TMPSPC ;GET SPACE FOR USER
SKIPE T3
CAMLE F,T3 ;DOES HE WANT MORE?
JRST TMPSPB ;YES, SO TELL HIM HE LOST
HRRZ P3,JBTTMP(J) ;SAVE LINK TO FIRST FILE
MOVEI P2,JBTTMP(J) ;SET OLD BLOCK ADDRESS
TMPWR3: HRRZ P1,JBTTMP ;GET ADDRESS OF FIRST IDLE BLOCK
HRRZ T2,(P1) ;GET ITS SUCCESSOR
HRRM T2,JBTTMP ;LINK THAT BLOCK TO IDLE CHAIN
HRRM P1,(P2) ;LINK LAST BLOCK OF USER TO NEW BLOCK
HRRZ P2,P1 ;SAVE OLD BLOCK ADDRESS
MOVSI T2,-TMPBL ;DECREASE JOB AND TOTAL SPACE
ADDM T2,JBTTMP
ADDM T2,JBTTMP(J)
HLLM S,(P1) ;INSERT FILE NAME
HRLI T4,-TMPBL ;SET FOR NO WORDS/BLOCK
TMPWR4: SOJL F,TMPWR6 ;DOES HE WANT TO WRITE MORE?
PUSHJ P,GETWD1 ;GET A WORD
PUSH P1,T1 ;YES, SO STICK IN HIS WORD
TMPWR5: AOBJN T4,TMPWR4 ;UPDATE USER ADDR, IS BLOCK DONE?
JUMPG F,TMPWR3 ;YES, DOES HE HAVE MORE?
HRRM P3,-TMPBL(P1) ;NO, LINK LAST BLOCK TO HIS FILES
JRST TMPSP ;GET SPACE AND RETURN
TMPWR6: SETZM 1(P1) ;FILL FINAL BLOCK WITH ZERO
AOJA P1,TMPWR5 ;AND GO ON UNTIL BLOCK DONE
;ROUTINE TO COMPUTE SPACE FOR USERS TMP FILES
TMPSPC: HLRZ T3,JBTTMP ;TOTAL FREE SPACE
HLRZ T2,JBTTMP(J) ;USER LIMIT
CAMLE T3,T2 ;SPACE IS MINIMUM OF THE TWO
MOVE T3,T2
POPJ P,
;ROUTINE TO GET SPACE AND RETURN TO USER (SKIP AND NO SKIP)
TMPSPB: SOS (P) ;NO SKIP RETURN
TMPSP: PUSHJ P,TMPSPC ;GET SPACE
STOT3:
; MOVE T1,T3 ;SET TO STORE T3
; JRST STOTAC ;RETURN IT
LDB T1,ACPTR ;GET USER AC
MOVEM T3,ACS(T1) ;STORE AC
POPJ P, ;AND RETURN
;READ DIRECTORY, READ AND CLEAR DIRECTORY
TMPDIR: SETZ T3, ;ZERO COUNT OF FILES
MOVEI P2,JBTTMP(J) ;SET LINK TO DELETE
HRRZ P1,(P2) ;LINK TO FIRST BLOCK
TMPDI1: JUMPE P1,TMPRE3 ;IF NONE, ZERO REST OF USERS BUFFER
HLLZ S,(P1) ;GET FILE NAME
MOVEI T1,1 ;SET LENGTH TO 1
TMPDI2: TRNE P4,1 ;DELETE?
PUSHJ P,TMPDEL ;YES, DELETE BLOCK
PUSHJ P,TMPCHA ;GET NEXT BLOCK OF FILE
AOJA T1,TMPDI2 ;THERE IS ONE, SO COUNT BLOCKS
IMULI T1,TMPBL ;GET LENGTH IN WORDS
HLL T1,S ;DONE, GET LENGTH, NAME OF OLD ONE
SOSL F ;IS THERE SPACE LEFT IN USER AREA?
PUSHJ P,PUTWD1 ;YES, STOW ENTRY
AOJA T3,TMPDI1 ;COUNT FILES, GO ON FOR NEXT ONE
SUBTTL TRAP HANDLING
;APR TRAPS ENABLE
; USER CALL IS
; MOVEI AC,BITS
; CALLI AC,16
;
;WHERE BITS ARE 1B18 FOR REPEATED TRAPS (EXCEPT CLK)
; 1B19 FOR PDLOV, 1B22 FOR ILL MEM REF, 1B23 FOR NXM
; 1B26 FOR CLOCK (NOT YET SUPPORTED), 1B29 FOR FOV, 1B32 FOR AROV
APRENB: MOVEI A,.FHSLF ;THIS FORK
MOVE B,[XWD LEVTAB,CHNTAB]
SIR ;NEW PSEUDOINTERRUPT CHANNELS
MOVEM CAC,USRENB ;SAVE FOR LATER REFERENCE
LSH CAC,1 ;MATCH UP WITH ENABLE FLAGS
ANDI CAC,220 ;FOR OV AND FOV
MOVEM CAC,CNIWRD ;AND REMEMBER FOR APR CONI
PUSHJ P,SETPSI ;SET UP PSI AS INDICATED BY USRENB
EIR ;ENABLE INTERRUPT SYSTEM
JRST MRETN
LIGHTS: MOVEI A,.FHSLF ;THIS FORK
RPCAP ;GET PROCESS CAPABILITIES
MOVE A,CAC ;GET ARGUMENT TO DISPLAY
TRNE C,WHEEL!OPER!MAINT ;WILL MONITOR COMPLAIN ABOUT LITES?
LITES ;NO. DO IT.
JRST MRETN
SWITCH: SWTCH
JFCL ;IGNORE ERROR RETURN
JRST MRETN
;ADDRESS CHECK ROUTINES
;CALL: MOVE A,ADDRESS
; MOVE B,LENGTH ;OPTIONAL IF A BLOCK IS TO BE CHECKED
; PUSHJ P,ADRCHK ;CALL ADRCKB IF CHECKING A BLOCK
; RETURN HERE IF OK ;NO RETURN IF OUT OF BOUNDS
ADRCHK: MOVEI B,1 ;MAKE THIS A ONE WORD BLOCK
ADRCKB: CAIGE A,20 ;IN THE AC'S
JRST ADRCKL ;YES, GO CHECK END OF BLOCK
CAML A,HSORG ;HIGH SEG ADDRESS?
CAMLE A,JBHRL ;YES, IS IT A LEGAL HIGH SEG?
CAMG A,JBREL ;NO, IS THIS A LEGAL LOW SEG ADDRESS?
CAIG A,.JBPFI ;IS THIS ADDRESS ABOVE THE PROTECTED AREA
JRST ITRAP ;ONE OF THE ABOVE FAILED
ADRCKL: ADDI B,-1(A) ;GET LAST WORD IN BLOCK TO CHECK
CAIGE B,20 ;IN THE ACS?
POPJ P, ;YES, OK RETURN
CAML B,HSORG ;HIGH SEG?
CAMLE B,JBHRL ;YES, OK?
CAMG B,JBREL ;NO, OK LOW SEG ADR?
CAIG B,.JBPFI ;CHECK ALSO PROTECTED DATA AREA
JRST ITRAP ;TOO BAD!
POPJ P, ;BLOCK IS OK
SETDDT: UMOVEM CAC,.JBDDT ;SET DDT ADDR
HRRZM CAC,JBDDT ;SAVE DDT ADDR
JRST MRETN
GETLIN: GJINF ;GET TTY NUMBER FOR THIS JOB
JUMPL D,RETZER ;DETACHED, RETURN ZERO
MOVE B,D ;GET TTY NUMBER
PUSHJ P,LIN26 ;TRANSLATE TO 'TTYN'
JRST STOTAC ;AND GIVE IT TO USER
;ROUTINE TO TURN TTY LINE # TO SIXBIT/TTYN/
;ACCEPTS IN B/ LINE NUMBER
;RETURNS IN A/ SIXBIT/TTYN/
LIN26: HRROI A,STRNG1 ;NOW GET TTY NUMBER IN ASCII
MOVEI C,10 ;RADIX 8 (OCTAL)
NOUT
PUSHJ P,ERROR
PUSHJ P,SEVN26 ;TRANSLATE SEVEN BIT TO SIXBIT
MOVSS A ;GET TTY# INTO RH
HRLI A,'TTY' ;ADD IN TTY
POPJ P, ;RETURN WITH ANSWER IN A
REASSI: MOVEI A,0 ;PRETEND IT FAILED
UMOVEM A,1(AC) ;SET AC+1 TO 0
JRST STOTAC ;AND AC TO 0
SUBTTL MORE UUOS
;REMAP
; CAC/ DESIRED HISEG ORIGIN ,, DESIRED NEW LOWSEG END
; BLOCK BETWEEN NEW LOWSEG END AND OLD LOWSEG END WILL BE MOVED
; TO NEW HISEG
REMAP: MOVE A,JBREL ;GET CURRENT LOW SEG END
SUBI A,(CAC) ;LENGTH OF DATA TO MOVE
JUMPLE A,MRETN ;RETURN IF .LE. 0
HRRZ B,CAC ;GET NEW LOW SEG END
TRO B,777 ;FORCE END OF PAGE
MOVEI C,.HSLOC ;GET DEFAULT HI SEG ORIGIN
CAMG C,B ;ABOVE LOW SEG END?
MOVEI C,1(B) ;NO, FORCE ABOVE
HLRZ D,CAC ;GET DESIRED HI SEG ORIGIN
SKIPN D ;DID HE SPECIFY
MOVE D,C ;NO, USE DEFAULT
TRZ D,777 ;FORCE BEGINNING OF PAGE
CAMG D,B ;ABOVE NEW LOW SEG END?
JRST MRETN ;NO, RETURN
MOVE C,D ;COPY HI SEG ORIGIN
ADDI C,-1(A) ;COMPUTE LAST WORD OF NEW HI SEG
TRO C,777 ;FORCE END OF PAGE
TLNE PF,L.FLSR ;FILSER MAPPED?
CAIGE C,FLSRLC ;YES, MUST BE BELOW IT
CAIL C,PATLOC ;ELSE MUST BE BELOW US
JRST MRETN ;NEW TOP TO HIGH, RETURN
XCTUU <HRRZM C,.JBHRL> ;STORE NEW HI SEG END FOR USER
EXCH C,JBHRL ;EXCHANGE NEW END FOR OLD
JUMPE C,REMAP1 ;JUMP IF NO OLD TO FLUSH
SETO A, ;PREPARE TO FLUSH OLD HI SEG
LDB B,[PAGEN HSORG] ;OLD ORIGIN PAGE
HRLI B,.FHSLF ;OUR FORK
MOVEI C,PATPAG ;UP TO HERE
TLNE PF,L.FLSR ;UNLESS FILSER MAPPED
MOVEI C,FLSRPG ;THEN HERE
SUBI C,(B) ;NUMBER OF PAGES TO FLUSH
TLO C,(1B0) ;REPEAT ARG
PMAP ;GOODBYE TO OLD HI SEG
REMAP1: HRRZM D,HSORG ;STORE NEW HI SEG ORIGIN
MOVE B,JBREL ;CURRENT LOW SEG END
SUBI B,(CAC) ;LENGTH OF DATA TO MOVE
MOVE C,B ;SAVE COPY OF HI SEG LENGTH
XCTUU <HRLM B,.JBHRL> ;STORE NEW HI SEG FREE POINTER
ADDI B,-1(D) ;COMPUTE LAST WORD OF DESTINATION
CAMG D,JBREL ;IS NEW ORIGIN ABOVE CURRENT END?
JRST REMAP2 ;NO, MUST USE SLOW CODE
HRLI D,1(CAC) ;NO OVERLAP, GET SOURCE FOR BLT
BLT D,(B) ;MOVE DATA
JRST REMAP3
REMAP2: HRRO A,JBREL ;GET LAST WORD OF SOURCE
REMP2A: POP A,(B) ;MOVE A WORD ADJUSTING SOURCE
SUBI B,1 ;ADJUST DESTINATION
SOJG C,REMP2A ;TEST FOR ALL WORDS MOVED AND LOOP
REMAP3: HRRZ A,CAC ;GET NEW END AGAIN
TRO A,777 ;FORCE END OF PAGE
MOVEM A,JBREL ;SAVE HERE
XCTUU <HRRM A,.JBREL> ;AND HERE
LDB B,[PAGEN JBREL] ;GET LOW SEG END PAGE
ADDI B,1 ;GET FIRST PAGE TO FLUSH
LDB C,[PAGEN HSORG] ;GET HIGH SEG START PAGE
SUBI C,(B) ;COMPUTE # OF PAGES TO FLUSH
JUMPE C,MRETN2 ;ALL DONE IF NONE, SUCCESS
SETO A, ;PREPARE TO FLUSH SOURCE PAGES
HRLI B,.FHSLF ;FROM US
TLO C,(1B0) ;INDICATE REPEAT COUNT
PMAP ;FLUSH
JRST MRETN2 ;SUCCESS
;GETTAB UUO SIMULATOR ROUTINES
; ONLY CERTAIN TABLES AND INDEXES ARE IMPLEMENTED
; INDEX = -1, -2, OWN JOB, OR OWN HIGH SEGMENT #
GETTAB: MOVEI A,.GTTBV ;GET ADDRESS OF BIT TABLE
MOVEI B,.GTTBC ;AND ADDRESS OF TABLE OF COUNTS
HRRE C,CAC ;GET DESIRED FUNCTION NUMBER
JUMPL C,CMRETN ;NEGATIVE NUMBERS NOT SUPPORTED
CAIG C,.GTMAX ;WITHIN BOUNDS?
PUSHJ P,.GTDSP ;GET DISPATCH VALUE
JRST CMRETN ;NOT SUPPORTED
XCT .GTTBL(C) ;DO THE FUNCTION
JRST STOTC1 ;STORE ANSWER AND SKIP RETURN
;ROUTINE TO GET A DISPATCH VALUE FROM GETTAB BIT TABLE
;CALLING SEQUENCE:
; MOVE A,ADR OF BIT TABLE
; MOVE B,ADR OF COUNT TABLE
; MOVE C,DESIRED INDEX
; PUSHJ P,.GTDSP
; NOT SUPPORTED INDEX
; SUCCESSFUL, DISPATCH VALUE IN C
.GTDSP: IDIVI C,^D36 ;GET BIT POSITION IN TABLE
MOVE E,C ;SAVE WORD INDEX VALUE
JUMPE C,.GTDS1 ;IF IN FIRST WORD, DONT GET COUNT
ADDI C,-1(B) ;GET INDEX INTO COUNT TABLE
MOVE C,0(C) ;GET COUNT OF PREVIOUS WORDS
.GTDS1: SETO B, ;INITIALIZE MASK
MOVNI D,1(D) ;GET NEGATIVE BIT POS WITHIN WORD
LSH B,(D) ;GET MASK OF UNWANTED BITS
ADDI E,(A) ;GET INDEX INTO BIT TAIBLE
MOVE E,(E) ;GET BIT WORD
MOVSI F,400000 ;SEE IF BIT IS ON
LSH F,1(D) ;GET MASK
TDNN F,E ;IS THIS BIT ON?
POPJ P, ;NO, UNSUPORTED FUNCTION
ANDCM E,B ;MASK OUT UNWANTED BITS
MOVE D,E ;NOW COUNT THE BITS
LSH E,-1 ;SEE HACK MEM ITEM 169 FOR EXPLAINATION
AND E,[333333,,333333]
SUB D,E
LSH E,-1
AND E,[333333,,333333]
SUBB D,E ;EACH OCTAL DIGIT IS REPLACED BY THE
LSH E,-3 ; NUMBER OF 1'S IN IT
ADD D,E
AND D,[070707,,070707]
IDIVI D,77 ;CASTING OUT 77'S
ADDI C,0(E)
SOJA C,CPOPJ1 ;RETURN WITH DISPATCH VALUE IN C
DEFINE GTABLE(NAM),<
NAM'TBL: GTDEF (NAM)
NAM'TBC: GTCGEN(NAM,\NAM'L)
NAM'TBV: GTVGEN(NAM,\NAM'L)
>
DEFINE GVAL(X,Y,Z,NAM),<
IF1,< IFNDEF NAM'V'Y,<NAM'V'Y==0
NAM'C'Y==0>
IFNDEF NAM'MAX,<NAM'MAX==0>
IFL NAM'MAX-X,<NAM'MAX==X>
NAM'V'Y==NAM'V'Y!1B<^O'X-^O'Z>
NAM'C'Y==NAM'C'Y+1
NAM'L==Y>>
DEFINE GTGEN(A,B,C),<
A
ZZ==B/^D36
ZZZ==ZZ*^D36
GVAL(B,\ZZ,\ZZZ,<C>)
>
DEFINE GTCGEN(NAM,LEN),<
ZZ==0
ZZZ==0
REPEAT LEN,<
GTCGN1(<NAM>,\ZZ)
ZZ==ZZ+1>>
DEFINE GTCGN1(A,B),<
IFNDEF A'C'B,<A'C'B==0>
A'C'B+ZZZ
ZZZ==ZZZ+A'C'B>
DEFINE GTVGEN(A,B),<
ZZ==0
REPEAT B+1,<
GTVGN1(<A>,\ZZ)
ZZ==ZZ+1>>
DEFINE GTVGN1(A,B),<
IFNDEF A'V'B,<A'V'B==0>
A'V'B>
.GTIDX: HLRZ A,CAC ;GET INDEX VALUE
CAIN A,-1 ;THIS JOB?
JRST CPOPJ2 ;YES, GIVE SKIP RETURN
CAIN A,-2 ;THIS JOB'S HIGH SEGMENT?
JRST CPOPJ1 ;YES, 1-SKIP RETURN
CAMN A,JOB ;THIS JOB?
JRST CPOPJ2 ;YES
CAMN A,HGHSGN ;THIS JOB'S HIGH SEG?
JRST CPOPJ1 ;YES
POPJ P, ;NO, THIS IS AN ERROR
.GTSTS: PUSHJ P,.GTIDX ;CHECK INDEX VALUE
JRST [HLRZ E,CAC ;GET JOB NUMBER
JRST .GTST1]
JRST CMRETN ;NO HIGH SEG'S ALLOWED
.GTST2: MOVSI A,440004 ;RUNABLE, LOGGED IN, AND JNA
JRST STOTC1 ;RETURN IT TO USER
.GTST1: HRRZ A,E ;GET JOB NUMBER
PUSHJ P,DGETJI ;DO THE GETJI
JRST [ CAIE A,GTJIX4 ;NOT LOGGED IN ERROR?
JRST CMRETN ;NO, ILLEGAL JOB NUMBER
JRST RETZR1] ;YES, RETURN 0
SKIPN STRNG1+.JIUNO ;IS JOB LOGGED IN?
JRST RETZR1 ;NO, RETURN 0
movsi a,440004 ;assume runable
SKIPge C,STRNG1+.JITNO ;IS THERE A TTY FOR IT?
jrst .gtst3 ;no, can't check input wait
SYSGET<TTYJOB> ;SEE IF IN TTY INPUT WAIT
HRL A,C ;GET TTY LINE NUMBER
HRR A,B ;AND TTYJOB TABLE NUMBER
GETAB ;RH = -1 IF NOT IN TTY INPUT WAIT
JRST CMRETN
TRC A,-1 ;CHECK FOR -1
TRCN A,-1
JRST .GTST2 ;NO, JUST RETURN RUNNABLE
MOVSI A,440164 ;NO, JUST SAY JOB IS IN TTY WAIT
.gtst3: PUSHJ P,SKPUSR ;SKIP IF USER MODE
movsi a,40224 ;NO, return job in stop queue
JRST STOTC1
.GTADR: PUSHJ P,.GTIDX ;GET ARG TYPE
JRST [ HLRZ E,CAC ;SOME OTHER JOB
JRST .GTAD1] ;GET ITS JOB NUMBER
JRST RETZR1 ;ALL HIGH SEGS ARE 0
MOVE E,JOB ;THIS JOB
.GTAD1: SYSGET<JOBNAM> ;NOW GET THE WORKING SET SIZE OF JOB
HRR A,B
HRL A,E ;GET JOB #
GETAB
JRST RETZR1
MOVE C,A ;SAVE INDEX INTO NAME TABLES
SYSGET<SNBLKS> ;GET TABLE #
HRR A,B ;GET NUMBER
HRL A,C ;AND INDEX
GETAB ;GET NUMBER OF BLOCKS THAT HAVE OCCURED
JRST RETZR1
MOVE D,A ;SAVE NUMBER OF BLOCKS
SYSGET <SSIZE> ;GET SIZE INTEGRAL
HRR A,B ;GET TABLE NUMBER
HRL A,C ;GET INDEX INTO TABLE
GETAB ;GET SIZE
JRST RETZR1
IDIV A,D ;GET AVERAGE SIZE
SKIPE B ;ANY REMAINDER?
AOS A ;YES, COUNT UP AVERAGE SIZE
ASH A,9 ;TURN PAGES INTO WORDS
HRLZI A,-1(A) ;GET HIGHEST LEGAL ADR IN LH
JRST STOTC1 ;AND GIVE IT TO USER
.GTPPN: PUSHJ P,.GTIDX ;LEGAL INDEX?
JRST .GTPPJ ;GET THE PPN OF ANOTHER JOB
JRST .GTSPP ;YES, HIGH SEGMENT PPN NEEDED
.GTPPS: AOS (P) ;SET UP SKIP RETURN
JRST GETPPN ;YES, RETURN JOB'S PPN
.GTPPJ: HLRZ A,CAC ;GET JOB NUMBER
MOVE B,[-1,,D] ;GET LOGGED IN DIR
MOVEI C,.JILNO
GETJI
JRST [ CAIE A,GTJIX4 ;NOT LOGGED IN ERROR?
JRST CMRETN ;NO, ILLEGAL JOB NUMBER
JRST RETZR1] ;YES, RETURN 0
MOVE A,D ;GET LOGGED IN DIR #
JUMPE A,STOTC1 ;NO JOB LOGGED IN IF 0
PUSHJ P,PPNUNM
JRST STOTC1 ;STORE ANSWER
.GTPRG: PUSHJ P,.GTIDX ;CHECK LEGALITY OF INDEX
JRST [HLRZ E,CAC ;GET JOB # DESIRED
JRST .GTPR1]
JRST .GTSNM ;HIGH SEG NAME WANTED
SKIPE A,LOWNAM ;HAS THE USER DONE A SETNAM UUO?
JRST STOTC1 ;YES, RETURN THIS NEW NAME
MOVE E,JOB ;GET OUR JOB NUMBER
.GTPR1: PUSHJ P,GTJBNM ;GET JOB NAME
JRST CMRETN
JRST STOTC1 ;GO STORE DATA AND SKIP RETURN
GTHSNS: MOVE B,F ;GET HANDLE FOR HIGH SEG
HRROI A,STRNG1 ;SET UP STRING AREA FOR JFNS
JFNS
ERJMP [SETZ A,
POPJ P,]
SEVN26: MOVE B,[POINT 7,STRNG1]
SVN26B: SETZ A, ;INITIALIZE ANSWER AC
MOVE D,[POINT 6,A] ;SET UP SIXBIT BYTE POINTER
MOVEI C,6 ;ONLY 6 CHARACTER NAME ALLOWED
.GTLOP: ILDB E,B
JUMPE E,CPOPJ ;END OF STRING
SUBI E,40 ;TRANSLATE TO 6-BIT
IDPB E,D ;STORE THIS CHARACTER
SOJG C,.GTLOP ;LOOP BACK
POPJ P, ;DO ONLY 6 CHARACTERS
.GTSPP: MOVE A,SEGPPN ;GET HIGH SEG PPN IF ANY
JRST STOTC1 ;GO RETURN IT TO USER
.GTSNM: MOVE A,SEGNAM ;GET HIGH SEG NAME IF ANY
JRST STOTC1 ;SKIP RETURN TO CALLER
.GTDEV: PUSHJ P,.GTIDX ;CHECK INDEX VALUE
JRST RETZR1 ;RETURN 0 FOR ALL OTHER JOB #'S
SKIPA A,SEGDEV ;GET HIGH SEG DEVICE
JRST CMRETN ;GETTAB FOR DEVICE OF LOW SEG IS ILLEGAL
JRST STOTC1 ;GO RETURN VALUE TO CALLER
.GTWSN: HLRZ C,CAC ;GET INDEX
CAIL C,.GTWLN ;GET LENGTH OF TABLE
JRST RETZER ;FAIL
MOVE A,.GTWTB(C) ;GET SIXBIT QUEUE STATES
JRST STOTC1
.GTWTB: SIXBIT/RNWSTS/
SIXBIT/DSAUMQ/
SIXBIT/DACBD1/
SIXBIT/D2DCMT/
SIXBIT/CAIOTI/
SIXBIT/DISLNU/
SIXBIT/STJD/
.GTWLN=.-.GTWTB
.GTCNF: HLRZ C,CAC ;GET INDEX
CAILE C,CNFMAX ;IN BOUNDS?
JRST CMRETN ;NO
MOVEI A,CNFTBV ;GET ADR OF BIT TABLE
MOVEI B,CNFTBC ;AND COUNT TABLE
PUSHJ P,.GTDSP ;GET DISPATCH INDEX
JRST CMRETN ;NO IMPLIMENTED
XCT CNFTBL(C) ;DO THE FUNCTION
JRST STOTC1 ;GO STORE VALUE AND SKIP RETURN
.GTCNM: SYSGET (<SYSVER>) ;GET TABLE NUMBER OF VERSION
HLRE C,B ;GET NEG NUMBER OF ENTRIES
MOVMS C ;MAKE IT POSITIVE
HLRZ A,CAC ;GET WORD NUMBER WANTED
CAML A,C ;IS IT IN BOUNDS?
JRST CMRETN ;NO!
HLLZ A,CAC ;SET UP FOR GETAB
HRR A,B ;GET TABLE #
GETAB
JRST CMRETN ;GETAB FAILED
JRST STOTC1 ;RETURN VALUE TO USER
.GTCTM: AOS (P) ;SKIP RETURN
JRST TIMER ;LET TIMER ROUTINE DO THE WORK
.GTCDT: AOS (P) ;SKIP RETURN
JRST DATE ;LET DATE UUO DO THE WORK
.GTCJN: HRRO A,NJOBS ;ANSWER IS HGHSGN,,NJOBS
JRST STOTC1
.GTPTY: SYSGTA (<PTYPAR>) ;GET # OF TTY'S
HLRZ A,A ;GET NUM OF PTY'S
HRL A,FIRPTY ;GET FIRST PTY # IN LH
JRST STOTC1 ;SKIP RETURN
.GTNSW: HLRZ C,CAC ;GET INDEX
CAILE C,NSWMAX ;IN BOUNDS?
JRST CMRETN ;NO
MOVEI A,NSWTBV ;GET ADR OF BIT TABLE
MOVEI B,NSWTBC ;AND COUNT TABLE
PUSHJ P,.GTDSP ;GET DISPATCH
JRST CMRETN ;NOT SUPPORTED
XCT NSWTBL(C) ;DO FUNCTION
JRST STOTC1 ;STORE VALUE
.GTOHT: SYSGET (<SYSTAT>) ;GET OVERHEAD TIME
HRLI A,2 ;ITEM 2 IN SYSTAT TABLE
JRST .GTLS1 ;GO RETURN IT TO USER
.GTLST: SYSGET (<SYSTAT>) ;GET LOST TIME
HRLI A,1
.GTLS1: HRR A,B
GETAB
JRST CMRETN
.GTJIF: AOS (P)
.GTJF1: MOVEI E,^D60 ;GET TIME IN JIFFIES
JRST RUNTM2
.GTNUP: TIME
JRST .GTJIF
.GTKTM: SYSGET (<DWNTIM>) ;GET TABLE NUMBER OF CEASE TABLE
HRRZ A,B ;SET UP FOR GETAB
GETAB ;GET DOWN TIME
JRST CMRETN
JUMPE A,STOTC1 ;IF NOT SET, RETURN 0
PUSH P,A ;SAVE SHUTDOWN TIME
GTAD ;GET CURRENT TIME
HRRZ B,0(P) ;GET SHUTDOWN SECONDS FROM MIDNIGHT
HRRZ C,A ;GET CURRENT SECS
SUB B,C ;GET DIFFERENCE
HLRZS A ;GET DAYS IN RH OF A
HLRZ C,0(P) ;GET SHUT DOWN DAYS
JUMPGE B,GTKTM1 ;IF OVERFLOWED,
ADDI B,^D24*^D3600 ;ADD IN A DAY
SOS C ;DECREMENT DAYS
GTKTM1: SUBM C,A ;GET DAYS TIL SHUTDOWN
IMULI A,^D24*^D60 ;CONVERT TO MINUTES
IDIVI B,^D60 ;TURN SECONDS INTO MINUTES
ADD A,B ;TOTAL SECONDS TIL SHUTDOWN
SKIPGE A ;ALREADY GONE BY?
SETO A, ;YES, RETURN -1
POP P,(P) ;CLAER OUT STACK
JRST STOTC1
.GTNMS: MOVE A,[SIXBIT/NCPGS/] ;GET USER CORE AVAILABLE
SYSGT
ASH A,9 ;PAGES TO WORDS
JRST STOTC1
.GTSGN: PUSHJ P,.GTIDX ;GET INDEX TYPE
JRST RETZR1 ;RETURN 0 FOR ALL OTHER JOBS
JRST CMRETN ;HIGH SEG NOT ALLOWED
HRRZ 1,JBHRL ;GET HIGH SEG SIZE
JUMPE 1,RETZR1 ;IF ZERO THEN RETURN ZERO
MOVE A,HGHSGN ;GET HGHSGN VALUE
HRLI A,200000 ;MARK THAT HIGH SEG IS SHARABLE
JRST STOTC1 ;GO STORE THIS VALUE
.GTNAM: PUSHJ P,.GTIDX ;IS THIS A REQUEST FOR THIS JOB
JRST .GTNMJ ;GO GET NAME OF OTHER JOBS
JRST CMRETN ;HIGH SEG IS ILLEGAL
GJINF ;GET JOB INFO
MOVE B,A ;ALWAYS USE LOGGED IN NAME
.GTNM1: HRROI A,STRNG1 ;SET UP STRING POINTER
DIRST ;TRANSLATE NUMBER TO ASCII STRING
JRST CMRETN ;NO TRANSLATION
PUSHJ P,SEVN26 ;TRANSLATE TO SIXBIT
HRRZ C,CAC ;GET GETTAB INDEX
CAIE C,32 ;WAS THIS A REQUEST FOR THE SECOND WORD
JRST STOTC1 ;NO, RETURN THIS VALUE
LDB A,B ;GET LAST CHAR SEEN
JUMPE A,RETZR1 ;IF ZERO, DONT RETURN GARBAGE FROM STRNG1
PUSHJ P,SVN26B ;GO GET SECOND SIX CHARACTERS
JRST STOTC1 ;RETURN SECOND WORD
.GTNMJ: HLRZ A,CAC ;GET JOB NUMBER
MOVE B,[-1,,D] ;GET LOGGED IN DIR NUMBER
MOVEI C,.JIUNO
GETJI
JRST RETZR1 ;ILLEGAL OR NOT LOGGED IN
SKIPN B,D ;IS JOB LOGGED IN?
JRST RETZR1 ;NO
JRST .GTNM1 ;YES, GO GIVE NAME TO CALLER
.GTKCT: SKIPA E,[^D60*^D20] ;ASSUME AVERAGE 20K CORE
.GTTIM: MOVEI E,^D60 ;GET JIFFIES
PUSHJ P,.GTIDX
JRST [ AOS (P)
HLRZS CAC
JUMPE CAC,NULTIM ;GIVE NULL TIME FOR JOB 0
JRST RUNTM0] ;SAME AS RUMTIM UUO
JRST CMRETN ;ILLEGAL FOR HIGH SEG
AOS (P)
JRST RUNTM9 ;GET OWN JOB'S RUNTIM
.GTNUL: AOS (P) ;SET UP FOR SKIP RETURN
NULTIM: MOVE A,[SIXBIT/SYSTAT/] ;GET NULL TIME FROM WORD 0 OF SYSTAT TAB
SYSGT
MOVE D,A ;SAVE NULLTIME
HRLI A,1 ;NOW GET LOST TIME
HRR A,B
GETAB
JRST [SOS 0(P) ;DECREMENT SKIP RETURN
JRST CMRETN]
ADD A,D ;TOPS-10 NULL TIME = LOST + IDLE
JRST .GTJF1 ;GO CHANGE UNITS TO JIFFIES
.GTSWP: PUSHJ P,.GTIDX ;CHECK LEGALITY OF #
JRST RETZR1 ;OTHER JOB = 0
SKIPA A,JBHRL ;GET SIZE OF HIGH SEG
JRST RETZR1
AOS A ;MAKE IT PAGES
LSH A,-9
JRST STOTC1
.GTTTY: PUSHJ P,.GTIDX ;CHECK LEGALITY OF #
JRST [ HLRZ C,CAC ;GET JOB #
JRST .GTTY1]
JRST CMRETN ;ILLEGAL FOR HIGH SEG
MOVE C,JOB ;GET THIS JOB'S JOB NUMBER
.GTTY1: HRRZ A,C ;GET JOB NUMBER
MOVE B,[-1,,D] ;GET TTY NUMBER FOR THIS JOB
MOVEI C,.JITNO
GETJI
JRST [ CAIE A,GTJIX4 ;NOT LOGGED IN ERROR?
JRST CMRETN ;NO, ILLEGAL JOB NUMBER
JRST RETZR1] ;YES, RETURN 0
MOVE A,D ;GET TTY NUMBER
JRST STOTC1 ;AND RETURN IT
.GTLVD: HLRZ C,CAC ;GET INDEX
CAILE C,LVDMAX ;WITHIN BOUNDS?
JRST CMRETN ;NO
MOVEI A,LVDTBV ;GET ADR OF BIT TABLE
MOVEI B,LVDTBC ;AND TABLE OF COUNTS
PUSHJ P,.GTDSP ;GET DISPATCH VALUE
JRST CMRETN ;NOT LEGAL
XCT LVDTBL(C) ;GET ANSWER
JRST STOTC1 ;RETURN IT TO USER
.GTC0V: HLRZ C,CAC ;GET INDEX
CAILE C,C0VMAX ;WITHIN BOUNDS?
JRST CMRETN ;NO
MOVEI A,C0VTBV ;GET ADR OF BIT TABLE
MOVEI B,C0VTBC ;AND TABLE OF COUNTS
PUSHJ P,.GTDSP ;GET DISPATCH VALUE
JRST CMRETN ;NOT IMPLEMENTED
XCT C0VTBL(C) ;GET ANSWER
JRST STOTC1 ;RETURN IT TO USER
.GTLIM: PUSHJ P,.GTIDX ;CHECK JOB #
JRST [ HLRZ C,CAC ;GET JOB #
JRST .GTLM1]
JRST CMRETN ;ILLEGAL FOR HI SEG
MOVE C,JOB ;OURSELF
.GTLM1: HRRZ A,C ;SET UP FOR GETJI
MOVE B,[-2,,C] ;-LENGTH,,BLOCK
MOVEI C,.JIRTL ;WORD TO START AT
GETJI
JRST CMRETN ;BOO... HISS...
MOVSI A,(677B9) ;RETURN INFINITE CORE LIMIT MINUS PA1050
SKIPE D ;BATCH JOB?
TXO A,1B10 ;YES, LIGHT JB.LBT
IMULI C,^D1000 ;CONVERT MSEC TO SEC
IDIVI C,^D60 ; AND SEC TO JIFFIES
HRR A,C ;STUFF INTO AC 1
JRST STOTC1 ;AND RETURN
.GTUPM: PUSHJ P,.GTIDX ;FOR WHO?
JRST CMRETN ;ILLEGAL FOR OTHER JOBS
CAIA ;OK FOR OUR HI SEG
JRST CMRETN ;ILLEGAL FOR OUR JOB
SKIPE A,JBHRL ;ANY HI SEG? (0 IF NONE)
MOVS A,HSORG ;YES, RETURN HI SEG ORIGIN IN LEFT HALF
JRST STOTC1 ;RETURN TO USER
.GTRDV: PUSHJ P,.GTIDX
JRST RETZR1 ;RETURN 0 IF NOT US
SKIPA A,SEGDEV ;SEGMENT
MOVE A,LOWDEV ;PROGRAM
JRST STOTC1
.GTRDI: PUSHJ P,.GTIDX
JRST RETZR1 ;RETURN 0 IF NOT US
SKIPA A,SEGPPN ;SEGMENT
MOVE A,LOWPPN ;PROGRAM
JRST STOTC1
;SET UP MAIN DISPATCH TABLE FOR GETTAB UUO
DEFINE GTDEF (A),<
XLIST
GTGEN (<JRST .GTSTS>,0,A)
GTGEN (<JRST .GTADR>,1,A)
GTGEN (<JRST .GTPPN>,2,A)
GTGEN (<JRST .GTPRG>,3,A)
GTGEN (<JRST .GTTIM>,4,A)
GTGEN (<JRST .GTKCT>,5,A)
GTGEN (<JRST .GTSWP>,7,A)
GTGEN (<JRST .GTTTY>,10,A)
GTGEN (<JRST .GTCNF>,11,A)
GTGEN (<JRST .GTNSW>,12,A)
GTGEN (<JRST .GTSGN>,14,A)
GTGEN (<JRST .GTLVD>,16,A)
GTGEN (<JRST .GTDEV>,24,A)
GTGEN (<JRST .GTWSN>,25,A)
GTGEN (<JRST .GTNAM>,31,A)
GTGEN (<JRST .GTNAM>,32,A)
GTGEN (<JRST .GTLIM>,40,A)
GTGEN (<JRST .GTC0V>,56,A)
GTGEN (<JRST .GTUPM>,100,A)
GTGEN (<JRST .GTRDV>,135,A)
GTGEN (<JRST .GTRDI>,136,A)
LIST
>
GTABLE (.GT) ;GENERATE .GTTBL,.GTTBC,.GTTBV, AND .GTMAX
;SET UP CONFIGURATION TABLE DISPATCH (TABLE 11)
DEFINE GTDEF (NAM),<
XLIST
GTGEN (<JRST .GTCNM>,0,NAM)
GTGEN (<JRST .GTCNM>,1,NAM)
GTGEN (<JRST .GTCNM>,2,NAM)
GTGEN (<JRST .GTCNM>,3,NAM)
GTGEN (<JRST .GTCNM>,4,NAM)
GTGEN (<JRST .GTCNM>,5,NAM)
GTGEN (<JRST .GTCNM>,6,NAM)
GTGEN (<MOVSI A,'DSK'>,7,NAM)
GTGEN (<JRST .GTCTM>,10,NAM)
GTGEN (<JRST .GTCDT>,11,NAM)
GTGEN (<MOVEI A,0>,12,NAM) ;SIZE OF MONITOR
GTGEN (<JRST .GTCJN>,15,NAM) ;# OF JOBS IN SYSTEM
GTGEN (<SETO A,>,16,NAM) ;DUAL REGISTER SOFTWARE SUPPORTED
GTGEN (<MOVSI A,751317>,17,NAM) ;DISK SYSTEM
GTGEN (<JRST .GTPTY>,22,NAM) ;XWD PTY TO TTY CORR, # OF PTY'S
GTGEN (<MOVEI A,40000>,112,NAM) ;VIROS MONITOR
LIST
>
GTABLE (CNF) ;GENERATE CNFTBL, CNFTBC, CNFTBV, CNFMAX
;SET UP NON-SWAPING DATA TABLE (TABLE 12)
DEFINE GTDEF (NAM),<
XLIST
GTGEN (<MOVSI A,1>,10,NAM) ;CORMAX
GTGEN (<JRST .GTNUP>,15,NAM) ;UP TIME
GTGEN (<JRST .GTCJN>,20,NAM) ;HIGHEST JOB NUMBER AVAILABLE
GTGEN (<JRST .GTLST>,22,NAM) ;LOST TIME
GTGEN (<JRST .GTNMS>,23,NAM) ;USER CORE AVAILABLE
GTGEN (<MOVSI A,1>,34,NAM) ;HIGHEST VALUE OF CORMAX
GTGEN (<JRST .GTKTM>,35,NAM) ;KSYS TIME
LIST
>
GTABLE (NSW)
;SET UP LEVEL-D TABLE (TABLE 16)
DEFINE GTDEF (NAM),<
XLIST
GTGEN (<MOVE A,[1,,1]>,0,NAM) ;MFD PPN
GTGEN (<MOVE A,[1,,4]>,1,NAM) ;SYS PPN
GTGEN (<MOVE A,[1,,2]>,2,NAM) ;FAILSAFE PPN
GTGEN (<MOVE A,[3,,3]>,4,NAM) ;SPOOLER PPN
GTGEN (<MOVSI A,(STDPRT)>,12,NAM) ;STANDARD PROTECTION
GTGEN (<MOVSI A,775000>,13,NAM) ;STANDARD UFD PROTECTION
GTGEN (<MOVSI A,'DSK'>,15,NAM) ;SPOOLER PPN
GTGEN (<MOVSI A,077000>,20,NAM) ;PROTECTION OF SPOOLED FILES
GTGEN (<MOVSI A,155000>,21,NAM) ;SYSTEM FILE PROTECTION
GTGEN (<MOVSI A,157000>,22,NAM) ;FILE PROTECTION FOR SYS FILES
LIST
>
GTABLE (LVD)
;TABLE 56 - CPU0 CDB VARIABLE TABLE
DEFINE GTDEF (NAM),<
XLIST
GTGEN (<JRST .GTNUP>,5,NAM) ;UPTIME IN JIFFIES
GTGEN (<JRST .GTLST>,12,NAM) ;LOST TIME IN JIFFIES
GTGEN (<JRST .GTNUL>,37,NAM) ;NULL TIME IN JIFFIES
GTGEN (<JRST .GTOHT>,42,NAM) ;OVERHEAD TIME IN JIFFIES
LIST
>
GTABLE (C0V)
;UUO'S NOT EXECUTED VERY OFTEN
SYSPHY:
SYSSTR: JUMPE CAC,SYSTR1 ;IF 0 RETURN 'DSK'
IFN FTFILSER,<
MOVE A,CAC ;GET DEVICE NAME
PUSHJ P,DPACHK ;SEE IF IT IS A TOPS-10 PACK
SKIPA ;IT ISNT
JRST TDOUUO ;YES, GO CALL FILSER
>
CAME CAC,[SIXBIT/DSK/] ;IS IT DSK?
JRST SYSTR2 ;NO, CHECK IF OTHER STR
MOVEI A,0 ;FENCE
JRST STOTC1 ;GO RETRUN 0
SYSTR1: MOVSI A,'DSK' ;RETURN DSK
JRST STOTC1
SYSTR2: MOVE D,CAC ;GET NAME
PUSHJ P,CHKDSK ;SEE IF IT IS A DSK
JRST MRETN ;NO
JRST RETZR1 ;YES, MAKE IT BE AT THE END
GETSTR: MOVEI A,1 ;SET A POSITIVE
CAMN B,[-1] ;-1 = DSK
MOVSI A,'DSK'
CAMN B,[SIXBIT/DSK/] ;DSK = 0
SETZ A,
SKIPN B ;0 = -1
MOVNI A,1
JUMPG A,CPOPJ ;A POSITIVE MEANS ILLEGAL VALUE IN B
JRST CPOPJ1 ;SKIP RETURN
JOBSTR: UMOVE B,(CAC) ;GET LOC
PUSHJ P,GETSTR ;GET STR VALUE OF NEXT STR
JRST MRETN ;ILLEGAL VALUE IN LOC
UMOVEM A,(CAC) ;STORE ANSWER
HLRZ B,CAC ;GET NUMBER OF ARGS
CAIGE B,3 ;ENOUGH FOR STATUS
JRST MRETN2 ;NO, SKIP RETURN
XCTUU <SETZM 2(CAC)> ;YES, RETURN ZERO AS STATUS
JRST MRETN2
GOBSTR: HLRZ D,CAC ;GET COUNT
UMOVE B,2(CAC) ;GET STR VALUE
PUSHJ P,GETSTR ;TRANSLATE IT
JRST GOBST1 ;ILLEGAL, GO GIVE ERROR RETURN
UMOVEM A,2(CAC) ;STORE ANSWER
CAIGE D,5 ;ENOUGH ROOM FOR STATUS
JRST MRETN2 ;NO
XCTUU <SETZM 4(CAC)> ;YES, GIVE ZERO
JRST MRETN2
GOBST1: SKIPA A,[3] ;RETURN 3
GOBST2: MOVEI A,6 ;RETURN 6
JRST STOTAC ; IN USERS AC
STRUUO:
IFN FTFILSER,<
UMOVE A,1(CAC) ;GET STRUCTURE NAME
PUSHJ P,DPACHK ;SEE IF THIS IS A TOPS-10 PACK
SKIPA ;IT ISNT
JRST TDOUUO ;YES, CALL FILSER
>
SETZ A, ;INITIALIZE ANSWER
HLRZ D,CAC ;GET N
CAIE D,4 ;4 IS THE ONLY ALLOWED VALUE
JRST STRU1 ;GIVE 4 ERROR RETURN
XCTUU<SKIPE (CAC)> ;0 IS THE ONLY FUNCTION IMPLEMENTED
JRST STOTAC ;GO RETURN 0 TO USER
UMOVE B,1(CAC) ;GET STR
CAME B,[SIXBIT/DSK/] ;DSK IS THE ONLY ONE ALLOWED
AOJA A,STOTAC ;GO GIVE 1 ERROR
JRST MRETN2 ;OK, GIVE SKIP RET
STRU1: MOVEI A,4 ;GIVE 4 ERROR
JRST STOTAC
DEVPPN: MOVE A,CAC ;GET ARGUMENT, DEV NAME OR CHNL #
PUSHJ P,GDVPPN ;GET PPN OF DEVICE
JRST MRETN ;NOT A DSK
MOVE A,B ;GET PPN
JRST STOTC1 ;RETURN IT TO USER
GDVPPN: PUSH P,A ;SAVE ARG, EITHER DEV NAME OR CHANEL #
SKIPL A ;CHECK FOR A CHANNEL # 0-17
CAILE A,17
SKIPA ;NOT A CHANNEL
JRST [ IMULI A,NTABS ;GET INDEX INTO CHANNEL TABLES
MOVE B,DEVNAM(A) ;GET DEVICE NAME
MOVEM B,0(P) ;STORE DEVICE NAME INSTEAD OF CHANNEL #
MOVE A,DIRNUM(A) ;GET DIRECTORY NUMBER OF FILE
JRST GDVPPD] ;GO TRANSLATE TO PPN
PUSHJ P,GETPHY ;SEE IF THERE IS A PPN FOR THIS DEV
JUMPE B,GDVPP0 ;NO LOGICAL NAME OR NO DIR NUM
JUMPE B,GDVPP1 ;NO PPN FOR THIS LOGICAL NAME
GDVPD0: MOVE A,B ;GET DIR NUMBER
GDVPPD: PUSHJ P,PPNUNM ;GET PPN FROM DIR NUMBER
GDVPD1: MOVE B,A ;RETURN WITH PPN IN B
POP P,A ;AND DEV NAME IN A
JRST CPOPJ1 ;GIVE SKIP RETURN
GDVPP0: MOVE A,0(P) ;GET BACK DEVICE NAME
CAME CAC,[SIXBIT/SYS/] ;SYS?
JRST GDVPP1 ;NO, GIVE ERROR RETURN
MOVE B,[XWD 1,4] ;RETURN SYS PPN
JRST GDVPD1
GDVPP1: MOVE D,0(P) ;NOW CHECK FOR DSK
PUSHJ P,CHKDSK
JRST APOPJ ;NOT A DSK
GJINF ;GET CONNECTED DIR
JRST GDVPD0 ;GO RETURN OWN PPN
;ROUTINE TO GET THE PHYSICAL DEVICE NAME FROM A LOGICAL NAME
;CALL:
; MOVE A,SIXBIT DEVICE NAME
; PUSHJ P,GETPHY
; NO LOGICAL NAME FOR THIS DEVICE
; LOGICAL NAME IS IN A (SIXBIT)
; DIR NUMBER OF DEVICE IN B (0 IF NONE SPECIFIED)
;GETPHY USES DEVNM7 AND STRNG1 AS SCRATCH STRINGS
GETPHY: PUSH P,A ;SAVE SIXBIT NAME
MOVE D,A ;GET SIXBIT NAME INTO ASCII
HRROI E,STRNG1
PUSHJ P,SIXTO7 ;CONVERT IT TO ASCII IN STRNG1
MOVEI B,":" ;ADD A COLON AFTER DEVICE
IDPB B,E
MOVEI B,0 ;FOLLOWED BY A NULL
IDPB B,E
HRROI B,STRNG1 ;NOW GET A DIR NUMBER FOR THIS DEV
MOVX A,RC%EMO ;NO RECOGNITION
RCDIR ;GET DIR NUMBER
ERJMP [MOVEI C,0 ;NO SUCH DEVICE, SET DIR # TO 0
JRST GETPH0] ;AND CONTINUE ON
TXNE A,RC%NOM!RC%AMB ;DID THIS SUCCEED?
JRST GETPH1 ;NO, NO SUCH DEVICE
GETPH0: HRROI A,STRNG1 ;NOW GET PHYSICAL DEVICE
STDEV ;GET DEVICE DESIGNATOR
ERJMP GETPH1
DEVST ;AND BACK TO THE PHYSICAL NAME
ERJMP GETPH1
PUSH P,C ;SAVE THE DIRECTORY NUMBER
PUSHJ P,SEVN26 ;GET SIXBIT DEVICE NAME
POP P,B ;RETURN DIR NUMBER IN B
POP P,(P) ;CLEAN UP STACK
JRST CPOPJ1 ;GIVE SUCCESSFUL RETURN
GETPH1: MOVEI B,0 ;NO DIR
JRST APOPJ ;EXIT CLEANING UP THE STACK
DVNAM.: TLNE CAC,-1 ;SIXBIT NAME?
JRST DEVNM1 ;YES
TRZE CAC,200000 ;UDX OF TTY?
JRST [ MOVE B,CAC ;GET LINE NUMBER
PUSHJ P,LIN26 ;GET SIXBIT NAME
JRST STOTC1] ;AND GIVE IT TO USER
SKIPL CAC ;CHECK FOR A CHANNEL NUMBER
CAILE CAC,17
JRST DEVNM1 ;NOT A CHANNEL #
IMULI CAC,NTABS ;GET INDEX INTO CHANNEL TABLES
SKIPE A,DEVNAM(CAC) ;IS THERE A DEVICE ON THIS CHANNEL
JRST STOTC1 ;YES, GO RETURN ITS NAME
JRST MRETN ;NO, GIVE ERROR RETURN
DEVNM1: MOVE A,CAC ;GET SIXBIT DEV NAME FOR GETPHY
PUSHJ P,GETPHY
SKIPA A,CAC ;NONE, USE WHAT WAS GIVEN BY USER
EXCH CAC,A ;USE THIS PHYSICAL NAME
HRROI A,STRNG1 ;NOW SEE IF DEVICE EXISTS
STDEV
JRST DEVNM2 ;IT DOES NOT EXIST
MOVE A,CAC ;RETURN SAME NAME
JRST STOTC1
DEVNM2:
IFN FTFILSER,<
MOVE A,CAC ;SEE IF THIS IS A TOPS-10 PACK
PUSHJ P,DPACHK
JRST DEVNM5 ;NO
MOVE A,B ;YES, GET ACTUAL NAME
JRST STOTC1 ;AND RETURN IT TO THE USER
>
DEVNM5: MOVS B,CAC ;CHECK GENERIC NAMES NOW
SETZB AC,BB ;START AT CHANNEL 0
DEVNM3: HLRZ A,DEVNAM(BB) ;GET LEFT HALF NAME ONLY
CAMN A,B ;IS THIS A MATCH?
JRST DEVNM4 ;YES, GO RETURN ACTUAL DEVICE
ADDI BB,NTABS
CAILE AC,17 ;LOOKED AT ALL CHANNELS?
AOJA 17,DEVNM3 ;NO, LOOP BACK
JRST MRETN ;YES, GIVE ERROR RETURN
DEVNM4: MOVE A,DEVNAM(BB) ;GET FULL DEVICE NAME
JRST STOTC1 ;GIVE IT TO USER
MTCHR: SKIPL BB,CAC ;CHECK FOR CHANNEL #
CAILE BB,17
JRST MTCHR1 ;NOT A CHANNEL #
IMULI BB,NTABS ;GET CHANNEL INDEX
MTCHR0: LDB AA,PDVNUM ;GET NUMERIC DEVICE TYPE
CAIE AA,MTA ;IS IT A MTA
JRST MTCHR2 ;NO, THIS IS AN ERROR
HRRZ A,JFNTAB(BB) ;GET JFN OF TAPE
MOVEI B,.MORDN ;READ IN DENSITY
MTOPR
ERJMP MTCHR3 ;NOT SET YET
PUSH P,C ;(326) save density
GDSTS ;(326) get device status
MTCHR4: ;(326)
HLRZS C ;(326) right-justify byte count
PUSH P,C ;(326) save byte count
MOVEI B,.MORDM ;(326) read tape data mode (JFN already set)
MTOPR ;(326) should never return 0 == system default
ERJMP [POP P,C ;FAILED, RESTORE AC
SETZ C, ;MAKE ZERO
JRST MTCHR5] ;AND RETURN RESULT
HLRZ B,TPRDMT(C) ;(326) get bytes per word
POP P,C ;(326) get byte count
IDIV C,B ;(326) convert bytes to words
SKIPE D ;(326) round up to next higher word
AOS C ;(326) if needed
MTCHR5: POP P,A ;(326) get density
HRL A,C ;(326) put in word count
JRST STOTC1 ;RETURN ANSWER
MTCHR3: GDSTS ;(326) get device chars (JFN already set)
LDB B,[POINT 2,B,28] ;(326) get density
SKIPN B ;(326) is it 0 ?
MOVEI B,3 ;(326) yes, make it 3
PUSH P,B ;(326) save density
JRST MTCHR4 ;(326) C already set by GDSTS
MTCHR1: MOVEI D,17 ;SEARCH FOR THIS DEV INITED
TDZA E,E
ADDI E,NTABS
CAME CAC,DEVNAM(E) ;IS THIS A MTACH
SOJGE D,.-2 ;NO, KEEP LOOKING
JUMPL D,MTCHR2 ;NO MATCH, GO GIVE ERROR RET
MOVE BB,E
JRST MTCHR0 ;GO SEE IF THIS IS A MTA
MTCHR2: SETO A,
JRST STOTAC
;TRMOP UUO SIMULATION
.TRMOP: UMOVE C,1(CAC) ;GET IO INDEX
TRC C,200000 ;CHECK ITS LEGALITY
MOVE A,[SIXBIT/TTYJOB/]
SYSGT ;GET MAX # OF TTY'S SUPPORTED
HLRES B ;...
MOVNS B ;MAKE COUNT POSITIVE
CAMLE C,B ;IS THIS A GOOD TTY #
JRST RETZER ;NO, GIVE ERROR RETURN
UMOVE C,2(CAC) ;GET SET VALUE
UMOVE A,1(CAC) ;GET IO INDEX
TRC A,600000 ;CHANGE INDEX TO TTY NUMBER
XCTUM <HRRZ B,0(CAC)> ;GET FUNCTION TO BE DONE
TRNN B,777000 ;FUNCTION TYPE 0?
JRST TRMOP0 ;YES
TRNN B,776000 ;FUNCTION TYPE 1?
JRST TRMOP1 ;YES
TRNE B,775000 ;FUNCTION TYPE 2?
JRST MRETN ;NO, THEN THIS IS AN ERROR
ANDI B,777 ;GET INDEX INTO FUNCTION TABLE
CAIL B,TRMRSL ;WITHIN BOUNDS?
JRST MRETN ;NO, ERROR
HLRZ D,TRMRST(B) ;GET ADR OF FUNCTION TO BE DONE
JRST (D) ;GO DO SET FUNCTION SPECIFIED
TRMOP1: ANDI B,777 ;GET FUNCTION INDEX
CAIL B,TRMRSL ;WITHIN BOUNDS?
JRST MRETN ;NO, ERROR
HRRZ D,TRMRST(B) ;GET ADR OF ROUTINE
JRST (D) ;GO DO IT
TRMOP0: CAIL B,TRM0TL ;WITHIN BOUNDS?
JRST MRETN ;NO, ERROR
JRST @TRM0TB(B) ;GO DO FUNCTION
TRM0TB: MRETN ;0 NOT IMPLEMENTED
TOSIP ;1 SKIP IF INPUT BUFFER NOT EMPTY
TOSOP ;2 SKIP IF OUTPUT BUFFER NOT EMPTY
TOCIB ;3 CLEAR INPUT BUFFER
TOCOB ;4 CLEAR OUTPUT BUFFER
TRM0TL==.-TRM0TB
TOSIP: SIBE ;SKIP IF INPUT BUFFER FULL
JRST MRETN2 ;YES, SKIP RETURN
PUSH P,A ;SAVE TTY NUMBER
GJINF ;GET OUR CONTROLING TTY
POP P,A ;GET BACK TTY NUMBER
TRZ A,TTYDSG ;CLEAR DEVICE TYPE
CAMN A,D ;IS THIS OUR OWN TTY
SKIPG TTCNT ;YES, ANY CHARS IN INTERNAL BUFFER
JRST MRETN ;NO, THEN NO CHARACTERS
JRST MRETN2 ;THERE ARE CHARACTERS, GIVE SKIP RETURN
TOSOP: SOBE ;SKIP IF OUTPUT BUFFER FULL
JRST MRETN2 ;YES, SKIP
JRST MRETN ;NO, DONT SKIP
TOCIB: CFIBF ;CLEAR MONITOR BUFFER
PUSHJ P,TTXTST ;SEE IF THIS IS THE CONTROLING TTY
JRST MRETN2 ;DONT CLEAR INTERNAL BUFFER
PUSHJ P,TTCL11 ;YES, CLEAR THE INTERNAL BUFFER ALSO
JRST MRETN2 ;GIVE SUCCESSFUL RETURN
TOCOB: CFOBF ;CLEAR OUTPUT BUFFER
JRST MRETN2 ;AND RETURN
TRMRST: MRETN,,TOOIPR ;0 OUTPUT IN PROGRESS
MRETN,,TOCOMR ;1 - MONITOR MODE
TOXONS,,TOXONR ;2 - TAPE MODE
TOLCTS,,TOLCTR ;3 - LOWER CASE
MRETN,,MRETN ;4
TOTABS,,TOTABR ;5 - HARDWARE TABS
TOFRMS,,TOFRMR ;6 - HARDWARE FORM FEED
TOLCPS,,TOLCPR ;7 - LOCAL COPY
TONFCS,,TONFCR ;10 - CR-LF SWITCH
MRETN,,MRETN ;11
TOWIDS,,TOWIDR ;12 - PAGE WIDTH
MRETN,,MRETN ;13
MRETN,,TOHLFR ;14 - HALF DUPLEX
MRETN,,MRETN ;15
MRETN,,MRETN ;16
TOFLCS,,TOFLCR ;17 - FILLER CLASS
MRETN,,MRETN ;20
TOPAGS,,TOPAGR ;21 - TTY PAGE
MRETN,,MRETN ;22
TOPSZS,,TOPSZR ;23 - TTY PAGE LENGTH
MRETN,,MRETN ;24
MRETN,,MRETN ;25
TOALTS,,TOALTR ;26 - SUPRESS ALTMODE CONVERSION
TRMRSL==.-TRMRST
TOOIPR: SOBE ;OUTPUT IN PROGRESS
JRST TRMB1R ;YES
JRST RETZR1 ;NO
TRMB1R: MOVEI A,1 ;RETURN A 1
JRST STOTC1 ;SKIP RETURN
TOCOMR: XCTUM <HRRZ A,1(CAC)> ;GET TTY NUMBER
TRC A,600000 ;MAKE IT 400000+TTY
PUSHJ P,DGETJI ;DO THE GETJI
JRST MRETN ;ILLEGAL TTY NUMBER
SKIPGE STRNG1+.JIJNO ;IS JOB NUMBER IN USE?
JRST TRMB1R ;NO, SAY IT IS IN MONITOR MODE
PUSHJ P,SKPUSR ;MONITOR MODE?
JRST TRMB1R ;YES, GIVE ON RETURN
JRST RETZR1 ;NOT IN MONITOR MODE
TOXONS: PUSHJ P,TTXTST ;SEE IF THIS IS THE CONTROLING TTY
JRST MRETN ;NO, FUNCTION NOT SUPPORTED
MOVE E,TYSTAT ;GET MODE WORD
TRNE C,1B35 ;SET OR CLEAR
TLOA E,TT.XON ;SET
TLZ E,TT.XON ;CLEAR
PUSHJ P,TTPSTS ;GO SET UP NEW MODE
JRST MRETN2 ;AND RETURN
TOXONR: PUSHJ P,TTXTST ;IS THIS THE CONTROLING TTY?
JRST MRETN ;NO, NOT SUPPORTED
TLNN E,TT.XON ;IS TAPE MODE ON OR OFF
JRST RETZR1 ;OFF
JRST TRMB1R ;ON
TTXTST: PUSH P,A ;SAVE ACS
PUSH P,C
GJINF
POP P,C
POP P,A
TRO D,TTYDSG ;GET TERMINAL UNIT
CAME A,D ;SAME AS DESIRED TTY?
POPJ P, ;NO, NON-SKIP RETURN
JRST CPOPJ1 ;YES, SKIP
TOLCTR: RFMOD
TLNE B,(1B3) ;LOWER CASE MODE ON?
TRNE B,1B31 ;AND NO CONVERSION BEING DONE?
JRST TRMB1R ;NO, THIS IS NOT A LOWER CASE TERMINAL
JRST RETZR1 ;LOWER CASE
TOLCTS: RFMOD
TRNE C,1B35 ;SET OR CLEAR
TLZA B,(1B3) ;CLEAR
TLOA B,(1B3) ;SET
TROA B,1B31 ;CONVERT TO UPPER CASE
TRZ B,1B31 ;DONT CONVERT
STPAR
JRST MRETN2
TOTABR: RFMOD
TLNE B,(1B2) ;TAB?
JRST TRMB1R ;YES
JRST RETZR1 ;NO
TOTABS: RFMOD
TRNN C,1B35 ;SET OR CLEAR?
TLZA B,(1B2) ;CLEAR
TLO B,(1B2) ;SET
STPAR
JRST MRETN2
TOFRMR: RFMOD
TLNE B,(1B1) ;HARDWARE FORM FEED
JRST TRMB1R ;YES
JRST RETZR1 ;NO
TOFRMS: RFMOD
TRNN C,1B35 ;SET OR CLEAR?
TLZA B,(1B1) ;CLEAR
TLO B,(1B1) ;SET
STPAR
JRST MRETN2
TOLCPR: RFMOD
TRNE B,3B25 ;LOCAL COPY ON?
JRST RETZR1 ;NO
JRST TRMB1R ;YES
TOLCPS: RFMOD
TRZ B,3B25 ;ASSUME NO ECHO
TRNN C,1B35 ;SET OR CLEAR?
TRO B,1B24 ;MAKE ECHOS HAPPEN
SFMOD
JRST MRETN2
TONFCR: PUSHJ P,GETWID ;(316) GET WIDTH =0?
JUMPE C,TRMB1R ;(316)YES, THEN CR-LF IS OFF
JRST RETZR1
TONFCS: TRNN C,1B35 ;SET OR CLEAR?
JRST [PUSHJ P,GETWID ;(316)CLEAR, GET CURRENT LINE WIDTH
JUMPN C,MRETN2 ;(316)IF 0, CR CLEARED, RETURN
SKIPGE C,TTWDTH ;(316)DO WE HAVE PREVIOUS WIDTH?
MOVEI C,^D72 ;(316)NO, SET WIDTH TO STANDARD 72
JRST TOWIDS] ;GO SET WIDTH
PUSHJ P,GETWID ;(316)GET LINE WIDTH
MOVEM C,TTWDTH ;(316)REMEMBER THIS WIDTH TO RESTORE IT LATER
JUMPE C,MRETN2 ;IF ALREADY 0, RETURN
MOVEI C,0
JRST TOWIDS ;GO SET WIDTH TO 0
TOWIDR: PUSHJ P,GETWID ;(316) GET LINE WIDTH
SKIPG A,C ;(316) IF WIDTH =0
MOVEI A,^D255 ;(316) RETURN THE MAXIMUM
JRST STOTC1 ;RETURN IT TO USER
TOWIDS: MOVEI B,.MOSLW ;(316)SET LINE WIDTH
MTOPR ;(316)
ERJMP CMRETN ;(316)
JRST MRETN2
GETWID: MOVEI B,.MORLW ;(316)READ LINE WIDTH
MTOPR ;(316)
ERJMP CMRETN ;(316)
POPJ P, ;(316)
TOHLFR: RFMOD
TRNE B,3B33 ;HLAF DUPLEX
JRST TRMB1R ;YES
JRST RETZR1 ;NO
TOALTR: PUSHJ P,TTXTST ;SEE IF THIS IS THE CONTROLING TTY
JRST MRETN ;NO, ERROR
MOVE E,TYSTAT ;GET CONTROLING STATUS
TLNE E,TT.ALT ;CONVERTING ALTMODES?
JRST TRMB1R ;NO
JRST RETZR1 ;YES
TOALTS: PUSHJ P,TTXTST ;SEE IF THIS IS THE CONTROLING TTY
JRST MRETN ;NO, GIVE ERROR RETURN
MOVE E,TYSTAT ;YES
UMOVE C,2(CAC) ;GET ARG AGAIN
TRNN C,1B35 ;SET OR CLEAR?
TLZA E,TT.ALT ;CLEAR
TLO E,TT.ALT ;SET
MOVEM E,TYSTAT
JRST MRETN2
TOFLCR: GTTYP ;GET TERMINAL TYPE
CAIN B,9 ;TERMINAL TYPE 9 IS NO FILLER
MOVEI B,0
MOVE A,B
JRST STOTC1 ;RETURN TERMINAL TYPE
TOFLCS: SKIPN B,C ;USER WANT NO FILL
MOVEI B,9 ;YES, GIVE HIM TYPE 9, NO FILL
STTYP
JRST MRETN2
TOPAGS: RFMOD ;READ IN TTY STATUS
TRNE C,1B35 ;SET OR CLEAR?
TROA B,TT%PGM ;SET
TRZ B,TT%PGM ;CLEAR
STPAR
JRST MRETN2
TOPAGR: RFMOD ;READ PAGE BIT
TRNE B,TT%PGM ;IS IT SET?
JRST TRMB1R ;YES, RETURN ANSWER
JRST RETZR1 ;NO
TOPSZS: RFMOD ;SET PAGE SIZE
DPB C,[POINT 7,B,10]
STPAR
JRST MRETN2
TOPSZR: RFMOD ;READ PAGE SIZE
LDB A,[POINT 7,B,10]
JRST STOTC1
TRMNO: HRRZ A,CAC ;GET JOB NUMBER
PUSHJ P,DGETJI ;DO THE GETJI
JRST RETZER ;ILLEGAL JOB NUMBER
SKIPL A,STRNG1+.JITNO ;IS THERE A TTY FOR THIS JOB?
SKIPN STRNG1+.JIUNO ;AND IS IT LOGGED IN?
JRST RETZER ;NO
TRO A,200000 ;MAKE TTY INTO UNIVERSAL IO INDEX
JRST STOTC1 ;GIVE IT TO USER
CTLJOB: MOVE A,CAC ;GET JOB NUMBER
HRROI B,D ;GET ONLY ONE WORD BACK IN D
MOVEI C,.JICPJ ;GET CONTROLING JOB IF ANY
GETJI
JRST [ CAIE A,GTJIX4 ;NOT LOGGED IN ERROR?
JRST CMRETN ;NO, BAD ARGUMENT
SETO D, ;YES, RETURN -1
JRST .+1]
MOVE A,D ;GET ANSWER
JRST STOTC1 ;AND RETURN IT TO USER
PATH: UMOVE E,0(CAC) ;GET LOC
GJINF ;GET OUR PPN INTO AC B
HRRZ A,E ;GET RH OF ARG 0
CAIE A,-4 ;ALLOW ONLY READING OF PATHS
CAIN A,-1
JRST PATH1 ;GO RETURN PATH
CAIE A,-3 ;DONT ALLOW SETTING OF PATHS
CAIN A,-2
JRST CMRETN
UMOVE A,0(CAC) ;GET DEVICE NAME OR CHANNEL #
PUSHJ P,GDVPPN ;GET ITS PPN
JRST PATH2 ;NOT A DISK
IFN FTFILSER,<
PUSH P,A ;SAVE DEVICE NAME
PUSH P,B ;SAVE PPN
PUSHJ P,DPACHK ;SEE IF THIS IS A TOPS-10 PACK
JRST [ POP P,B ;GET BACK PPN
POP P,A ;GET BACK DEVICE
UMOVEM A,0(CAC) ;STORE DEVICE NAME
JRST PATH3]
POP P,B ;YES
POP P,A
JRST TDOUUO ;GO CALL FILSER TO DO UUO
>
IFE FTFILSER,<
UMOVEM A,0(CAC) ;STORE NEW DEVICE NAME
JRST PATH3 ;AND THEN STORE PPN
PATH1: MOVE A,B ;GET DIR NUM
PUSHJ P,PPNUNM ;UNMAP IT INTO A PPN
MOVE B,A
PATH3: UMOVEM B,2(CAC)
PUSH P,B ;SAVE PPN
MOVEI A,0 ;GET OWN PPN
PUSHJ P,PPNUNM
POP P,B ;GET BACK PPN OF THIS DEV
CAME A,B ;ARE THEY THE SAME?
SKIPA A,[1B30!1B35] ;NO, SET IGNORE BIT
MOVEI A,1B29!1B35 ;YES, DONT SET IGNORE BIT
UMOVEM A,1(CAC)
HLRZ A,CAC ;GET ARG COUNT
CAIGE A,4 ;OK TO STORE HERE
JRST MRETN2 ;NO
XCTUU <SETZM 3(CAC)> ;MARK END OF PATH
JRST MRETN2
PATH2:
IFN FTFILSER,<
UMOVE A,0(CAC) ;GET DEVICE NAME OR CHANNEL #
TLNN A,-1 ;CHANNEL NUMBER?
CAILE A,17 ;...
JRST PATH4 ;NO
IMULI A,NTABS ;YES, GET INDEX
MOVE A,DEVNAM(A) ;GET SIXBIT DEVICE NAME
PATH4: PUSHJ P,DPACHK ;SEE IF IT IS A TOPS-10 PACK
SKIPA ;NO
JRST TDOUUO ;YES, CALL FILSER
>
JRST RETZR1 ;RETURN A 0
;THE CHKACC UUO
CHKACC:
JRST RETZR1 ;ALWAYS SUCCEED
REPEAT 0,< ;CHKACC DOES NOT WORK WHEN CONNECTED TO
;A DIRECTORY OTHER THAN THE LOGGED IN
;DIRECTORY (IF USER GROUPS ARE IN USE)
MOVE A,[1,,2] ;SEE IF THIS IS OPERATOR
XCTUU <CAMN A,2(CAC)> ;...
JRST RETZR1 ;YES, ACCESS IS ALWAYS ALLOWED
XCTLB <LDB D,[POINT 9,0(CAC),35]> ;GET FIL PROT
JUMPE D,[MOVEI D,-1 ;IF 0, ASSUME NO PROTECTION
JRST CHKAC1]
PUSHJ P,GTPROT ;GET THE PROTECTION TRANSLATION IN D
CHKAC1: PUSH P,D ;SAVE PROTECTION
UMOVE A,1(CAC) ;GET THE DIR PPN
HRROI B,[ASCIZ/DSK/] ;MUST SUPPLY A STR
PUSHJ P,PPN2DR ;TRANSLATE IT TO A DIR NUMBER
JRST RETZER ;UNKNOWN PPN
PUSH P,A ;SAVE DIR NUMBER
UMOVE A,2(CAC) ;GET PPN OF USER
HRROI B,[ASCIZ/DSK/]
PUSHJ P,PPN2DR ;TRANSLATE IT TO DIR NUMBER
JRST RETZER ;ILLEGAL PPN
MOVEM A,STRNG1+.CKALD ;LOGGED IN DIR
MOVEM A,STRNG1+.CKACD ;AND ALSO CONNECTED DIR
SETZM STRNG1+.CKAEC ;NO ENABLED CAPABILITIES
POP P,STRNG1+.CKAUD ;SET UP DIR NUMBER
POP P,STRNG1+.CKAPR ;AND PROTECTION
XCTUU <HLRZ A,0(CAC)> ;GET ACCESS CODE
CAIL A,CHKACL ;IS THIS A LEGAL CODE?
JRST RETZER ;NO
MOVE A,CHKACT(A) ;GET TRANSLATED ACCESS CODE FOR JSYS
MOVEM A,STRNG1+.CKAAC ;STORE FOR THE CHKAC JSYS
MOVEI A,6 ;SIX ARGUMENTS
MOVEI B,STRNG1 ;ADDRESS OF ARGUMENTS
CHKAC ;CHECK THE ACCESS
JRST RETZER ;SOMETHING WAS BAD
SETCA A, ;TOPS-10 LIKES IT -1=FALSE, 0=TRUE
JRST STOTC1 ;GO RETURN ANSWER
CHKACT: .CKACF ;(0) CHANGE PROT
.CKACF ;(1) RENAME
.CKAWT ;(2) WRITE
.CKAWT ;(3) UPDATE
.CKAAP ;(4) APPEND
.CKARD ;(5) READ
.CKAEX ;(6) EXECUTE
.CKACF ;(7) CREATE IN UFD
.CKADR ;(10) READ DIRECTORY
CHKACL==.-CHKACT ;LENGTH OF TABLE
> ;END OF REPEAT 0 AROUND CHKACC
UUFDST: TRNE PF,R.DIRN ;USETI?
JRST MRETN ;NO, ILLEGAL
HRRZ C,FORTY ;HOW MANY BLOCKS TO SKIP
SOSGE C ;GET START OF BLOCK INSTEAD OF END
PUSHJ P,ERRARG ;ILLEGAL ARGUMENT
ASH C,6 ;100 ENTRIES PER DISK BLOCK
MOVSI A,RDMFDF ;SEE IF WE ARE READING MFD
TDNE A,FLAGWD(BB) ;...
JRST UMFDST ;YES, GO SIMULATE IT
SKIPN LSTUFJ ;IS THERE A SAVED UFD?
JRST UUFDS0 ;NO
MOVE A,DIRNUM(BB) ;GET DIR NUM OF UFD
CAMN C,LSTUFP ;IS WORD OF DIR SAME AS SAVED DIR
CAME A,LSTUFD ;AND IS DIR NUM THE SAME AS SAVED UFD?
JRST UUFDS0 ;NO, TOO BAD
HRRZ A,JFNTAB(BB) ;YES, WE WILL USE THE SAVED JFN INSTEAD
MOVE B,LSTUFJ ;GET SAVED JFN
CAIE A,(B) ;THE SAME?
RLJFN ;NO, RELEASE OLD JFN
JFCL
MOVEM B,JFNTAB(BB) ;SAVE NEW JFN
SETZM LSTUFJ ;CLEAR SAVED JFN WORD
MOVEM C,IOBYTP(BB) ;STORE CORRECT POINTER WORD
JRST UUFDSD ;USETI IS DONE
UUFDS0: CAMGE C,IOBYTP(BB) ;DO WE NEED TO BACK UP
JRST UUFDS2 ;YES
SUB C,IOBYTP(BB) ;GET COUNT OF GNJFN'S TO BE DONE
JUMPE C,UUFDSD ;NONE, JUST RETURN
UUFDS1: MOVE A,JFNTAB(BB) ;GET FULL JFN
GNJFN
JRST [MOVSI A,UFDEOF ;NO MORE ENTRIES,
IORM A,FLAGWD(BB); SET UFDEOF FLAG
SETZM JFNTAB(BB) ;GET RID OF RELEASED JFN POINTER
JRST UUSETE] ; AND SET EOF FOR FUTURE INPUT'S
AOS IOBYTP(BB) ;KEEP COUNT OF WHERE WE ARE
SOJG C,UUFDS1 ;LOOP FOR MANY TIMES
JRST UUFDSD ;FINALLY DONE
UUFDS2: HRRZ A,JFNTAB(BB) ;GIVE UP OLD JFN
RLJFN
JFCL
PUSHJ P,ULKUFA ;SET UP NAME AND DIRECTORY
JFCL
MOVEM A,JBLOCK ;SAVE FLAGS
MOVEI A,JBLOCK ;SET UP FOR GTJFN
HRROI B,STRNG1
GTJFN ;GET NEW JFN
PUSHJ P,ERROR ;SHOULD WORK!
MOVEM A,JFNTAB(BB) ;STORE NEW JFN
SETZM IOBYTP(BB) ;MARK THAT WE STARTED OVER
JRST UUFDST ;GO TRY AGAIN
UMFDST: CAMN C,LSTMFP ;IS THIS TO A KNOWN PLACE
JRST [MOVEM C,IOBYTP(BB) ;YES, SAVE POINTER
MOVE C,LSTMFN ;GET LAST DIR NUMBER USED
MOVEM C,MFDPT(BB)
JRST UUFDSD] ;USETI IS DONE
CAMGE C,IOBYTP(BB) ;DO WE NEED TO BACK UP?
JRST [SETZM IOBYTP(BB) ;RESET POINTER
MOVEI A,1 ;SET DIR NUM TO 1
HRRM A,MFDPT(BB)
JRST .+1]
SUB C,IOBYTP(BB) ;GET COUNT OF DIR'S TO BE SKIPPED
JUMPE C,UUFDSD ;IF NONE, JUST RETURN
UMFDS1: PUSHJ P,RDMFD ;GET NEXT DIR
MOVSI A,UFDEOF ;ALL THROUGH?
TDNE A,FLAGWD(BB) ;...
JRST UUSETE ;YES, GO SET EOF
SOJG C,UMFDS1 ;LOOP BACK
UUFDSD: MOVE A,[XWD UFDEOF,1B22] ;TURN OFF ALL EOF BITS
ANDCAM A,FLAGWD(BB)
JRST MRETN ;DONE
ULKUFA: MOVE D,DIRNUM(BB) ;UFD HAS BEEN LOOKED UP ONCE
JRST ULKUF1 ;SO DONT NEED TO TRANSLATE DIR NUMBER
ULKUFD: MOVE D,FILNAM(BB) ;GET UFD #
MOVE A,DEVNAM(BB) ;GET SIXBIT STR NAME
CAMN D,[XWD 1,1] ;IS THIS THE MFD
JRST ULKMFD ;YES
PUSHJ P,GETDR0 ;GET MATCHING DIRECTORY NUMBER
POPJ P, ;GIVE ERROR RETURN
MOVEM D,DIRNUM(BB) ;STORE NEW DIRECTORY NUMBER
ULKUF1: MOVSI A,RDUFDF ;MARK THAT WE ARE READING A UFD
IORM A,FLAGWD(BB)
HRROI A,STRNG1 ;SET UP THE MAIN STRING
MOVE B,D ;GET DIR NUMBER
DIRST ;PUT STR:<DIR> IN MAIN STRING
HRROI A,STRNG1 ;FAILED, RESET STRING POINTER
HRROI B,[ASCIZ/*.*.0/] ;FINISH THE MAIN STRING
SETZ C,
SOUT
MOVSI A,100100 ;SET UP PROPER FLAGS
JRST CPOPJ1 ;SKIP RETURN
ULKMFD: PUSHJ P,GETDR0 ;GET A DIR NUMBER
POPJ P, ;NONE, FAIL RETURN
HRRI D,1 ;START AT DIR NUMBER 1
MOVEM D,MFDPT(BB) ;INITIALIZE MFD POINTER
MOVSI A,RDUFDF!RDMFDF ;SET PORPER FLAGS
IORM A,FLAGWD(BB) ; IN FLAG WORD
POP P,(P) ;DONT POPJ AND DO GTJFN
SETOM JFNTAB(BB) ;SO OPENX WONT COMPLAIN
JRST ULK7 ;THERE IS NO JFN FOR THIS SIMULATION
INDUFD: TLNE B,UFDEOF ;IS THIS THE END
JRST INDM4B ;YES, GO SET EOF BIT
PUSH P,D ;SAVE THE COMMAND LIST POINTER
INDUF1: MOVE D,FLAGWD(BB) ;GET FLAGS
TLNE D,UFDEOF ;ARE WE THROUGH?
JRST INDUFE ;YES, GO CLEAR REST OF BUFFER
PUSHJ P,RDUFD ;NO, GO GET NEXT FILE NAME
JUMPE D,INDUF1 ;IF NO NAME LOOP BACK
UMOVEM D,1(C) ;STORE FILE NAME
AOBJP C,INDUE1 ;END OF COMMAND?
UMOVEM E,1(C) ;NO, STORE EXTENSION
AOBJP C,INDUE1 ; END OF COMMAND?
JRST INDUF1 ;NO, LOOP BACK AGAIN
INDUFE: XCTUU <SETZM 1(C)> ;ZERO THE REST OF THE COMMAND
AOBJN C,INDUFE
INDUE1: POP P,D
AOJA D,INCML ;GO SEE IF MORE COMMANDS
RDUFD: MOVE D,FLAGWD(BB) ;GET FLAGS
TLNE D,RDMFDF ;READING MFD?
JRST RDMFD ;YES, GO DO IT INSTEAD
PUSH P,C
RDUFD1: HRRZ B,JFNTAB(BB) ;GET RH OF JFN ONLY FOR JFNS
HRROI A,STRNG1 ;SET UP TEMPORARY STRING POINTER
MOVE C,[XWD 1100,2] ;GET NAME AND EXT SEPARATED BY TAB
JFNS
MOVE A,[POINT 7,STRNG1] ;NOW DO ASCII TO SIX BIT CONVERSION
MOVE B,[POINT 6,D]
SETZB D,E
MOVEI C,6 ;6 CHARACTER NAME ONLY
RDULP: ILDB F,A ;GET ASCII CHARACTER
CAIN F,C.CNTV ;CONTROL-V?
ILDB F,A ;YES, GET NEXT CHAR
CAIN F,C.TAB ;TAB?
JRST RDUEXT ;YES, GO READ THE EXTENSION
SUBI F,40 ;MAKE SIXBIT
IDPB F,B ;STORE IN D
SOJG C,RDULP ;LOOP BACK FOR MORE
ILDB F,A ;SCAN FOR A TAB
CAIE F,C.TAB ;SINCE LONGER THAN 6 CHARACTER NAMES ALLOWED
JRST LNGFIL ;LONG FILES ARE NOT ALLOWED
RDUEXT: MOVEI C,3 ;3 CHARACTER EXTENSION MAXIMUM
MOVE B,[POINT 6,E]
RDULP1: ILDB F,A ;GET ASCII CHAR
JUMPE F,RDUFDN ;DONE?
SUBI F,40 ;NO, MAKE IT SIXBIT
IDPB F,B ;STORE IN E
SOJG C,RDULP1 ;LOOP BACK
ILDB F,A ;GET NEXT CHARACTER IN EXTENSION
JUMPN F,LNGFIL ;TOO LONG? DONT ALLOW LONG FILES.
RDUFDN: HRRZ A,JFNTAB(BB) ;GET JFN
MOVE B,[XWD 1,7] ;SET UP TO GET FILE VERSION #
MOVEI C,C ;INTO AC C
GTFDB
ERJMP .+1
HLR E,C ;SAVE VERSION # IN RH OF EXTENSION WORD
AOS IOBYTP(BB) ;COUNT UP # OF FILES SEEN
MOVE A,JFNTAB(BB) ;ADVANCE THE JFN POINTER
GNJFN ;ADVANCE JFN
RDUFDE: JRST [ MOVSI B,UFDEOF
IORM B,FLAGWD(BB) ;NO MORE FILES, SET EOF FOR NEXT TIME
SETZM JFNTAB(BB) ;MARK THAT THE JFN WAS RELEASED
JRST .+1]
POP P,C
POPJ P, ;RETURN
LNGFIL: SETZB D,E ;NO FILE NAME THIS TIME
MOVE A,JFNTAB(BB) ;ADVANCE THE FILE POINTER
GNJFN
JRST RDUFDE ;NO MORE FILES
JRST RDUFD1 ;LOOP BACK FOR NEXT FILE NAME
RDMFD: HRROI A,STRNG1 ;SET UP DUMMY STRING POINTER
MOVE B,MFDPT(BB) ;GET CURRENT MFD POINTER
DIRST ;SEE IF THIS DIRECTORY NUMBER EXISTS
JRST NODIR ;IT DOESNT
MOVE A,MFDPT(BB) ;GET DIR NUMBER
PUSHJ P,PPNUNM ;GET PPN
MOVE D,A ;INTO AC D
MOVSI E,'UFD' ;MAKE THIS A UFD ENTRY
AOS A,MFDPT(BB) ;COUNT UP DIR POINTER
MOVEM A,LSTMFN ;SAVE LAST NUMBER POINTED TO
SETZM NOMFDC(BB) ;SEEN A LEGAL DIR #
AOS A,IOBYTP(BB) ;COUNT UP BYTE POINTER
MOVEM A,LSTMFP ;SAVE LAST MFD POINTER VALUE
POPJ P, ;AND RETURN
NODIR: MOVSI B,UFDEOF ;PREPARE FOR EOF
AOS MFDPT(BB) ;COUNT UP DIR POINTER
AOS A,NOMFDC(BB) ;GET CURRENT COUNT OF ILLEGAL DIR'S
CAIG A,MAXDIR ;DONE?
JRST RDMFD ;NO, GO LOOK FOR ANOTHER DIR
IORM B,FLAGWD(BB) ;SET EOF BIT
SETZB D,E ;CLEAR NAME AND EXTENSION
POPJ P, ;RETURN WITHOUT COUNTING UP IOBYTP
INUFD: MOVN A,IOCNT ;GET NEG WORD COUNT
HRL C,A
HRR C,IOBPT
INUFD1: MOVE A,FLAGWD(BB) ;GET FLAGS
TLNE A,UFDEOF ;ARE WE DONE?
JRST INUFD2 ;YES, GO SET EOF
PUSHJ P,RDUFD ;NO, GO GET NEXT FILE NAME
JUMPE D,INUFD1 ;IF NO NAME DONT STORE IT
UMOVEM D,1(C) ;STORE NAME
UMOVEM E,2(C) ;AND EXTENSION
ADD C,[XWD 2,2] ;UPDATE C
SKIPGE C ;DID WE FINISH A FULL BUFFER
JRST INUFD1 ;NO, GO GET NEXT FILE NAME
INUFD2: HLRES C ;NOW UPDATE IOCNT AND IOBPT
ADD C,IOCNT ;GET WORDS NOT USED
JUMPE C,INTY8A ;IF NO WORDS PUT IN BUFFER, GIVE EOF
ADDM C,IOBPT ;UPDATE IOBPT
MOVNS C
ADDM C,IOCNT ;AND IOCNT
JRST INTTY9 ;AND RETURN TO USER
SLEEP: MOVE A,CAC ;NUMBER OF SECONDS TO SLEEP
IMULI A,^D60 ;CONVERT TO JIFFIES
ANDI A,7777 ;TRUNCATE TO 12 BITS
;THIS EXTRA CONVERSION MAKES SLEEP ^D751 WORK
;WHICH SOME FOLKS EXPECT TO TURN INTO 4 JIFFIES
IMULI A,^D1000 ;CONVERT SECONDS TO MS
IDIVI A,^D60 ;GET IT BACK INTO MILLISECONDS
SKIPG A ;IS TIME 0
MOVEI A,^D16 ;YES, ALWAYS SLEEP 16 MS
PUSH P,[MRETN] ;SET UP RETURN PC
HRRZ B,A ;SAVE LAST HIBERNATE REQUEST
HRLI B,(HB.RPT) ;ALWAYS MAKE SLEEP WAKE ON PTY ACTIVITY
MOVEM B,HIBWRD
SETOM IOWATF ;ALLOW PTY'S TO WAKE US UP
JRST IOWAT1 ;GO TO SLEEP FOR SEPCIFIED AMOUNT
HB.RTC=1B14 ;WAKE ON CHARACTER READY
HB.RTL=1B13 ;WAKE ON LINE READY
HB.RPT=1B12 ;WAKE ON PTY ACTIVITY
HIBER: PUSH P,[HIBER2] ;SET UP RETURN
MOVEM CAC,HIBWRD ;REMEMBER LAST COMMAND
TLNE CAC,(HB.RPT!HB.RTC!HB.RTL)
SETOM IOWATF ;ENABLE FOR WAKE UPS
TLNE CAC,(HB.RTC!HB.RTL) ;ENABLED FOR TTY WAKEUP?
JRST STTTYF ;YES, GO START THE TTY FORK
HIBER1: HRRZ A,CAC ;GET SLEEP TIME
JUMPE A,IOWAIT ;IF ZERO, DO AN INFINITE SLEEP
JRST IOWAT1 ;GO SLEEP FOR SPECIFIED TIME
STTTYF: SKIPE TTLINE ;LINE ALREADY THERE?
POPJ P, ;YES, RETURN IMMEDIATELY
TLNN CAC,(HB.RTL) ;WAITING FOR A LINE?
SKIPG TTCNT ;NO, ANY CHARACTERS ALREADY?
SKIPA A,TTYFRK ;NO, GET TTY FORK HANDLE
POPJ P, ;THERE IS A CHAR, SO JUST RETURN
JUMPN A,STTTY1 ;IF THERE IS A FORK ALREADY, GO USE IT
MOVE A,[XWD 640000,TTFKST]
MOVEI B,0 ;CREATE A FORK IN SAME SPACE WITH SAME ACS
CFORK ;AND START IT AT TTFKST
PUSHJ P,ERROR ;SOMETHING WENT WRONG
MOVEM A,TTYFRK ;SAVE FORK HANDLE
STTTY1: FFORK ;FREEZE THE FORK
MOVEI B,0 ;SET THE ACS TO COPY OF THIS FORKS
SFACS
MOVEI B,TTFKST ;GET STARTING ADR
SFORK ;START THE FORK
TLO PF,L.TFA ;MARK THAT FORK IS NOW ACTIVE
RFORK ;AND THAW IT
JRST HIBER1 ;THEN GO TO SLEEP
HIBER2: SKIPN A,TTYFRK ;HERE WHEN WOKEN UP
JRST MRETN2 ;NO TTYFRK TO FREEZE
TLZE PF,L.TFA ;IS THE TTY FORK ACTIVE?
FFORK ;YES, ALWAYS FREEZE IT
JRST MRETN2 ;SUCCESFUL RETURN
TTFKST: MOVE P,[IOWD FPDLEN,FRKPDL]
MOVEI A,PRIJFN ;GET PRIMARY INPUT JFN
MOVE E,TYSTAT ;GET TTY STATUS WORD
TLNN E,TT.BIN ;BINARY MODE?
TLNE CAC,(HB.RTC) ;OR CHARACTER MODE?
TLOA E,TT.BKE ;YES, SET BREAK ON EVERYTHING
TLZ E,TT.BKE ;NO, CLEAR BKE
PUSHJ P,TTPSTS ;SET UP NEW MODE
PUSHJ P,TTFILL ;GO SEE IF ANY CHARACTERS THERE
PUSHJ P,TTFILW ;NO, GO WAIT FOR ONE
HALTF ;HALT
PUSHJ P,BUGSTP ;IF CONTINUED, PRINT ERROR MESSAGE
WAKE: CAME CAC,JOB ;DOING A WAKE ON HIMSELF?
JUMPG CAC,WAKE1 ;GO WAKE THE DESIRED JOB
SETOM WAKEF ;MARK THAT HIBER SHOULD WAKE UP ONCE
JRST MRETN2 ;SKIP RETURN
WAKE1: HRRZ A,CAC ;GET JOB NUMBER TO BE WOKEN
TWAKE ;WAKE IT ******** TEMPORARY
JFCL
JRST MRETN2
;PTY SIMULATION ROUTINES
PTYSTF: MOVEI B,1B19!1B20 ;OPEN THE PTY FOR READ AND WRITE
PUSHJ P,OPENX
POPJ P, ;OPEN FAILED, GIVE ERROR RETURN
MOVSI B,IOPENF!OOPENF ;MARK THIS IN FLAGWD
IORM B,FLAGWD(BB)
HRRZ A,JFNTAB(BB) ;NOW ENABLE INTERUPTS FOR THIS PTY
MOVE B,[1B0+1B1+<IOCHN>B17+24]
MTOPR
ERJMP . ;IGNORE ERRORS
JRST CPOPJ1
OPNPTY: MOVSI A,IOPENF!OOPENF ;MARK THAT IT WAS OPENED FOR BOTH
IORM A,FLAGWD(BB) ;INPUT AND OUTPUT
JRST CPOPJ1
INPTY: HRRZ A,DEVNUM(BB) ;GET UNIT #
ADD A,FIRPTY ;MAKE TTY #
IORI A,TTYDSG ;MAKE IT A FILE DESIGNATOR
SOBE ;ANY CHARACTERS TO GET?
SKIPN A,JFNTAB(BB) ;YES, GO READ IN ONE
JRST INTTY9 ;NO, WE ARE THROUGH
HRRZS A
MOVE C,B ;SAVE COUNT OF CHARACTERS IN BUFFER
INPTY1: SOSGE IOCNT ;ANY MORE TO DO?
JRST INDON1 ;NO, RETURN TO CALLER
BIN ;READ IN NEXT CHAR
IDPB B,IOBPT ;STORE IN USERS BUFFER
SOJG C,INPTY1 ;LOOP BACK FOR MORE
JRST INPTY ;SEE IF MORE CHARS JUST CAME IN
OUTPTY: PUSHJ P,PTYSHD ;YES, GO SET HALF DUPLEX MODE
PUSHJ P,PTYPRM ;GO SEE IF PTY NEEDS PRIMING
JRST OUTPT4 ;NEEDS A CONTROL-C
JRST OUTPT0 ;DOES NOT NEED A CONTROL-C, JUST WAIT
JRST OUTPT1 ;DOES NOT NEED PRIMING
OUTPT4: SKIPG C,IOCNT ;SET UP TO SCAN FOR A ^C IN BUFFER
POPJ P, ;NO MORE CHARACTERS
MOVE A,IOBPT ;...
OUTPT3: ILDB B,A ;GET A CHARACTER
CAIN B,C.CC ;IS THIS A CONTROL-C
SOJA C,[MOVEM C,IOCNT ;SET BUFFER PAST THIS ^C
MOVEM A,IOBPT
JRST OUTPT4] ;GO SEND A CONTROL-C
SKIPN B ;IS THIS A NULL
SOJG C,OUTPT3 ;LOOP BACK UNTIL A NON-NULL IS SEEN
OUTPT2: MOVE A,JFNTAB(BB) ;GET THE JFN FOR THIS PTY
MOVEI B,C.CC ;SEND OUT A CONTROL-C TO PRIME LINE
BOUT
MOVEI C,^D300 ;LOOP FOR 30 SECONDS ONLY
OUTPT0: MOVEI A,^D100 ;AND SLEEP SOME
IJSYS (DISMS)
PUSHJ P,PTYPRM ;LINE STILL NEED PRIMING?
JRST OUTPTY ;NEEDS A CONTROL-C
SOJG C,OUTPT0 ;LOOP BACK UNTIL LINE IS PRIME
OUTPT1: SOSGE IOCNT ;ANY CHARS TO SEND OUT
POPJ P, ;NO
XCTLB <ILDB B,IOBPT> ;GET NEXT CHAR
JUMPE B,OUTPT1 ;SKIP NULLS
HRRZ A,JFNTAB(BB) ;GET JFN FOR PTY
MOVSI C,PTYCRF ;GET <CR> FLAG
CAIN B,C.LF ;SENDING OUT A LINE FEED?
TDNN C,FLAGWD(BB) ;WAS LAST CHAR A <CR>
BOUT ;SEND OUT CHAR (EXCEPT <CR>)
ANDCAM C,FLAGWD(BB) ;CLEAR <CR> FLAG
CAIN B,C.CR ;DID WE JUST SEND A <CR>
IORM C,FLAGWD(BB) ;YES, SET <CR> FLAG
MOVSI C,PTYCWF ;PREPARE TO SET ^C BIT
CAIN B,C.CC ;WAS THIS A ^C?
IORM C,FLAGWD(BB) ;YES, REMEMBER THAT
AOS C,IOBYTP(BB) ;COUNT UP CHARACTERS SENT OUT
CAIN B,C.CR ;WAS THIS A BREAK CHARACTER?
SETZB C,IOBYTP(BB) ;YES, CLEAR THE COUNT
CAIGE C,^D80 ;FULL BUFFER?
JRST OUTPT1 ;NO, LOOP BACK
HRRZ A,DEVNUM(BB) ;GET UNIT NUMBER
ADD A,FIRPTY ;GET TTY NUMBER
IORI A,TTYDSG ;MAKE DEVICE DESIGNATOR
RFMOD ;FORCE THIS BUFFER OUT
SFMOD
SETZM IOBYTP(BB) ;CLEAR COUNT
MOVE A,JFNTAB(BB) ;RESTORE JFN
JRST OUTPT1 ;LOOP BACK UNTIL DONE
PTYSHD: HRRZ A,DEVNUM(BB) ;GET PTY UNIT #
ADD A,FIRPTY ;MAKE IT INTO A TTY #
IORI A,TTYDSG ;CREATE TTY DEVICE DESIGNATOR
RFMOD ;GET TTY CHARACTERISTICS
TRC B,3B33 ;IS LINE HALF DUPLEX ALREADY?
TRCN B,3B33 ;...
POPJ P, ;YES, DONT DO STPAR
IORI B,3B33 ;SET LINE HALF DUPLEX
STPAR
POPJ P, ;RETURN
PTYPRM: SYSGET (<TTYJOB>) ;SEE IF PTY IS PRIMED FOR OUTPUT
HRRZ A,DEVNUM(BB) ;GET UNIT NUMBER
ADD A,FIRPTY ;TURN IT INTO TTY NUMBER
HRLZS A
HRR A,B ;GET TABLE NUMBER FOR TTYJOB
GETAB
JRST CPOPJ1 ;FAILED, TRY TO SEND ANYWAY
JUMPGE A,CPOPJ2 ;LINE IS PRIMED
TLC A,-1 ;SEE IF LINE NEEDS A CONTROL-C
TLCE A,-1 ;-1 MEANS YES, -2 MEANS NO
JRST CPOPJ1 ;-2 GIVE SINGLE SKIP RETURN
POPJ P, ;LINE NEEDS PRIMING
TTYINT: MOVEM A,IAC+A ;SAVE AN AC
MOVSI A,(HB.RTC!HB.RTL) ;GET TTY WAKE UP BITS
JRST PTYIN1 ;GO OR THEM INTO WAKEF
PTYINT: MOVEM A,IAC+A ;SAVE AN AC
MOVSI A,(HB.RPT) ;SET PTY ACTIVITY FLAG
PTYIN1: IORM A,WAKEF ;SET WAKE UP FLAG WITH WAKE CONDITIONS
SKIPE INPAT ;IN COMPATIBILITY PACKAGE?
SKIPN IOWATF ;YES, WAITING FOR INPUT OR OUTPUT
JRST IOINR ;NO, JUST RETURN
MOVE A,HIBWRD ;GET LAST HIBERNATE WORD
TDNN A,WAKEF ;SEE IF JOB SHOULD BE WOKEN
JRST IOINR ;NO, JUST RETURN
POP P,RETSAV ;YES, DISMIS TO DIFFERENT ADDR
SETZM WAKEF ;MARK THAT A WAKE WAS DONE
SETZM IOWATF ;CLEAR IO FLAG SO WE DONT COME HERE AGAIN
IOINR: MOVE A,IAC+A ;RESTORE AC
DEBRK
IOWAIT: MOVSI A,100000 ;WAIT FOR A LONG LONG TIME
IOWAT1: MOVE B,A ;
SKIPN UIFLAG ;USER INTERUPT WAITING?
SKIPE CSTFLG ;OR ^C BEEN TYPED?
JRST CCTRAP ;YES, DONT GO TO SLEEP
IOWAT3: SKIPN A,B ;IS IT ZERO STILL
MOVEI A,1 ;YES, SLEEP FOR AT LEAST 1 MS
MOVE B,HIBWRD ;GET FLAGS
TDNE B,WAKEF ;SEEN A WAKE YET
JRST IOWAT2 ;YES, DONT SLEEP
IOWAT4: IJSYS (DISMS) ;NO, GO TO SLEEP
IOWAT2: SETZM IOWATF ;CLEAR IO WAIT FLAG
SETZM WAKEF ;CLEAR EVENT FLAG
POPJ P, ; BEFORE STARTING AGAIN
GETPTY: PUSH P,A ;GET A PHYSICAL PTY
MOVSI A,600000+PTY ;PTY DEV DESIGNATOR
GETPT1: MOVE B,A ;SAVE A
HRROI A,STRNG1 ;SEE IF DEVICE IS LEGAL
DEVST
JRST [ MOVSI C,'PTY'
JRST GETPT4] ;DEVICE NOT LEGAL, NO MORE PTY'S
MOVE A,B
DVCHR ;GET CHARACTERISTICS
TLNN B,(1B5) ;IS THIS DEVICE AVAILABLE
AOJA A,GETPT1 ;NO TRY AGAIN
HRRZ D,A ;GET DEVICE #
PUSHJ P,GETPT6 ;GET 6 BIT PTY NAME
MOVEI B,17 ;NOW SEE IF THIS DEV IS ALREADY INITED
SETZ D,
GETPT3: CAME D,BB ;SAME CHANNEL #?
CAME C,DEVNAM(D) ;MATCH?
SKIPA ;NO MATCH OR SAME CHANNEL
AOJA A,GETPT1 ;YES, GO TRY FOR ANOTHER
ADDI D,NTABS ;UPDATE INDEX
SOJGE B,GETPT3 ;LOOP FOR ALL CHANNELS
GETPT4: POP P,A
POPJ P, ;RETURN WITH PTY NAME IN C
GETPT6: MOVSI C,'PTY' ;SET UP ANSWER AC
MOVE B,[POINT 6,C,17]
GETPT2: IDIVI D,10 ;GET LOW ORDER CHARACTER
ADDI E,20 ;MAKE IT SIXBIT
PUSH P,E ;SAVE IT
SKIPE D ;DONE YET?
PUSHJ P,GETPT2 ;NO, GO GET NEXT CHAR
POP P,E ;POP OFF NEXT CHAR
IDPB E,B ;PUT IT IN C
POPJ P, ;RETURN
JOBSTS: JUMPL CAC,JBSJOB ;THIS IS A JOB NUMBER
MOVE BB,CAC ;GET CHANNEL #
IMULI BB,NTABS ;GET INDEX VALUE
LDB AA,PDVNUM ;GET DEVICE TYPE
CAIE AA,PTY ;IS IT A PTY?
JRST RETZER ;NO, THIS IS AN ERROR
HRRE A,DEVNUM(BB) ;GET PTY UNIT NUMBER
JUMPL A,BUGSTP
ADD A,FIRPTY ;TURN IT INTO A TTY NUMBER
MOVEM A,STRNG1+.JITNO ;SAVE TERMINAL NUMBER
IORI A,TTYDSG ;MAKE IT A TTY NUMBER
PUSHJ P,DGETJI ;DO THE GETJI
SETOM STRNG1+.JIJNO ;FLAG NO JOB ON TTY
JOBST0: PUSHJ P,JOBST2 ;GET BITS IN E
JRST RETZER ;SOMETHING WAS WRONG, GIVE ERROR RETURN
MOVE A,E ;GET ANSWER
JRST STOTC1 ;RETURN
JOBST2: SETZ E, ;INITIALIZE ANSWER
SKIPGE STRNG1+.JIJNO ;IS THIS JOB LOGGED IN?
JRST JBST2B ;NO
HRRZ A,JFNTAB(BB) ;NOW CHECK FOR TTY HUNGRY
MOVEI B,25
MTOPR ;0=NOT HUNGRY -1=HUNGRY
ERJMP .+1 ;IGNORE ERRORS
SKIPE B
TLO E,(1B4) ;MARK THAT TTY IS HUNGRY
JBST2B: SKIPGE A,STRNG1+.JITNO ;GET TTY NUMBER
JRST JBST2A ;THERE ISNT ONE
IORI A,TTYDSG ;XWD 0,400000+TTY#
SOBE ;IS BUFFER EMPTY
TLO E,(1B3) ;NO, MARK THAT OUTPUT IS READY
JBST2A: SKIPG A,STRNG1+.JIJNO ;IS THE JOB LOGGED IN?
TLO E,(1B4) ;NO, SET HUNGRY BIT
JUMPL A,JOBST1 ;IF NO JOB, SET MONITOR MODE BIT
TLO E,(1B0) ; SET JOB # ASSIGNED BIT
HRR E,A ;STORE TSS JOB #
SKIPE STRNG1+.JIUNO ;IS JOB LOGGED IN?
TLO E,(1B1) ;YES, THEN JOB IS LOGGED IN
PUSHJ P,SKPUSR ;SEE IF IN USER MODE
JOBST1: TLO E,(1B2) ;LITE MONITOR MODE BIT
MOVSI A,PTYCWF ;CHECK IF JOB WAITING FOR ^C
TDNN A,FLAGWD(BB)
JRST CPOPJ1 ;NO, THEN OK TO RETURN
TLNN E,(1B2) ;YES, IS JOB IN MONITOR MODE ALREADY?
TLZA E,(1B4) ;NO, CLEAR INPUT WAIT BIT
ANDCAM A,FLAGWD(BB) ;IN MONITOR MODE, CLEAR ^C BIT
JRST CPOPJ1
;ROUTINE TO GET JOB NAME IN A
;CALL WITH JOB NUMBER IN RH OF E
GTJBNM: HRRZ A,E ;GET JOB NUMBER
MOVE B,[-1,,STRNG1] ;GET JOB NAME
MOVEI C,.JIPNM
GETJI
JRST [ CAIE A,GTJIX4 ;NOT LOGGED IN ERROR?
POPJ P, ;NO, ERROR
SETZ A, ;RETURN 0 JOB NAME
JRST CPOPJ1]
MOVE A,STRNG1 ;GET NAME
JRST CPOPJ1 ;SKIP RETURN WITH NAME IN A
JBSJOB: MOVN A,CAC ;GET JOB NUMBER
PUSHJ P,DGETJI ;DO THE GETJI
JRST RETZR1 ;ILLEGAL #
SKIPN STRNG1+.JIUNO ;IS JOB LOGGED IN?
JRST RETZR1 ;NO, GIVE BAD RETURN
SKIPG D,STRNG1+.JITNO ;GET TTY NUMBER
JRST JOBST3 ;-1 MEANS NO TTY FOR JOB
SUB D,FIRPTY ;GET PTY NUMBER FROM TTY NUMBER
HRLI D,600000+PTY ;GET DEVICE DESIGNATOR
SETZB B,BB ;NOW SEE IF THIS PTY IS INITED
JBSJ0: CAMN D,DEVNUM(BB) ;MATCH?
JRST JOBST0 ;YES, GO DO UUO
CAIL B,17 ;CHECKED ALL CHANNELS
JRST JOBST3 ;YES, GIVE ERROR RETURN
ADDI BB,NTABS ;INCREMENT INDEX
AOJA B,JBSJ0 ;LOOP BACK FOR ALL CHANNELS
JOBST3: MOVN A,CAC ;GET JOB NUMBER IN RH OF A
HRLI A,(1B0!1B1) ;MARK THAT JOB IS LOGGED IN
JRST STOTC1 ;GIVE THIS PARTIAL ANSWER TO CALLER
PTYSTS: HRRE A,DEVNUM(BB) ;GET TTY NUMBER
JUMPL A,BUGSTP ;ERROR IF NEGATIVE
ADD A,FIRPTY ;GET TTY #
MOVEM A,STRNG1+.JITNO ;SAVE TERMINAL #
IORI A,TTYDSG ;GET DEVICE DESIGNATOR
PUSHJ P,DGETJI ;DO THE GETJI
SETOM STRNG1+.JIJNO ;MARK NO JOB
PUSHJ P,JOBST2 ;GET BITS IN LH OF E
JFCL ;IGNORE ERROR RETURN
TLNE E,(1B3) ;ANY OUTPUT READY?
TRO E,1B25 ;YES
TLNE E,(1B4) ;INPUT WANTED?
TRO E,1B24 ;YES
TLNE E,(1B2) ;MONITOR MODE?
TRO E,1B26 ;YES
ANDI E,7000 ;GET ONLY DESIRED BITS
HRRZ A,FLAGWD(BB) ;GET OTHER STATUS BITS
TRO A,(E) ;SET PTY DEPENDENT STATUS BITS
POPJ P, ;AND RETURN
UTPCLR: PUSHJ P,SETUPG
JRST MRETN
CAIE AA,DTA ;IS IT DECTAPE?
JRST MRETN ;NO, UTPCLR IS A NOP
PUSHJ P,DTAINI ;GO CLOSE ANY OPEN JFNS FOR THIS DTA
MOVE A,DEVNUM(BB) ;GET DECTAPE DEVICE DESIGNATOR
INIDR
PUSHJ P,ERROR
JRST MRETN
;MNTFAI CHECKS IF AN ERROR WAS CAUSED BECAUSE THE DEVICE WAS NOT MOUNTED
;MNTFAI IS CALLED WITH A PUSHJ SO THAT ERROR WILL TYPE OUT A REASONABLE
; ERROR ADDRESS.
;MNTFAI GIVES A NO SKIP RETURN IF THE USER DOES NOT WANT THE TRAP
; AND A SKIP RETURN IF THE DEVICE IS NOT MOUNTED AND NO TRAP IS SET UP
MNTFAI: CAIN A,GJFX28 ;NOT MOUNTED?
JRST MNTFA1 ;YES
CAIE A,MNTX2 ;AND IS DEVICE NOT MOUNTED?
CAIN A,OPNX8 ;ANOTHER UNMOUNTED MESSAGE TYPE
SKIPA ;DEVICE IS NOT MOUNTED, GO TRAP
POPJ P, ;ERROR
MNTFA1: PUSHJ P,DOKTRP ;GO SEE IF OK TO TRAP
JRST CPOPJ1 ;LET CALLER TYPE MESSAGE OR WHATEVER
JRST MRETN ;TRAP TO C(.JBINT)
DOKTRP: HRRZ A,.JBINT ;GET TRAP VECTOR
JUMPE A,CPOPJ ;IF NOT SET UP JUST RETURN
XCTUU <SKIPE 2(A)> ;IS PC ZERO
POPJ P, ;NO, GIVE ERROR RETURN
UMOVE B,1(A) ;GET FLAGS
TRNN B,1B35 ;IS THIS USER SET UP FOR DEVICE TRAPS
POPJ P, ;NO
UMOVE C,0(A) ;GET ENTRY ADDRESS
HRRM C,PDL ;STORE FOR RETURN
SOS B,JOBPD1 ;GET USER PC
UMOVEM B,2(A) ;STORE TRAPPED ADR
HRRI B,0(AC) ;GET CHANNEL #
HRLI B,1B35 ;SET TYPE OF TRAP
UMOVEM B,3(A) ;STORE FOR USER
JRST CPOPJ1 ;SKIP RETURN
DTAMNT: HRRZ A,DEVNUM(BB) ;GET THE DEVICE NUMBER
HRLI A,600003 ;MOUNT AND READ THE DIRECTORY
MOUNT ;NO, DO THE MOUNT
POPJ P,
MOVSI C,DTAMF ;MARK THAT DTA WAS MOUNTED
IORM C,FLAGWD(BB) ;SET THAT WE DID A MOUNT
JRST CPOPJ1
DTMNTF: PUSHJ P,MNTFAI ;GO SEE IF IT NEEDS TRAPING
PUSHJ P,ERROR ;NO, TYPE ERROR MESSAGE
DTMNT1: TMSG <$? PA1050: DEVICE >
PUSHJ P,TMSGDV
TMSG <: NOT MOUNTED$>
JRST EXITM1 ;EXIT TO MONITOR AND DO UUO OVER
; AGAIN IF USER TYPES CONTINUE
UUGETF: PUSHJ P,SETUP ;GET AA AND BB
MOVE A,FLAGWD(BB) ;CHECK FOR A LOOKUP OR ENTER
TLNN A,LOOKPF!ENTERF
JRST MRETN ;IF NOT MAKE THIS A NOP
PUSHJ P,PTRGET ;FIRST FREE WORD
JRST MRETN
IDIV B,DEVTB2(AA)
SKIPE C ;FIRST WORD OF BUFFER?
ADDI B,1 ;NO-GO TO NEXT BUFF
HRRZ A,FORTY ;TARGET ADDRESS
UMOVEM B,(A)
JRST MRETN
DTASET: PUSHJ P,DTAINI ;CLOSE ANY OPEN JFNS FOR THIS DTA
HRRZ A,JFNTAB(BB)
JUMPG A,DTAST2 ;IS DTA ALREADY OPENED?
PUSHJ P,DTGTJF ;NO, GO GET A JFN FIRST
JRST DTMNTF ;GO PROCESS ERROR
DTAST2: MOVE B,FLAGWD(BB) ;GET FLAGS
TLNN B,OOPENF!IOPENF ;IS DECTAPE ALREADY OPENED?
JRST DTAST3 ;NO, GO OPEN IT
TLNE B,DTADMP ;YES, IS IT IN DUMP MODE?
JRST DTAST4 ;YES, DONT REOPEN IT
HRLI A,(1B0) ;CLOSE IT FIRST
CLOSF
JFCL
DTAST3: PUSHJ P,DTMTND ;MOUNT IT WITHOUT READING DIR
JRST DTMNTF ;MOUNT FAILED
HRRZ A,JFNTAB(BB) ;GET JFN AGAIN
MOVE B,[XWD 447400,300000] ;OPEN IN DUMP MODE
OPENF
PUSHJ P,ERROR
MOVSI B,OOPENF!IOPENF!DTADMP
IORM B,FLAGWD(BB) ;MARK IT AS OPEN
DTAST4: HRRZ A,JFNTAB(BB)
MOVEI B,30 ;DECLARE BLOCK FOR DUMP I/O
HRRZ C,FORTY ;BLOCK TO POSITION TO
TRNN PF,R.DIRN ;DOING USETI
CAIG C,1101 ;HIGHER THAN LIMIT?
SKIPA ;OK, GO DO MTOPR
JRST UUSETE ;OFF THE END, GO SET EOF BIT
MTOPR
ERJMP . ;IGNORE ERRORS
MOVSI A,UFDEOF ;CLEAR EOF INDICATIONS
ANDCAB A,FLAGWD(BB)
TRNN A,100 ;IS THIS MODE 100?
CAIE C,144
JRST MRETN ;MODE 100 OR NOT DIRECTORY BLOCK
MOVSI B,RDUFDF ;READING DIRECTORY
IORM B,FLAGWD(BB) ;SET UFD BIT
JRST MRETN
DTGTJF: PUSHJ P,DTMTND ;GO MOUNT THE TAPE WITHOUT READING DIR
POPJ P, ;MOUNTING FAILED
PUSHJ P,DEV67 ;GET ASCIZ STRING FOR DTA
SETZB B,JBLOCK ;SET UP FOR GTJFN
PUSHJ P,JBKSET ;SET UP JBLOCK
HRROI A,DEVNM7 ;GET DEVICE NAME
MOVEM A,JBLOCK+2
MOVEI A,JBLOCK
GTJFN
PUSHJ P,ERROR
HRRZM A,JFNTAB(BB) ;STORE JFN
JRST CPOPJ1
DTMTND: HRRZ A,DEVNUM(BB) ;GET UNIT NUMBER
HRLI A,640003 ;DONT READ DIRECTORY
MOUNT ;MOUNT THE DTA
POPJ P, ;GIVE ERROR RETURN
MOVSI A,DTAMF ;MARK THAT DTA IS NO LONGER MOUNTED
ANDCAM A,FLAGWD(BB)
JRST CPOPJ1 ;SUCCESSFUL
DTAINI: MOVE E,DEVNUM(BB) ;GET DEVICE DESIGNATOR FOR THIS DTA
MOVNI F,NTABS ;INITIALIZE INDEX INTO CHANNEL TABLE
MOVEI G,20 ;CHECK ALL CHANNELS
DTAINL: ADDI F,NTABS ;INCREMENT INDEX
HRRZ A,JFNTAB(F) ;IS THERE A JFN ON THIS CHANNEL
JUMPE A,DTAIN0 ;NO, DONT BOTHER WITH THIS CHANNEL
CAME F,BB ;IS THIS THE CURRENT CHANNEL
CAME E,DEVNUM(F) ;NO, IS THIS THE SAME DTA
DTAIN0: SOJG G,DTAINL ;NO, LOOP BACK FOR OTHER CHANNELS
JUMPLE G,DTAIN2 ;CHECKED ALL CHANNELS?
MOVE D,FLAGWD(F) ;NO, THIS IS A MATCH
TLNE D,DTACLS ;IS THIS DTA CLOSED ALREADY?
JRST DTAIN0 ;YES, DONT BOTHER WITH IT
HRLI A,(1B0) ;KEEP THE JFN
CLOSF ;BUT CLOSE IT
JFCL
MOVSI B,DTACLS ;MARK THAT THE JFN WAS CLOSED
IORM B,FLAGWD(F)
JRST DTAIN0 ;CHECK OTHER CHANNELS
DTAIN2: HRRZ A,JFNTAB(BB) ;GET JFN IF ANY OF THIS DTA
JUMPE A,CPOPJ ;NONE, THEN WE'RE DONE
MOVE E,FLAGWD(BB) ;GET FLAGS
TLNN E,DTACLS ;WAS THIS JFN CLOSED BEFORE
POPJ P, ;NO, THEN RETURN
TLNE E,DTADMP ;WAS THE TAPE IN DUMP MODE?
JRST DTODMP ;YES, GO MOUNT AND OPEN IT AS SUCH
PUSHJ P,DTAMNT ;GO RE MOUNT THIS TAPE
JRST DTMNTF ;MOUNT FAILED
PUSHJ P,MDTAER ;MULTIPLE DTA FILES OPEN IS NOT ALLOWED
DTODMP: PUSHJ P,DTMTND ;MOUNT THE DTA WITHOUT READING DIR
JRST DTMNTF ;FAILED
MOVE B,[447400,,300000] ;OPEN DTA IN DUMP MODE
OPENF
PUSHJ P,BUGSTP ;FAILED
POPJ P,
;THE TAPOP UUO - ONLY PARTIALLY IMPLEMENTED TO SUPPORT COBOL
TAPOP: PUSH P,AC ;SAVE UUO AC
UMOVE AC,1(CAC) ;GET CHANNEL NUMBER
PUSHJ P,SETUP ;SET UP AA AND BB
POP P,AC ;RESTORE AC VALUE
HRRZ A,JFNTAB(BB) ;GET JFN INTO A IF THERE IS ONE
UMOVE C,2(CAC) ;GET ARGUMENT VALUE
UMOVE D,0(CAC) ;GET FUNCTION
CAIGE D,1000 ;0 - 777?
JRST TAPOP0 ;YES
CAIGE D,2000 ;1000 - 1777?
JRST TAPOP1 ;YES
CAIL D,3000 ;2000 - 2777?
JRST RETZER ;NO, ILLEGAL FUNCTION
ANDI D,777 ;GET INDEX
CAIL D,TAPT2L ;LEGAL INDEX?
JRST RETZER ;NO
JRST @TAPTB2(D) ;DISPATCH FOR THIS FUNCTION
TAPOP0: CAIL D,TAPT0L ;LEGAL FUNCTION?
JRST RETZER ;NO
JRST @TAPTB0(D) ;DISPATCH
TAPOP1: ANDI D,777 ;MASK OFF 1000
CAIL D,TAPT1L ;LEGAL FUNCTION?
JRST RETZER ;NO
JRST @TAPTB1(D) ;YES, DISPATCH
TAPTB0:
TAPT0L==.-TAPTB0
TAPTB1: RETZER ;1000
TAPRDN ;1001 - READ DENSITY
TAPTYP ;1002 - GET CONTROLLER TYPE
TAPRRB ;1003 - SEE IF READING BACKWARDS
RETZER ;1004
RETZER ;1005
RETZER ;1006
TAPRDM ;1007 - READ DATA MODE
TAPT1L==.-TAPTB1
TAPTB2: RETZER ;2000
TAPSDN ;2001 - SET DENSITY
RETZER ;2002
TAPSRB ;2003 - SET READ BACKWARDS
RETZER ;2004
RETZER ;2005
RETZER ;2006
TAPSDM ;2007 - SET DATA MODE
TAPT2L==.-TAPTB2
;GET CONTROLLER TYPE
TAPTYP: MOVEI A,4 ;ALWAYS SAY TM02
JRST STOTC1
;READ DENSITY
TAPRDN: JUMPE A,TPRDN1 ;IF NO JFN, USE MTADEN
GTSTS
JUMPGE B,TPRDN1 ;IF NOT OPEN, USE MTADEN
MOVEI B,.MORDN ;MTA IS OPEN, READ DENSITY DIRECTLY
MTOPR
ERJMP RETZER ;FAILED
SKIPA A,C ;GET ANSWER INTO AC A
TPRDN1: LOAD A,MTADEN ;GET DENSITY
JRST STOTC1 ;AND RETURN
;GET MAGTAPE BUFFER SIZE
GETMBS: SETO A, ;GET THE DATA MODE
HRROI B,C ;INTO C
MOVEI C,.JIDM ;DATA MODE
GETJI
ERJMP CPOPJ
HLRZ F,TPRDMT(C) ;GET THE BYTES PER WORD
SETO A, ;NOW GET DEFAULT RECORDS PER BUFFER
HRROI B,D ;GET ANSWER IN D
MOVEI C,.JIRS ;GET RECORD SIZE IN BYTES
GETJI
JRST CPOPJ ;FAILED
IDIV D,F ;GET NUMBER OF WORDS PER BUFFER
SKIPE E ;ROUND UP TO NEXT HIGHEST WORD
AOS D ;IF NEEDED
MOVE A,D ;GET ANSWER INTO A
JRST CPOPJ1 ;AND RETURN
;READ DATA MODE
TAPRDM: PUSHJ P,TAPRD0 ;GET THE DATA MODE
JRST RETZER ;FAILED, RETURN 0
JRST STOTC1 ;RETURN THE ANSWER
TAPRD0: MOVE B,FLAGWD(BB) ;SEE IF MODE HAS BEEN SET
TLNN B,MTADMS
JRST TPRDM1 ;NO GO GET IT
LOAD A,MTADM ;GET DATA MODE
JRST CPOPJ1 ;RETURN OK
TPRDM1: HRRZ A,JFNTAB(BB) ;GET THE JFN
JUMPE A,TPRDM2 ;IS THERE A JFN
GTSTS ;YES
JUMPGE B,TPRDM2 ;FILE NOT OPEN
MOVEI B,.MORDM ;GET MODE
MTOPR
ERJMP TPRDM2 ;ON FALUIRE GIVE DEFAULT
JRST TPRDM3 ;GO CONVERT MODE TO 10 MODE
TPRDM2: SETO A, ;SET UP TO GET DEFAULT MODE IN C
HRROI B,C
MOVEI C,.JIDM
GETJI ;GET DEFAULT MODE
ERJMP CPOPJ
TPRDM3: HRRZ A,TPRDMT(C) ;CONVERT 20 MODE TO 10 MODE
JRST CPOPJ1
TPRDMT: 1,,0 ;SYSTEM DEFAULT (USE CORE DUMP)
1,,1 ;DUMP MODE 9-TRK
6,,5 ;SIXBIT,7-TRK DUMP MODE
5,,4 ;ANSI ASCII (7 BITS IN 8-BIT BYTE)
4,,2 ;INDUSTRY COMPATIBLE MODE
;SET DENSITY
TAPSDN: STOR C,MTADEN ;STORE DENSITY
JUMPE A,MRETN2 ;IF NO JFN, THEN DONE
GTSTS ;SEE IF OPEN
JUMPGE B,MRETN2 ;IF NOT OPEN, RETURN
MOVEI B,.MOSDN ;MTA IS OPEN
MTOPR ;SET THE DENSITY
ERJMP RETZER ;ILLEGAL DENSITY
JRST MRETN2 ;SUCCESSFUL
;SET DATA MODE
TAPSDM: PUSHJ P,TPSDM ;SAVE DATA MODE
JRST RETZER ;ILLIGAL MODE
JRST MRETN2 ;TAKE SKIP RETURN
TPSDM: MOVSI B,MTADMS ;INDICATE DATA MODE SET
IORM B,FLAGWD(BB)
STOR C,MTADM ;SAVE DATA MODE
SKIPGE C,TPSDMT(C) ;GET DATA MODE
POPJ P, ;ILLEGAL DATA MODE
JUMPE A,CPOPJ1 ;IF NO JFN, THEN RETURN
GTSTS ;SEE IF MTA IS OPEN
JUMPGE B,CPOPJ1 ;IF NOT OPEN, RETURN
MOVEI B,.MOSDM ;SET UP TO SET DATA MODE
HRRZS C ;GET MODE
MTOPR
ERJMP CPOPJ
JRST CPOPJ1 ;RETURN OK
TPSDMT: 1,,.SJDDM ;CORE DUMP
1,,.SJDMC ;CORE DUMP (9 TRACK)
4,,.SJDM8 ;INDUSTRY COMPATIBLE MODE
-1 ;6 BIT MODE (9 TRACK)
5,,.SJDMA ;7 BIT MODE
6,,.SJDM6 ;SIXBIT (7 TRACK)
;READ BACKWARDS FUNCTIONS
TAPRRB: JUMPE A,RETZR1 ;IF NO JFN, THE DIRECTION IS FORWARD
MOVE A,FLAGWD(BB) ;GET FLAGS
TLNN A,MTARDB ;SET TO READ BACKWARDS?
TDZA A,A ;NO, GET A ZERO
MOVEI A,1 ;YES, GET A ONE
JRST STOTC1 ;RETURN ANSWER
TAPSRB: JUMPE A,CMRETN ;IF NO JFN, THIS IS AN ERROR
MOVSI B,MTARDB ;GET READ BACKWARDS FLAG
TRNN C,1 ;WANT TO RESET TO NORMAL READING?
ANDCAM B,FLAGWD(BB) ;YES, CLEAR BIT
TRNE C,1 ;WANT TO READ BACKWARDS INSTEAD?
IORM B,FLAGWD(BB) ;YES, THEN SET THE BIT
JRST MRETN2 ;SUCCESSFUL
UMTAPE: PUSHJ P,SETUP
MOVE A,FLAGWD(BB) ;IS IT INIT'ED?
TLNN A,INITF
PUSHJ P,ERRCHN
CAIN AA,2 ;IS DEVICE A MAGTAPE?
JRST MTAPE0 ;YES
CAIN AA,DTA ;OR A DECTAPE?
TLNE A,LOOKPF!ENTERF ;YES, IS IT ALREADY OPENED FOR A FILE?
JRST MRETN ; NOP
MTAPE0:
REPEAT 0,<
;********** TEMPROARY CODE TO GET AROUND RELEASE 2 MONITOR BUG *****
HRRZ A,FORTY ;GET MTAPE NUMBER
CAIE A,1 ;REWIND?
CAIN A,6 ;FORWARD ON RECORD?
JRST MTAPE6 ;YES
CAIE A,7 ;BACKSPACE ONE RECORD?
CAIN A,11 ;UNLOAD?
JRST MTAPE6 ;YES
CAIE A,16 ;FORWARD 1 FILE?
CAIN A,17 ;BACKSPACE 1 FILE?
JRST MTAPE6 ;YES
JRST MTAPE7 ;NO, DO NOT CLOSE THE JFN
MTAPE6: PUSH P,FORTY ;CLOSE THIS CHANNEL BEFORE ALL MTAPE'S
SETZM FORTY ;CLOSE BOTH SIDES
SETZM IOCNT
PUSHJ P,UCL1K ;KEEP THE JFN
POP P,FORTY ;GET BACK THE UUO
MTAPE7:
> ;END OF REPEAT 1
HRRZ A,JFNTAB(BB) ;GET JFN IF ANY
HRRZ B,FORTY ;GET COMMAND
CAIE B,100 ;HANDLE 100 AND 101 DIFFERENTLY
CAIN B,101
JRST MTAPE5
HRRZ A,JFNTAB(BB) ;GET JFN
JUMPN A,MTAPE2 ;NO GTJFN IF HAVE JFN
CAIE AA,DTA ;DTA?
JRST MTAPE3 ;NO
PUSHJ P,DTMTND ;MOUNT WITH NO DIRECTORY
JRST MTMNTF ;GO TRAP TO USER
MTAPE3: PUSHJ P,JBKSET ;INITIALIZE JBLOCK
PUSHJ P,DEV67 ;MOVE THE NAME TO ASCIZ BLOCK
HRROI A,DEVNM7 ;POINTER TO IT.
MOVEM A,JBLOCK+2 ;DEVICE NAME MTAX
MOVSI A,(GJ%FOU) ;FOR OUTPUT
MOVEM A,JBLOCK
SETZ B,
MOVEI A,JBLOCK
GTJFN
PUSHJ P,ERROR
MOVEM A,JFNTAB(BB)
MTAPE2: GTSTS
JUMPGE B,MTAPE4 ;JUMP IF NOT YET OPENED
PUSHJ P,MTAPE1
JRST MRETN
MTAPE4: MOVE B,[XWD 447400,200000] ;OPEN IN DUMP MODE
HRRZ C,FORTY
CAIE C,3 ;WRITE AN EOF?
CAIN C,13 ;OR ERASE TAPE?
MOVE B,[447400,,100000] ;YES, OPEN IT FOR WRITE
OPENF
PUSHJ P,ERROR
PUSHJ P,MTAPE1
HRLI A,(CO%NRJ) ;OPENED IT ONLY TO DO THE MTOPR.
CLOSF
PUSHJ P,ERROR
JRST MRETN
MTAPE5: MOVEI C,1 ;SET FOR 9-TRK CORE DUMP
CAIE B,100 ;IS IT 9-TRK CORE DUMP
MOVEI C,2 ;NO SET TO INDUSTRY COMPATIBLE MODE
PUSHJ P,TPSDM ;SAVE MODE AND SET IF POSSIBLE
JRST MRETN ;ILLEGAL MODE SHOULD NOT GET HERE
JRST MRETN ;RETURN TO USER
MTAPE1: HRRZ B,FORTY ;GET COMMAND
MTOPR ;DO IT
ERJMP . ;IGNORE ERRORS
POPJ P,
MTMNTF: PUSHJ P,MNTFAI ;TRAP TO USER
PUSHJ P,ERROR ;HE DID NOT WANT TRAP, TYPE MESSAGE
JRST DTMNT1 ;SAY THAT DEVICE IS NOT MOUNTED
INDMER: PUSHJ P,DTAX3Q ;SEE IF SIZE ERROR ON DTA
JRST INDM4B ;EOF SEEN
PUSH P,B ;YES. STASH POSITION OF OFFENDING IOWD
PUSH P,0(B) ;STASH THE IOWD ON STACK
INDME1: MOVSI A,MAXIOL ;SEE IF A K LEFT
ADD A,0(P) ; ..
JUMPG A,INDME2 ;NO. SHOULD BE READY TO QUIT.
MOVSI A,-MAXIOL ;A REASONABLE SIZE IOWD
HRR A,0(P) ;FIRST PART OF THE BIG LIST
MOVEM A,DMPLST ;PLACE TO STASH IOL
SETZM DMPLST+1 ;TERMINATE LIST
HRRZ A,JFNTAB(BB) ;READY TO DO SOME I/O. GET JFN
MOVEI B,DMPLST ;WHERE IO LIST IS
DUMPI ;TRY THIS
JRST INDME4 ;GO SEE IF EOF
MOVE A,[XWD MAXIOL,MAXIOL] ;UPDATE PARTIAL IOWD ON STACK
ADDM A,0(P) ; ..
JRST INDME1 ;TRY THE REST OF IOLIST
INDME2: POP P,DMPLST ;SHOULD BE READY TO HANDLE THIS
HRRZ A,JFNTAB(BB) ;GET THE JFN
HLLZ B,DMPLST ;IS IT BY LUCK EMPTY NOW?
JUMPE B,INDME3 ;JUMP IF SO
MOVEI B,DMPLST
DUMPI ;READ IT
JRST INDME5 ;GO SEE IF EOF
INDME3: POP P,B ;RESTORE PLACE IN I/O LIST
ADDI B,1 ;NEXT WORD.
SKIPE 0(B) ;END OF LIST, I HOPE?
JRST INDM1 ;NO. HAVE TO TRY THAT PART OF LIST
JRST INDM3 ;END. QUIT INDMP SUBR
INDME4: POP P,DMPLST ;RESTORE DMPLST
INDME5: POP P,B ;AND B
CAIE A,IOX4 ;IS THIS AN EOF
PUSHJ P,ERROR ;NO
JRST INDM4B ;YES, GO SET EOF BIT
DTAX3Q: CAIN A,IOX4 ;EOF?
POPJ P, ;YES, GO SET THE BIT
CAIE A,DUMPX3 ;RECOVERABLE LENGTH ERROR?
JRST ERROR ;NO. GIVE ERROR MESSAGE
LDB A,PDVNUM ;GET DEVICE TYPE CODE.
CAIE A,DTA ;DECTAPE?
JRST ERROR ;NOPE. LOSE.
JRST CPOPJ1 ;YES. RETURN.
INDTA: PUSHJ P,DTAINI ;CLOSE ANY OTHER JFNS FOR THIS DTA
MOVE B,FLAGWD(BB) ;ARE WE READING A DIRECTORY
TLNN B,RDUFDF!DTADMP
JRST INBYT ;NO, LET INBYT DO THE WORK
TLNE B,UFDEOF ;EOF YET?
JRST INTY8A ;YES
MOVN C,IOCNT ;SET UP DUMPI COMMAND
HRLZS C
HRR C,IOBPT
SETZ D,
TDNE B,[XWD RDUFDF,100] ;READING THE DIRECTORY OR IN MODE 100?
JRST [SUB C,[XWD 1,1] ;YES, READ 200 WORDS INTO THE 177 WORD
TRO PF,R.NOWC ;BUFFER. THIS USES THE BYTE COUNT WORD
JRST .+1] ;AS THE EXTRA WORD. TOPS-10 KLUDGE!!!
MOVEI B,C ;POINT TO COMMAND LIST
DUMPI
JRST INDTA1 ;GO CHECK FOR EOF
MOVSI A,RDUFDF
MOVSI B,UFDEOF ;DIRECTORY IS ONLY ONE BLOCK LONG
TDNE A,FLAGWD(BB) ;ARE WE READING A DIRECTORY
IORM B,FLAGWD(BB) ;YES, MAKE IT BE ONLY ONE BLOCK LONG
MOVE A,IOCNT ;SET UP IOBPT
ADDM A,IOBPT
SETZM IOCNT
JRST INTTY9 ;RETURN
INDTA1: CAIE A,IOX4 ;EOF?
PUSHJ P,ERROR ;NO
JRST INTY8A ;YES, GO SET BIT
IFN SAMFRK,<
INBYT: HRRZ A,JFNTAB(BB) ;GET JFN (RH ONLY)
BIN ;GET FIRST BYTE
MOVE G,B ;SAVE IT
GTSTS
TLNE B,1000 ;END OF FILE?
JRST INTY8A ;YES
MOVE B,G
SOSGE IOCNT
JRST INDON1
IDPB B,IOBPT
MOVE 2,IOBPT
MOVN 3,IOCNT
SIN ;LET MONITOR DO THE LOOPING
MOVEM 2,IOBPT
MOVNM 3,IOCNT ;STORE UPDATED BYTE COUNT
JRST INTTY9
>
OUTDTA: PUSHJ P,DTAINI ;CLOSE OTHER JFNS FOR THIS DTA
MOVE B,FLAGWD(BB) ;GET FLAGS
TLNN B,DTADMP ;IN DUMP MODE FOR DTA
JRST OUTBYT ;NO USE SOUT OR BOUT
TLNE B,UFDEOF ;HAS DIR ALREADY BEEN WRITTEN
JRST [MOVEI B,1B22 ;YES, SET END OF FILE
IORM B,FLAGWD(BB)
POPJ P,] ;AND RETURN
MOVSI C,-200 ;YES, SET UP FOR A FULL 200 WORDS
HRR C,IOBPT ;GET START OF BUFFER
SETZ D,
TDNE B,[RDUFDF,,100] ;MODE 100 OR WRITING DIR?
HRRI C,-1(C) ;YES, THE FIRST WORD IS THE WORD COUNT WORD
MOVEI B,C ;GET COMMAND LIST POINTER
DUMPO
PUSHJ P,ERROR
MOVE A,IOCNT
ADDM A,IOBPT
SETZM IOCNT
MOVSI B,UFDEOF ;SET EOF FLAG IF THIS WAS THE DIR
MOVE C,FLAGWD(BB)
TLNE C,RDUFDF ;ONLY IF WRITING THE DIR
IORM B,FLAGWD(BB) ;THEN CLOSE WONT WRITE GARBAGE ON TAPE
POPJ P,
OUTMTA: TROA PF,R.DIRN ;FLAG OUTPUT DIRECTION
INMTA: TRZ PF,R.DIRN ;FLAG INPUT DIRECTION
SKIPG B,IOCNT
POPJ P,
MOVSI A,MTABFS ;SEE IF THE BUFFERS ARE SET UP
TDNN A,FLAGWD(BB)
JRST [ IORM A,FLAGWD(BB) ;NO, SET THEM UP BEFORE FIRST USE
HRRZ A,JFNTAB(BB) ;GET THE JFN OF THE MTA
MOVEI B,.MORDM ;READ THE DATA MODE
MTOPR
ERJMP .+1 ;IF THIS FAILS, USE DEFAULTS FOR JOB
HLRZ D,TPRDMT(C) ;GET NUMBER OF BYTES PER WORD
MOVEI B,.MORRS ;READ THE RECORD SIZE
MTOPR
ERJMP .+1 ;IF FAILS, DONT CHANGE IT
HRRZ B,BUFHTB(BB) ;GET POINTER TO BUFFER RING
TRNE PF,R.DIRN ;DOING OUTPUT?
HLRZ B,BUFHTB(BB) ;YES, GET OUTPUT BUFFER
HRRZ B,0(B) ;GET ADDRESS OF FIRST BUFFER IN RING
LDB B,[POINT 17,0(B),17] ;GET BUFFER SIZE
IMULI B,0(D) ;GET NUMBER OF RECORDS PER BUFFER
CAIL C,-1(B) ;IS THE MTA RECORD SIZE TOO SMALL?
JRST .+1 ;NO, DONT CHANGE ANYTHING
MOVEI C,776(B) ;YES, SET UP LARGER BUFFER
TRZ C,777 ;ROUNDED UP TO THE NEXT PAGE
MOVEI B,.MOSRS ;SET THE RECORD SIZE
MTOPR
ERJMP .+1
JRST .+1]
HRRZ A,JFNTAB(BB) ;GET JFN
MOVE B,IOBPT ;GET BYTE POINTER
MOVN C,IOCNT ;AND NEGATIVE COUNT OF BYTES
TRNE PF,R.DIRN ;IN OR OUT?
JRST OUTMT1 ;OUTPUTTING
SINR ;READ IN THE RECORD
ERJMP SEQMTE ;ERROR OCCURED
SEQMTR: MOVEM B,IOBPT ;STORE UPDATED BYTE POINTER
MOVNM C,IOCNT ;AND UPDATED COUNT
POPJ P, ;AND EXIT
OUTMT1: SOUTR
ERJMP SEQMTE ;ERROR OCCURED ON THE WRITE
JRST SEQMTR ;GO EXIT
SEQMTE: MOVEM B,IOBPT ;STORE UPDATED BYTE POINTER
MOVNM C,IOCNT ;AND COUNT
HRRZ A,JFNTAB(BB) ;NOW GET ERROR STATUS
GDSTS
TRNN B,MT%EOF ;END OF FILE?
JRST TAPERR ;NO, GO ANALIZE IT
JRST RECCH1 ;YES, GO SET EOF BIT AND EXIT
MTALP2: MOVEM B,SPDELC ;INITIAL COMMAND
MTALP: MOVE B,SPDELC ;NEXT OR CORRECTED IOL
TRNE PF,R.DIRN ;OUTPUT?
JRST DMP2 ;YES. GO DO OUTPUT
MOVSI C,MTALTW ;MARK LAST TRANSFER NOT A WRITE
ANDCAM C,FLAGWD(BB)
DUMPI
JRST EOFCHK
JRST DMP3
MTALP1: SETOM MTDUMP ;FLAG DUMP MODE REQUEST
SETZM IOCNT ;SET POSITIVE COUNT SO RECORD LENGTH
AOS IOCNT ;ERROR DOESN'T HAPPEN SPURIOUSLY
JRST MTALP2 ;GO TO IT
DMP2: MOVSI C,MTALTW ;MARK LAST TRANSFER WAS A WRITE
IORM C,FLAGWD(BB)
DUMPO
JRST MTAERR ;ERROR, GIVE USER THE ERROR BITS
DMP3: MOVE C,IOCNT ;GET SIZE OF BUFFER
ADDM C,IOBPT ;UPDATE BUFFER POINTER
DMP4: SETZM IOCNT ;OK
JRST RECCH1 ;UPDATE THE STATUS
EOFCHK: CAIE A,IOX4 ;EOF?
JRST RECCHK ;NO
MOVEI A,1B22
IORM A,FLAGWD(BB)
JRST DMP4
CLSMTA: MOVSI A,OUFIRF ;WAS A WRITE DONE?
MOVE B,FLAGWD(BB)
ANDI B,17 ;GET MODE OF OPEN
CAIL B,15 ;SEQUENTIAL MODE?
TDNN A,FLAGWD(BB) ;OR NO WRITE DONE?
POPJ P, ;YES, DONT DO ANYTHING
MOVE A,JFNTAB(BB) ;NO, NOW WRITE OUT EOF
MOVEI B,3 ;MTOPR CODE 3 = EOF
MTOPR
ERJMP . ;IGNORE ERRORS
MTOPR ;DO 2 EOF'S AND BACK OVER ONE
ERJMP . ;IGNORE ERRORS
MOVEI B,7 ;MTOPR CODE 7 = BACKSPACE
MTOPR
ERJMP . ;IGNORE ERRORS
POPJ P, ;THRU
;INPUT ERROR OTHER THAN EOF FROM DUMPI
RECCHK: HLRO A,(B) ;GET -WC FROM TRANSFER IN PROGRESS
SKIPE MTDUMP ;AND IF DUMP MODE,
MOVNM A,IOCNT ;STORE AS LAST TRANSFER ATTEMPT
HRRZ A,JFNTAB(BB) ;GET THE JFN
GDSTS ;GET THE VIROS STATUS
TRNN B,10000 ;RECORD LENGTH ERROR?
JRST TAPERR ;CHECK OTHER ERRORS
HLRZ D,C ;WORD COUNT
MOVEI B,.MORDM ;SET UP TO GET DATA MODE
MTOPR
ERJMP [MOVE C,D ;IF ERROR ASSUME DUMP MODE
JRST RECCH2] ;AND SKIP DIVIDE
HLRZ C,TPRDMT(C) ;CONVERT TO 10 MODE
EXCH C,D ;SET UP FOR DIVIDE
IDIVI C,(D) ;GET WORDS TRANSFERED
SKIPE D ;REMAINDER?
AOS C ;YES
RECCH2: ADDM C,IOBPT ;UPDATE BUFFER POINTER WORD
SUB C,IOCNT ;WORDS NOT TRANSFERRED
MOVNM C,IOCNT
MTAERR: PUSHJ P,GST2 ;CONVERT TO 10/50 ERROR BITS
SKIPLE IOCNT ;WAS ERROR REALLY TOO LONG?
TRZ A,1B21 ;YES. TOO SHORT ISN'T AN ERROR ON 10/50
HRRM A,FLAGWD(BB) ;STORE STATUS BITS.
HRRZ A,JFNTAB(BB)
SETZ B,
MTOPR ;CLR ERROR FLAGS
ERJMP . ;IGNORE ERRORS
POPJ P,
;HERE ON SUCCESS FOR DUMPI OR DUMPO, NO ERRORS. JUST UPDATE
; THE PHYSICAL UNIT STATUS BITS
RECCH1: PUSHJ P,GST2 ;UPDATE FLAGS
HRRM A,FLAGWD(BB) ;IN CHANNEL CONTROL BLOCK
POPJ P,0 ;AND RETURN TO DUMP IO PROCESSOR
TAPERR: TRNN B,722000 ;OTHER KNOWN ERRORS
PUSHJ P,ERROR ;NO, GO COMPLAIN
JRST MTAERR ;YES, MARK THESE ERRORS IN STATUS WORD
;ROUTINE TO DO SETSTS ON MTA
MTASET: PUSHJ P,MTASTS ;CALL SUBR
JRST MRETN
MTASTS: HRRZ A,JFNTAB(BB) ;GET JFN OF MTA
HRRZ B,FLAGWD(BB) ;GET MODES
ANDI B,1700 ;ONLY CARE ABOUT DENSITY, PARITY AND ERROR RETRY SUPPRESS
TRZE B,100 ;ERROR RETRY SUPPRESS?
TRO B,40000 ;YES, PUT IN POSITION FOR SDSTS
SDSTS ;SET THESE BITS
MOVEI B,.MOSDN ;SET UP TO SET DENSITY
LOAD C,MTADEN ;GET DENSITY IF ANY
SKIPE C ;HAS IT BEEN SPECIFIED
MTOPR ;YES, SET IT
ERJMP .+1
MOVEI B,.MOSDR ;SET UP READ BACKWARDS FUNCTION
MOVSI C,MTARDB ;GET FLAG
TDNN C,FLAGWD(BB) ;WANT TO READ BACKWARDS?
TDZA C,C ;NO, GET A ZERO
MOVEI C,1 ;YES, GET A ONE
MTOPR ;TELL MONITOR WHAT TO DO
ERJMP .+1 ;IGNORE ERROR
MOVE B,FLAGWD(BB) ;GET THE FLAGS
TLNN B,MTADMS ;HAS THE DATA MODE BEEN SET
POPJ P, ;NO, DO NOT SET IT TAKE SYSTEM DEFAULT
MOVEI B,.MOSDM ;NOW DO THE DATA MODE SETTING
LOAD C,MTADM
HRRE C,TPSDMT(C) ;GET DATA MODE
JUMPL C,CPOPJ ;IF NONE, RETURN
MTOPR ;SET THE DESIRED DATA MODE
ERJMP .+1
POPJ P, ;RETURN TO CALLER
OUDMER: PUSHJ P,DTAX3Q ;SEE IF DTA SIZE ERROR.
JRST ERROR ;EOF SEEN
PUSH P,B ;YES. SAVE POSITION OF IOWD
PUSH P,0(B) ;STASH OFFENDING IOWD
OUDME1: MOVSI A,MAXIOL ;A REASONABLE VIROS LENGTH
ADD A,0(P) ;WITHIN THAT FAR OF END?
JUMPG A,OUDME2 ;JUMP IF SO.
MOVSI A,-MAXIOL ;MAKE A PARTIAL IOWD
HRR A,0(P) ; ..
MOVEM A,DMPLST ;STASH IT FOR DUMPO
SETZM DMPLST+1 ;AND CLEAR FOR A TERMINATOR
HRRZ A,JFNTAB(BB) ;GET THE JFN
MOVEI B,DMPLST ;AND WHERE THE SHORT IOL IS
DUMPO ;TRY IT AGAIN, SAM
PUSHJ P,ERROR ;IF THIS LOSES, GIVE UP.
MOVE A,[XWD MAXIOL,MAXIOL] ;UPDATE THE POINTER
ADDM A,0(P) ; ..
JRST OUDME1 ;AND TRY THE REST OF IT
OUDME2: POP P,DMPLST ;GET BACK THE PARTIAL IOLIST LEFT
HRRZ A,JFNTAB(BB) ;GET THE JFN BACK
HLLZ B,DMPLST ;DID IOL JUST NOW RUN OUT?
JUMPE B,OUDME3 ;IF SO, SKIP I/O
MOVEI B,DMPLST ;POINT TO IO LIST
DUMPO ;TRY TO OUTPUT REMAINING STUFF
PUSHJ P,ERROR ;CAN'T
OUDME3: POP P,B ;GET THE POSITION IN ORIGINAL IOL
ADDI B,1 ;POINT AFTER TROUBLESOME GUY
SKIPE 0(B) ;MORE TO DO YET?
JRST OUTDM1 ;YES. GO TRY NEXT IOWD
JRST OUTDM3 ;NO. QUIT.
;ENQ/DEQ TRANSLATION
.ENQ: PUSHJ P,ENQSET ;SET UP THE ARGUMENT BLOCK
JRST ENQERE ;FAILED
IJSYS <ENQ> ;DO THE FUNCTION
JRST ENQERR ;FAILED, GO TRANSLATE ERROR CODE
JRST MRETN2 ;SUCCESSFUL
.DEQ: TLNE CAC,-1 ;FUNCTION 0?
JRST [ HLRZ A,CAC ;NO, GET FUNCTION CODE INTO A
HRRZ B,CAC ;AND GET REQUEST ID INTO B (IF FUNC 1)
JRST DEQ1] ;GO DO DEQ JSYS DIRECTLY
PUSHJ P,ENQSET ;SET UP FOR JSYS
JRST ENQERE ;ILLEGAL ARGUMENT BLOCK
DEQ1: IJSYS <DEQ> ;DO THE JSYS
JRST ENQERR ;ERROR, GO TRANSLATE ERROR CODE
JRST MRETN2 ;SUCCESSFUL
.ENQC: TLNN CAC,-1 ;FUNCTION 0 ONLY
JRST [ MOVEI A,6 ;INVALID FUNCTION
JRST STOTAC]
PUSHJ P,ENQSET ;SET UP ARG BLOCK FOR JSYS
JRST ENQERE ;FAILED
MOVE C,ACS+1(AC) ;GET THIRD ARG - STATUS BLOCK ADR
IJSYS <ENQC>
JRST ENQERR ;FAILED, TRANSLATE ERROR CODE
JRST MRETN2
ENQSET: XCTUU <HRRZ D,0(CAC)> ;GET LENGTH OF ARG BLOCK
CAILE D,TMPBKL ;TOO BIG?
POPJ P, ;YES, GIVE ERROR RETURN
HRLZ C,CAC ;GET ADR OF ARG BLOCK
HRRI C,TMPBLK ;MOVE BLOCK TO INSIDE PAT
ADDI D,TMPBLK-1 ;GET END POINT
BLT C,0(D)
HLRZ D,TMPBLK ;GET # OF LOCKS
MOVEI C,TMPBLK+2 ;GET POINTER TO FIRST JFN WORD
ENQSLP: HRRE B,0(C) ;GET LOCK TYPE
JUMPL B,ENQSL1 ;IF NOT A CHANNEL, IGNORE
IMULI B,NTABS ;GET OFFSET INTO CHANNEL TABLE
HRRZ A,JFNTAB(B) ;GET JFN
HRRM A,0(C) ;REPLACE CHANNEL # WITH JFN
ENQSL1: ADDI C,3 ;STEP TO NEXT LOCK
SOJG D,ENQSLP ;LOOP BACK FOR ALL LOCKS
HLRZ A,CAC ;GET FUNCTION CODE
MOVEI B,TMPBLK ;GET POINTER TO ARG BLOCK
JRST CPOPJ1
ENQERR: MOVSI D,-ENQTBL ;SET UP TO TRANSLATE ERROR CODE
ENQERL: HRRZ C,ENQTAB(D) ;GET NEXT ERROR CODE
CAMN A,C ;FOUND A MATCH YET?
JRST ENQERF ;YES, GO USE IT
AOBJN D,ENQERL ;LOOP BACK TILL FOUND
ENQERE: TDZA A,A ;UNKNOWN ERROR, RETURN 0
ENQERF: HLRZ A,ENQTAB(D) ;GET ERROR CODE TRANSLATION
JRST STOTAC
ENQTAB: 6,,ENQX1
17,,ENQX2
25,,ENQX3
22,,ENQX4
23,,ENQX5
1,,ENQX6
24,,ENQX7
20,,ENQX8
10,,ENQX9
7,,ENQX10
11,,ENQX11
2,,ENQX12
15,,ENQX13
4,,ENQX14
26,,ENQX15
12,,ENQX16
14,,ENQX17
21,,ENQX18
5,,ENQX19
0,,ENQX20
3,,ENQX21
13,,MONX01
ENQTBL==.-ENQTAB
;IO ERROR - THIS DOES NOT GET PASSED TO THE USER VIA CNIWRD
; RATHER IT CAUSES IO ERROR BITS TO BE SET IN THE FILE STATUS WORD
IOERR: MOVEM 17,IAC+17 ;SAVE SOME AC'S
MOVEI 17,IAC
BLT 17,IAC+16
SKIPN INPAT
JRST IOER2 ;GIVE ERROR MESSAGE AND HALT.
MOVEI 7,1B19+1B20 ;PREPARE TO SET THESE BITS IN STAT WD
MOVE 1,BB ;EXTENSIVE CHECK TO BE SURE WE KNOW
CAIL 1,0 ;WHAT WE'RE DOING
CAIL 1,NTABS*20 ;BB SHOULD HAVE INDEX TO IO CHANNEL
JRST IOER2 ;DOESN'T,ISSUE ERROR MESSAGE AND HALT
IDIVI 1,NTABS ;SHOULD BE POINTING TO FIRST OF BLOCK
JUMPN 2,IOER2 ;NO, ISSUE ERROR MESSAGE AND HALT
HRRZ A,RETSAV ;GET THE ADR OF THE INSTRUCTION
CAIL A,MOVINS ;DOING THE BLT AT MOVBUF?
CAILE A,MOVINE
SKIPA ;NO
JRST IOER0 ;YES,THEN MARK THE ERROR BITS
HRRZ 1,IAC+1 ;AC1 AT TIME OF INTERRUPT
HRRZ 2,JFNTAB(BB) ;GET JFN #
CAME 1,2 ;IS THIS A JFN IN 1
JRST IOER2 ;NO,ISSUE ERROR MESSAGE AND HALT
IOER0: IORM 7,FLAGWD(BB) ;ALL SEEMS IN ORDER, SET ERROR BITS
IOER1: MOVSI 17,IAC ;RESTORE AC'S
BLT 17,17
DEBRK ;AND RESUME IO
IOER2: MOVE P,[IOWD IPDLL,IPDL]
TMSG <$? PA1050: I-O ERROR AT ADDRESS > ;(317) FATAL ERROR MESSAGE
MOVEI 1,PROJFN ;TYPE OUT ADR
HRRZ 2,RETSAV
MOVEI 3,10
NOUT
JFCL
TMSG <$>
HALTF ;(317) HALT IF NOT PAT GENERATED ERROR
JRST IOER1 ;GO EXIT
;CARD READER INPUT ROUTINE
INCDR: MOVE A,FLAGWD(BB) ;GET MODE
ANDI A,17
CAIE A,10 ;IMAGE MODE IS SPECIAL
JRST INBYT ;DO NORMAL PROCESSING
INCDR1: HRRZ A,JFNTAB(BB) ;GET JFN
SOSG IOCNT ;ANY MORE TO DO?
JRST INTTY9 ;NO, GO EXIT
BIN ;GET A 16 BIT BYTE
ERJMP INERR ;ERROR OR EOF
IDPB B,IOBPT ;STORE 12 BITS ONLY
JRST INCDR1 ;LOOP UNTIL DONE
INERR: MOVEI A,.FHSLF ;GET ERROR CODE
GETER
HRRZS B ;GET CODE
CAIN B,IOX4 ;EOF?
JRST INTY8A ;YES, GO SET EOF
MOVEI A,1B19+1B20 ;NO, SET ERROR BITS
IORM A,FLAGWD(BB)
JRST INTTY9 ;AND RETURN
;MACHINE SIZE EXCEEDED INTERRUPT
MACHSZ: MOVEM 17,IAC+17 ;SAVE THE ACS
MOVEI 17,IAC
BLT 17,IAC+16
MOVE P,[IOWD IPDLL,IPDL]
MOVE A,RETSAV ;GET INTERRUPT PC
TLNN A,10000 ;INTERRUPT FROM USER MODE?
JRST MACHS1 ;NO, FATAL ERROR
TMSG <$%% PA1050: INTERNAL SYSTEM RESOURCES CURRENTLY DEPLETED,$ WAITING 30 SECONDS BEFORE ATTEMPTING TO CONTINUE.$>
MOVEI T1,^D30000
DISMS ;WAIT 30 SEC
MACHS0: MOVSI 17,IAC ;RESTORE ACS
BLT 17,17
DEBRK
MACHS1: TMSG <$? PA1050: INTERNAL SYSTEM RESOURCES CURRENTLY DEPLETED.$>
HALTF ;FATAL
JRST MACHS0 ;IF USER IS BRAVE, TRY TO CONTINUE
REPEAT 0,<
CTOINT: MOVEM A,IAC+A ;STASH AC A ON A CONTROL O INT
MOVEM B,IAC+B ;ALSO AC B
MOVEM C,IAC+C ;AND C
MOVEI A,PROJFN ;PRIMARY FILE
MOVSI B,B18 ;SIGN OF TYSTAT
XORB B,TYSTAT ;COMPLEMENT IT.
SKIPGE B ;ON NOW?
CFOBF ;YES. CLEAR TTY OUTPUT BUFFER
HRROI A,[ASCIZ /^O
/]
PSOUT ;TYPE OUT THE ECHO FOR THE ^O
MOVE A,RETSAV ;SEE WHERE THE BREAK WAS FROM
MOVE B,-1(A) ;GET THE INSTRUCTION
CAME B,CPSOUT ;PRIMARY I/O?
CAMN B,CPBOUT ; ..
JRST CTOIN1 ;YES.
CAME B,CBOUT ;NO. DIRECTED I/O?
CAMN B,CSOUT ; ..
SKIPA
JRST ABDBRK ;NO. JUST DEBREAK
MOVE B,IAC+A ;YES. GET THE JFN.
CAIE B,PRIJFN ;PRIMARY FILE?
CAIN B,PROJFN ; ..
JRST CTOIN1 ;YES
JRST ABDBRK ;NO. RETURN TO IT
CTOIN1: TLO A,(1B5) ;FORCE TTY JSYS TO QUIT.
MOVEM A,RETSAV ;PUT BACK FOR DEBRK
> ;END OF CONTROL-O SIMULATION
ABDBRK: MOVE A,IAC+A ;GET THE AC'S BACK
MOVE B,IAC+B ; ..
MOVE C,IAC+C
DEBRK ;AND DISMISS THE PSI
;CONTROL-C INTERCEPT ROUTINES
ER.ICC==1B34 ;CONTROL-C ENABLE BIT
CHKCCI: SKIPE INFLSR ;IS THIS A CALL TO DISABLE CONTROL-C?
JRST CHKCC1 ;YES, GO DO IT
SKIPN A,.JBINT ;DOES USER WANT TO DISABLE CONTROL-C?
POPJ P, ;NO, RETURN
MOVE A,1(A) ;GET ENABLE WORD
TRNE A,ER.ICC ;NO, USER WANT IT TO BE ENABLED?
CHKCC1: SKIPE CCIENB ;^C ALREADY ENABLED?
POPJ P, ;NO, RETURN
PUSHJ P,SETCCE ;ENABLE FOR INTERCEPTING ^C'S
POPJ P, ;CANNOT ENABLE FOR CONTROL-C INT
SETOM CCIENB ;MARK THAT ^C IS NOW ENABLED
JRST SETPSI ;GO ENABLE ^C CHANNEL
SETCCE: MOVEI A,.FHSLF ;READ IN CAPABILITIES
RPCAP
TLNN B,(1B0) ;CAN CONTROL-C BE ENABLED?
JRST [TLO PF,L.NCCE ;NO, MARK THAT IT CANNOT BE SET
POPJ P,] ;AND RETURN
TLON C,(1B0) ;IS ^C ALREADY ON
EPCAP ;NO, ENABLE IT
JRST CPOPJ1
CCIINT: MOVEM A,IAC+A ;COME HERE ON A ^C INTERRUPT
MOVEM B,IAC+B
MOVEM C,IAC+C
AOS A,FRUSTC ;HOW MANY ^C'S SO FAR?
CAIL A,MAXFRU ;IS USER TRYING DESPARATLY TO STOP
JRST NOCCTP ;YES, STOP
SKIPN A,.JBINT ;DOES USER WANT TO TRAP?
JRST NOCCI ;NO, DONT TRAP
MOVE B,1(A) ;GET ENABLE BITS
TRNN B,ER.ICC ;STILL SET?
JRST NOCCI ;NO, GO DISABLE FEATURE
SKIPE 2(A) ;PC WORD ZERO?
JRST NOCCI ;NO, LET ^C GO THROUGH TO EXEC
MOVSI B,ER.ICC ;MARK WHICH TRAP CONDITION OCCURED
IORM B,3(A) ;IN INTERRUPT BLOCK
CCINT1: SETOM CCIFLG ;MARK THAT A ^C IS IN PROGRESS
MOVE A,IAC+A ;RESTORE ACS
MOVE B,IAC+B
MOVE C,IAC+C
JRST CSTART ;GO TRAP TO USER
NOCCI: SKIPE INPAT ;IN COMPATIBILITY PACKAGE
SKIPN INFLSR ;AND IN FILSER?
SKIPA ;NO
JRST CCINT1 ;YES, DONT LET CONTROL-C GO THROUGH
NOCCTP: SETZM CCIENB ;DISABLE ^C INTERCEPT
MOVEI A,3 ;DEACTIVATE ^C CHANNEL
DTI
MOVEI A,-1 ;GET CONTROLING TTY DESIGNATOR
MOVEI B,C.CC ;GET A ^C
STI ;PUT IT INTO TTY INPUT BUFFER
STI ;AND AGAIN BECAUSE CONTROL-C IS DEFERED
JRST ABDBRK ;NOW DISMIS, ALLOWING ^C TO INTERRUPT EXEC
CCTRAP: SOS PDL ;BACK UP THE PC
JRST MRETN ;GO TRAP TO HIM
;ROUTINE TO INTERCEPT USER INTERRUPTS VIA COMPAT 6 UUO
USRINT: SKIPE UIIFLG ;DOING IIC FROM BELOW?
JRST USRIN3 ;YES
MOVEM A,UIACA ;SAVE AN AC
SKIPE INFLSR ;IN FILSER
JRST USRIN2 ;YES, DELAY INTERRUPT
HRRZ A,@USRSAV ;GET PC OF INTERRUPTED PROGRAM
CAIL A,PATLOC ;IN PAT?
CAILE A,ENDFF
JRST USRIN1 ;NO, GO TRAP TO USER
SKIPN INPAT ;INSIDE PAT PROPER
JRST USRIN0 ;NO, GO BACK UP PC AND TRAP
CAIL A,INJSYS ;INTERRUPTABLE JSYS?
CAIL A,INJSYE
JRST USRIN2 ;NO
SETZM IOWATF ;CLEAR WAITING FLAG
MOVE A,MONUPC ;GET RETURN ADDRESS
HRRI A,-1(A) ;BACK UP PC
MOVEM A,@USRSAV ;SET UP INTERRUPT PC
MOVSI 17,ACS ;RESTORE ACS
BLT 17,17 ;...
JRST @UITRAP ;TRAP TO USER
USRIN0: MOVE A,MONUPC ;GET RETURN ADDRESS
HRRI A,-1(A) ;BACK UP PC
MOVEM A,@USRSAV ;SET UP INTERRUPT PC
USRIN1: MOVE A,UIACA ;RESTORE AC
JRST @UITRAP ;TRAP TO USER PROGRAM
USRIN2: SETOM UIFLAG ;MARK THAT AN INTERRUPT IS IN PROGRESS
MOVE A,UIACA ;GET BACK AC
DEBRK ;FINISH UUO
PUSHJ P,BUGSTP
USRIN3: MOVE A,JOBPD1 ;GET ADDRESS TO TRAP TO
MOVEM A,@USRSAV
MOVE A,ACS+A ;RESTORE ACS
MOVE B,ACS+B
SETZM UIIFLG ;CLEAR INTERRUPT FLAG
JRST @UITRAP ;TRAP TO USER JOB
NXPINT: MOVEM A,IAC+A
MOVEM B,IAC+B ;PRESERVE TWO AC'S
MOVEM C,IAC+C
HRRZ A,RETSAV ;GET PC OF INTERRUPT
CAIL A,PATLOC ;IS LESS THAN COMPATIBILITY PACKAGE
JRST ABDBRK ;YES, THIS IS OK, PROBABLY DDT
MOVEI A,.FHSLF ;THIS FORK
GTRPW ;GET THE TRAP STATUS WORD
SKIPN INPAT ;FROM INSIDE PAT?
TLNE A,1 ;OR FROM MONITOR MAP (SPURIOUS)?
JRST ABDBRK ;YES. QUIT. PROCESS CONTINUES.
HRRZS A ;ADDRESS REFERRED TO
TRNE A,776000 ;REFERENCE TO PAGE 0 OR 1 IS OK.
CAMG A,JBREL ;ABOVE USER'S LEGIT AREA?
JRST ABDBRK ;NO. FILLING IN SPACE. OK.
CAMGE A,HSORG ;IN HISEG?
JRST NXPBAD ;NO. BAD.
CAMG A,JBHRL ;OUT OF BOUNDS IN HIGH SEG?
JRST ABDBRK ;NO. SCRATCH PAGE IN HIGH SEG.
;***SHOULD CHECK UWP BIT***
NXPBAD: MOVEM A,ASAVE ;STASH ADDRESS FOR A MOMENT
HRRZ B,A ;PAGE REFERENCED BY ACCIDENT
LSH B,-11 ;PAGE NUMBER FROM ADDRESS
HRLI B,.FHSLF ;IN THIS FORK
SETO A, ;TO OBLIVION
SETZ C, ;CLEAR COUNT OF PAGES TO BE DELETED
PMAP ;GET RID OF THE PAGE
MOVE A,ASAVE ;GET THE ADDRESS BACK
MOVE B,USRENB ;DID USER ASK FOR THESE ERRORS?
TRNE B,1B22!1B23 ;BY ILL MEM REF OR NXM?
JRST MINT1 ;YES. GO SNEAK INTO MEMINT CODE.
MOVEI B,NXPTRP ;PC TO GET THIS TRAP
EXCH B,RETSAV ;PUT IT IN DE-BREAK PC
HRL B,A ;SAVE ADDRESS ATTEMPTED TOO
MOVEM B,MONUPC ;***WHERE SHOULD THIS REALLY GO?
JRST ABDBRK ;AND DEBREAK, STOPPING USER.
;HERE ON NON-PSI LEVEL AFTER STOPPING USER.
NXPTRP: MOVEM 17,ACS+17 ;STASH USER'S AC'S
MOVEI 17,ACS
BLT 17,ACS+16 ; ..
MOVE P,PATSTK ;GET THE STACK AC TO PDL
MOVE PF,PFLAGS ;AND THE GENERAL FLAGS
TMSG <$? PA1050: ILLEGAL REFERENCE TO ADDRESS >
MOVEI A,PROJFN ;TO TTY OUTPUT
HLRZ B,MONUPC ;ADDRESS ATTEMPTED
MOVEI C,10 ;OCTAL RADIX
NOUT ;TYPE OUT THE ADDRESS
JFCL
ATUSER: HRROI A,[ASCIZ / AT USER /]
PSOUT
MOVEI A,PROJFN ;ADDRESS THE TTY AGAIN
HRRZ B,MONUPC ;GET THE PC AT TIME OF ERROR
TLO B,(1B5) ;USER MODE BIT
; *** LOST OLD ARITH FLAGS. FOO.***
MOVEM B,PDL ;IN CASE HE SAYS CONTINUE.
HRRZS B ;CLEAR FOR NOUT
MOVEI C,10 ;RESET OCTAL IN CASE OF ATUSER ENTRY
NOUT ;TYPE IT OUT
JFCL ;"CAN'T FAIL"
MOVEI A,C.CR ;CRLF
PBOUT ;TYPE CRLF
MOVEI A,C.LF ;AND LF
PBOUT
NXPHLT: MOVSI 17,ACS ;RESTORE USER AC'S
BLT 17,17 ; ..
SETZM INPAT ;OUT OF PAT
HALTF ;HOW TO STOP AND ALLOW CONTINUE, MAKE
; ALL THIS MORE GENERAL!!!
MOVE P,PATSTK ;HE TYPED CONTINUE. CAN'T, BUT NEED
MOVE PF,PFLAGS ;STACK AND FLAGS TO SAY SO.
PUSHJ P,SETCV ;RESET EXEC CONTROL
PUSHJ P,SETPSI ; ..
TMSG <$? PA1050: CAN'T CONTINUE$>
JRST NXPHLT
OVINT: SKIPE INPAT
JRST ERRINT
MOVEM A,IAC+1
MOVE A,RETSAV
TLO A,(1B0) ;MARK OVERFLOW IN SAVED FLAGS
MOVEM A,.JBTPC ;SETUP RETURN PC
MOVE A,CNIWRD
TRO A,10 ;OVERFLOW
JRST INT
FOVINT: SKIPE INPAT
JRST ERRINT
MOVEM A,IAC+1
MOVE A,RETSAV
TLO A,(1B0+1B3) ;MARK OV AND FOV IN FLAGS
MOVEM A,.JBTPC ;SETUP RETURN PC
MOVE A,CNIWRD
TRO A,100 ;FLOATING OVERFLOW
JRST INT
PDLINT: SKIPE INPAT
JRST ERRINT
MOVEM A,IAC+1
MOVE A,RETSAV
MOVEM A,.JBTPC ;SETUP RETURN PC
MOVE A,CNIWRD
TRO A,200000 ;PDL OVERLFOW
JRST INT
MINT1: MOVE A,IAC+A ;HERE FROM NXPBAD. FAKE MEMINT
MOVE B,IAC+B ;BY RESETTING AC'S AND THEN
MOVE C,IAC+C
JRST MINT2 ; JUMPING INTO MEM INT ROUTINE
MEMINT: SKIPE INPAT
JRST ERRINT
MINT2: MOVEM A,IAC+1
MOVE A,RETSAV
MOVEM A,.JBTPC ;SETUP RETURN PC
MOVE A,CNIWRD
TRO A,20000 ;MEM PRO VIOLATION
INT: MOVEM A,.JBCNI ;SETUP APR CONI
MOVE A,.JBAPR
TLZ A,440140 ;CLEAR SAME BITS AS DOES TOPS10
HRRM A,RETSAV ;RETURN TO USER INTERRUPT ROUTINE
MOVE A,IAC+1
SETZM INPAT ;TURN OFF PAT UUO SIMULATOR
DEBRK
HALTF
INSINT: ;HERE ON ILLEGAL INSTRUCTION TRAP
MOVEM A,IAC+A ;STASH USER AC
SKIPN INPAT ;IN COMPATIBILITY PACKAGE?
JRST INSIN1 ;NO
TRZE PF,R.ILLJ ;DOING AN XJSYS COMMAND?
JRST INSILJ ;YES, GO RETURN ERROR CODE IN A
INSIN1: MOVEI A,INSTRP ;DIDDLE THE DEBREAK
EXCH A,RETSAV ;TO COME BACK AT NON-PSI LEVEL
HRRI A,-1(A) ;DECREMENT PC
MOVEM A,MONUPC ;STASH THE INT LOCATION
MOVE A,IAC+A ;RESTORE THE AC
DEBRK ;CLEAR OFF THE PSI CHANNEL
INSTRP: MOVEM 17,ACS+17 ;STASH ALL AC'S
MOVEI 17,ACS ; ..
BLT 17,ACS+16 ; ..
MOVE P,PATSTK ;GET A PDL STACK
MOVE PF,PFLAGS ;AND SYSTEM FLAGS
SETOM INPAT ;FLAG PAT STACK READY, ETC.
TMSG <$? PA1050: ILLEGAL INSTRUCTION >
HRRZ A,MONUPC ;WHERE IT CAME FROM
MOVE A,(A) ;GET INSTRUCTION
PUSHJ P,TYPINS ;GO TYPE OUT INSTRUCTION
JRST ATUSER ;AND THE PC, THEN STOP.
INSILJ: MOVE A,[2,,IAC+2] ;SAVE SOME ACS
BLT A,IAC+10 ; FOR GETER WHICH USES 10 ACS
MOVEI A,.FHSLF ;GET ERROR CODE FOR THIS FORK
GETER
HRRZ A,B ;LEAVE ERROR CODE IN AC A
MOVE 10,[IAC+2,,2] ;RESTORE ACS
BLT 10,10
AOS RETSAV ;SKIP THE AOS 0(P) INSTRUCTION IN DOJSYS
DEBRK ;RETURN
;ROUTINE TO HANDLE QUOTA EXCEEDED INTERRUPTS
QUOINT: MOVEM 17,IAC+17 ;SAVE ALL ACS
MOVEI 17,IAC
BLT 17,IAC+16
MOVE 17,IAC+17 ;(336) FIX STACK UP AGAIN
SKIPN INPAT ;IN THE MIDDLE OF A UUO?
JRST QUOTRP ;NO, BETTER NOT TRY TO HANDLE THIS
MOVE A,RETSAV ;GET PC
TLNN A,10000 ;OUT OF USER MODE?
JRST QUOTRP ;NO, THIS IS NOT GUARANTEED TO BE RECOVERABLE
MOVEI A,.FHSLF ;GET THE ERROR CODE
GETER
HRRZ A,B ;ERROR CODE TO AC A
PUSHJ P,WARN ;GO TRY TO EXPUNGE THE DELETED FILES
JRST QUOTRP ;DID NOT WORK
MOVEM PF,IAC+PF ;SAVE THE UPDATED FLAGS
QUOCON: MOVSI 17,IAC ;RESTORE THE ACS
BLT 17,17
DEBRK ;TRY TO CONTINUE
QUOTRP: TMSG <$? PA1050: >
MOVEI A,PROJFN ;TYPE OUT ERROR MESSAGE
HRLOI B,.FHSLF ;GET LAST ERROR
SETZ C,
ERSTR
JFCL
JRST [ TMSG <QUOTA EXCEEDED OR DISK FULL>
JRST .+1]
TMSG < AT LOCATION >
MOVEI A,PROJFN
HRRZ B,RETSAV ;GET PC
MOVEI C,10 ;IN OCTAL
NOUT
JFCL
HALTF ;LET USER TRY TO CLEAN UP
JRST QUOCON ;IN CASE OF A CONTINUE
IFN SAMFRK,< ;THIS ONLY WRITTEN FOR SAME FORK
CSTART:
SKIPN INPAT ;HAVE AC'S AND STACK?
JRST CSTNIP ;NO. NOT IN PAT.
SETZM IOWATF ;CLEAR IOWAIT FLAG IF ON
PUSH P,A ;STASH AN AC
HRRZ A,RETSAV ;WHERE IS THE RETURN TO?
CAIL A,INJSYS ;INTERRUPTABLE JSYS?
CAIL A,INJSYE
JRST CSTRUN ;RUNNING A UUO, LET IT FINISH
SETZM IOWATF ;CLEAR WAITING FLAG
MOVE A,MONUPC ;GET ADDRESS OF UUO
SUBI A,1 ;POINT BACK AT THE UUO
MOVEM A,.JBOPC ;STORE FOR USER
SETZM INPAT ;SNEAK OUT THE BACK DOOR OF PAT
PUSHJ P,CSTADR ;FIND ADDRESS OF THE START/ETC
HRRZM A,RETSAV ;DEBREAK TO HERE
MOVE A,TTYFRK ;MAKE SURE HIBERNATE TTY FORK IS STOPPED
TLZE PF,L.TFA ; IS FORK ACTIVE?
FFORK ;YES, FREEZE IT
SETZM CCIFLG ;CLEAR ^C INTERCEPT FLAG IF ON
MOVSI 17,ACS ;GET THE USER'S AC'S BACK
BLT 17,17 ; ..
DEBRK ;END OF INTERRUPT
CSTRUN: PUSHJ P,CSTADR ;GET ADDRESS TO GO TO
SKIPE CSTFLG ;WAS CSTFLG ALREADY SET?
JRST [ SKIPE CCIFLG ;ALREADY HANDLING INT?
JRST .+1
PUSH P,B ;SAVE ACS
MOVE B,RETSAV ;GET INTERRUPTED PC
HRRZM A,RETSAV ;DEBRK TO NEW ADDR
MOVEM B,.JBOPC ;GIVE PC TO USER
POP P,B ;RESTORE ACS
POP P,A
DEBRK] ;AND GO TO NEW ADDRESS
HRROM A,CSTFLG ;STORE IN FLAG FOR MRETN
POP P,A ;RESTORE AC A
DEBRK ;END OF INTERRUPT
CSTNIP: MOVEM P,SEE ;SAVE USER AC P
MOVE P,PSISTK ;SET UP A STACK
PUSH P,A ;AND STASH ANOTHER AC
PUSH P,EE ;SAVE UMOVE ACS
PUSH P,FF
HRRZ A,RETSAV ;WHERE WERE WE?
CAIN A,EXITH ;DOING EXIT1? (SPECIAL CASE)
JRST [ MOVE A,.JBOPC ;YES, .JBOPC IS CORRECT
JRST CSTNI1]
CAIG A,ENDFF ;IN PAT?
CAIGE A,PATLOC ; ..
SKIPA A,RETSAV ;NO. DEBREAK ADDRESS TO .JBOPC
JRST [MOVE A,MONUPC ;GET ADDRESS OF UUO+1
SOJA A,.+1] ;ADDRESS TO RETURN TO
MOVEM A,.JBOPC ;STORE FOR USER TO SEE
CSTNI1: PUSHJ P,CSTADR ;GET PLACE TO GO TO
MOVEM A,RETSAV ;AND MAKE DEBRK GO THERE
SETZM CCIFLG ;CLEAR ^C INTERCEPT FLAG IF ON
POP P,FF
POP P,EE
POP P,A ;RESTORE AC'S USED
MOVE P,SEE ; ..
DEBRK ;AND GO TO NEW ADDRESS
CSTADR: PUSH P,B
SKIPE CCIFLG ;IS THIS A ^C INTERCEPT?
JRST CCIADR ;YES, HANDLE IT DIFFERENTLY
PUSH P,C
PUSH P,E
PUSHJ P,TTBINI ;GO CLEAR TTCALL BUFFER AFTER ^C
PUSHJ P,SETPSI ;IN CASE NOT ALL CHANNELS ON WHEN
POP P,E
POP P,C ; USER TYPED ^C. GET THEM BACK
POP P,B
MOVE A,JBREL ;RESTORE .JBREL
UMOVEM A,.JBREL
MOVE A,JBHRL ;AND .JBHRL
XCTMU <HRRM A,.JBHRL>
SKIPL A,CSTCOD ;GET THE CODE FROM EXEC
JRST CSTAD1 ;POSITIVE IS GOTO ADDR
MOVMS A ;MAKE CODE POSITIVE
CAILE A,CSTMCD ;OR OUT OF RANGE?
MOVEI A,0 ;YES. GO STRAIGHT TO VIROS DDT
XCT [ MOVEI A,DDTLOC ;FORCE DDT
HRRZ A,.JBSA ;START COMMAND
HRRZ A,.JBREN ;REENTER COMMAND
JRST [ HRRZ A,.JBDDT ;USER'S OWN DDT?
TRNN A,-1 ;ANYTHING THERE?
MOVEI A,DDTLOC ;NO. USE VIROS DDT
JRST CSTAD1]
MOVEI A,CLSCMD
MOVEI A,UNMCMD](A)
TRNN A,-1 ;AN ADDRESS AVAILABLE?
MOVEI A,CSTADX ;NO.
CSTAD1: PUSH P,A ;SAVE ADDRESS OF WHERE TO START
PUSH P,E ;THIS AC NEEDS SAVING IF ON INT LVL
MOVEI A,PRIJFN ;GET TTY JFN
MOVE E,TYSTAT ;AND STATUS WORD
PUSHJ P,NOCTRO ;CLEAR CONTROL-O ON MON-USER XITION
POP P,E ;RESTORE AC E
JRST APOPJ ;RETURN WITH ADDRESS IN A
CSTADX: TMSG <$? PA1050: NO START ADDRESS$>
PUSHJ P,CLRALL ;CLEAR PSI AND COMPAT VECTOR
HALTF
PUSHJ P,SETCV ;IF CONTINUED, PUT COMP VEC BACK
PUSHJ P,SETPSI ;AND PSI SYSTEM.
JRSTF @.JBOPC ;IF HE CONTINUES, GO HERE.
> ;END OF IFN SAMFRK
CCIADR: MOVE B,.JBINT ;GET INTERCEPT ARGUMENT POINTER
SKIPE INPAT ;IN PAT?
SKIPN INFLSR ;AND DISABLING CONTROL-C?
SKIPN B ;NO
JRST [JUMPN B,CCIAD0 ;YES, IF INTERCEPT ENABLED, GET ADR
JRST CCIAD1]
CCIAD0: SKIPN INPAT ;DELAYED TRAP?
MOVEM A,2(B) ;NO, STORE INTERRUPTED PC
HRRZ A,0(B) ;PICK UP TRAP ADRESS
SETZM INFLSR ;DISABLE FILSER FLAG SO ^C IS NOT DONE
CCIAD1: POP P,B ;RESTORE B
POPJ P, ;AND RETURN
;UTILITY AND ERROR ROUTINES
TMSGQ: PUSH P,A ;DON'T CLOBBER AC'S
PUSH P,B
MOVE B,@-2(P)
TMSG1: ILDB A,B
ADDI A,40
CAIN A,"/"
JRST [POP P,B
POP P,A
JRST CPOPJ1]
CAIN A,"$"
JRST [MOVEI A,C.CR ;SEND OUT CR-LF
PBOUT
MOVEI A,C.LF ;LF
JRST CPBOUT]
CPBOUT: PBOUT
JRST TMSG1
TMSGDV: PUSHJ P,DEV67 ;GET DEVICE NAME TO BE TYPED
HRROI A,DEVNM7 ;GET POINTER TO STRING
PSOUT ;TYPE IT
POPJ P, ;AND RETURN
WARN: TROE PF,R.EXP ;ALREADY EXPUNGED?
POPJ P, ;YES, DONT DO IT AGAIN
PUSH P,B ;SAVE AN AC
MOVE B,TYSTAT ;GET CONTROLING TTY STATUS
CAIN A,IOX11 ;QUOTA EXCEEDED OR DISK FULL?
JRST FULERR ;YES
CAIN A,OPNX23 ;QUOTA EXCEEDED
JRST QUOERR ;YES
CAIN A,OPNX10 ;NO ROOM?
JRST DSKFUL ;YES, TELL USER
CAIN A,GJFX23 ;DIR FULL
JRST DIRFUL ;YES
POP P,B
POPJ P,
FULERR: TLNE B,TT.GAG!TT.BIN ;USER WANT MESSAGES?
JRST DIREX1 ;NO JUST EXPUNGE
TMSG <$%% PA1050: QUOTA EXCEEDED OR DISK FULL>
JRST DIREXP ;GO EXPUNGE
QUOERR: TLNE B,TT.GAG!TT.BIN ;USER WANT MESSAGES?
JRST DIREX1 ;NO JUST EXPUNGE
TMSG <$%% PA1050: QUOTA EXCEEDED>
JRST DIREXP ;GO EXPUNGE
DSKFUL: TLNE B,TT.GAG!TT.BIN ;USER WANT MESSAGES?
JRST DIREX1 ;NO
TMSG <$%% PA1050: DSK IS FULL>
JRST DIREXP ;GO EXPUNGE
DIRFUL: TLNE B,TT.GAG!TT.BIN ;USER WANT MESSAGES?
JRST DIREX1 ;NO
TMSG <$%% PA1050: DIRECTORY FULL>
DIREXP: TMSG < - DELETED FILES BEING EXPUNGED$>
DIREX1: SKIPN B,DIRNUM(BB) ;GET DIRECTORY OF PROBLEM FILE
GJINF ;GET CONNECTED DIR NUM
SETZ A, ;NO SPECIAL FLAGS
XJSYS <DELDF> ;EXPUNGE DIRECTORY
JFCL ;IGNORE ERROR RETURN
POP P,B
JRST CPOPJ1 ;GIVE SKIP RETURN
ERRARG: TMSG <$? PA1050: BAD ARGUMENT FOR UUO CALL.$>
JRST ERROR2
ERRCHN: TMSG <$? PA1050: I-O TO UNASSIGNED CHANNEL.$>
JRST ERROR2
CORBUG: TMSG <$? PA1050: PROGRAM TOO LARGE, COMPATIBILITY PACKAGE IS OVERLAPPED$>
JRST TRP3
BUGSTP: TMSG <$? PA1050: COMPATIBILITY ERROR OR UNIMPLEMENTED FUNCTION$>
JRST ERROR1
ILLINP: MOVE A,DEVTBL(AA) ;GET MODES
TLNE A,2 ;INPUT LEGAL?
JRST ILLIN1 ;YES
TMSG <$? PA1050: DEVICE >
PUSHJ P,TMSGDV ;ADD IN DEVICE NAME
TMSG < CANNOT DO INPUT$>
JRST ERROR1
ILLIN1: PUSHJ P,DOKTRP ;SEE IF USER WANTS TO TRAP ON THIS
JRST [PUSHJ P,ILLINM ;NO, THEN TYPE OUT MESAGE
JRST EXITM1] ;AND HALT JOB
HRRZ A,.JBINT ;NOW SEE IF MESSAGE SHOULD BE TYPED
XCTUM <SKIPL 1(A)> ;CHECK BIT 0 OF INTLOC+1
PUSHJ P,ILLINM ;TYPE OUT MESSAGE
JRST MRETN ;TRAP TO USER
ILLINM: TMSG <$? PA1050: DEVICE >
PUSHJ P,TMSGDV ;DEVICE NAME
TMSG <: IS OFFLINE, TYPE CONTINUE WHEN DEVICE IS READY$>
POPJ P,
ILLOUT: MOVE A,DEVTBL(AA) ;GET MODES
TLNE A,1 ;OUTPUT LEGAL?
JRST ILLOU1 ;YES
TMSG <$? PA1050: DEVICE >
PUSHJ P,TMSGDV
TMSG <: CANNOT DO OUTPUT$>
JRST ERROR1
ILLOU1: PUSHJ P,DOKTRP ;SEE IF USER WANTS A TRAP
JRST [PUSHJ P,ILLOUM ;NO, TYPE OUT MESSAGE
JRST EXITM1] ;AND HALT
HRRZ A,.JBINT ;NOW SEE IF MESSAGE SHOULD BE TYPED
XCTUM <SKIPL 1(A)> ;CHECK BIT 0 OF INTLOC+1
PUSHJ P,ILLOUM ;TYPE OUT MESSAGE
JRST MRETN ;TRAP TO USER
ILLOUM: TMSG <$? PA1050: DEVICE >
PUSHJ P,TMSGDV
TMSG <: IS EITHER OFF-LINE OR WRITE LOCKED, TYPE CONTINUE WHEN DEVICE IS READY$>
POPJ P,
MDTAER: TMSG <$? PA1050: MULTIPLE OPEN FILES ON A SINGLE DTA IS NOT SUPPORTED$>
JRST ERROR2
CONERR: TMSG <$? PA1050: CAN'T CONTINUE$>
JRST EXIT2
ERROR: TMSG <$? PA1050: ERROR IN JOB$>
HRLI B,.FHSLF
HRR B,A ;GET ERROR CODE TO TRANSLATE
SETZ C,
MOVEI A,PROJFN
ERSTR
JFCL
JFCL
ERROR1: TMSG <$COMPATIBILITY LOCATION = >
MOVEI A,PROJFN ;GET PRIMARY OUTPUT JFN FOR ERR MESSAGE
HRRZ B,(P)
SUBI B,1
MOVEI C,10
NOUT
JFCL
SETZ C,
ERROR2: TMSG <$USER LOCATION >
JRST TRP2
ITRAP: TMSG <$? PA1050: ADDRESS CHECK OR ILLEGAL UUO AT LOCATION >
TRP2: HRRZ 2,PDL
SUBI 2,1
MOVEI 3,^D8
MOVEI 1,PROJFN
NOUT
JFCL
TMSG <$INSTRUCTION = >
HRRZ 2,PDL
MOVE 1,-1(2)
PUSHJ P,TYPINS ;TYPE OUT INSTRUCTION
TRP3: TMSG <$>
MOVEI 1,PRIJFN ;CLEAR TYPE AHEAD
CFIBF ; ON ERRORS
TRO PF,R.FERR ;FLAG ERROR TO PREVENT SUICIDE
JRST EXIT2 ;RESTORE ACS AND HALTF
TYPINS: PUSH P,A ;SAVE INSTRUCTION TO BE TYPED
HLRZ B,A ;GET LH
MOVEI A,PROJFN ;GET OUTPUT DESIGNATOR
MOVEI C,10 ;OCTAL
NOUT
JFCL
TMSG<,,> ;LH,,RH
HRRZ B,0(P) ;GET RH
NOUT
JFCL
HLLZ B,0(P) ;GET INSTRUCTION OP CODE
TLC B,(<JRST 4,0>) ;IS THIS A HALT?
TLNE B,777400
JRST APOPJ ;NO, EXIT
TMSG< (HALT)> ;YES, TYPE HALT
JRST APOPJ ;AND RETURN
ERRINT:
IFN FTSTAT,<
TLNE PF,L.LSTA ;LOCAL STATISTICS BEING DONE?
AOS STATLC+ST.UEI ;YES, COUNT UP UNEXPECTED INTERRUPTS
TLNE PF,L.GSTA ;GLOBAL STATISTICS BEING DONE?
AOS STATGC+ST.UEI ;YES
>
DEBRK
HALTF
;CALL SIXBIT TABLE HERE BECAUSE RARELY USED.
DEFINE CC (A,B)
<
SIXBIT /A/ >
MCALT: ;TABLE FOR CALL FOR NEG CALLI'S
MCALLI ;SIXBIT NAMES OF NEGATIVE CALLS
NMCAL==.-MCALT ;NUMBER OF MINUS CALLS
CALLIT:
DEFINE CC (A,B)<
IFLE .-CALLIT-MXSIXB,<
SIXBIT /A/
>>
PCALLI ;SIXBIT TABLE OF POSITIVE CALLI'S
NPCAL==.-CALLIT ;NUMBER OF POSITIVE CALLS
ILEGAL: PUSHJ P,ITRAP ;ILLEGAL UUO CATCHER
EXIT: TRZ PF,R.EXIT ;ASSUME EXIT 0,
CAIE AC,0 ;MONRET AS OPPOSED TO EXIT?
TROA PF,R.EXIT ;YES. FLAG THAT.
PUSHJ P,IRESET ;RELEASE IF CALLI 0,12
EXIT2: MOVE A,PDL ;CALLING PC
MOVEM A,JOBPD1 ;TO STACK
MOVEM A,.JBOPC ;AND TO .JBOPC EARLY, SINCE WILL KILL PAT.
SKIPE JBHRL
PUSHJ P,MAKVES ;YES. MAY BE LOADER EXIT. MAKE HIGH VEST
MOVE E,TYSTAT ;GET CONTROLING TTY STATUS BITS
MOVEI A,PRIJFN ;SET UP JFN
PUSHJ P,NOCTRO ;CLEAR CONTROL O FLAG
RFMOD
MOVEM B,SVMOD ;(321) save for possible CONTinue
TRZ B,77B23+3B25+3B29 ;FIELDS OF INTEREST
TRO B,17B23+2B25+1B29 ;NEW VALUES
SFMOD ;SET THEM.
TRNE PF,R.SUIC ;SUICIDE COMPT.?
JRST EXIT4 ;YES, TYPE NOTHING
TRNE PF,R.EXIT!R.FERR ;EXIT OR MONRET, OR FATAL ERROR?
JRST EXIT3 ;MONRET. DON'T SAY "EXIT"
TMSG <$EXIT$>
EXIT4: PUSHJ P,CLRALL ;CLEAR ALL PSI ACTIVITY
SKIPLE A,TMPJFN ;IS THE TMPCOR FILE OPEN?
RLJFN ;YES, CLOSE IT
JFCL
SETZM TMPJFN ;CLEAR ITS JFN
MOVEI A,SUICA-1 ;STASH SOME AC'S
PUSH A,ACS+A ;IN LOW CORE
PUSH A,ACS+B
PUSH A,ACS+C
SETZM INPAT ;NOTE THAT NO LONGER HAVE A STACK
MOVE A,[XWD ACS+D,D] ;RESTORE REST OF USER'S AC'S
BLT A,17 ; ..
MOVE A,[XWD KSUIC,SUICID] ;MOVE THE SUICIDE CODE TO LOW CORE
BLT A,ESUIC ; ..
MOVE A,[JRSTF @JOBPD1] ;INSTR TO REPLACE HALTF WITH
TRNE PF,R.SUIC ;COMMITTING SUICIDE?
MOVEM A,SUICX ;YES, REPLACE HALTF
TRNE PF,R.SUIC ;ALSO INCR JOBPD1 IF SUICIDE FUNCTION
AOS JOBPD1 ; TO GIVE SKIP RETURN
MOVSI B,.FHSLF ;THIS FORK FOR PMAP
SETO A, ;TO NONEXISTENCE
HRRI B,PATPAG ;CLEAR STARTING AT BEGINING OF PAT
TLNE PF,L.FLSR ;FILSER MAPPED IN?
HRRI B,FLSRPG ;START AT FILSER START ADR
MOVEI C,NPATPG ;THRU END OF PAT
TLNE PF,L.FLSR ;FILSER MAPPED IN?
ADDI C,PATPAG-FLSRPG ;YES, GET UPDATED COUNT
TLO C,(1B0) ;WITH A MULTIPLE PMAP
MOVE 0,ACS ;RESTORE USER AC 0
JRST SUICID ;AND GO DELETE PA1050 FROM MAP
EXITM1: SOS PDL ;BACK UP PC TO POINT TO UUO
SOS MONUPC ;THIS TOO IN CASE DDT IS TYPED (FOR .JBOPC)
EXIT3: MOVEI A,EXIT1 ;GET ADDRESS TO CONTINUE AT
EXCH A,PDL ;GET USERS PC
MOVEM A,EXITPC ;SAVE IN CASE HE CONTINUES
MOVEM A,.JBOPC ;SAVE ADR OF LAST USER PC
PUSHJ P,CLRCCI ;CLEAR CONTROL-C INTERCEPT
JRST MRETN ;RESTORE AC'S AND HALT
EXIT1: HALTF
EXITH==. ;PC OF HALTF
MOVEM 17,ACS+17
MOVEI 17,ACS
BLT 17,ACS+16
MOVE P,PATSTK ;SETUP LOCAL STACK
MOVE B,SVMOD ;(321) get user's SFMOD for controlling TTY
MOVEI A,PRIJFN ;(321) get JFN for controlling TTY
SFMOD ;(321) restore user's TT%WAK, TT%ECO, TT%DAM
HLLZ PF,PFLAGS ;FLAGS TO AC FOR PAT'S FLAGS.
PUSH P,EXITPC ;SET UP RETURN PC
TRNE PF,R.FERR ;FATAL ERROR?
PUSHJ P,CONERR ;YES, CANT CONTINUE
PUSHJ P,SETCV ;SET COMPATIBILITY VECTOR
PUSHJ P,SETPSI ;IF CONTINUED
JRST MRETN ;IF CONTINUED
KSUIC: ;CODE FOR SUICIDE OF PAT
PHASE 20 ;WHERE TO MOVE IT TO
SUICID: PMAP ;DO IT.
MOVEI A,.FHSLF ;CLOSE ALL FILES
CLZFF
MOVE A,SUICA ;RESTORE LAST 3 ACS
MOVE B,SUICB
MOVE C,SUICC
SUICX: HALTF ;THIS INSTR GETS REPLACED WITH JRSTF @JOBPD1
; IF SUICIDE COMPT. UUO INVOKED
JRST .-1
ESUIC==.-1
SUICA: BLOCK 1
SUICB: BLOCK 1
SUICC: BLOCK 1
..LPH==.-SUICID ;LENGTH OF THIS PHASE BLOCK
PHASE KSUIC+..LPH ;RESUME OUTER PHASE BLOCK
SETNAM: MOVE A,CAC ;SIXBIT NAME OF USER PROGRAM
MOVEM A,LOWNAM ;SAVE THE NEW NAME FOR VERSION WATCHERS
MOVEI A,.FHSLF ;GET PRIVILEGES
RPCAP
MOVE A,LOWNAM ;GET NAME AGAIN
MOVE B,A ;GET JOB NAME TOO
TRNN C,WHEEL!OPER ;WHEEL OR OPERATOR?
MOVE A,[SIXBIT/(PRIV)/] ;NO, SET SUBSYS NAME TO PRIVATE
SETSN
JFCL ;IGNORE ERROR RETURN
JRST MRETN
LOGOUT: GJINF ;SEE IF JOB IS LOGGED IN
JUMPN A,EXIT ;IF LOGGED IN, JUST EXIT
MOVNI A,1 ;LOG THE JOB OUT
LGOUT
JRST EXIT ;FAILED, TURN INTO AN EXIT
JRST EXIT ;SHOULD NOT GET HERE
;COPY VESTIGAL JOB DATA AREA FROM LOSEG TO HISEG
MAKVES: LDB A,[PAGEN HSORG] ;GET VEST JDA PAGE NUMBER
HRLI A,.FHSLF
RPACS ;GET PAGE ACCESS
TXNN B,PA%WT!PA%CPY ;WRITABLE?
POPJ P, ;NO, GIVE UP NOW
MOVSI B,-NVSTIG
MOVE A,HSORG ;GET HISEG ORIGIN
HRLI A,B ;CONSTRUCT INDIRECT WORD HIORG(B)
MAKVS0: JRST @VESTG2(B)
MAKVS2: UMOVE D,@A ;GET CURRENT VALUE
CAMN D,C ;IF DIFERENT WE WILL CHANGE IT
JRST MAKVS1 ;DONT CHANGE IT SINCE PAGE BECOMES PRIVATE
UMOVEM C,@A
MAKVS1: AOBJN B,MAKVS0
POPJ P,
VESTG2: [UMOVE C,.JBSA
JRST MAKVS2]
[UMOVE C,41
JRST MAKVS2]
[UMOVE C,.JBCOR
JRST MAKVS2]
JRST [XCTUU <HLL C,.JBHRL>
XCTUU <HRR C,.JBREN>
JRST MAKVS2 ]
[UMOVE C,.JBVER
JUMPE C,MAKVS1
JRST MAKVS2]
IFN FTFILSER,<
;INTERFACE TO TOPS-10 FILSER ROUTINES
VIRVEC=600000 ;ENTRY VECTOR FOR FILSER MODULE
VTHRIC==0 ;THRICE ENTRY
VUUO==1 ;VIRUUO ENTRY
VMUUO==2 ;MONUUO ENTRY
VMUPC==3 ;MONUPC ENTRY
VTDAT==4 ;THSDAT ENTRY
VTIME==5 ;TIME ENTRY
VDAT==6 ;DATE ENTRY
VPPN==7 ;PPN ENTRY
VACS==10 ;ACS ENTRY
TONCE: PUSHJ P,SETVVV ;GO SET UP VIRVEC VARIABLES
JRST @VIRVEC+VTHRIC ;CALL ONCE ONLY CODE
TOPEN: PUSHJ P,TMAP ;SEE IF FILSER IS MAPPED
JRST MRETN ;COULD NOT FIND FILSER DATA BASE
PUSHJ P,SETVVV ;GO SET UP VARIABLES
MOVE A,[OPEN TOPNBL] ;GET OPEN INSTRUCTION
DPB AC,[POINT 4,A,12] ;SET UP AC FIELD
MOVEM A,@VIRVEC+VMUUO ;SET UP UUO TO BE DONE
SETZM @VIRVEC+VMUPC ;PC IS 0
MOVEI A,17 ;MODE 17 ONLY
MOVEM A,TOPNBL
MOVE A,DEVNAM(BB) ;GET DEVICE TO BE OPENED
MOVEM A,TOPNBL+1 ;STORE IN OPEN BLOCK
SETZM TOPNBL+2 ;NO BUFFER HEADERS
PUSHJ P,@VIRVEC+VUUO ;GO DO UUO
SKIPG @VIRVEC+VMUPC ;WAS IT SUCCESFUL
JRST MRETN ;NO
SETZ B,
JRST UOPENE ;CONTINUE THE OPEN
TLKUP: PUSHJ P,SETVVU ;GO SET UP THE VARIABLES AND UUO
MOVSI B,IOPENF!LOOKPF ;MARK THAT IT IS OPENED
IORM B,FLAGWD(BB)
HRRZ G,FORTY ;GET FILE LENGTH
UMOVE A,0(G) ;GET FIRST WORD TO SEE IF EXTENDED
TLNN A,-1 ;SIXBIT NAME?
CAIGE A,3 ;NO, GREATER THAN 3 ARGUMENTS?
TRZA PF,R.UEXT ;THIS IS AN OLD STYLE LOOKUP
TRO PF,R.UEXT ;EXTENDED LOOKUP
UMOVE A,5(G) ;GET EXTENDED LOOKUP VALUE
TRNE PF,R.UEXT ;EXTENDED LOOKUP?
JRST TLKUP1 ;YES
UMOVE A,3(G) ;NO, GET # OF WORDS IN FILE
JUMPL A,TLKUP0 ;NEGATIVE?
HLRZS A ;GET BLOCKS IN RH OF A
ASH A,7 ;THIS IS + BLOCKS
JRST TLKUP1
TLKUP0: HLRES A ;GET NEG WORDS
MOVNS A
TLKUP1: MOVEM A,IOEOFP(BB) ;STORE FILE LENGTH
JRST MRETN ;AND RETURN
TENTER: PUSHJ P,SETVVU ;GO DO UUO
MOVSI A,OOPENF!ENTERF ;SET FLAGS
IORM A,FLAGWD(BB)
JRST MRETN ;AND RETURN
TRENME: PUSHJ P,SETVVU ;GO DO UUO
JRST MRETN ;AND RETURN
TCLOSE: PUSHJ P,SETVVV ;SET UP VARIABLES
MOVE A,IOCNT ;GET CLOSE BITS
HRLI A,(CLOSE) ;SET UP UUO
DPB AC,[POINT 4,A,12] ;SET UP AC FIELD
MOVEM A,@VIRVEC+VMUUO ;SAVE UUO
MOVE A,MONUPC
MOVEM A,@VIRVEC+VMUPC ;SET UP PC
PUSHJ P,@VIRVEC+VUUO ;DO THE CLOSE
JRST UCL3 ;RETURN TO THE SIMULATED CLOSE
TUSET: JRST SETVVU ;GO DO THE UUO
TRELEA: PUSHJ P,URELR ;GO FORCE OUT THE LAST BUFFERS
PUSHJ P,SETVVV ;RELEASE UUO
MOVSI A,(RELEASE) ;SET UP UUO
DPB AC,[POINT 4,A,12] ;SET UP CHANNEL #
MOVEM A,@VIRVEC+VMUUO
MOVE A,MONUPC ;SET UP PC
MOVEM A,@VIRVEC+VMUPC
PUSHJ P,@VIRVEC+VUUO ;GO DO RELEASE
JRST MRETN ;AND THEN RETURN
TMOVB: MOVE A,IOEOFP(BB) ;CALCULATE # OF WORDS LEFT IN FILE
SUB A,IOBYTP(BB) ;FOR INPUT ONLY
TRNN PF,R.DIRN ;IS THIS INPUT
CAML A,IOCNT ;ARE THERE ENOUGH CHARACTERS
MOVE A,IOCNT ;YES
JUMPLE A,CPOPJ ;IF ZERO DONT DO ANYTHING
ADDM A,IOBYTP(BB) ;UPDATE POINTER
MOVN B,A ;GET NEGATIVE COUNT
ADDM B,IOCNT ;DECREMENT IOCNT
MOVSS B ;SET UP IOWD FOR UUO
HRR B,IOBPT ;GET USERS BUFFER AREA
MOVEM B,TOPNBL ;SAVE IOWD
ADDM A,IOBPT ;UPDATE BYTE POINTER
SETZM TOPNBL+1 ;ZERO TO END IO COMMAND LIST
MOVE A,[INPUT TOPNBL] ;GET UUO TO BE DONE
TRNE PF,R.DIRN ;IS THIS AN OUTPUT
HRLI A,(OUTPUT) ;YES, CHANGE IT TO OUTPUT UUO
DPB AC,[POINT 4,A,12] ;SET UP CHANNEL #
MOVEM A,@VIRVEC+VMUUO ;SAVE UUO TO BE DONE
SETZM @VIRVEC+VMUPC
PUSH P,D ;SAVE D FOR PAT
PUSHJ P,SETVVV ;SET UP TIME AND DATE
POP P,D
PUSHJ P,@VIRVEC+VUUO ;DO THE UUO
JRST CPOPJ1
TDOUUO: PUSHJ P,TMAP ;GO SEE IF FILSER IS MAPPED IN
JRST MRETN ;HAD SOME TROUBLE
PUSHJ P,SETVU1 ;GO DO THE CURRENT UUO
JRST MRETN ;AND RETURN TO THE USER
TMAP: SKIPE FLSJFN ;IS FILSER ALREADY MAPPED?
JRST TMAP2 ;YES, DONT MAP IT AGAIN
MOVE A,JBREL ;SEE IF ENOUGH CORE
CAMG A,JBHRL ;ANY HI-SEG?
MOVE A,JBHRL ;YES, USE IT
CAIL A,FLSRLC ;ROOM LEFT FOR FILSER?
JRST TNOCOR ;NO, GO BOMB OUT
PUSH P,C ;SAVE C FOR OPEN
HRROI A,STRNG1 ;SET UP TO GET FILSER NAME
MOVEI B,"<" ;SET UP DIRECTORY NAME
BOUT
PUSH P,A ;SAVE THE STRING POINTER
GJINF ;GET LOGGED IN DIR
MOVE B,A ;ADD IT TO STRING
POP P,A ;GET BACK STRING POINTER
DIRST ;GET DIRECTORY NAME INTO STRING
JFCL
MOVEI B,">" ;TERMINATE DIR NAME
BOUT
MOVE B,JOB ;WITH JOB NUMBER AS FIRST THREE LETTERS
MOVE C,[XWD 140003,12]
NOUT ;GET ASCIZ JOB NUMBER
POPJ P, ;OPPS, GIVE ERROR RETURN
HRROI B,[ASCIZ/FILSER-DATA-BASE.TMP/]
SETZ C, ;END ON ZERO BYTE
SOUT ;BUILD GTJFN NAME
MOVSI A,100001 ;GET OLD FILE ONLY
HRROI B,STRNG1 ;SET UP FOR GTJFN
GTJFN
JRST APOPJ ;COULD NOT FIND FILSER FILE
MOVE B,[XWD 440000,302000]
OPENF ;OPEN FOR READ AND WRITE
JRST APOPJ ;ERROR RETURN
HRRZM A,FLSJFN ;STORE THIS JFN
HRLZS A ;NOW MAP IN FILSER
MOVSI B,.FHSLF ;INTO THIS JOB AREA
HRRI B,FILPAG
MOVSI C,140000 ;READ AND WRITE
MOVEI D,FILEND ;LAST PAGE TO BE MAPPED
TMAP0: PMAP ;MAP IN PAGE
CAIG D,(B) ;DONE?
JRST TMAP1 ;YES
AOS A
AOJA B,TMAP0 ;LOOP BACK FOR REST OF PAGES
HRRZS A,FLSJFN ;CLOSE AND RELEASE JFN
CLOSF ;SO IT GOES AWAY ON EXIT
JFCL
TMAP1: POP P,C ;RESTORE C
TLO PF,L.FLSR ;MARK THAT FILSER HAS BEEN LOADED
MOVSI A,(CALLI) ;FAKE UP A RESET UUO
MOVEM A,@VIRVEC+VMUUO ;TO CLEAR OUT ANY UNCLOSED FILES
SETZM @VIRVEC+VMUPC ;USER PC IS 0
PUSHJ P,@VIRVEC+VUUO ;DO THE RESET
TMAP2: JRST CPOPJ1 ;GIVE SKIP RETURN
TRESET: JRST SETVU1 ;GO DO THE UUO AND POPJ
SETVVU: SETZM IOBYTP(BB) ;START AT WORD 0
SETOM JFNTAB(BB) ;PRETEND WE HAVE A JFN
SETVU1: PUSHJ P,SETVVV ;GO SET TIME AND DATE
MOVE A,FORTY ;GET UUO TO DO
MOVEM A,@VIRVEC+VMUUO ;SAVE FOR FILSER
MOVE A,MONUPC ;GET USER PC
MOVEM A,@VIRVEC+VMUPC
PUSHJ P,@VIRVEC+VUUO ;GO DO UUO
MOVE A,@VIRVEC+VMUPC ;GET NEW USER PC
MOVEM A,PDL ;STORE FOR RETURN
POPJ P, ;AND RETURN
SETVVV: SETO B, ;GET DATE
PUSHJ P,NODATE
ANDI D,7777 ;12 BITS ONLY
DPB C,[POINT 3,D,23] ;ADD IN 3 HIGH ORDER BITS ALSO
MOVEM D,@VIRVEC+VTDAT ;STORE FOR FILSER
GTAD ;GET TIME AND DATE
HRRZ B,A ;TRANSLATE TIME TO TOPS-10 FORMAT
FLTR B,B
FMPR B,[3.03407407] ;MAGIC NUMBER TO TURN SECONDS INTO TOPS-10 FORMAT
FIXR B,B
HLLZS A ;ZERO TIME PART
ADD A,B ;ADD IN FRACTION OF A DAY
MOVEM A,@VIRVEC+VDAT
SETO B, ;NOW GET LOCAL TIME IN SECONDS
SETZ D,
ODCNV
HRRZ A,D
IMULI A,^D60 ;CREATE JIFFIES
MOVEM A,@VIRVEC+VTIME ;STORE FOR FILSER
GJINF
HRRZ A,B ;GET PPN
PUSHJ P,PPNUNM ;UNMAP IT
MOVEM A,@VIRVEC+VPPN ;SAVE OUR PPN
MOVEI A,ACS ;GET USER ACS
MOVEM A,@VIRVEC+VACS
SETOM INFLSR ;DISABLE CONTROL-C DURING UUO
PUSHJ P,CHKCCI ;TO KEEP DATA BASE IN TACT
JFCL
POPJ P, ;AND RETURN
TNOCOR: TMSG <$? PA1050: NOT ENOUGH CORE TO MERGE IN FILSER-DATA-BASE$>
JRST EXITM1
;ROUTINE TO SEE IF THIS IS A TOPS-10 PACK
;CALLED WITH SIXBIT NAME IN A
;SKIP RETURNS IF TOPS-10 PACK WITH 'DPAX' IN A AND STR IN B
DPACHK: PUSH P,A ;SAVE DEV NAME
PUSHJ P,GETPHY
JRST [HLRZ A,0(P) ;NONE, SEE IF NAME WAS DPAX
CAIE A,'DPA'
JRST APOPJ ;NO, RETURN
POP P,A ;GET NAME BACK
MOVE B,A ;PUT IT IN B ALSO
JRST CPOPJ1] ;AND RETURN
HLRZ B,0(P) ;SEE IF THIS IS DPAX
CAIN B,'DPA'
JRST [MOVE B,A ;YES, PUT PHYSICAL NAME IN B
POP P,A ;AND DPAX IN A
JRST CPOPJ1] ;AND RETURN
HLRZ B,A ;GET GENERIC NAME OF PHYSICAL NAME
CAIE B,'DPA' ;IS THIS A TOPS-10 PACK?
JRST APOPJ ;NO, RETURN
POP P,B ;YES, GET BACK ORIGINAL NAME INTO B
JRST CPOPJ1 ;AND RETURN
>
;PRODUCE <SUBSYS>'S SHARE FILE OF THIS CODE
MAKEPF: RESET ;CLEAR THE WORLD
MOVE P,PATSTK ;NEED A STACK HERE
PUSHJ P,CLRALL ;MAKE SURE NO LEFTOVER INTS
MOVEI 1,.FHSLF
MOVE 2,[XWD EVECL,EVEC] ;EXEC WILL SCVEC FROM THIS EVEC
SEVEC ; WHEN IT BRINGS IN PA1050 ON A UUO
HRROI T1,[ASCIZ /
Output file: /]
PSOUT
MOVEI T1,[GJ%FOU+GJ%MSG+GJ%CFM
.PRIIN,,.PRIOU
0 ;DEFAULT DEVICE
0 ;DEFAULT DIR
-1,,[ASCIZ /PA1050/] ;DEFAULT NAME
-1,,[ASCIZ /EXE/] ;DEFAULT EXT
-1,,[ASCIZ /777752/] ;DEF PROTECTION
0] ;DEFAULT ACCT
SETZ T2,
GTJFN
PUSHJ P,ERROR
MOVEM A,JFNTAB ;PRESERVE OVER TYPEOUT
TMSG < SAVED VERSION > ;COMMENT COMPLETED
SKIPN PVLOC
JRST [ TMSG <0>
JRST MAKPF0]
MOVEI A,PROJFN
LDB B,[POINT 9,PVLOC,11]
MOVEI C,10
SKIPE B
NOUT
JFCL
LDB B,[POINT 6,PVLOC,17]
JUMPE B,MAKPF1
MOVEI A,PROJFN
SUBI B,1
IDIVI B,^D26 ;1 OR 2 LETTERS?
JUMPE B,[MOVE B,C
JRST MAKPF2]
PUSH P,C ;SAVE SECOND LETTER
ADDI B,"A"-1
BOUT
POP P,B
MAKPF2: ADDI B,"A"
BOUT
MAKPF1: MOVEI A,PROJFN
HRRZ B,PVLOC ;TYPE VERSION IN OCTAL
JUMPE B,MAKPF3
MOVEI B,"("
BOUT
HRRZ B,PVLOC
MOVEI C,10
SKIPE B ;DON'T PRINT 0
NOUT ;ON TTY
JFCL
MOVEI A,PROJFN
MOVEI B,")"
BOUT
MAKPF3: LDB B,[POINT 3,PVLOC,2]
JUMPE B,MAKPF0
MOVEI A,PROJFN
MOVEI B,"-"
BOUT
LDB B,[POINT 3,PVLOC,2]
MOVEI C,10
NOUT
JFCL
MAKPF0: TMSG < AS FILE$ >
MOVEI A,PROJFN
HRRZ B,JFNTAB
MOVE C,[211112,,110011]
JFNS ;TYPE FILE NAME
MOVE A,JFNTAB
HRLI 1,.FHSLF ;THIS FORK,
HLRE 2,SJBSYM ;GET LENGTH OF SYMBOL TABLE
MOVNS 2 ;POSITIVE LENGTH
ADDI 2,ENDFF ;PLUS WHERE THEY START IS END OF SYMS.
LSH 2,-11 ;BEGINNING OF THAT PAGE
MOVNI 2,1(2) ;-<PAGE AFTER END>
MOVSI 2,PATPAG(2) ;(PLUS START IS -LENGTH) TO LH
MOVEI 3,PATLOC
LSH 3,-^D9 ;FIRST PAGE
HRRI 2,120000(3) ;WITH READ AND EXECUTE ALLOW BITS
MOVEI C,0 ;DOCUMENTED TO WANT 0 IN C
SSAVE ;CREATE SHARE FILE
PUSHJ P,CRLF
HALTF
;GET 10/50 .SHR TYPE FILE
GETSHR: RESET ;CLEAR VIROS STUFF
CALLI 0 ;'FIRST' UUO
MOVE P,PATSTK
SETOM INPAT
HRROI 1,[ASCIZ /
.SHR FILE TO BE LOADED: /]
PSOUT
MOVSI 1,120003
MOVE 2,[XWD PRIJFN,PROJFN]
GTJFN
PUSHJ P,ERROR
MOVE 2,[XWD 440000,200000]
OPENF
PUSHJ P,ERROR
MOVEI 7,.HSLOC ;HIGH SEGMENT ADDRESS
MOVEM 7,HSORG ;DEFAULT HIGHSEG ORG
GSHR1: BIN
JUMPN 2,GSHR3 ;IF NON-0, CAN'T BE END OF FILE
GTSTS
TLNE 2,1000
JRST GSHR2
SETZ 2, ;NOT EOF, STORE THE 0
GSHR3: MOVEM 2,0(7)
AOJA 7,GSHR1
GSHR2: CLOSF
PUSHJ P,ERROR
MOVEI A,.HSLOC+10 ;GIVE USER AT LEAST SOME HIGH SEG
MOVEM A,JBHRL ;SO UMOVE'S WONT FAIL
PUSHJ P,SETVES ;SETUP VESTIGAL DATA
MOVEI 1,.FHSLF
HRRZ 2,.JBSA
HRLI 2,<JRST>B53 ;LH SPECIFYING 10/50 ENTRY VECTOR
SEVEC
SETZM INPAT
HALTF
;CREATE 10/50 SHR TYPE FILE
MAKSHR: CALLI 0
MOVE P,PATSTK
SETOM INPAT
PUSHJ P,MAKVES ;COPY JOB DATA AREA TO VESTIGAL AREA
MOVEI A,.FHSLF
UMOVE B,.JBSA
HRLI B,1
SEVEC ;SETUP ENTRR VECTOR
MAKS2: HRROI A,[ASCIZ/
SSAV ON FILE = /]
PSOUT
MOVSI A,460003
MOVE B,[XWD PRIJFN,PROJFN]
GTJFN
JRST MAKS2
HRLI A,.FHSLF
SETZ C,
MOVE B,[XWD -300,400+520B26]
SSAVE ;SSAVE PAGES 400 TO 677 WITH
;READ, EXECUTE, COPY ON WRITE.
PUSHJ P,CLRALL ;NO PI'S OR COMPATIBILITY VECTOR
SETZM INPAT
HALTF
;AFTER-LOADING FIXUP
LIN2: MOVE P,PATSTK ;GET A STACK
PUSHJ P,CLRALL ;CLEAR COMPAT VECTOR AND PSI SYSTEM
SETO 1,
MOVSI 2,.FHSLF
MOVE 3,[1B0!PATPAG] ;CLEAR 0 TO PAT-1
PMAP ;FLUSH EVERYTHING NOT IN PAT
HALTF
XLIST ;LITERALS
LIT ;HIGH CORE LITERALS
LIST
FFF0:
FFF: BLOCK 100 ;PATCH SPACE
ENDFF: ;END OF EVERYTHING, USED BY MAKEPF,LINIT
DEPHASE
IFN SAMFRK,<
LOC 140 ;IN LOW SEGMENT FOR FIXUPS
>
;START HERE AFTER LOADING
LINIT:! RESET ;TURN OFF PI SYSTEM
MOVE P,[IOWD TSTKL,TSTK] ;SET UP A STACK TO USE
MOVEI A,.FHSLF ;CLOBBER THE PSI SYSTEM
DIR ; DISABLE SYSTEM
CIS ;CLEAR ANYTHING PENDING
SETO B, ;ALL ONES
DIC ;DISABLE ALL CHANNELS
MOVE A,[JRST COMPAT] ;SHOULD BE FIRST WORD OF PROGRAM
CAMN A,KEVEC-PATLOC+LODORG ;IS IT?
JRST LIN0 ;YES. OK.
HRROI A,[ASCIZ /
? LOADING ERROR
/]
PSOUT ;SOMEONE HAS CHANGED THE LOADER!
HALTF
LIN0:! MOVEI B,PATPAG ;PAGE WHERE PAT LIVES
HRLI B,.FHSLF
SETO A,
MOVE C,[1B0!NPATPG] ;CLEAR ALL OF PAT
PMAP ;CLEAR AREA TO PUT CODE
MOVE A,[XWD LODORG,PATLOC] ;READY TO BLT THE CODE
BLT A,ENDFF ;WHERE IT SHOULD END
MOVE A,[KEVEC,,EVEC] ;MOVE LITERAL VECTOR TO RUNNING VECTOR
MOVEI B,EVECL(A) ;END OF RUNNING VECTOR
BLT A,-1(B) ;SEEMS TO BE ONLY WAY TO GET TO 700000.
HLRE A,.JBSYM ;-LENGTH OF SYM TAB
MOVMS A ;+ LENGTH OF SYM TAB
HRLZ B,.JBSYM ;WHERE SYMTAB NOW STARTS
HRRI B,ENDFF ;WHERE IT WILL START
HRRM B,.JBSYM ;UPDATE .JBSYM ITSELF
BLT B,ENDFF(A) ;MOVE THE SYMBOLS
MOVSI 1,(1B2+1B17)
HRROI 2,[ASCIZ /SYS:UDDT.EXE/]
GTJFN
PUSHJ P,ERROR
HRLI 1,.FHSLF
GET ;GET DDT
MOVE 1,.JBSYM
MOVEM 1,@DDTLOC+1 ;SETUP DDT SYMTAB PTR
MOVEM 1,SJBSYM ;STORE AT ENTRY VECTOR+DELTA TOO
MOVE 1,.JBUSY ;GET UNDEFINED SYMBOL TBL POINTER
MOVEM 1,@DDTLOC+2 ;STORE IT
JRST LIN2 ;COMPLETE FIXUP IN HIGH CORE
TSTKL==10
TSTK: BLOCK TSTKL
END LINIT