Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/phone20/phnsrv.mac
There are 3 other files named phnsrv.mac in the archive. Click here to see a list.
;MSC:<BUDNE.FONE.REED>PHNSRV.MAC.1003 16-Aug-85 NM+1D.1H.51M.13S., by BUDNE
; Released to "integration tools clearinghouse"
;MSC:<BUDNE.FONE>PHNSRV.MAC.1000 26-Dec-84 NM+4D.10H.50M.52S., by BUDNE
; Remove PTYnnn STUFF
;MSC:<BUDNE.FONE>PHNSRV.MAC.999 10-Jun-84 FQ+4D.14H.0M.3S., by BUDNE
; CLEAR ALL USRXX VARS AT KFORK TIME
;MSC:<BUDNE.FONE>PHNSRV.MAC.995 5-Jun-84 NM+7D.0H.5M.41S., by BUDNE
; ONLY RETURN STATUS FOR DIR, VERIFY, AND RING (AS WITH VAX)
TITLE PHNSRV - TOPS-20 Phone server
SUBTTL Robert A. Brown/Philip L. Budne
SUBTTL Definitions and symbols
SEARCH MONSYM,MACSYM,JOBDAT
SALL ;PRETTY LISTINGS
.DIRECTIVE FLBLST ;PRETTIER LISTINGS
.REQUEST SYS:MACREL ;FOR ACVAR
PURPAG==400 ;PAGE FOR PURE CODE & DATA
PURADR==PURPAG*1000 ;ADDRESS FOR PURE CODE & DATA
TWOSEG PURADR
ASCIZ "
Copyright (c) 1984, 1985 by Philip L. Budne and Digital Equipment Corp.
"
; This program may be copied for non profit use, with the inclusion of
; the above Copyright. No title to and ownership of the software is
; hereby transferred.
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by anyone.
;
; Neither Digital nor the Author assume responsibility for the use or
; reliability of this software anywhere.
;Parameters
EDIT==^D1000 ;LAST MAJOR EDIT
MAXJOB==^D510 ;NUMBER OF JOBS TO SCAN
MAXSRV==^D10 ;MAXIMUM NUMBER OF INFERIOR SERVER FORKS
IFNDEF DEBUGF,DEBUGF==0 ;DEBUG MODE
DATAPG==300 ;PAGE FOR DATA BUFFER IN INFERIOR
DATADR=DATAPG*1000 ;ADDR TO MATCH
DATLEN==1000 ;ONE PAGE OF DATA
;Rel 6.0 Symbols
IFNDEF .TT102,.TT102==:^D37 ;VT102
IFNDEF .TTH19,.TTH19==:^D38 ;HEATHKIT/ZENITH H19/Z19
IFNDEF .TT131,.TT131==:^D39 ;VT131
IFNDEF .TT200,.TT200==:^D40 ;VT200
IFNDEF .MORTF,.MORTF==:54 ;READ TERMINAL FLAGS
IFNDEF MO%NUM,MO%NUM==:1B34 ; REFUSE USER-MESSAGES
IFNDEF MO%NTM,MO%NTM==:1B35 ; INHIBIT NON-JOB OUTPUT
;AC definitions
T0==0
T1==1
T2==2
T3==3
T4==4
T5==5
.FPAC==6 ;FIRST PRESERVED AC
.NPAC==14-6 ;THIS MANY (6..13)
AX==14 ;BYTE POINTER
I==15 ;USER INDEX (** DO NOT TRY USING TRVAR!! **)
;;;16 ;USED BY MACSYM (ACVAR,STKVAR)
P==17 ;PDL
;Instructions
OPDEF PJRST [ JUMPA 13, ]
OPDEF $FATAL [ 1B8 ] ;ERROR LUUO
DEFINE RETSKP < JRST CPOPJ1 >
DEFINE FATAL(MESS) <
IFB <MESS>,< $FATAL 0 ;> $FATAL [ASCIZ ~MESS~]
> ;FATAL
DEFINE EFATAL(MESS) < ERCAL [ FATAL(MESS) ] > ;EFATAL
;Protocol message codes
MS$CHK==:^D7 ;CHECK USER
MS$RNG==:^D8 ;RING PHONE
MS$HUP==:^D9 ;HANGUP
MS$BUS==:^D10 ;TARGET IS BUSY
MS$ANS==:^D11 ;TARGET HAS ANSWERED
MS$REJ==:^D12 ;REJECT CALL
MS$DON==:^D13 ;DONE WITH SLAVE
MS$TXT==:^D14 ;CONVERSATION TEXT
MS$DIR==:^D15 ;NEXT DIRECTORY LINE
MS$FAX==:^D16 ;MAKE A RECORD FACSIMILE (*NOT USED*)
MS$3RD==:^D17 ;HANDLE FORCED LINK TO THIRD PARTY
MS$HLD==:^D18 ;PUT ON HOLD
MS$OFF==:^D19 ;TAKEN OFF HOLD
;Status codes
ST$OTH==:^D0 ;OTHER..
ST$AOK==:^D1 ;OK
ST$IUS==:^D2 ;INVALID USER SYNTAX
ST$FAI==:^D3 ;SLAVE FAILED
ST$UID==:^D4 ;UID MISSING
ST$SNP==:^D5 ;SLAVE DOES NOT HAVE PRIVS
ST$UNE==:^D6 ;USER DOES NOT EXIST
ST$TTY==:^D7 ;PHONE CANNOT USE TTY
ST$LOG==:^D8 ;USER HAS LOGGED OFF
ST$OFF==:^D9 ;"OFF THE HOOK" /NOBROAD, REFUSE LYNX, TTY GAG
SUBTTL SHARED VARIABLES
MYPID: BLOCK 1 ;PHNSRV PID (USED BY INFERIORS)
LCLNOD: BLOCK 2 ;LOCAL NODE NAME (USED BY INFERIORS)
TRCFLG: BLOCK 1 ;TRACE FORK TERMINATIONS (FOR TESTING)
PIGFLG: BLOCK 1 ;INFERIORS RUN LOCKED IN HIGH QUEUE (OFF)
NUMACT: BLOCK 1 ;NUMBER OF ACTIVE INFERIORS
;PER FORK INFORMATION (SHARED)
USRFK: BLOCK MAXSRV ;FORK INDEX FOR THIS USER SLAVE PROCESS
USRPD: BLOCK MAXSRV ;TARGET USER'S PID
USRNM: BLOCK MAXSRV ;TARGET USER'S USER NUMBER
USRJB: BLOCK MAXSRV ;TARGET USER JOB NUMBER
USRJF: BLOCK MAXSRV ;TARGET USER JFN
SYSVER: BLOCK 40 ;SYSTEM VERSION STRING (FOR SYSTAT)
;;;PTYPAR: BLOCK 1 ;NUMBER OF FIRST PTY (FOR DIR/SYSTAT)
OPRUNO: BLOCK 1 ;OPERATOR USER NUMBER (FOR DIR/SYSTAT)
P1FLG: BLOCK 1 ;PSI LEVEL 1 PC
P2FLG: BLOCK 1 ;PSI LEVEL 2 PC
P3FLG: BLOCK 1 ;PSI LEVEL 3 PC
ACSAVE: BLOCK 17 ;AC SAVE AREA FOR FORK TERMINATION INTERUPT
SUBTTL IMPURE STORAGE
; **Private copies of these exist for each fork**
RELOC ;TO LOW SEG
PLIST: BLOCK <LPLIST==30> ;PUSH DOWN LIST (STACK)
JUNK: BLOCK 100 ;TEMP JUNK BUFFER
SAVPNT: BLOCK 1 ;BP TO DATA FIELD OF MESSAGE
GJIBLK: BLOCK .JIMAX+1 ;FOR GETJI'S IN RING ETC..
PC1: BLOCK 1 ;INFERIOR LEVEL 1 PSI PC
FOJBLK: BLOCK 3 ;BLOCK FOR .MUFOJ IN CHKPID
QRYBLK: BLOCK 10 ;BLOCK FOR .MUQRY IN QRYPID
RINGFL: BLOCK 1 ;STATE OF RING FLAG
ONCE: BLOCK 1 ;FIRST TIME FLAG (DIR,SYSTAT)
NETJFN: BLOCK 1 ;NETWORK JFN FROM FOREIGN MASTER
IPCBLK: BLOCK 20 ;DATA BUFFER (FOR SUPERIOR IPCF ONLY)
IPRCVS: BLOCK 11 ;MRECV BLOCK
IPSNDS: BLOCK 4 ;MSEND BLOCK
PIDNAM: BLOCK ^D<<39+7+4>/5> ;USER PID NAME
RELOC ;BACK TO HISEG
SUBTTL CONSTANTS
LEVTAB: EXP P1FLG,P2FLG,P3FLG ;PSI LEVEL TABLE
DEFINE XX (LEV,ADR,OFF,LBL) <
IFNB <OFF>,BLOCK OFF-.
IFNB <LBL>,LBL:!
IFN <LEV+ADR>,<
CHNMSK==CHNMSK!1B<.>
LEV,,ADR
> ;IFN LEV+ADR
> ;XX
CHNMSK==0
CHNTAB: PHASE 0 ;PSI CHANNEL TABLE
XX 1,CONINT,,CONCHN ;DECNOT CONNECT
XX 1,POVINT,.ICPOV ;PDL OVERFLOW
XX 1,EOFINT,.ICEOF ;EOF
XX 1,DAEINT,.ICDAE ;DATA ERROR
XX 1,ILIINT,.ICILI ;ILL INSTR
XX 1,INFINT,.ICIFT ;INFERIOR FORK TERMINATION
XX 0,0,^D36 ;FILL UP TABLE
DEPHASE
SUBTTL SERVER DISPATCH TABLE
DEFINE ACTION(OFFSET,ROUT) <
BLOCK OFFSET-.
EXP ROUT
> ;ACTION
DSPTAB: PHASE 0 ;*** FUNCTION DISPATCH ***
ACTION MS$CHK,CHECK ;Check out user (*) RETURNS STATUS
ACTION MS$RNG,RING ;Ring phone (*) RETURNS STATUS
ACTION MS$HUP,FORWRD ;Remote has hung up
ACTION MS$BUS,FORWRD ;Master is busy
ACTION MS$ANS,FORWRD ;Phone answered
ACTION MS$REJ,FORWRD ;Call rejected
ACTION MS$DON,SRVERR ;Slave no longer needed
ACTION MS$TXT,FORWRD ;Conversation text
ACTION MS$DIR,DIRECT ;Directory request (*) RETURNS STRING
ACTION MS$FAX,0 ;Facsimile (**NOT USED**)
ACTION MS$3RD,FORWRD ;Add third party
ACTION MS$HLD,FORWRD ;Put PHONE on hold
ACTION MS$OFF,FORWRD ;Take PHONE off hold
MAXDSP==.-1
DEPHASE
SUBTTL MAIN PROGRAM
START: RESET ;STOP THE WORLD!!
MOVE P,[IOWD LPLIST,PLIST] ;SET UP PDL
MOVE T1,[CALL LUUOH] ;LUUO INSTR
MOVEM T1,.JB41 ;STORE
CALL PSIINI ;INITIALIZE PSI SYSTEM
CALL INIT ;INITIALIZE THE WORLD
CALL IPCINI ;INITIALIZE IPCF
CALL NEWJFN ;GET NET JFN
WAIT ;SLEEP UNTIL CONNECT
CONWAI: JFCL ;PC ENDS UP HERE
NEWJFN: SETZM NETJFN ;NO LISTENER JFN
MOVSI T1,(GJ%SHT) ;SHORT FORM
HRROI T2,[ASCIZ/SRV:29./] ;TELEPHONE SERVER
GTJFN ;GET JFN
FATAL (Could not get JFN) ; CAN'T?
MOVX T2,<FLD(8,OF%BSZ)!OF%WR!OF%RD> ;OPEN FOR READ/WRITE IN 8 BIT
OPENF ;TRY IT!
FATAL (Could not open JFN)
MOVEM T1,NETJFN ;SAVE SERVER JFN
MOVEI T2,.MOACN ;ASSIGN INTERRUPT SYSTEM CHANNEL NUMBERS
MOVX T3,<FLD(CONCHN,MO%CDN)!FLD(.MOCIA,MO%DAV)!FLD(.MOCIA,MO%INA)>
MTOPR ;DEVICE OPERATION; ENABLE FOR CONNECT INTERUPTS
EFATAL (Could not connect to PSI)
RET
CONINT:
IFE DEBUGF,<
CALL GOTCON ;HANDLE CONNECT INTERUPT
CALL NEWJFN ;GET FRESH NET JFN
> ;IFE DEBUGF
IFN DEBUGF,<
SETZ I,
MOVE T1,NETJFN ;GET JFN
MOVEM T1,USRJF(I) ;SAVE
MOVEI T2,.MOCC ;CONNECT
SETZB T3,T4 ;NO DATA
MTOPR ;DEVICE FUNCTION
MOVEI T1,SERVER
MOVEM T1,P1FLG
> ;IFN DEBUGF
DEBRK ;RETURN FROM INTERUPT
EFATAL (CONINT DEBRK failed)
GOTCON: MOVSI I,-MAXSRV ;FOR ALL FORKS
GOC.1: SKIPE USRFK(I) ;FREE?
AOBJN I,GOC.1 ; NO, KEEP LOOKING
JUMPGE I,GOC.2 ;NONE FOUND, REJECT
MOVE T1,NETJFN ;GET JFN
MOVEI T2,.MOCC ;CONNECT
SETZB T3,T4 ;NO DATA
MTOPR ;DEVICE FUNCTION
ERJMP GOC.2 ;FAILED!
CALL NEWFRK ;START SERVER
JRST GOC.2 ; FAILED
RET ;AOK
GOC.2: MOVE T1,NETJFN ;GET JFN
TLO T1,(CZ%ABT) ;ABORT I/O
CLOSF ;CLOSE
ERJMP .+1 ; SIGH
RET
SUBTTL SERVER FORK MAIN CODE
SERVER:
IFE DEBUGF,<
RESET ;STOP THE WORLD!
> ;IFE DEBUGF
MOVE P,[IOWD LPLIST,PLIST] ;GET A PDL
MOVEI T1,.FHSLF ;THIS FORK
SETO T3, ;ALL CAPS
EPCAP ;ENABLE
IFE DEBUGF,<
SKIPN PIGFLG ;BE PIGGY?
IFSKP. ; CHECK...
MOVX T2,<FLD(1,JP%MNQ)!FLD(2,JP%MXQ)> ;RUN IN QUEUE 1
SPRIW ;GET PIGGY
ERJMP .+1 ;SIGH
ENDIF.
> ;IFE DEBUGF
;Clear shared vars
SETZM USRPD(I) ;NO MORE PID
SETZM USRNM(I) ;NO MORE USER NUMBER
SETZM USRJB(I) ;NO MORE JOB
;Clear private vars
SETZM RINGFL ;NO FIRST RING
SETZM ONCE ;ZERO COUNT
SUBTTL SERVER MAIN LOOP
SRVLOP: MOVE T1,USRJF(I) ;GET FILE
MOVE T2,[POINT 8,DATADR] ;GET ADDRESS
MOVNI T3,DATLEN*4-1 ;GET LENGTH IN 8 BIT BYTES (W/ ROOM FOR NULL)
SINR ;READ!
ERJMP SRVERR ;SIGH
ADDI T3,DATLEN*4-1 ;GET LENGTH OF DATA
SETZ T1, ;GET NULL
IDPB T1,T2 ;ENSURE ASCIZ
MOVE AX,[POINT 8,DATADR] ;INTIAL BYTE POINTER
ILDB T1,AX ;GET COMMAND BYTE
CAIG T1,MAXDSP ;IN RANGE?
SKIPN T1,DSPTAB(T1) ;GET DISPATCH ADDR
MOVEI T1,SNDOTH ; RETURN "SOME OTHER ERROR"
CALL (T1) ;EXECUTE
TRN ;EXPECT THE UNEXPECTED
JRST SRVLOP ;LOOP
SRVERR: HALTF ;DIE ON ERROR
SRVDED: JFCL ;MAGIC LABEL
IFN 0,<
;Remote systat
SYST: MOVE AX,[POINT 8,DATADR] ;Initial byte pointer
SKIPN T1,ONCE ;First time ?
JRST [AOS T1,ONCE ;Mark were here
MOVEI T2,SYSTAB ;Output system name
CALL DOWRT ;Write it
JRST SYST3]
SYST0: AOS T1,ONCE
CAILE T1,MAXJOB
PJRST SNDNUL
;;;; MUCH STUFF HERE
SYST3: RETSKP
> ;IFN 0 (SYSTAT)
;Forward the message to local target
FORWRD: SKIPE T1,USRPD(I) ;HAVE A PID FOR OUR USER?
CALL CHKPID ; IS PID VALID?
RET ; NOPE
CALL SIPCF ; FORWARD IT TO THE LOCAL PHONE
TRN
RET
SUBTTL CODE 8: RING USER
RING: STKVAR <SAVEBP,THSRNG> ;SAVED BP, CURRENT RING
MOVEM AX,SAVEBP ;SAVE MESSAGE DATA
RG.XXX: ILDB T1,AX ;GET BYTE
JUMPN T1,RG.XXX ;TOSS USER NAME
ILDB T1,AX ;GET RING FLAG
SKIPN RINGFL ;ALREADY GOT FIRST RING?
MOVEM T1,RINGFL ;NO, STORE NEW FLAG (SHOULD BE TRUE)
MOVEM T1,THSRNG ;SAVE CURRENT STATE
CALL FNDUSR ;CHECK FOR A PID
JRST RG.MES ; NONE, JUST SEND VIA TTMSG
CAMN T1,USRPD(I) ;SAME PID AS LAST TIME?
JRST RG.FWD ; YES, JUST FORWARD
;Here with a new PID
MOVEM T1,USRPD(I) ;NO, SAVE NEW PID
SKIPN RINGFL ;WAS SOME PAST RING THE FIRST?
JRST RG.FWD ; NO, THIS ONE *SHOULD* BE
;Here with a new PID, after first ring sent: forward with flag set
MOVE T1,SAVEBP ;GET DATA
RG.FAK: ILDB T0,T1 ;GET BYTE
JUMPN T0,RG.FAK ;TILL END OF USER
MOVEI T0,1 ;GET TRUE
IDPB T0,T1 ;STORE RING FLAG
;Here to forward a ring
RG.FWD: MOVE T2,SAVEBP ;GET USER BP
SKIPE THSRNG ;WAS THIS RING THE FIRST?
CALL LCLRNG ; YES, DO LOCAL RING FIRST
TRN ; NO+IGNORE ERROR
CALL FORWRD ;FORWARD LOCAL PACKET
PJRST SNDAOK
RG.MES: MOVE T2,SAVEBP ;GET BP TO USER
CALL LCLRNG ;DO LOCAL RING
PJRST SNDERR ; RETURN ERROR CODE
PJRST SNDAOK ;RETURN AOK
SUBTTL DO LOCAL RING
;Creates message text in JUNK buffer and send to all
;*MUST BE DONE BEFORE FORWARD, SINCE IPCF SENDS PAGE W/ USER NAME IN IT!!!*
; T2/ BP to user
; CALL LCLRNG
; <error code in T1>
; <AOK>
LCLRNG: ACVAR <X1,X2,X3>
HRROI T1,JUNK ;POINT TO BUFFER
CALL CPYSTR
MOVEI T2,[ASCIZ/ is calling you at /]
CALL CPYSTR
MOVEI T2,LCLNOD ;NODE NAME
CALL CPYSTR
MOVEI T2,[ASCIZ/ on /]
CALL CPYSTR
SETOB T2,T3 ;NOW, FANCY
ODTIM ;OUTPUT
ERJMP .+1 ; FUEY!
MOVEI T2,[BYTE(7) 7,7,7,12,15,0] ;DING**3, CRLF
CALL CPYST0
;Now loop for all jobs, and blat the OK ones.
LR.BEG: MOVE X1,[1-MAXJOB,,1] ;AOBJN COUNT
SETZB X2,X3 ;COUNT OF MATCHES, SENDS
LR.LOP: MOVEI T1,(X1) ;GET JOB
MOVE T2,[-.JISTM-1,,GJIBLK] ;BUFFER
SETZ T3, ;START AT JOB
GETJI ;GET INFO
JRST LR.BOT ; U LOSE
MOVE T2,USRNM(I) ;GET USER NUMBER
CAME T2,GJIBLK+.JIUNO ;MATCH
JRST LR.BOT ; NO, KEEP LOOKIN
SKIPG T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
JRST LR.BOT ; DETACHED
ADDI X2,1 ;INCR MATCHES
;;; MOVEI T1,.TTDES(T1) ;GET DESC
;;; CALL CHKTTY ;CHECK TYPE & LINKS
;;; JRST LR.BOT ; NO GOOD
MOVE T1,GJIBLK+.JITNO ;GET TTY NUMBER
MOVEI T1,.TTDES(T1) ;MAKE DEVICE
HRROI T2,JUNK ;GET TEXT
TTMSG ;SHOVE BELOW SPY LEVEL
ERJMP [SETZ T3, ; TERMINATE ON ZERO.
SOUT ; TRY WITH SOUT
ERJMP .+1 ; IGNORE ERROR
JRST .+1 ] ;KEEP GOING
ADDI X3,1 ;INCR SENDS
LR.BOT: AOBJN X1,LR.LOP ;...LOOP FOR ALL JOBS
JUMPN X3,CPOPJ1 ;AOK IF ANY SENDS DONE
MOVEI T1,ST$TTY ;ASSUME BAD TTY
CAIG X2,0 ;ANY MATCHES?
MOVEI T1,ST$LOG ; NO, "USER LOGGED OFF"
RET
ENDAV.
;Code 7, First packet; check this guy out
CHECK: CALL PNTDAT ;POINT TO DATA
CALL GETUSR ;GET USER NUMBER OF TARGET INTO USRNM(I)
PJRST SNDERR ; RETURNS ERROR IN T1
CALL LKUS ;CHECK IF LOGGED IN, WITH NICE TTY
PJRST SNDERR ; SORRY, RETURN ERROR
CALL FNDUSR ;CHECK FOR USER WITH PID
TRNA ; ERROR?, WHAT ERROR?
MOVEM T1,USRPD(I) ;GOTCHA!
PJRST SNDAOK ;RETURN OK
;Code 15, Directory; list available users
DIRECT: AOS T1,ONCE ;GET NEXT JOB
CAILE T1,MAXJOB ;DONE?
PJRST SNDNUL ; YES, SEND NULL RECORD
MOVE AX,[POINT 8,DATADR] ;INITIAL BYTE POINTER
MOVE T2,[-.JIBAT-1,,GJIBLK] ;WHAT TO STORE WHERE
SETZ T3, ;START AT BEGINING
GETJI ;GET JOB INFO
JRST DIRECT ;NO JOB, GET NEXT
SKIPE T1,GJIBLK+.JIUNO ;LOGGED IN?
CAMN T1,OPRUNO ; SKIP <OPERATOR>
JRST DIRECT ; GET ANOTHER
SKIPN GJIBLK+.JIBAT ;BATCH?
SKIPGE GJIBLK+.JITNO ; GET TERMINAL NUMBER
JRST DIRECT ; RE-JECT
MOVEI T2,GJIBLK+.JIPNM ;PROGRAM NAME?
CALL SIXOUT ;TYPE "PROCESS NAME"
MOVEI T1,"I"-100 ;TAB
IDPB T1,AX
IDPB T1,AX
MOVE T1,AX ;GET DEST BP
MOVE T2,GJIBLK+.JIUNO ;GET USER NUMBER AGAIN
DIRST ;CONVERT TO STRING
ERCAL DIRECT
MOVEI T2," " ;TERMINATE WITH A SPACE
IDPB T2,T1 ;STORE
MOVEI T2,^D8*2 ;DESIRED WIDTH
CALL DOPAD ;PAD WITH TABS
MOVE T2,GJIBLK+.JITNO ;GET TERMINAL NUMBER
MOVEI T1,.TTDES(T2) ;GET DEVICE DESC
CALL CHKTYP ;GOOD TTY TYPE?
JRST [MOVEI T2,[ASCIZ/unusable ---/]
JRST DIRR2]
;;; MOVE T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
MOVEI T2,[ASCIZ /TTY/] ;ASS-U-ME IT IS A TTY
;;; CAML T1,PTYPAR ;IS IT A PTY?
;;; MOVEI T2,[ASCIZ /PTY/] ; YES...
CALL DOWRT ;WRITE PREFIX
MOVE T1,AX ;BORROW BP
MOVE T2,GJIBLK+.JITNO ;GET TTY NUMBER
;;; CAML T2,PTYPAR ;A PTY?
;;; SUB T2,PTYPAR ; YES, REMOVE OFFSET
MOVEI T3,10 ;OCTAL
NOUT
ERJMP .+1
MOVE AX,T1 ;RESTORE BP
MOVE T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
MOVEI T1,.TTDES(T1) ;GET TERMINAL DEVICE DESC
CALL CHKLNK ;ALLOW LINKS ?
SKIPA T2,[[ASCIZ " refuse links/user messages"]]
MOVEI T2,[ASCIZ " available"]
DIRR2: CALL DOWRT ;WRITE PHONE STATUS
DIRR3: SETZ T2,
IDPB T2,AX ;ENSURE A NULL
CALL DECOUT ;WRITE TEXT
RET
;Write text to DECnet
DECOUT: SETZ T3, ;CLEAR COUNT
MOVE T2,[POINT 8,DATADR] ;POINT TO BUFFER
DECOU2: ILDB T0,T2 ;GET NEXT CHAR
CAIE T0,0 ;NULL?
SOJA T3,DECOU2 ;NO, COUNT IT
;Write counted data to DECnet
DECCNT: MOVE T1,USRJF(I) ;NET JFN
MOVE T2,[POINT 8,DATADR] ;BP TO BUFFER
SOUTR ;OUTPUT RECORD
ERJMP SRVERR
RET
;SEND EMPTY RECORD TO TERMINATE DIRECTORY
SNDNUL: SETZM DATADR ;ZERO BUFFER
MOVEI T3,0 ;LENGTH
PJRST DECCNT ;SEND
SNDOTH: SKIPA T1,[ST$OTH] ;"SOME OTHER ERROR"
SNDAOK: MOVEI T1,ST$AOK ; ALL OK
SNDERR: SETZM DATADR ;CLEAR BUFFER
DPB T1,[POINT 8,DATADR,7] ;STORE CODE
MOVNI T3,1 ;XMIT ONE BYTE
PJRST DECCNT ;SEND, AND RETURN
SUBTTL Initialization
PSIINI: MOVEI T1,.FHSLF ;CURRENT PROCESS
MOVE T2,[LEVTAB,,CHNTAB] ;PSI tables
SIR ;SET UP TABLES
MOVX T2,CHNMSK ;GET CHAN MASK
AIC ;ENABLE CHANNELS
EIR ;ENABLE PSI
RET
INIT: MOVEI T1,.FHSLF ;THIS FORK
SETO T3, ;ENABLE ALL CAPABILITIES
EPCAP
MOVEI T1,.NDGLN ;GET OUR NODE NAME
MOVEI T2,T3 ;ARGBLOCK
HRROI T3,LCLNOD ;STORE HERE
NODE ;GET NODE NAME
MOVX T1,RC%EMO ;GET EXACT MATCH
HRROI T2,[ASCIZ/OPERATOR/]
SETZ T3,
RCUSR ;GET OPERATOR USER NUMBER
MOVEM T3,OPRUNO ;SAVE
MOVE T1,[SIXBIT/SYSVER/] ;GET SYSTEM STRING FOR SYSTAT REQUESTS
SYSGT
HLLZ T3,T2 ;KEEP COUNTER
SYVLOP: HRL T1,T3 ;INDEX INTO TABLE
HRR T1,T2 ;GET TABLE NUMBER
GETAB
FATAL (GETAB failed)
MOVEM T1,SYSVER(T3) ;STORE VALUE
AOBJN T3,SYVLOP ;LOOP
;;; MOVE T1,[SIXBIT /PTYPAR/] ;GET PTY INFO
;;; SYSGT
;;; HRRZM T1,PTYPAR ;STORE FIRST PTY
RET
;Look for a valid user
LKUS: MOVEI T5,1 ;START WITH JOB 1
SETO T4, ;NO ERROR CODE
LK.TOP: MOVEI T1,(T5) ;GET JOB NUMBER
MOVE T2,[-3,,GJIBLK] ;WHERE TO STORE INFO
SETZ T3, ;START AT ZERO
GETJI
ERJMP LK.BOT
MOVE T1,GJIBLK+.JIUNO ;GET USER NUMBER
CAME T1,USRNM(I) ;MATCH REQUESTED ONE
JRST LK.BOT ;NO, KEEP LOOKING
SKIPG T1,GJIBLK+.JITNO ;DETACHED?
JRST [MOVEI T4,ST$TTY ; "NOT AT A PHONE"
JRST LK.BOT] ;KEEP LOOKING
ADDI T1,.TTDES ;MAKE INTO DEVICE DESCRIPTOR
MOVEM T1,JUNK ;SAVE TERMINAL NUMBER
CALL CHKLNK ;CHECK LINKS
JRST [MOVEI T4,ST$OFF ; "OFF THE HOOK"
JRST LK.BOT]
MOVE T1,JUNK ;GET TTY DES
CALL CHKTYP ;CHECK TTY TYPE
JRST [MOVEI T4,ST$TTY ; "NOT AT A PHONE"
JRST LK.BOT]
;;; MOVE T2,GJIBLK+.JIJNO ;SAVE JOB NUMBER
;;; MOVEM T2,USRJB(I)
RETSKP
LK.BOT: CAIG T5,MAXJOB ;LAST JOB?
AOJA T5,LK.TOP ;KEEP LOOPING
MOVEI T1,ST$TTY ;ASSUME "NOT AT A PHONE"
CAIL T4,0 ;ANY ERRORS?
MOVE T1,T4 ; YES, RETURN CODE IN T1
RET
;Point to data area
PNTDAT: MOVE T1,[POINT 8,DATADR,7] ;POINT PAST CODE
PD.1: ILDB T0,T1 ;GET NEXT BYTE
JUMPN T0,PD.1 ;LOOP TILL NULL (END OF SENDER)
MOVEM T1,SAVPNT ;SAVE BYTE POINTER
RET
;Get user number from data packet
;Assumes data of form {[_]NODE::}[_]OURNODE::LUSER
; SAVPNT/ BP to user id
; CALL GETUSR
; <failed to parse>
; <ok>
; T2/ BP to USER
; T3/ BP to last NODE::
; T4/ flag,,count
GETUSR: MOVE T1,SAVPNT ;GET BYTE POINTER TO DATA
MOVE T3,T1 ;SETUP BP TO BEFORE LAST NODE::
MOVE T2,T1 ;SETUP BP TO AFTER END OF LAST NODE::
SETZ T4, ;ZERO COUNT
;Here to start field
GU.1: ILDB T0,T1 ;GET NEXT CHAR
CAIE T0,"_" ;VAX QUOTE CHAR?
JRST GU.2 ; NO, CHECK IT OUT
MOVSI T4,1 ;ZERO COUNT, SET NODE FLAG
;Here to parse text
GU.L: ILDB T0,T1 ;GET ANOTHER
GU.2: JUMPE T0,GU.3 ;END OF STRING
CAIE T0,":" ;A COLEN?
AOJA T4,GU.L ; NO, KEEP LOOKING
ILDB T0,T1 ;GET NEXT BYTE
CAIN T0,":" ;BETTER BE A ":"
TRNN T4,-1 ; YES, ANY COUNT?
JRST GU.IUS ; NO; NULL FIELD, OR ONLY ONE ":"
MOVE T3,T2 ;SAVE START OF LAST NODE
MOVE T2,T1 ;MIGHT BE LAST NODE IN LIST, SAVE BP TO USER
SETZ T4, ;ZERO COUNT
JRST GU.1 ;START AGAIN
;Here at end of string
GU.3: TLNN T4,1 ;LAST FIELD HAVE AN "_" ?
CAMN T2,T3 ; NO, PARSE ANYTHING?
JRST GU.IUS ; NOTHING PASED OR USER BEGAN WITH "_"
TRNN T4,-1 ;EMPTY FIELD?
JRST [ MOVEI T1,ST$UID ; "USER MISSING"
RET ] ; BOMB
MOVX T1,RC%EMO ;EXACT MATCHES ONLY
RCUSR ;GREAT NAME..
TLNE T1,(RC%NOM!RC%AMB) ;NO MATCH OR AMBIGUOUS ??
JRST [ MOVEI T1,ST$UNE ; "Target user does not exist"
RET ] ; RETURN SAD.
MOVEM T3,USRNM(I) ;SAVE USER NUMBER
RETSKP ;RETURN HAPPY
GU.IUS: MOVEI T1,ST$IUS ;"ILLEGAL USER SYNTAX"
RET
; AX/ dest byte pointer
; T2/ Addr of string
; CALL DOWRT
; <always>
; AX/ updated
DOWRT: HRLI T2,(POINT 7,) ;Usual byte size
DOWRT2: ILDB T0,T2 ;Get character
JUMPE T0,CPOPJ ;Done if null
IDPB T0,AX ;Store in 8 bits
JRST DOWRT2 ;And continue
;Pad with a tab after text output JSYS (DIRST/DEVST)
DOPAD: PUSH P,T2 ;SAVE DESIRED WIDTH
PUSH P,T1 ;SAVE BP
CALL CLB ;CALCULATE ACTUAL
POP P,AX ;RESTORE BP
POP P,T3 ;GET DESIRED LENGTH
DOPAD1: CAIL T2,(T3) ;PAST IT?
RET ; YES, QUIT
MOVEI T0,"I"-100 ;NO, ADD A TAB
IDPB T0,AX ;DEPOSIT
ADDI T2,^D8 ;EQUIVILENT
ANDI T2,^-<^D8-1> ;ROUNDING
JRST DOPAD1 ;TRY AGAIN
;Calculate difference for two 8-bit byte pointers
; AX/ old pointer
; T1/ new pointer
; CALL CLB
; T2/ number of bytes difference
CLB: MOVEI T2,(T1) ;GET WORD INFO FROM NEW POINTER
SUBI T2,(AX) ;CALCULATE DIFFERENCE FROM OLD POINTER
LSH T2,2 ;FOUR CHARACTERS PER WORD
CLB1: LDB T0,[POINT 6,AX,5] ;GET CHARACTER COUNT FROM OLD
LDB T3,[POINT 6,T1,5] ;AND FROM NEW
SUBI T0,(T3) ;SUBTRACT OLD FROM NEW
ASH T0,-3 ;CHANGE BITS TO BYTES
ADD T2,T0 ;ADD TO NUMBER FROM WORDS
RET ;ALL DONE
SUBTTL IPCF -- RIPCFS - Recieve short message
; For HERE message, or <SYSTEM>INFO
RIPCFS: MOVX T1,IP%TTL ;TRUNCATE
MOVEM T1,IPRCVS+.IPCFL ;STORE FLAGS
MOVE T1,MYPID ;PHNSRV PID
MOVEM T1,IPRCVS+.IPCFR ;RECIEVE SIDE
SETZM IPRCVS+.IPCFS ;UNKNOWN SENDER
MOVE T2,[20,,IPCBLK] ;POINTER TO MESSAGE AREA
MOVEM T2,IPRCVS+.IPCFP ;STORE
MOVEI T1,11 ;LENGTH DESCRIPTOR BLOCK
MOVEI T2,IPRCVS ;LOCATION OF DESCRIPTOR BLOCK
MRECV ;FINALLY!
ERJMP CPOPJ ;WE HAD AN ERROR FOLKS
RETSKP
SUBTTL IPCF -- SIPCFS - Send short message
SIPCFS: MOVEM T1,IPSNDS+.IPCFR ;STORE TARGET
SETZM IPSNDS+.IPCFL ;CLEAR FLAGS
MOVE T1,MYPID ;FROM PHNSRV
MOVEM T1,IPSNDS+.IPCFS ;STORE PID
MOVE T1,[20,,IPCBLK] ;POINT TO PACKET BLOCK
MOVEM T1,IPSNDS+.IPCFP ;STORE
MOVEI T1,4 ;LENGTH OF PACKET DESC BLOCK
MOVEI T2,IPSNDS ;ADDRESS
MSEND ;MAKE REQUEST
ERJMP CPOPJ
RETSKP
;Find PID assoc with a name
; T1/ BP to name
; CALL FNDPID
; <lose>
; <win>
; T1/ PID
FNDPID: HRROI T2,IPCBLK+.IPCI2 ;DEST
CALL CPYTXT ;STORE NAME
MOVEI T1,.IPCIW ;LOOKUP
MOVEM T1,IPCBLK+.IPCI0 ;STORE FUCNTION
SETZM IPCBLK+.IPCI1 ;FOR MY EYES ONLY
CALL IPCSYS ;SEND TO SYSINF
RET ; PASS ERROR
MOVE T1,IPCBLK+.IPCI1 ;PID
RETSKP
;Assign name to MYPID
; T1/ BP to name
NAMPID: HRROI T2,IPCBLK+.IPCI2
CALL CPYTXT ;STORE NAME
MOVEI T1,.IPCII ;CREATE NAME
MOVEM T1,IPCBLK+.IPCI0 ;STORE FUCNTION
SETZM IPCBLK+.IPCI1 ;FOR MY EYES ONLY
;Deal with SYSINF
IPCSYS: SETZ T1, ;SYSINF
CALL SIPCFS ;SEND MESS OFF
JRST ISY.2 ; SIGH
ISY.1: CALL RIPCFS ;RECEIVE A SHORT PACKET
JRST ISY.2 ; ITS NOT MY FAULT!!
LDB T1,[POINTR IPRCVS,IP%CFC] ;GET PRIV-SENDER FIELD
CAIE T1,.IPCCF ;FROM SYSTEM-WIDE <SYSTEM>INFO?
CAIN T1,.IPCCP ; OR FROM MY <SYSTEM>INFO?
TRNA ; YES!!
JRST ISY.1 ; NO, WAIT FOR IT THEN
LDB T2,[POINTR IPRCVS,IP%CFE] ;GET SYSINF RETURN CODE
JUMPN T2,CPOPJ ;ERROR
RETSKP
ISY.2: SETZ T2, ;RETURN NO ERROR
RET
SUBTTL IPCF -- IPCINI - Initialization
IPCINI: MOVEI T1,.FHSLF ;FOR THIS PROCESS
CALL CREPID ;CREATE A PID
FATAL (Could not create PHNSRV PID) ; REPORT ERROR
MOVEM T1,MYPID ;SAVE THE PID
IFN 0,<
HRROI T1,[ASCIZ "PHNSRV"] ;CALL ME PHNSRV...
CALL NAMPID ;... PHNSRV IS MY NAME
PJRST IPCERR
MOVEI T1,3 ;LENGTH
MOVEI T2,T3 ;ADDRESS
MOVEI T3,.MUPIC ;IPCF/PI FUNCTION
MOVE T4,MYPID ;PID
MOVEI T5,IPCCHN ;CHANNEL
MUTIL
EFATAL (.MUPIC failed)
> ;IFN0
RET
IPCERR: TMSG <
==============================
PHNSRV: Error >
MOVEI T1,.PRIOU ;TTY
MOVEI T3,10 ;OKTAL
NOUT ;TYPE
TRN
TMSG < from <SYSTEM>INFO >
HRROI T1,[ASCIZ /(Duplicate name has been specified)/]
CAIN T2,.IPCDN ;MOST LIKELY ERROR
PSOUT
CALL ENDERR
SUBTTL IPCF -- SIPCF - Send an IPCF page to a local master
; Always sends a page (should be fastest)
SIPCF: MOVEI T1,IP%CFV ;SEND A PAGE
MOVEM T1,IPSNDS+.IPCFL ;STORE FLAGS
MOVE T1,[1000,,DATAPG] ;SEND THE BUFFER WE JUST GOT
MOVEM T1,IPSNDS+.IPCFP ;STORE POINTER
MOVE T1,USRPD(I) ;GET USER'S PID
MOVEM T1,IPSNDS+.IPCFR ;STORE RECIEVER
MOVEI T1,4
MOVEI T2,IPSNDS
MSEND
ERJMP CPOPJ
RETSKP
SUBTTL IPCF -- QRYPID - Query IPCF queue for a PID
; T1/ PID
; CALL QRYPID
; <empty>
; <some>
QRYPID: MOVEM T1,QRYBLK+1 ;STORE PID IN BLOCK
MOVEI T1,.MUQRY ;FUNCTION
MOVEM T1,QRYBLK ;STORE
DMOVE T1,[EXP 10,QRYBLK] ;LENGTH, ADDR
MUTIL ;ANY MORE PACKETS?
ERJMP CPOPJ ; ASSUME ERROR MEANS NO.
RETSKP ;YES
SUBTTL IPCF -- CHKPID - Find owning job for a PID
;Check a PID
; T1/ PID
; CALL CHKPID
; <invalid>
; <valid>
; T1/ owning job
CHKPID: MOVEM T1,FOJBLK+1 ;STORE PID
MOVEI T1,.MUFOJ ;FUNCTION
MOVEM T1,FOJBLK ;STORE
DMOVE T1,[EXP 3,FOJBLK] ;LEN & ADDR
MUTIL ;FIND THE PID'S JOB
ERJMP CPOPJ ;RETURN ERROR
MOVE T1,FOJBLK+2 ;GET JOB NUMBER
RETSKP ;RETURN HAPPY
SUBTTL IPCF -- CREPID - Create a PID
; T1/ Flags
; CALL CREPID
; <lose>
; <win>
; T1/ PID
CREPID: DMOVE T1,[EXP 3,T3] ;LEN & ADDR
DMOVE T3,[EXP .MUCRE,.FHSLF] ;CREATE FOR THIS PROCESS
MUTIL ;DOIT
ERJMP CPOPJ ;RETURN ERROR
MOVE T1,T5 ;GET PID
RETSKP ;RETURN HAPPY
SUBTTL IPCF -- DESPID - Destroy a PID
; T1/ PID
; CALL DESPID
; <lose>
; <win>
DESPID: MOVE T4,T1 ;PUT PID IN PLACE
DMOVE T1,[EXP 2,T3] ;LEN & ADDR
MOVEI T3,.MUDES ;FUNCTION
MUTIL ;DOIT
ERJMP CPOPJ ;RETURN ERROR
RETSKP ;RETURN HAPPY
;Output full SIXBIT word
; T2/ Addr of SIXBIT word
; AX/ Dest BP
; CALL SIXOUT
; <always>
; AX/ Updated BP
SIXOUT: MOVEI T1,6 ;BYTE COUNT
HRLI T2,(POINT 6,) ;MAKE BP
SIXOU2: ILDB T0,T2 ;GET NEXT BYTE
ADDI T0,40 ;MAKE INTO ASCII
IDPB T0,AX ;STORE
SOJG T1,SIXOU2 ;LOOP
RET
;Check for OK terminal type
; T1/ Terminal specifier
; CALL CHKTYP
; <Not supported by PHONE>
; <ok>
CHKTYP: GTTYP ;GET TTY TYPE
ERJMP CPOPJ ;YOU LOSE
CAIE T2,.TTV52 ;VT52?
CAIN T2,.TT100 ;VT100?
RETSKP ;OK
CAIE T2,.TT125 ;VT125?
CAIN T2,.TTK100 ;GIGI?
RETSKP ;OK
CAIE T2,.TT131 ;VT131?
CAIN T2,.TT102 ;VT102?
RETSKP ;OK
CAIE T2,.TT200 ;VT2XX?
CAIN T2,.TTH19 ;HEATHKIT-19?
RETSKP ;OK
RET ;UNSUPPORTED
;Check terminal characteristics
; T1/ tty spec
; CALL CHKTTY
CHKTTY: ACVAR <X1>
MOVE X1,T1 ;SAVE DESC
CALL CHKTYP ;OK TYPE?
RET ;NO
MOVE T1,X1 ;GET TTY AGAIN
;Check terminal LINKs status
; T1/ Terminal specifier
; CALL CHKLNK
; <refuse links>
; <accept links>
CHKLNK: MOVEI T2,.MORTF ;NEW FANGLED TERMINAL BITS
MTOPR ;READ THEM
ERJMP CHKLN2 ; OLD MONITOR?
TRNE T3,MO%NUM!MO%NTM ;GOT YER EARS ON?
RET ; NO, YOU LOSE
JRST CPOPJ1 ;YES, YOU WIN
CHKLN2: RFMOD ;GET TERMINAL JFN MODE WORD
ERJMP CPOPJ ;WHOOPS!
TRNE T2,TT%ALK ;ALLOW LINKS ?
CPOPJ1: AOS (P) ;YES.
CPOPJ: RET ;NO.
ENDAV. ;(FROM CHKTTY)
;Create new inferior fork & all its mappings
; I/ "fork number"
; CALL NEWFRK
NEWFRK: MOVE T1,NETJFN ;GET JFN TO BE USED
MOVEM T1,USRJF(I) ;SAVE
MOVSI T1,(CR%CAP!CR%ACS) ;GIVE CAPABILITIES & ACS
MOVEI T2,0 ;START WITH OUR AC0
CFORK ;CREATE FORK
EFATAL (CFORK FAILED) ;DIE
MOVEM T1,USRFK(I) ;STORE FORK INDEX
MOVSI T2,(T1) ;GET INFERIOR,,0
MOVSI T1,.FHSLF ;GET SUPERIOR,,0
SKIPN T3,.JBREL ;GET LINK END OF LOW SEG
FATAL (.JBREL is empty)
ADDI T3,777 ;ROUND UP
LSH T3,-^D9 ;MAKE PAGE COUNT
HRLI T3,(PM%CNT!PM%RD!PM%CPY) ;GET FUNNY BITS
PMAP ;SET UP MAPPING FOR IMPURE DATA
EFATAL (PMAP1 failed) ;DIE
HRRI T1,PURPAG ;GET SUPERIOR,,PAGE
HRRI T2,PURPAG ;GET INFERIOR,,PAGE
MOVE T3,[PM%CNT!PM%RWX!<1000-PURPAG>] ;COPY FROM PURPAG UP
PMAP ;MAP WITH WRITE ACCESS
EFATAL (PMAP2 failed)
MOVE T1,USRFK(I) ;GET INFERIOR FORK
MOVEI T2,SERVER ;START AT SERVER START ADDR
SFORK ;START THE FORK
EFATAL (SFORK failed) ;SIGH
AOS NUMACT ;NUMBER OF ACTIVE FORKS
RETSKP
;Here on inferior termination interupt
INFINT: MOVEM 16,ACSAVE+16 ;SAVE AC16
MOVEI 16,ACSAVE ;FROM ACS TO ACSAVE
BLT 16,ACSAVE+15 ;COPY AC0..15
MOVSI I,-MAXSRV ;ALL SERVERS
IIN.L: SKIPN T1,USRFK(I) ;GET HANDLE
JRST IIN.B ; NO FORK!
CALL CHKFRK ;CHECK THIS FORK
TRNA ;ITS DEAD JIM!
JRST IIN.B ;OK
SKIPN TRCFLG ;FORK TRACE?
IFSKP.
PUSH P,T1 ;SAVE T1
TMSG <FORK >
POP P,T3 ;RESTORE STATE
HRROI T1,[ASCIZ "HALTED"]
CAIE T3,.RFHLT ;REALLY?
HRROI T1,[ASCIZ "^C"]
PSOUT
TMSG < AT >
MOVEI T0,(T2) ;GET PC
CALL SYMOUT ;TYPE SYMBOL
CALL CRLF
ENDIF.
MOVE T1,USRFK(I) ;GET HANDLE
KFORK ;REMOVE DEAD BODY
ERJMP .+1 ;YAWN
SOS NUMACT ;DECR NUMBER OF ACTIVE FORKS
SKIPN T1,USRJF(I) ;HAD A JFN?
JRST IIN.B ; NO
TLO T1,(CZ%ABT) ;YES, ABORT I/O
CLOSF ;AND CLOSE
ERJMP .+1 ; IGNORE ERROR
SETZM USRJF(I) ;CLEAR JFN
SETZM USRFK(I) ;CLEAR AWAY HANDLE
SETZM USRPD(I) ;CLEAR PID
SETZM USRJB(I) ;CLEAR JOB NUMBER
SETZM USRNM(I) ;CLEAR USER NUMBER
IIN.B: AOBJN I,IIN.L ;..LOOP
SKIPN NETJFN ;HAVE AN OPEN LISTENER?
CALL NEWJFN ; NO, GET ONE
MOVSI 16,ACSAVE ;ACSAVE TO ACS
BLT 16,16 ;AC0..16
DEBRK
EFATAL (INFINT DEBRK failed)
;Check fork status
; T1/ Handle
; CALL CHKFRK
; <dead>
; <alive>
CHKFRK: RFSTS ;GET FORK STATUS
ERJMP CPOPJ ;MUST BE DEAD..
HLRZ T1,T1 ;GET STATUS CODE
CAIN T1,-1 ;GOOD HANDLE?
RET ;NOPE.
ANDI T1,(RF%STS) ;GET JUST STATE
CAIE T1,.RFHLT ;HALTED?
CAIN T1,.RFFPT ; FORCED TERMINATION?
RET ; YEP
RETSKP ;OTHERWISE LOOKS GOOD.
;Find user w/ PID
; I/ User index
; CALL FNDUSR
; <not found>
; <found>
; T1/ PID if found
FNDUSR: MOVE T1,[POINT 7,PIDNAM]
MOVEI T2,"<" ;>START PID NAME
IDPB T2,T1 ;STORE
SKIPE T2,USRNM(I) ;GET USER NUMBER
DIRST ;CONVERT DIR # TO STRING
RET ; YOU LOSE<
HRROI T2,[ASCIZ ">PHONE"]
CALL CPYST0 ;COPY W/ NULL
HRROI T1,PIDNAM ;GET NAME
CALL FNDPID ;WHO OWNS IT?
RET ; NOONE
RETSKP
IFN 0,<
;Hang until prev instruction skips
; <TEST-INSTR>
; CALL HANG
HANG: PUSH P,T1 ;SAVE AN AC
MOVEI T1,^D250 ;1/4 SEC
DISMS ;SLEEP.
POP P,T1 ;RESTORE
SOS (P) ;DO TEST AGAIN
RET
;Get lock on JOBxxx vars
; CALL JOBXP
JOBXP: AOSE JOBLCK ;INTERLOCK
CALL HANG ;WAIT FOR SUCCESS
MOVEM I,JOBOWN ;MAKE US THE OWNER
RET
;Release JOBxxx lock
; CALL JOBXV
JOBXV: CAME I,JOBOWN ;DO WE OWN?
RET ;NOPE.
SETOM JOBOWN ;NO OWNER
SETOM JOBLCK ;FREE LOCK
RET
> ;IFN 0
SUBTTL ERROR STUFF
POVINT: MOVEI T1,[ASCIZ /PDL overflow/]
TRNA
EOFINT: MOVEI T1,[ASCIZ /File EOF/]
TRNA
DAEINT: MOVEI T1,[ASCIZ /Data error/]
TRNA
ILIINT: MOVEI T1,[ASCIZ /Illegal instruction/]
MOVE P,[IOWD LPLIST,PLIST] ;SET UP PDL
MOVEM T1,.JBUUO ;STORE STRING ADDR FOR FAKE LUUO
PUSH P,P1FLG ;PUSH "CALL" PC
MOVEI T1,LUUOH ;WHERE TO START
MOVEM T1,P1FLG ;STORE AS RETURN ADDR
DEBRK
LUUOH: MOVEI T1,.PRIOU
DOBE
TMSG <
==============================
PHNSRV: >
HRRO T1,.JBUUO ;GET LUUO INSTR
TRNN T1,-1 ;HAVE TEXT?
HRROI T1,[ASCIZ /FATAL error/]
PSOUT
ENDERR: MOVEI T1,.PRIOU
FMSG <
last error: >
MOVEI T1,.PRIOU
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
TRNA
TRN
FMSG <
called from: >
HRRZ T0,(P) ;GET CALL PC
SUBI T0,1
CALL SYMOUT
FMSG <
at >
SETO 2,
ODTIM
FMSG <
==============================
>
HALTF
JRST START
SYM==0
;Symbol output routine
; SYM/ desired symbol
; CALL SYMOUT
;(For details, read "Introduction to DECSYSTEM-20 Assembly Language
; Programming", by Ralph Gorin, published by Digital Press, 1981.)
SYMOUT: SETZB T3,T5 ;NO CURRENT PROGRAM NAME OR BEST SYMBOL
MOVE T4,.JBSYM ;SYMBOL TABLE POINTER
HLRO T1,T4
SUB T4,T1 ;-COUNT,,ENDING ADDRESS +1
SYMLUP: LDB T1,[400400,,-2(T4)] ;SYMBOL TYPE
JUMPE T1,NXTSYM ;PROGRAM NAMES ARE UNINTERESTING
CAILE T1,2 ;0=PROG NAME, 1=GLOBAL, 2=LOCAL
JRST NXTSYM ;NONE OF THE KIND WE WANT
MOVE T1,-1(T4) ;VALUE OF THE SYMBOL
CAMN T1,SYM ;EXACT MATCH?
JRST [ MOVE T5,T4 ;YES, SELECT IT
JRST FNDSYM]
CAML T1,SYM ;SMALLER THAN VALUE SOUGHT?
JRST NXTSYM ;TOO LARGE
SKIPE T2,T5 ;GET BEST ONE SO FAR IF THERE IS ONE
CAML T1,-1(T2) ;COMPARE TO PREVIOUS BEST
MOVE T5,T4 ;CURRENT SYMBOL IS BEST MATCH SO FAR
NXTSYM: ADD T4,[2000000-2] ;ADD 2 IN THE LEFT, SUB 2 IN THE RIGHT
JUMPL T4,SYMLUP ;LOOP UNLESS CONTROL COUNT IS EXHAUSTED
SKIPN T4,T5 ;DID WE FIND ANYTHING HELPFUL?
JRST OCTSYM
;FOUND AN ENTRY THAT LOOKS CLOSE. SEE IF IT REALLY IS AND IF SO USE IT
FNDSYM: MOVE T1,SYM ;DESIRED VALUE
SUB T1,-1(T4) ;LESS SYMBOL'S VALUE = OFFSET
CAIL T1,200 ;IS OFFSET SMALL ENOUGH?
JRST OCTSYM ;NO, NOT A GOOD ENOUGH MATCH
MOVE T4,T5 ;GET THE SYMBOL'S ADDRESS
MOVE T1,-2(T4) ;SYMBOL NAME
TLZ T1,740000 ;CLEAR FLAGS
CALL SQZTYO ;PRINT SYMBOL NAME
MOVE T2,SYM ;GET DESIRED VALUE
SUB T2,-1(T4) ;LESS THIS SYMBOL'S VALUE
JUMPE T2,CPOPJ ;IF NO OFFSET, DON'T PRINT "+0"
MOVEI T1,"+" ;ADD + TO THE OUTPUT LINE
PBOUT
TRNA
OCTSYM: MOVE T2,SYM ;HERE IF PC MUST BE IN OCTAL
MOVEI T1,.PRIOU ;AND COPY NUMERIC OFFSET TO OUTPUT
MOVEI T3,10
NOUT
HALT .-1 ;BLEAH
RET
;Output squoze
; A/ radix50 symbol
; CALL SQZTYO
SQZTYO: IDIVI T1,50 ;DIVIDE BY 50
PUSH P,T2 ;SAVE REMAINDER
CAIE T1,0 ;DONE?
CALL SQZTYO ; NO, RECURSE
POP P,T1 ;GET CHARACTER
ADJBP T1,[350700,,[ASCII/ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%/]]
LDB T1,T1 ;CONVERT SQUOZE CODE TO ASCII
PBOUT
RET
;Copy string w/ null
; ** ORDER REVERSED FROM CPYST0 **
; T1/ Source
; T2/ Dest
CPYTXT: EXCH T1,T2
CALL CPYST0
EXCH T1,T2
RET
;Copy string w/ null
; T1/ Dest
; T2/ Source
CPYST0: CALL CHKBPS ;CHECK BPS
ST0LOP: ILDB T0,T2 ;GET A BYTE
IDPB T0,T1 ;STORE
JUMPN T0,ST0LOP ;END?
RET
;Copy a string
; T1/ Dest
; T2/ Source
CPYSTR: CALL CHKBPS ;CHECK BYTE POINTERS
CPYST2: ILDB T0,T2 ;GET A CHAR
JUMPE T0,CPOPJ ;END.
IDPB T0,T1 ;STORE
JRST CPYST2 ;LOOP
;Check byte pointers
CHKBPS: MOVEI T4,T1
CALL CHKBP
MOVEI T4,T2
CHKBP: HLRZ T0,(T4) ;GET LH
CAIE T0,0 ;ADDR
CAIN T0,-1 ; OR HRROI?
MOVEI T0,(POINT 7,) ; YES, MAKE INTO BP
HRLM T0,(T4) ;RESTORE
RET
CRLF: TMSG <
>
RET
SUBTTL SPECIAL ACVAR SUPPORT
.SAV1: PUSH P,.FPAC
PUSHJ P,0(.A16) ;CONTINUE PROGRAM
SKIPA
AOS -1(P)
POP P,.FPAC
POPJ P,
.SAV2: PUSH P,.FPAC
PUSH P,.FPAC+1
PUSHJ P,0(.A16)
SKIPA
AOS -2(P)
POP P,.FPAC+1
POP P,.FPAC
POPJ P,
.SAV3:
.SAV4: PUSH P,.FPAC
PUSH P,.FPAC+1
PUSH P,.FPAC+2
PUSH P,.FPAC+3
PUSHJ P,0(.A16)
SKIPA
AOS -4(P)
POP P,.FPAC+3
POP P,.FPAC+2
POP P,.FPAC+1
POP P,.FPAC
POPJ P,
LITTER: END START