;USR0:PHNSRV.MAC.1000 1-Nov-84 FQ+1D.0H.6M.2S., by BUDD ; Other things above PTYs; print PTY numbers as big TTY numbers (sigh) ;MSC:PHNSRV.MAC.999 10-Jun-84 FQ+4D.14H.0M.3S., by BUDNE ; CLEAR ALL USRXX VARS AT KFORK TIME ;MSC: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 ;Parameters EDIT==^D1000 ;LAST EDIT MAXJOB==^D510 ;NUMBER OF JOBS TO SCAN MAXSRV==^D10 ;MAXIMUM NUMBER OF INFERIOR SERVER FORKS IFNDEF DEBUGF,DEBUGF==0 ;DEBUG MODE PURPAG==400 ;PAGE FOR PURE CODE & DATA PURADR==PURPAG*1000 ;ADDRESS FOR PURE CODE & DATA 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 .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 ,< $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 TWOSEG PURADR 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 ;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 ,BLOCK OFF-. IFNB ,LBL:! IFN ,< 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, ;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, 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, ;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 ;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 ; ; LCLRNG: ACVAR 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 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 ; ; ; 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 ; ; 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 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 ; ; ; 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 INFO? CAIN T1,.IPCCP ; OR FROM MY 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 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 ; ; 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 ; ; ; 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 ; ; ; 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 ; ; 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 ; ; 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 ; ; 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 CAIN T2,.TTH19 ;HEATHKIT-19? RETSKP ;OK RET ;UNSUPPORTED ;Check terminal characteristics ; T1/ tty spec ; CALL CHKTTY CHKTTY: ACVAR 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 ; ; 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 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 ; ; 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 ; ; ; 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 ; ; 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