;XSUBRS.MAC;27 16-DEC-75 16:53:41 EDIT BY PLUMMER ; 1.54 ;CORRECT RFMOD BIT CHECKED IN HUPSI ;XSUBRS.MAC;24 30-SEP-75 11:24:05 EDIT BY PLUMMER ; CHANGE ERROR REPLY FOR GJFX32 ;XSUBRS.MAC;21 24-SEP-75 12:10:24 EDIT BY PLUMMER ; ^C NEVER CLEARS INPUT BUFFER -- MONITOR DOES THIS ; DIFFERENT HANDLING OF DEFERRING OF ^C ;XSUBRS.MAC;20 19-SEP-75 13:17:32 EDIT BY PLUMMER ;XSUBRS.MAC;19 19-SEP-75 10:02:30 EDIT BY PLUMMER ; FIX SAVE/RESTORE OF JOB TIW ; UNMAP DOESN'T BOTHER WITH PAGES WHICH DON'T EXIST ;XSUBRS.MAC;13 17-SEP-75 09:56:58 EDIT BY PLUMMER ; PARC CHANGES... DEFDIR AND TOUT ;XSUBRS.MAC;9 27-FEB-75 12:47:08 EDIT BY PLUMMER ; INCREASE REATTACH WAIT TO 60 MINUTES ;XSUBRS.MAC;8 13-JAN-75 10:38:52 EDIT BY PLUMMER ; FIX BUG IN TCONF ;XSUBRS.MAC;7 10-JAN-75 15:56:02 EDIT BY PLUMMER ; MAKE TCONF SKIP PROPERLY ;XSUBRS.MAC;2 3-JAN-75 09:48:25 EDIT BY PLUMMER ; REPAIRS TO TCONF (PARC) ;XSUBRS.MAC;5 2-JAN-75 12:26:55 EDIT BY PLUMMER ;1.53 ;XSUBRS.MAC;4 31-DEC-74 11:31:40 EDIT BY PLUMMER ; ADD EOF CATCHER TO TCONF ; TCONF ROUTINE (PARC) ; ADD TCONF (PARC) ;XSUBRS.MAC;3 16-DEC-74 21:52:32 EDIT BY PLUMMER ; FPIN ROUTINE ; 1.52 ;XSUBRS.MAC;26 25-NOV-74 11:30:25 EDIT BY PLUMMER ; MAXJFN PARAMTER IN RLJFNS ;XSUBRS.MAC;25 22-NOV-74 11:30:08 EDIT BY PLUMMER ; LOCAL FLOATING NUMBER PRINTER FOR %Q (PARC) ;XSUBRS.MAC;22 21-NOV-74 23:33:39 EDIT BY PLUMMER ; CONVERT TO $SYSGT ; UNMAP ROUTINE ;XSUBRS.MAC;20 25-OCT-74 11:05:13 EDIT BY PLUMMER ; FIX DOUBLE CONFIRMATION MESSAGE PROBLEM (PARC) ;XSUBRS.MAC;19 26-JUL-74 13:40:27 EDIT BY PLUMMER ; REPAIR DDT PAGE 0 WIPER AT ERR7F-1 ;XSUBRS.MAC;17 21-JUN-74 15:54:00 EDIT BY PLUMMER ; MAKE "DIRNAM" NOT WIPE STRING IN NON-RECOGNITION CASE ;XSUBRS.MAC;16 17-JUN-74 14:48:40 EDIT BY PLUMMER ; MAKE DIRNAM RETURN STRING PTR IN B ; MAKE ERR7 TEST ^C COUNT (PARC) ;XSUBRS.MAC;15 10-JUN-74 16:17:15 EDIT BY PLUMMER ; PARAMETERIZE ^T TIMES (PARC) ; ^C DEFERRED WHILE IN EXEC, 1ST ^C DOES NOT CFIBF ;XSUBRS.MAC;14 13-MAR-74 13:55:20 EDIT BY PLUMMER ; RESTORE PRIMARY JFNS STORED AT ENTRY WHEN ERROR OR ^C OCCURS ;XSUBRS.MAC;13 5-MAR-74 10:55:39 EDIT BY PLUMMER ; MAKE ^C CLEAR INBUF ONCE AGAIN ;XSUBRS.MAC;10 25-JAN-74 12:41:28 EDIT BY PLUMMER ; FIX %I ROUTINE TO MAKE JOB COUNT INCLUDE JOB 0 ;XSUBRS.MAC;7 4-DEC-73 12:01:07 EDIT BY PLUMMER ; PRINT UUO CONVERTS TENEX TO CRLF'S FOR FTP NUTS ; AVOID LOSSAGE IN ETYPE ROUTINE %X IF ILL INSTR IN EPHEMERON ; OCCURS WHEN NO REGULAR FORK EXISTS (BUGFIX) ;XSUBRS.MAC;5 14-NOV-73 10:50:26 EDIT BY PLUMMER ; TURN ON DEFERRED ^C FOR USER PROGRAMS, STILL IMMEDIATE FOR EXEC ;XSUBRS.MAC;3 31-OCT-73 13:40:51 EDIT BY PLUMMER ; NEW ^T ROUTINE, CHANGE TO DOECEO FOR BELL ;XSUBRS.MAC;52 2-OCT-73 13:16:19 EDIT BY PLUMMER ; 1.51 ; CHANGES TO ^C ROUTINE AND ERROR HANDLER FOR REDIRECTION ; ADD [FILE LIST FULL] WARNING TO JFN LIST GETTER ;XSUBRS.MAC;24 26-SEP-73 22:28:05 EDIT BY PLUMMER ; CHANGES TO EOF ON PRIMARY INPUT JFN, ^C, AND ERROR ROUTINE FOR ; IO REDIRECTION ;XSUBRS.MAC;21 13-AUG-73 17:09:50 EDIT BY PLUMMER ; BELPSI REPAIR (BUGFIX) ;XSUBRS.MAC;20 26-JUL-73 22:01:22 EDIT BY PLUMMER ; ADD ^G INTERRUPT ;XSUBRS.MAC;18 20-JUL-73 15:07:49 EDIT BY PLUMMER ; MAKE "NOT LOGGED IN" AN ERROR IN TTYNUM (BUGFIX) ;XSUBRS.MAC;17 12-JUL-73 22:25:20 EDIT BY PLUMMER ; EOF ON PRIMARY INPUT CAUSES "QUIT" TO BE SIMULATED ;XSUBRS.MAC;16 10-JUL-73 15:08:49 EDIT BY PLUMMER ; MAKE BUFFS ABLE TO STOP ON NULL OR COUNT RUNOUT ;XSUBRS.MAC;15 5-JUL-73 15:45:09 EDIT BY PLUMMER ; BUFFS FOR ACCT VALIDATION STUFF ;XSUBRS.MAC;11 26-JUN-73 16:46:44 EDIT BY PLUMMER ; ADD INTON IN JERR ;XSUBRS.MAC;9 1-JUN-73 23:20:50 EDIT BY PLUMMER ; ADD EXTERNS FOR TTYNUM ; ERROR ROUTINE BUGFIX ;XSUBRS.MAC;7 1-JUN-73 00:46:31 EDIT BY PLUMMER ; PUSH B IN ERROR ROUTINE (BUGFIX) ; REVERT TO TTY: IF PRIMARY INPUT FILE HITS EOF ; TTYNUM ROUTINE FOR LINK AND ADVISE ; %I AND %K KNOW ABOUT SINGULAR NOUNS (HACK) ;XSUBRS.MAC;5 18-MAY-73 16:26:36 EDIT BY PLUMMER ; REWROTE ERROR ROUTINE ;XSUBRS.MAC;3 7-MAY-73 16:09:28 EDIT BY PLUMMER ; ADD PROGX TEST IN CONF ;XSUBRS.MAC;2 7-MAY-73 12:21:36 EDIT BY PLUMMER ; CHANGES TO %X TO HANDLE EPHEMERALS ; ^T REVISED ;XSUBRS.MAC;4 5-MAY-73 20:53:02 EDIT BY PLUMMER ; ADD INTON AND INTOFF TO ERROR ROUTINES TO AVOID RACE ON EFORK ;XSUBRS.MAC;3 5-MAY-73 16:52:18 EDIT BY PLUMMER ; CHANGES TO ERROR AND ^C ROUTINES TO HANDLE EPHEMERONS ; FIX ^T TO ALWAYS PRINT LOAD AV. ;XSUBRS.MAC;8 27-MAR-73 12:01:21 EDIT BY PLUMMER ; DIRNAM: MAKE SURE BIT17(1) OFF AT CALL TO STDIR ;XSUBRS.MAC;50 26-FEB-73 17:35:56 EDIT BY PLUMMER ; 1.50 ; ^R AND ^A DURING PASSWORD INPUT FIXED ; FLUSH JOB TIW STUFF ; NEW TTY MODE HANDLING ; ADD DELAY AND CFIBF AFTER BAD FILE NAME INPUT ; 1.49 ; BIGOCT USES F3 INSTEAD OF F1 SO ^E CR WORKS ; ^C FREEZES LFORK, NOT FORK ; FIX MULTIPLE EOL PROBLEM IN DEFAULT RUN STUFF. RST MADE PARALLEL ; CHANGE TO GTJFN. ; 1.48 ; ONE ^C DOES NOT CLEAR INPUT BUFFER ; DATE INPUT ROUTINE MOVED FROM X1CMD ; LOWER CASE LETTERS ACCEPTED IN NOISE WORDS ; NEGATIVE NUMBERS MAY BE INPUT WITH "BIGOCT" ; HANGUP AUTOLOGOUT TIME SET TO 20 MINUTES ; FIX FOR NEW STIW ; 1.47 ; 1.46 ; DEFAULT RUN COMMAND ; ROUTINE TO GET EDIT FILE ; SUBROUTINE FILE 1 FOR PDP-10 TENEX EXECUTIVE ; SUBROUTINES AND UUO SERVICE ROUTINES IN THIS FILE ARE ; MOSTLY MONITOR-INDEPENDENT LANGUAGE DECODING OPERATIONS, ; WHEREAS THOSE IN SUBROUTINE FILE 2 ARE MOSTLY MONITOR- ; DEPENDENT OPERATIONS SUCH AS IO, AND UTILITY OPERATIONS ; (THOUGH MANY OF THEM ALSO EFFECT THE LANGUAGE). ; THOSE IN SUBROUTINE FILE 3 PROCESS PSEUDO-INTERRPUPTS ; AND ERROR MESSAGE UUOS AND ROUTINES. ;SEE XMAIN.MAC FOR LOADING PROCEDURE TITLE SUBRS SEARCH STENEX,XDEF .DIRECTIVE XSRCVN %XS %XS==%XS INTERN CRIF ;TYPE EOL IF NEEDED TO GET CARRIAGE AT LEFT INTERN DATEIN ;DATE AND TIME INPUT ROUTINE INTERN TOUT ;HH:MM:SS TYPER INTERN READY,READY2 ;PRINT ONE OR TWO READY CHARACTERS (@ OR !) INTERN %KEYW ;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD) INTERN PRVCK ;USER-PRIVILEGE-CHECK SUBROUTINE INTERN %NOI ;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO) INTERN %SBCOM ;UUO TO INPUT AND DISPATCH ON SUBCOMMANDS INTERN %INHEL ;UUO TO INPUT FIELD WITH HELP ("INHELP" MACRO) INTERN CSTR,MORE ;INPUT AND APPEND TO FIELD SUBROUTINES INTERN PASCOM ;PASS COMMENT INTERN %ALLOW ;CHECK FIELD TERMINATOR (ALLOW UUO) INTERN CONF ;TERMINATE AND CONFIRM COMMAND INTERN TCONF ;TRANSPARENT CONFIRMATION ROUTINE INTERN SPRTR ;ANALYZE SEPARATOR/TERMINATOR IN ARG LIST INTERN CCHRI ;INPUT A CHARACTER OF COMMAND INTERN $CTRLA,$CTRLR,$CTRLV,$CTRLW,$CTRLX,$FORMF,$EOL,$DASH,$CONT,$RUB INTERN UBP ;REMOVE LAST CHARACTER FROM COMMAND STRING INTERN %TYPE,CTYPE,%$TYPE,$CTYPE,%ALTYP ;TYPE MESSAGE SUBRS & UUOS INTERN CINFN,COUTFN,SPECFN,CPFN ;INPUT IN, OUT, SPECIAL, PROG FILE NAMES INTERN CEDFN ;COLLECT EDIT FILE NAME INTERN .INFG,INFG,$INFG,DIRARG ;INPUT FILE GROUP DESCRIPTORS INTERN TYPIF,GNFIL,FRSTF,NEXTF ;ROUTINES FOR STEPPING THRU FILES IN GRP INTERN INTRM ;INPUT TERMINATING CHARACTER AFTER IDTIM, ETC. INTERN DEVN ;COLLECT DEVICE NAME INTERN DIRNAM ;COLLECT DIRECTORY NAME INTERN DEFDIR ;COLLECT OR DEFAULT DIRECTORY NAME INTERN TTYNUM ;INPUT TTY NUMBER FROM USER NAME OR OCTAL NUMBER INTERN FPIN,DECIN,BIGOCT,OCTAL,TOCT,OCTCOM ;NUMBER IN AND OUTPUT SUBRS INTERN BUFFF ;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG INTERN BUFFS ;BUFFER STRING FROM ELSEWHERE IN CORE INTERN ALLBK,NALNBK,DOECEO,NOECHO,DOECHO,LTTYMD,RTTYMD,INPTTY,INETTY INTERN %PRINT ;OUTPUT CHARACTER UUO INTERN CCHRO ;OUTPUT CHARACTER (OF COMMAND IF "STCF" ON) INTERN MAPPF ;MAP PAGE OF FORK SUBR INTERN LOADF ;LOAD WORD FROM FORK SUBR INTERN STOREF ;STORE WORD INTO FORK SUBR INTERN %GTB ;CONVENTIENT GETAB JSYS CALL UUO INTERN $SYSGT ;FAST SYSGT INTERN UNMAP ;UNMAP BUFFER PAGES INTERN USEPSI ;TERMINAL PSI TO PRINT RUNTIME (^T) INTERN HUPSI ;DATAPHONE CARRIER OFF (HANGUP) PSI INTERN DING,CERR,NIYE,NIM,SCREWUP,JERR,JERRC ;VARIOUS ERROR CONDITIONS INTERN %TRAP ;CHANNEL 1 ERROR PSI MESSAGE UUO INTERN ILIPSI ;ILLEGAL INSTRUCTION PSI INTERN EOFPSI ;END-OF-FILE PSEUDO-INTERRUPT ON CHANNEL 1 INTERN DATPSI ;FILE DATA ERROR INTERRUPT INTERN CCPSI ;^C PSI ON CHANNEL 1 INTERN ALOPSI ;PSI ON CHAN 1 FROM AUTOLOGOUT FORK INTERN AUTOLO ;ROUTINE TO DO AUTOLOGOUT INTERN %ERR,%$ERR,%.$ERR ;GENERAL ERROR UUOS (MACROS "ERROR" ETC) INTERN RERET ;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO INTERN RLJFNS ;CLOSE & RELEASE JFNS USED BY CURRENT COMMAND INTERN %ETYPE ;TYPE MESSAGE, INTERPRETING %-CODES INTERN FLOAT ;FLOAT INTEGER IN A ;EXTERNS TO PROGRAM USING THESE SUBROUTINES EXTERN CUUO ;WHERE UUOS DISPATCH TO (SEE CCPSI) EXTERN ERRET ;WHERE ERROR UUOS RETURN TO EXTERN LAPRNT ;SUBROUTINE TO PRINT LOAD AV. FOR ^T EXTERN FSTAT ;SUBROUTINE TO PRINT FORK STATUS FOR ^T EXTERN SIXPRT ;SIXBIT PRINTER EXTERN TIMPMN,TIMPSC ;TAD+MIN AND TAD+SEC ;EXTERNS TO WRITEABLE STORAGE FILE (XPRIV.MAC) EXTERN .P EXTERN CIJFN,COJFN,JBUFP,.JBUFP,JBUF,CJFN1,CJFN2,PRIMRY EXTERN INIFH1,INIFH2 EXTERN EOFDSP,ILIDSP,ERRMF EXTERN CRJFNI,CRJFNO,CREDIF,CREDOF EXTERN CINITF,PRVENF,PROPSF,DOT,CUSRNO,FORK,LFORK,NPAGE,EFORK EXTERN STRTIM,TTYACF,ALOFH EXTERN PTTYMD,ETTYMD EXTERN CERET EXTERN CSTRR,CSBUFP EXTERN FRSTFR EXTERN ERCOD,ERPC EXTERN CBUF,CBUFE,CWBUF,CJFNBK,CSBUF,CSBUFE EXTERN LEV1PC EXTERN PAGEN EXTERN %EDAYT EXTERN EDFILE EXTERN IUSRNM EXTERN FRAME,DIRNO EXTERN EXEC EXTERN SGTNAM,SGTAC1,SGTAC2 ;TABLES FOR $SYSGT EXTERN CTLIM0,CTLIM1 ;^T VARIABLES EXTERN MODES ;EXTERNS TO READ-ONLY STORAGE IN XMAIN.MAC EXTERN CHRTBL ;CHARACTER TABLE ;SUBROUTINES TO PRINT READY CHARACTER: "@" NORMALLY, ; "!" IF PRIVILEGED COMMANDS ENABLED. READY: PUSH P,A PUSH P,B MOVE A,COJFN RFPOS TRNN B,-1 ;AT LEFT MARGIN? JRST READY3 ;YES MOVEI B,CR ;NO, TYPE CRLF FIRST BOUT MOVEI B,LF BOUT JRST READY3 READY2: CALL READY ;PRINT 2 READY CHRS FOR SUBCOMMANDS PUSH P,A ;PRINT ONE READY CHARACTER PUSH P,B MOVE A,COJFN READY3: MOVEI B,"@" SKIPE PRVENF MOVEI B,"!" BOUT POP P,B POP P,A RET ;%KEYW ;KEYWORD INPUT AND LOOKUP UUO SERVICE ROUTINE ("KEYWD" UUO) ;DOES EDITING, TABLE LOOKUP, RECOGNITION. ;DEFAULTS: ON NULL INPUT, OR WITHOUT INPUT IF LAST TERMINATOR = EOL, ; OR IF DASH AND TERMINATOR INPUT ; ;USAGE: ; SET FLAGS BAKFF,PUNCF,NEOLF IF DESIRED ; (SEE COMMENTS IN FILE XDEF.MAC) ; KEYWD TABLE ; 0 OR XWD [VALUE],[ASCIZ @TEXT@] FOR DEFAULT VALUE ; R1: NOT IN TABLE, OR NULL INPUT WITH NO DEFAULT IN CALL. ; "BAKFF" IS SET SO SAME INPUT IS USED ON NEXT CALL. ; R2: FOUND, "VALUE" IN "KWV" ; ON EITHER RETURN, TERMINATOR IS IN "TRM" AND "CHR", ; DESCRIPTIVE BITS FOR TERMINATOR IN "CBT" ; TEXT IS APPENDED TO "CBUF", "BFP" IS END BYTE PTR, ".BFP", BEG. ; PUNCF AND NEOLF ARE CLEARED ; EOLNEF SET IF AN EOL WAS INPUT AND WAS NOT ECHOED ; ;GOES DIRECTLY TO "CERR" ON BAD CHARACTER, TOO LONG, AMBIGUOUS, ETC ;ACCEPTABLE CHARACTERS ARE LETTERS AND DIGITS ONLY UNLESS "PUNCF" ON. ; ("-" ALSO ACCEPTED MERELY TO SIMPLIFY CODING DEFAULT ON "-" IN INPUT.) ;TERMINATORS: ALT MODE, SPACE, COMMA IF "COMOK" ON IN VALUE (OW_CERR), ;EOL OR SEMICOLON IF "EOLOK" ON IN VALUE, ;LEFT PAREN IF "LPROK" ON IN VALUE, ;"<" IF "LANOK" ON IN VALUE (SPECIAL TREATMENT DESCRIBED BELOW). ; ;DEFAULTING: ON ALT MODE DEFAULT TEXT IS TYPED; GOOD RETURN IS GIVEN ; AS THOUGH DEFAULT TEXT HAD BEEN INPUT. ; ;BACKUP: IF "BAKFF" IS SET AT ENTRY, PREVIOUS INPUT STRING IS RE-USED. ; ;GLITCH NOTE: IF LAST TERMINATOR IS EOL OR SEMICOLON, ; DEFAULTS WITHOUT INPUT, SO OPTIONAL FIELDS ; AT END OF COMMAND ARE AUTOMATICALLY DEFAULTED. ; BUT THIS DOESN'T HAPPED IF BAKFF IS SET (EXTERNALLY). ALSO THIS ; MEANS "TEOL" BIT IN AC "CBT" MUST BE OFF ; AT FIRST CALL ON A NEW LINE. ; ;TABLE FORM: ; TABLE: NUMBER OF ENTRIES ; XWD [VALUE],[ASCIZ @TEXT@] FOR EACH ENTRY, ALPH ORDER ; ;"VALUE" HAS BITS IN LEFT HALF (SOME INTERPRETED HERE), ; ; USUALLY DISPATCH ADDRESS IN RIGHT HALF %KEYW: PUSH P,D PUSH P,C PUSH P,B PUSH P,A PUSH P,40 TLNE Z,BAKFF JRST .+3 TRNE CBT,TEOL ;LAST TERMINATOR=EOL OR SEMICOLON? JRST [ SKIPN D,@-5(P) ;YES, DEFAULT ARGUMENT GIVEN? JRST .+1 JRST CWRD2] ;YES, GO DEFAULT WITHOUT INPUTTING ;INPUT. "INHELP" MACRO INPUTS A FIELD (WITH CSTR), DOING EDITING & ;RE-USING PREVIOUS INPUT IF "BAKFF" ON, AND TYPES MESSAGE IF "?" INPUT. ;%Z TYPES ALL KEYWORDS IN TABLE. CSTR HANDLES NEOLF AND EOLNEF. MOVE A,(P) ;TABLE ADDRES FOR %Z INHELP ; ;CHECK THAT FIELD TERMINATOR IS LEGAL ALLOW TEOL+TSPC+TALT+TCOM+TLPR+TLAN ;LEFT-JUSTIFY AND ZERO-FILL THE STRING IN CWBUF BECAUSE "FSYM" ; REQUIRES IT THAT WAY. SETZM CWBUF SETZM CWBUF+1 SETZM CWBUF+2 SETZM CWBUF+3 CAILE CNT,^D18 ;WILL IT FIT 4-WORD BUFFER ERROR MOVE B,.BFP ;BEGINNING OF STRING MOVEI C,-1(CNT) ;REDUCE COUNT BY ONE TO OMIT TERMINATOR JUMPG C,CWRD3 ;JUMP IF NON-NULL INPUT SKIPN D,@-5(P) ;PICK UP WORD AFTER CALL JRST CWRD8 ;NO DEFAULT SPECIFIED IN CALL CWRD2: HLRZ C,D ;PRETEND WE RETURNED FROM FSYM: [VALUE], HRLI D,B53 ;.. BYTE POINTER TO TEXT JRST CWRD4 ;USE CODE FOR "UNIQUE SUBSET" MATCH CWRD3: MOVE D,[POINT 7,CWBUF,-1] CWRD3A: ILDB A,B ;COPY LOOP CAIL A,141 ;ASCII LOWER CASE A CAILE A,172 ;ASCII LOWER CASE Z JRST .+2 ;NOT A LOWER CASE LETTER SUBI A,40 ;CONVERT LOWER CASE TO UPPER IDPB A,D SOJG C,CWRD3A CAIN CNT,2 ;CHECK FOR "-": 1 CHAR+TERMINATOR? JRST [ CAIN A,"-" ;YES, WAS THAT CHARACTER "-"? SKIPN D,@-5(P) ;YES, PICK UP WORD AFTER CALL JRST .+1 ;NOT "-" OR NO DEFAULT PTR AFTER CALL HLRZ C,D ;PRETEND WE GOT EXACT MATCH RETURN... JRST CWRD5] ;...FROM FSYM: [VALUE] IN C ;%KEYW... ;LOOK IT UP MOVE A,(P) ;POINTER THAT CAME IN 40 MOVEI B,CWBUF ;LOCATION OF TEXT CALL FSYM ;SEARCH TABLE (A) FOR TEXT (B). 4 RETURNS. ;R1: NO MATCH AT ALL. GIVE BAD RETURN WITH "BAKFF" SET. JRST CWRD8 ;R2: AMBIGUOUS PARTIAL MATCH. ALLOW MORE INPUT IF ALT MODE. JRST [CAIE CHR,ALTM JRST CERR ;TERMINATOR NOT ALT MODE CALL DING ;RING BELL, STOP NON-INTERACTIVE JOB, ;CLEAR TTY INPUT BUFFER. CALL UBP ;GET RID OF ALT MODE IN BUFFER JRST MORE] ;GET MORE INPUT, RETN WHERE CSTR DID ;R3: UNIQUE PARTIAL MATCH. TYPE REST ON ALT MODE. ;ALSO, DEFAULT COMES HERE W TEXT PTR TO ENTIRE TEXT CWRD4: JRST [CAIE CHR,ALTM JRST .+1 ;NOT ALT MODE, OK AS IS. MOVE B,(C) ;USED BY PRVCK CALL PRVCK ;CHECK PRIVILEGE BEFORE PRINTING REST JRST CERR ;PRIVILEGE NEEDED & LACKING CALL UBP ;BACK UP TLO Z,STCF ;SAY "STORE PRINTED CHARACTERS" MOVE A,D ;POINTER TO REST RETURNED BY "FSYM" CALL CTYPE ;PRINT AND ALSO STORE STRING TLZ Z,STCF JRST CWRD6] ;PRIVILEGES ARE ALREADY CHECKED. ;R4: PERFECT MATCH. ;ALSO, "-" INPUT DEFAULT COMES HERE ;CHECK WHETHER THE USER HAS SPECIAL PRIVILEGES REQUIRED ; BY CERTAIN KEYWORDS (MOST DON'T REQUIRE ANY). CWRD5: MOVE B,(C) ;VALUE WORD INCLUDES PRIVILEGE FLAGS CALL PRVCK ;SKIP IF USER HAS PRIVS, IF ANY REQUIRED JRST CERR ;HE LACKS PRIVILEGES. CWRD6: MOVE KWV,(C) ;VALUE WORD. "FSYM" RETURNED PTR TO IT. TLNN KWV,NSPALT ;THIS BIT SAYS DON'T... ALTYPE ( ) ;TYPE SPACE AFTER WORD TERMINATED WITH ALT MODE. ;%KEYW... ;WORD HAS BEEN FOUND IN TABLE. ;CHECK CERTAIN TERMINATORS VS CERTAIN FLAGS. TRNE CBT,TCOM JRST [ TLNN KWV,COMOK JRST CERR JRST .+1] TRNE CBT,TLPR JRST [ TLNN KWV,LPROK JRST CERR JRST .+1] TRNE CBT,TEOL JRST [ TLNN KWV,EOLOK+ONEWD ;ONEWD IMPLIES EOLOK JRST CERR JRST .+1] TRNE CBT,TLAN JRST [ TLNN KWV,LANOK JRST CERR ;SPECIAL HANDLING OF "<" TERMINATOR, VALID ONLY IN ;CONTEXTS WHERE IT IS REALLY THE BEGINNING OF THE ;THE NEXT FIELD: SET UP BAKFF, CNT, .BFP SO ;THAT NEXT CSTR WILL RETURN 1-CHAR STRING "<". ;VALUES OF CNT AND .BFP FOR CURRENT KEYWORD ARE LOST. MOVE .BFP,BFP CALL UBP ;UNINCREMENTS BFP EXCH .BFP,BFP MOVEI CNT,1 TLO Z,BAKFF JRST .+1] ;EXIT AOSA -5(P) ;SKIP CWRD8: TLO Z,BAKFF ;ON BAD RETURN SET "BACK UP FIELD" FLAG AOS -5(P) ;GET PAST DEFAULT ARGUMENT WORD POP P,40 POP P,A POP P,B POP P,C POP P,D RET ;PRVCK ;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE ; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM ; A KEYWORD TABLE. ;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM. ;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE). PRVCK: TLNN B,WHLUO+OPRUO+ERRUO+WOEPUO JRST [ AOS (P) ;NO SPEC CAP REQUIRED, QUICK EXIT. RET] PUSH P,A ;COMMAND REQUIRES SPECIAL CAPABILITIES PUSH P,B PUSH P,C PUSH P,D MOVE D,B MOVEI A,B0 RPCAP ;READ CAPABILITIES ENABLED FOR THIS PROCESS TLNE D,WOEPUO ;WOEPUO REQUIRES WHEEL, OPER, OR CONF INF ACCESS TRNN B,1B18+1B19+1B20 ;...POSSIBLE BUT NOT NECESSARILY JRST .+2 ;...ENABLED. JRST PRVCK8 TLNE D,WHLUO TRNN C,1B18 JRST .+2 JRST PRVCK8 ;WHEEL COMMAND AND "ENABLE"D WHEEL USER TLNE D,OPRUO TRNN C,1B19 JRST .+2 JRST PRVCK8 ;OPERATOR COMMAND AND "ENABLE"D OPERATOR USER TLNE D,ERRUO TRNN C,1B20 ;TEST "CONFIDENTAIL INFORMATION ACCESS" CAP JRST .+2 PRVCK8: AOS -4(P) POP P,D POP P,C POP P,B POP P,A RET ;FSYM - SYMBOL TABLE LOOKUP SUBROUTINE USED IN %KEYW (PRECEDING) ;SYMBOL TABLE LOOKUP SUBROUTINE ;TAKES: A: POINTER TO TABLE ; B: WORD POINTER TO INPUT STRING TO SEARCH FOR. MUST BE LEFT ; ADJUSTED, NULL TERMINATED, LAST WD FILLED W NULLS. ; CALL FSYM ;RETURNS: +1: NO MATCH AT ALL ; +2: INPUT IS AMBIGUOUS -- IT IS INITIAL SUBSTRING OF MORE ; THAN ONE TABLE ENTRY'S TEXT ; +3: INPUT IS INITIAL SUBSTRING OF A UNIQUE TABLE ENTRY ; D: BYTE POINTER TO REST OF THAT ENTRY'S TEXT ; C: "VALUE" FROM THAT TABLE ENTRY IN RH ; +4: INPUT EXACTLY MATCHES A TABLE ENTRY ; C: AS FOR +3 ; AC'S UNCHANGED EXCEPT AS INDICATED ;TABLE FORM: ; LABEL: NUMBER OF ENTRIES ; XWD VALUE,[ASCIZ /TEXT/] PER ENTRY ; . ; . ; ENTRIES MUST BE ALPHABETICALLY ORDERED ON ASCII COLLATING SEQUENCE ; (AS OPPOSED TO ALGEBRAICALLY ORDERED ON 36-BIT WORD VALUES) ;AC USE ; A POINTS AT LAST ENTRY IN TABLE ; B POINTER WHICH IS INDEXED THRU INPUT TEXT ; C POINTER INTO TABLE ; D WORD OF INPUT TEXT ; E POINTER WHICH IS INDEXED THROUGH THE TEXT OF A TABLE ENTRY ; F WORD OF TEXT FROM TABLE ENTRY ; G "DELTA" - THE BINARY SEARCH INCREMENT IFN E-D-1, ;E=D+1 IS ASSUMED ;FSYM ENTRY FSYM: PUSH P,A ;SAVE AC'S PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F PUSH P,G HRRZ A,-6(P) ;INIT DELTA TO HIGHEST POWER OF 2 IN TABLE LENGTH MOVE D,(A) ;TABLE LENGTH JFFO D,.+2 JRST NOMAT ;0 LENGTH: NO MATCH MOVEI G,1 MOVN E,E LSH G,43(E) ;SHIFT BY 35 - # OF 0 BITS TO GET POWER MOVEI C,(A) ;INIT POINTER THAT RUNS OVER TABLE ADD A,(A) ;LOCATION OF LAST USED ENTRY IN TABLE ;FSYM... ; BINARY SEARCH. STOPS AT = ENTRY OR SMALLEST > ENTRY. FSRC1: ADDI C,(G) ;ADD DELTA TO TABLE POINTER FSRC1A: LSH G,-1 ;HALVE DELTA FOR NEXT TIME AROUND CAILE C,(A) JRST FSRC4 ;POINTS BEYOND END OF TABLE, GO BACK UP. ;COMPARE THE INPUT TEXT TO A TEXT IN THE TABLE MOVE B,-5(P) ;GET PTR TO INPUT TEXT SUPPLIED IN B MOVE E,(C) ;POINTER INTO TABLE TEXT FROM TABLE WORD FSRC2: MOVE D,(B) ;GET AN INPUT WORD LSH D,-1 ;POSITION SO DATA ISN'T IN SIGN BIT MOVEI B,1(B) ;INDEX INPUT POINTER MOVE F,(E) ;GET A WORD OF TABLE TEXT LSH F,-1 CAMGE F,D JRST FSRC3 ;TABLE ENTRY LESS THAN INPUT CAME F,D JRST FSRC4 ;TABLE ENTRY GREATER THAN INPUT TRNE D,177 ;THESE WORDS EQUAL, AT END OF INPUT? AOJA E,FSRC2 ;NO, INDEX TABLE TEXT PTR, CONT. COMPARE ;MATCH FOUND. ;CODE FOR EXITS, SEARCH STUFF CONTINUES AFTER THIS. AOS -7(P) ;INCREMENT RETURN ADDRESS UPAR: AOS -7(P) HLRZ D,(C) ;VALUE FIELD FROM ENTRY WHICH MATCHED MOVEM D,-4(P) ;RETURN SAME IN C APAR: ;AT THIS POINT C POINTS TO THE = OR SMALLEST > TABLE ENTRY ; & COULD BE RETURNED FOR USE IN INSERTION OR DELETION AOS -7(P) NOMAT: POP P,G ;RESTORE AC'S POP P,F POP P,E POP P,D POP P,C POP P,B POP P,A RET ;RETURN ;THE TEXT OF THIS TABLE ENTRY IS LESS THAN INPUT STRING FSRC3: JUMPN G,FSRC1 ;DELTA><0, MOVE DOWN AND CONTINUE SEARCH AOJA C,NEM1 ;DONE SEARCH. NEXT ENTRY IN TABLE IS THE ;SMALLEST LARGER ENTRY. IF THERE IS NO NEXT ENTRY, THEN ;THERE IS NO MATCH. "SBST" SUBR IS CODED TO HANDLE THIS ;THIS TABLE ENTRY GREATER THAN INPUT, OR POINTER IS OF END OF TABLE FSRC4: SUBI C,(G) ;MOVE UP IN TABLE JUMPN G,FSRC1A ;UNLESS DELTA=0, CONTINUE SEARCH. ;FSYM... ;WE GET TO "NEM1" WHEN THE SEARCH COMPLETES WITHOUT FINDING AN EXACT ;MATCH. C POINTS TO SMALLEST TABLE ENTRY GREATER THAN INPUT. ;THIS ENTRY MAY OR MAY NOT BE A SUBSET MATCH; IF IT IS, THEN IT IS ;AMBIGUOUS IF AND ONLY IF NEXT ENTRY IS ALSO A SUBSET MATCH. ;NOTE ALSO THAT WE CAN TEST NEXT ENTRY FIRST, AND IF IT IS SUBSET, ;THEN WE KNOW INPUT IS AMBIGUOUS WITHOUT TESTING THIS ENTRY. ;TEST NEXT ENTRY NEM1: ADDI C,1 ;POINT C AT NEXT ENTRY CALL SBST ;SUBSET TEST SUBR COMPARES ENTRY C TO INPUT SOJA C,NEM2 ;R1: NOT A SUBSET (INCLUDES NO NEXT ENTRY) SOJA C,APAR ;R2: IS A SUBSET, SO INPUT IS AMBIG. GIVE R2. ;NOT AMBIGUOUS, SO TEST THIS ENTRY NEM2: CALL SBST JRST NOMAT ;INPUT NOT SUBSET THIS ENTRY, NO MATCH MOVEM E,-3(P) ;IS A SUBSET. RETURN BYTE POINTER TO REST OF JRST UPAR ; TABLE ENTRY IN D. GIVE R2. ;SUBROUTINE SBST FOR FSYM ;SUBSET TEST SUBROUTINE FOR "FSYM". ;COMPARES INPUT STRING AND STRING FOR TABLE ENTRY C POINTS TO, ; SKIPS IF FORMER IS INITIAL SUBSTRING OF LATTER. ;ON R2, RETURNS IN E A BYTE POINTER TO REST OF TABLE ENTRY STRING ;MUST BE CALLED ONLY WHEN INPUT STRING IS LESS THAN TABLE STRING ;SEE "FSYM"'S COMMENTS ON AC USE. CLOBBERS B,D,E,F,G. SBST: CAILE C,(A) ;C BEYOND END OF TABLE? RET ;YES, NO ENTRY, INPUT ISN'T SUBSET, RETURN. ;FIND FIRST WORD OF STRINGS IN WHICH THEY DIFFER MOVE B,-6(P) ;POINTER TO INPUT TEXT MOVE E,(C) ;POINTER TO TABLE ENTRY'S TEXT SBST1: MOVE D,(B) ;WORD OF INPUT LSH D,-1 ;POSITION FOR COMPARE MOVEI B,1(B) ;INDEX INPUT POINTER MOVE F,(E) ;WORD OF TABLE ENTRY LSH F,-1 ;POSITION CAMGE F,D ;REMOVE AFTER DEBUGGING CALL SCREWUP ;.. GO TO EXEC'S PROGRAM ERROR ROUTINE CAMG F,D AOJA E,SBST1 ;IF ITS = IT MUST NOT BE END. TRNE D,177 ;IS DIFFERENCE IN LAST WORD OF INPUT? RET ;NO, INPUT CAN'T BE SUBSTRING OF TABLE ENTRY. ;MASK OFF TABLE TEXT TO LENGTH OF INPUT HRLZI G,-4 TDNE D, [-1 ;LOOP TO SEE HOW MANY BYTES OF D ARE 0 1777777777 7777777 37777 177 ] (G) ;YES, (G). AOBJN G,.-1 ANDCM F,@.-2 ;THIS CLEARS F WHERE THERE ARE BITS IN TABLE ;CONVERT WORD PTR IN E TO BYTE POINTER AS REQUIRED ON R2. HLL E, [POINT 7,0,-1 POINT 7,0,6 POINT 7,0,13 POINT 7,0,20 POINT 7,0,27 ] (G) ;NOW IF MASKED PART OF TABLE WORD = INPUT WORD, INPUT IS SUBSET. CAMN F,D AOS (P) ;SKIP RET ;%NOI ;NOISE WORD UUO SERVICE ROUTINE ("NOISE" MACRO) ; ;ARGUMENT IS AN ASCIZ TEXT ;IF LAST TERMINATOR IS ALT MODE, TYPE " () ". ;IF SPACE, COMMA, OR COLON, PASS FOLLOWING PARENTHESIZED TEXT (IF ANY), ; REQUIRING THAT INPUT BE A PROPERLY ORDERED SUBSET OF GIVEN. ; AN ALT MODE IN PARENTHESIZED TEXT CAUSES REST OF GIVEN TO BE OUTPUT, ; AND "TRM" TO BE SET TO ALT MODE. ;IF !, SPECIAL BEHAVIOR FOR LOGIN COMMAND: TYPE " () ", ; THEN ALSO PASS PARENTHESIZED TEXT, IF ANY, AS AFTER SPACE (IN CASE ; A COMMAND FILE, MIMICING A TYPESCRIPT, CONTAINS THE TEXT). ;IF LEFT PAREN, SIMILARLY PASS TEXT TO ) OR ALT MODE. ;OTHER TERMINATORS PRODUCE NO ACTION. ; ;CAVEAT: IF TRM IS SPACE OR COMMA AND THERE IS NO (TEXT), ; %NOI HAS READ AHEAD ONE INPUT FIELD (AND SET BAKFF). SO DON'T ; TRY TO OUTPUT ANYTHING BETWEEN CALL TO %NOI AND NEXT INPUT. %NOI: PUSH P,40 ;SAVE ARGUMENT ADDRESS TRNE CBT,TLPR JRST NOI0 CAIE TRM,"!" TRNE CBT,TALT ;FOR ALT MODE OR ! TYPE GIVEN TEXT JRST [U$TYPE [ASCIZ /(/] POP P,40 PUSH P,40 ;KEEP IT IN PD ALSO U$TYPE @40 U$TYPE [ASCIZ /) /] CAIE TRM,"!" JRST [ POP P,40 RET] ;THE FOLLOWING IS JUST LIKE "JRST NOIA" ;EXCEPT ECHOING, IF OFF, IS NOT TURNED ON. TLO Z,NEOLF CALL CSTR CAIN TRM,"(" CAILE CNT,1 JRST [ TLO Z,BAKFF JRST [ POP P,40 RET]] JRST NOI0A] TRNN CBT,TSPC+TCOM+TCOL ;SPACE, TAB, COMMA, OR COLON? JRST [ POP P,40 ;OtHER TERMINATORS IGNORED RET] ;%NOI... ;SPACE AND COMMA GET HERE ;PASS UP (TEXT), WHERE TEXT IS ANY SUBSET OF GIVEN IN ORIGINAL ORDER, ;WITH ANY NUMBER OF ADDED SPACES. ;FIRST WE MUST SEE IF NEXT CHARACTER IS "(". BEFORE DOING THIS, WE ;MUST INPUT AN ENTIRE FIELD, TO MAKE EDITING CHARACTERS WORK ;RIGHT (CONSIDER THE CASE WHERE USER TYPES LETTER, BAKSLASH, "(" ). NOIA: TLO Z,NEOLF ;DON'T ECHO EOLS - FIELD MAY BE A FILE NAME CALL CSTR ;INPUT A FIELD CAIN TRM,"(" ;WAS INPUT "(", CAILE CNT,1 ;WITH NOTHING BEFORE IT? JRST [ TLO Z,BAKFF ;NO "(". BACK OUT AND RETURN. ;UNECHOED EOL WILL BE ECHOED IF APPROPRIATE AT NEXT ;"CSTR" OR AT "CONF" JRST [ POP P,40 RET]] TLNE Z,NECHOF ;ECHOING OFF (PASSWORD) ? PRINT (TRM) ;YES, PRINT THE "(". ;INPUT CHARACTERS TILL ) OR ALT MODE. ;CAN'T PROCESS DURING INPUT BECAUSE OF EDITING. ; ( AS LAST TERMINATOR COMES HERE NOI0: TLNE Z,NECHOF ;ECHOING OFF? CALL DOECHO ;YES, PUT IT ON SO NOISE WORD IS ECHOED NOI0A: CALL CSTR ;INPUT TILL ANY TERMINATOR TRNE CBT,TRPR+TALT ; ) OR ALT MODE? JRST NOI1 TRNE CBT,TSPC ;SPACE OR TAB? JRST MORE ;AFTER SPACE GET MORE (RETURNS TO .-4) JRST CERR ;EOL, SEMICOLON, COMMA, ETC ILLEGAL HERE. ;%NOI... ;MATCH LOOP: INPUT CHAR IS OK IF IT MATCHES A CHARACTER IN GIVEN ;STRING AFTER LAST ONE MATCHED. IGNORE SPACES IN BOTH STRINGS. NOI1: EXCH A,(P) ;SAVE A, GET POINTER TO GIVEN. PUSH P,B PUSH P,C PUSH P,D HRLI A,B53 ;FORM BYTE PTR TO GIVEN MOVE C,.BFP ;BYTE PTR TO INPUT IGNOI2: ILDB D,C ;GET AN INPUT CHARACTER CAIL D,141 ;ASCII LOWER CASE A CAILE D,172 ;ASCII LOWER CASE Z JRST .+2 ;NOT A LOWER CASE LETTER SUBI D,40 ;CONVERT LOWER CASE TO UPPER CAIE D,TAB CAIN D," " JRST IGNOI2 CAIN D,")" ; RIGHT PAREN TERMINATES LOOP IGNOI1: JRST [POP P,D ;EXIT POP P,C POP P,B POP P,A RET ] CAIN D,ALTM ;ON ALT MODE TERMINATION, PRINT REST OF GIVEN AND ). JRST [CALL UBP ;BACK UP BFP TO UNBUFFER ALT MODE TLO Z,STCF ;SAY APPEND PRINTED CHARS TO CWBUF CALL CTYPE ;PRINT REST OF GIVEN (A POINTS TO IT) UTYPE [ASCIZ /) /] ;ADD ) AND SPACE TO IT TLZ Z,STCF JRST IGNOI1] ;EXIT IGNOI3: ILDB B,A ;GET A GIVEN CHARACTER CAIL B,141 ;LOWER CASE A CAILE B,172 ;LOWER CASE Z CAIA ;NOT A LOWER CASE LETTER SUBI B,40 ;GIVE IT A RAISE CAIN B," " JRST IGNOI3 JUMPE B,CERR ;MATCH FAILS IF GIVEN ENDS BEFORE INPUT CAME B,D ;MATCH? JRST IGNOI3 ;NO, TRY NEXT GIVEN ON SAME INPUT CHAR JRST IGNOI2 ;YES, GO TO NEXT CHAR IN BOTH STRINGS ;SBCOM UUO ;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO ;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS ;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST %SBCOM: PUSH P,CERET PUSH P,.P PUSH P,.JBUFP PUSH P,KWV1 PUSH P,E PUSH P,40 SBCOM1: MOVEI A,SBCOM1 MOVEM A,CERET ;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE MOVEM P,.P ;PD LEVEL TO RESTORE AFTER ERROR MOVE A,JBUFP MOVEM A,.JBUFP ;JFN STACK LEVEL TO BE RESTORED AFTER ERROR MOVE BFP,[POINT 7,CBUF,-1] ;COMMAND STRING BUFFER POINTER CALL READY2 ;TYPE 2 READY CHARACTERS: @@ OR !! SETZB TRM,CBT ;CLEAR TERMINATOR AND BITS: EOL HERE WOULD ;MAKE "KEYWD" DEFAULT THO IT SHOULDN'T. TLZ Z,BAKFF+PUNCF+NEOLF+EOLNEF+DASHF ;AN OBSCURE CASE IN "DIRECTORY" LEAVES NEOLF ON, ;WHICH TURNS EOLNEF ON IN CONFIRM, WHICH SCREWS UP ;FOLLOWING "KEYWD". KEYWD @(P) ;INPUT A KEYWORD AND LOOK UP IN CALLER'S TABLE T <>,ONEWD,SBCOM9 ;NULL DEFAULTS TO THIS. JRST CERR ;ERROR IF NOT FOUND IN TABLE TLZ Z,F1 ;REQUIRED BY SOME COMMANDS, EG "CREATE". MOVE KWV1,KWV ;SAVE KEYWORD'S BITS FOR "CONFIRM" ETC TLNE KWV1,ONEWD ;IF "ONE WORD COMMAND" BIT ON, CONFIRM ;CONFIRM BEFORE DISPATCH MOVE E,-1(P) ;PRESERVE E FOR "CREATE" ;(I DON'T THINK IT CAN GET CLOBBERED ANYWAY) TRNN KWV1,-1 CALL SBCOM9 ;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS CALL (KWV1) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND MOVEM E,-1(P) JRST SBCOM1 ;GO GET ANOTHER ;TERMINATING SUBCOMMAND INPUT SBCOM9: SUB P,[XWD 2,2] ;FORGET SUBCOMMAND RETURN AND 40 POP P,E POP P,KWV1 POP P,.JBUFP POP P,.P POP P,CERET RET ;UINHEL UUO (INHELP MACRO) ;INPUT STRING WITH CSTR (NEXT). IF STRING CONSISTS OF "?" ONLY, ; OR ? AND A TERMINATOR, "ETYPE" THE MESSAGE THE EFFECTIVE ADDRESS ;POINTS TO, RETYPE COMMAND LINE SO FAR, AND INPUT ANOTHER STRING. %INHEL: PUSH P,A PUSH P,40 CALL CSTR CAILE CNT,2 JRST UINHE9 ;TOO LONG MOVE A,.BFP ILDB A,A ;FIRST CHARACTER CAIE A,"?" JRST UINHE9 ;NOT "?" MOVE BFP,.BFP ;DISCARD "?" STRING PRINT " " MOVE A,-1(P) ;CALLER'S A FOR ETYPE UETYPE @(P) ;GIVEN MESSAGE CAMN BFP,[POINT 7,CBUF,-1] ;AFTER NULL COMMAND, U.$ERR 0 ;USE ERROR CODE TO RESTORE P, RETYPE READY ;CHARACTERS, RESTART COMMAND. U.$ERR DOESN'T ;CLEAR INBUF, 0 MEANS NO MESSAGE. NOTE THAT ;AT LEAST THE FIRST FEW AC'S AREN'T RESTORED. ETYPE (%Y) ;RETYPE INPUT LINE CALL CSTR ;INPUT ANOTHER STRING ;EXIT: FIX THINGS UP SO "MORE" CAN BE USED AS AFTER A CALL ; DIRECTLY TO "CSTR". UINHE9: SUB P,[XWD 1,1] ;FORGET 40 POP P,A POP P,CSTRR ;STORE RETURN FOR USE BY "MORE" JRST @CSTRR ;CSTR AND MORE ;INPUT A FIELD SUBROUTINE (CSTR), ;AND APPEND TO FIELD REENTRY POINT (MORE). ;FIELD CONSISTS OF 0 OR MORE CHARACTERS CONSISTING OF ; LETTERS AND DIGITS, AND ALSO PUNCTUATION IF "PUNCF" IS ON. ; "-" IS ACCEPTED IN FIELD TO SIMPLIFY CODING "-" FOR NULL FIELD. ;ANY OTHER CHARACTER IS FIELD TERMINATOR. ;FLAG "BAKFF" CAUSES PREVIOUSLY INPUT FIELD TO BE USED AGAIN. ; CAVEAT: EXACTLY THE SAME FIELD IS AGAIN RETURNED IF "PUNCF" ; WAS ON AND HAS BEEN TURNED OFF. ; NO KNOWN CASES WHERE THIS MATTERS. 3/4/70 ;FLAG "NEOLF" SUPPRESSES EOL ECHOING. THIS IS USED WHEN A FILE ; NAME IS BEING INPUT, BECAUSE "GTJFN" PRINTS EOL WHERE ; APPROPRIATE EVEN IF EOL IS IN STRING NOT ON FILE. ; ;ACCEPTS: "BFP": POINTER TO CURRENT END OF COMMAND STRING ; "MORE" ALSO REQUIRES THAT .BFP, CNT, CHR, TRM, AND CBT ; HAVEN'T BEEN CLOBBERED. ;RETURNS: "BFP": NEW END ; ".BFP": BEGINNING = OLD END ; "CNT": # OF CHARACTERS IN FIELD ; (USED BY ^A AND ^W SO MUST BE PRESERVED IF "MORE" IS USED) ; "TRM" AND "CHR": TERMINATING CHARACTER ; "CBT": CHRTBL WORD FOR TERMINATING CHAR -- DESCRIPTIVE BITS ; SUCH AS "TEOL", "OCTDIG", ETC. ; FLAGS BAKFF, PUNCF, NEOLF CLEAR ; FLAG EOLNEF SET IF UNECHOED EOL INPUT ; ;"MORE" DOESN'T INITIALIZE .BFP AND CNT. ;"MORE" RETURNS TO WHERE "CSTR" WAS LAST CALLED FROM. ; BEWARE OF PD LEVEL BEING DIFFERENT! ;CSTR AND MORE... ;BEGIN NEW FIELD ENTRY CSTR: POP P,CSTRR ;SO "MORE" RETURNS SAME PLACE TLNE Z,NEOLF ;SUPPRESSION OF EOL ECHOING REQUESTED? ;THIS FEATURE IS USED WHEN READING A STRING TO ;BE FED TO GTJFN, WHICH PRINTS THE EOL ITSELF. JRST [ CALL NOECEO ;YES, CHANGE CCOC SO EOL'S NOT PRINTED JRST CSTR0] TLZE Z,EOLNEF ;NO. ECHO PREVIOUSLY UNECHOED EOL FROM PRECEDING PRINT EOL ;FIELD OR FROM THIS FIELD IF BAKFF ON. CSTR0: TLZE Z,BAKFF ;TEST AND CLEAR "RE-USE SAME FIELD" FLAG ;RE-USE SAME FIELD: CHECK LAST TERMINATOR AGAIN, TO ;MAKE IT READ MORE IN THE CASE WHERE "PUNCF" WAS OFF AND NOW ;IS ON. THIS CAN HAPPEN IN FILE NAME COLLECTION. JRST CSTR2 ;(USUALLY JUST EXITS.) CALL NALNBK ;SET BREAK SET TO NON-ALPHANUMERICS CSTR1: MOVE .BFP,BFP ;BEGIN A NEW INPUT FIELD TO PREVENT SETZ CNT, ;...EDITING. CALL CCHRI ;INPUT A CHARACTER, STORE, PROCESS EDIT CHARS CSTR2: TLNE Z,CTRLVF ;IF PRECEDED BY ^V, JUMPN CHR,CSTR3 ;ANY CHAR BUT NULL IS PART OF FIELD. TRNN CBT,ALPHAN ;IS IT ALPHANUMERIC (INCLUDES "-")? JRST CSTR5 ;NO. CSTR3: CALL CCHRI ;YES, INPUT AND STORE NEXT CHARACTER. JRST CSTR2 ;HAVE A NON-ALPHANUMERIC CHARACTER CSTR5: TLNE Z,PUNCF ;ARE WE ALLOWING PUNCTUATION IN FIELD? TRNN CBT,PUNBIT ;YES, IS IT A PUNCTUATION CHARACTER? JRST .+2 JRST CSTR3 ;CSTR AND MORE... ;HAVE PROBABLE TERMINATOR. ;BUT IF ITS SPACE OR TAB AND CNT=1, THEN ITS A LEADING CHARACTER THAT ; MUST BE IGNORED. ;LEADING CHARACTERS MUST BE IGNOZED HERE, NOT IN A LOOP AT BEGINNING ; OF FIELD INPUT, TO HANDLE CASE WHERE TYPIST DELETES ENTIRE ; FIELD WITH EDITING CHARACTERS, THEN TYPES A SPACE OR TAB. CAIG CNT,1 ;ANY CHARS BEFORE IT? JRST [ TRNE CBT,TSPC ;IS IT A SPACE, TAB, OR & ? JRST CSTR1 ;YES, IGNORE IT. JRST .+1] ;NO, IT TERMINATES FIELD. ;REALLY HAVE TERMINATOR MOVE TRM,CHR PUSH P,A PUSH P,B SETZ A, MOVE B,BFP IDPB A,B ;STORE 0 AFTER STRING. NEEDED FOR FILE NAMES. POP P,B POP P,A CSTR9: TLZ Z,PUNCF ;CLEAR "PUNCTUATION CHARACTERS ALLOWED" FLAG TLZE Z,NEOLF ;CLEAR "DON'T ECHO EOLS" FLAG CALL DOECEO ;AND CHANGE CCOC SO EOLS WILL PRINT PUSH P,CSTRR ;RETURN RET ;ENTRY TO ADD MORE CHARACTERS TO SAME FIELD AND RETURN TO WHERE "CSTR" ;WAS CALLED. MORE=CSTR3 ;PASCOM ;SUBROUTINE TO PASS COMMENT, IF ANY. ;IF TRM=;, IGNORE INPUT TO EOL. ;DO IT BY FIELDS FOR CONSISTENT BEHAVIOR OF EDITING CHARACTERS. ;BUT LEAVE AC'S SET FOR PRECEDING FIELD. PASCOM: TRNN Z,CTRLVF ;I'VE FORGOTTEN WHY ^V; DOESN'T COUNT CAIE TRM,";" RET ;NO COMMENT PUSH P,.BFP PUSH P,CNT PUSH P,CHR PUSH P,TRM PUSH P,CBT PASCM1: CALL CSTR CAIN TRM,FORMF JRST .+3 CAIE TRM,EOL JRST PASCM1 POP P,CBT POP P,TRM POP P,CHR POP P,CNT POP P,.BFP RET ;SERVICE ROUTINE FOR "ALLOW" UUO. ;CHECKS THAT LAST CHARACTER (USUALLY FIELD TERMINATOR) IS AS ;DESCRIBED BY BITS IN EFFECTIVE ADDRESS. ;IE MAKES SURE E OR'D WITH C(CBT) >< 0. %ALLOW: TRNN CBT,@40 JRST CERR RET ;CONF ;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE ;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS. ;USES KWV1,TRM AND DOES THE FOLLOWING: ; IF PROGX, THE THING (BEING RUN?) GETS THE REST OF THE COMMAND LINE ; SO NO SCANNING FOR EOL'S ETC. IS PERMITTED. ; IF BAKFF ON, ERROR UNLESS CNT=1. ; IF TRM=; , INPUT CHARS TO EOL AND EXIT. ; IF NOCONF ON, TYPE EOL UNLESS TRM=EOL OR FORMFEED AND EXIT. ; IF TRM> POP P,B POP P,A CALL ALLBK ;SET BREAK SET TO ALL CHARACTERS CONF6: MOVE .BFP,BFP ;NEW FIELD PREVENTS INVALID EDITING SETZ CNT, ;... CALL CCHRI ;INPUT CHARACTER TRNE CBT,TSPC JRST CONF6 ;IGNORE PRECEDING SPACES AND TABS MOVE TRM,CHR CONF7: CALL PASCOM ;IF ;, IGNORE CHARACTERS TIL EOL CONF8: TLNE Z,CTRLVF JRST CONFE ;^V ALWAYS LOOSES TRNE CBT,TEOL ;EOL OR ; OR FORMFEED JRST CONF9 ;SUCCESS CAIN CHR,ALTM JRST [ TLNN KWV1,ALTCON ;ALT MODE. OK AS TERMINATOR? JRST CONFE ;NO, TYPE " ? " AND RETRY PRINT EOL JRST CONF9] JRST CONFE ;CONFIRMATION SUCCESSFUL CONF9: TLZ Z,BAKFF ;REALLY MATTERS, EG, FOR "^E PRINT" RET ;CONFIRMATION FAILURE ;ON "?" TYPE EXPLANATORY MESSAGE, RETYPE COMMAND, ALLOW RETRY CONFE: CAIG CNT,1 CAIE CHR,"?" JRST CONFE1 ;NOT "?" MOVE BFP,.BFP ;REMOVE THE "?" FROM THE COMMAND LINE ETYPE < CONFIRM WITH CARRIAGE RETURN%Y>; %Y RETYPES COMMAND JRST CONF6 ;GO INPUT CONFIRMATION CHARACTER AGAIN CONFE1: TYPE < ? > ;KEEP TRYING TILL HE TYPES ^X OR ^C. BTCHER ;STOP NON-CONVERSATIONAL JOB MOVE BFP,.BFP ;FORGET BAD CONFIRMATION CHAR (FOR ^R) JRST CONF6 ;GO TRY AGAIN ;TCONF ;CONFIRMATION ROUTINE (LIKE CONF) INTENDED TO BE USED DURING COMMAND ;EXECUTION. DIFFERS FROM CONF IN THAT IT IS TRANSPARENT TO MOST AC'S ;AND HAS SEPARATE CONFIRMATION AND NON-CONFIRMATION RETURNS. ; CALL TCONF ; RET +1: NOT CONFIRMED (I.E. ^X OR TUROUT) ; RET +2: CONFIRMED (CR, EOL, ETC.) ;NOTE THIS ROUTINE PROBABLY OUGHT TO BE IMPLEMENTED AS A SPECIAL CALL ;TO CONF, BUT HTAT REQUIRES SAVING INCREDIBLE AMOUNTS OF STATE ;(INCLUDING THE CONTENTS OF CSBUF!) TCONF: CALL DOECEO ;ENSURE CR WILL ECHO CALL ALLBK ;BREAK ON ALL TYPED IN CHARACTERS PUSH P,EOFDSP ;CALLER (LIST) MIGHT HAVE ITS OWN TRAP MOVEI A,CCHEOF ;ROUTINE TO HANDLE EOF MOVEM A,EOFDSP TCONF1: MOVE A,CIJFN CFIBF ;FLUSH TYPEAHEAD TO AVOID CONFUSION BIN ;GET CONFIRMATION CHARACTER CAIN B,177 JRST TCONFR ;RUBOUT CAIN B,"X"-100 JRST TCONFX ;^X CAIN B,15 ;CR, EXPECT TO SEE LF AFTER SO READ IT BIN CAIE B,37 CAIN B,12 JRST TCONFC ;EOL OR LF, CONFIRMATION TYPE < ? > ;SOMETHING ELSE, KEEP TRYING UNTIL JRST TCONF1 ;USER TYPES EOL OR RUBOUT TCONFC: AOSA -1(P) ;HERE FOR CONFIRMATION EXIT TCONFX: TYPE <^X > POP P,EOFDSP ;RESTORE PREVIOUS EOF DISPATCH RET TCONFR: TYPE POP P,EOFDSP ;RESTORE PREVIOUS EOF DISPATCH RET ;SPRTR ;TEST TERMINATOR (SEPARATOR) AND MAYBE READ AND TEST THE NEXT FIELD, ; TO DETERMINE WHETHER THERE'S A COMMA NEXT (R2), THE END OF THE ; COMMAND (R3), OR GARBAGE OR ANOTHER ARG WITHOUT A COMMA (R1). ; ;TYPICAL USES: AFTER "DIRECTORY" OR "TYPE", TO SEE IF THERE IS ; A COMMA TO INITIATE SUBCOMMAND INPUT, OR A FILE NAME ARG (NOT ; SEPARATED WITH COMMA), OR NEITHER; BETWEEN ARGS IN A LIST ; SEPARATED WITH COMMAS, AS IN SOME SUBCOMMANDS OF "CREATE". ; ;IN MORE DETAIL: ; RETURN +1: ; ALT MODE OR SPACE NOT FOLLOWED IMMEDIATELY BY COMMA, EOL, OR ; ALT MODE, IE FOLLOWED BY SOME OTHER TERMINATOR, OR AN ; ALPHANUMERIC FIELD. BAKFF SET, READY TO PROCESS FIELD. ; ; RETURN +2: ; COMMA, PERHAPS PRECEDED BY SPACE OR ALT MODE. ; READY TO INPUT SUBCOMMANDS OR NEXT ARG OF LIST. ; ; RETURN +3: ; EOL, SPACE-EOL, SPACE-ALT MODE, ALT MODE-EOL, OR 2 ALT MODES. ; BAKFF SET EXCEPT IN EOL CASE, READY TO CALL "CONF". ; ;CAVEAT: DON'T CALL THIS FOR A COMMAND WITH "CONFRC" BIT SET, ; BECAUSE IT CAN READ CONFIRMING CHARACTER BEFORE CONF HAS HAD ; ITS CHANCE TO TYPE "[CONFIRM:]". SPRTR: TRNE CBT,TEOL AOS (P) ;EOL. R3. TRNE CBT,TCOM+TEOL JRST [ AOS (P) ;COMMA GETS R2. RET] ALLOW TSPC+TALT ;ERR IF CHAR NOT EOL, COMMA, SPACE, OR ALT MODE. CALL CSTR ;AFTER SPACE OR ALT MODE GET NEXT FIELD. CAIGE CNT,2 ;NON-NULL, ALWAYS BACK UP AND GIVE R1. TRNN CBT,TCOM+TEOL+TALT ;ALSO BAKUP & R1 IF NOT COM, EOL, ALTM. JRST [ TLO Z,BAKFF RET] AOS (P) TRNE CBT,TCOM RET ;NULL, COMMA: R2 WITHOUT BACKUP. TLO Z,BAKFF ;NULL, ALT MODE OR EOL: BACK UP, R3. JRST [ AOS (P) RET] ;CCHRI ;INPUT A CHARACTER FOR COMMAND STRING INTO "CHR". ;RETURNS IN AC "CBT" THE CHARACTER'S WORD IN THE CHARACTER TABLE -- ; THIS CONTAINS DESCRIPTIVE BITS (SEE COMMENTS ABOVE "CHRTBL") ;STORES IN CBUF (POINTER CBP) ;EDITING CHARACTERS: ; ^A DELETE CHAR (CAN ONLY DELETE TO BEGINNING OF FIELD) ; ^W DELETE FIELD (CAN ONLY DELETE CURRENT ONE) ; ^X DELETE LINE (DOESN'T RETURN TO CALLER) ; ^R RETYPE LINE ? IF COLLECT FILE NAME IS COMPATIBLE. ; ^V GET ANOTHER CHARACTER AND RETURN IT EVEN IF ITS AN EDITING CHAR, ; & RETURN "CTRLVF" ON. ;OTHER SPECIAL CHARACTERS: ; ( IF ECHOING OFF, TURN IT ON AND PRINT "(". ; THIS KLUDGE IS NECESSARY BECAUSE NOISE WORD CAN BE TYPED IN ; BEFORE PASSWORD. ;CALLERS MUST CLEAR CHARS-IN-FIELD COUNTER (CNT) AT BEGINNING OF EACH ;NEW FIELD. CCHRI: PUSH P,A PUSH P,B MOVEI A,CCHEOF MOVEM A,EOFDSP ;SETUP TO DETECT EOF ON COMMAND INPUT TLZ Z,CTRLVF ;SAY NO ^V (YET) BEFORE THIS CHARACTER ;RETURN HERE AFTER PROCESSING SPECIAL CHARACTER ;GET CHARACTER INTO "CHR", BITS INTO "CBT", DISPATCH IF SPECIAL CCHR1: MOVE A,CIJFN ;INPUT SOURCE DESIGNATOR BIN ;INPUT CHARACTER TO B CAIN 2,12 ;LF? MOVEI 2,EOL ;YES, MAKE LIKE EOL CAIN B,15 ;REAL CR? JRST [ BIN ;YES, ASSUME LF FOLLOWING MOVEI 2,EOL ;AND REPLACE WITH EOL JRST .+1] MOVE CHR,B AOS TTYACF ;SAY THERE'S BEEN TTY ACTIVITY, SO JOB ;WON'T GET AUTOLOGOUTED FOR LACK THEREOF MOVE CBT,CHRTBL(CHR) ;BITS WORD FROM CHARACTER TABLE TLNE Z,CTRLVF ;PRECEDED BY ^V? JRST CCHR8 ;YES, NO SPECIAL PROCESSING TLNE CBT,-1 ;HAS A SPECIAL-CASE DISPATCH ADDR? JRST [ HLRZ B,CBT ;YES, DISPATCH. JRST (B)] ;NOT SPECIAL. CHECK FOR COMMAND TOO LONG, STORE CHARACTER. CCHR8: HRRZ B,BFP CAIL B,CBUFE ERROR AOJ CNT, IDPB CHR,BFP ;STORE CHARACTEB IN COMMAND BUFFER SETZM EOFDSP POP P,B POP P,A RET ;CCHRI... ;ROUTINES FOR SPECIAL CHARACTERS ;PROCESS ^A $CTRLA: SKIPG CNT ;ANY DELETEABLE CHARACTERS? JRST [ CALL DING ;NO, RING BELL JRST CCHR1] ;INPUT ANOTHER CHARACTER PRINT "\" ;YES, ECHO \ LDB B,BFP TLNN Z,NECHOF ;DON'T PRINT IF ECHOING IS OFF CALL CCHRO ;DELETED CHARACTER CALL UBP ;BACK UP BFP AND CNT JRST CCHR1 ;GET ANOTHER INPUT CHARACTER ;PROCESS ^W $CTRLW: SKIPG CNT JRST [ CALL DING ;NO FIELD TO DELETE JRST CCHR1] UTYPE [ASCIZ /_/] CALL UBP JUMPG CNT,.-1 JRST CCHR1 ;PROCESS ^R $CTRLR: TLNE Z,NECHOF ;IS ECHOING OFF? JRST [ CALL DING ;YES JRST CCHR1] ;GO GET NEXT CHAR CALL DOECEO ;MAKE SURE EOL WILL PRINT SETZ CHR, MOVE B,BFP IDPB CHR,B ;TERMINATE WITH 0 PRINT EOL PRINT " " UTYPE CBUF ;TYPE CR, SPACE, COMMAND BUFFER TLNE Z,NEOLF ;IF EOL ECHO SUPPRESSION IN EFFECT, CALL NOECEO ;CHANGE CCOC BACK SO EOL'S WON'T PRINT JRST CCHR1 ;PROCESS ^X $CTRLX: .$ERROR <^X>; XXX? ;PROCESS RUBOUT (LATER A PSI(?)) $RUB: .$ERROR ;.$ERROR MEANS NO CR FIRST, NO CLR INBUF ;CCHRI... ROUTINES FOR SPECIAL CHARACTERS... ;PROCESS ^L (FORMFEED) $FORMF: CALL DOECEO ;MAKE EOL'S PRINT PRINT EOL ;ECHO CR-LF AFTER FORMFEED ;ABOVE FAILS IF FORM FEED IS BACKED UP OVER: TWO EOL'S ECHOED. ;DON'T THINK IT CAN HAPPEN. 5/14/70. FORMF1: TLNE Z,NEOLF ;IF EOL ECHO SUPPRESSION IN EFFECT, CALL NOECEO ;CHANGE CCOC SO EOL'S WON'T PRINT JRST CCHR8 ;PROCESS EOL $EOL: TLNE Z,NEOLF ;EOL ECHOING SUPPRESSED? TLO Z,EOLNEF ;YES, SAY THERE IS AN UNECHOED EOL. JRST CCHR8 ;PROCESS "-" $DASH: TLNE Z,DASHF ;"DASHF" MAKES IT NON-ALPHANUMERIC, AND THUS TRZ CBT,ALPHAN ;A TERMINATOR. USED IN "LIST" SUBCMD "PAGES". JRST CCHR8 ;PROCESS ^V $CTRLV: TLO Z,CTRLVF ;INDICATE PRECEDED BY ^V JRST CCHR1 ;GO GET ANOTHER CHARACTER ;PROCESS CONTINUATION CHARACTER (&) $CONT: CALL DOECEO ;MAKE EOL'S PRINT PRINT EOL ;ECHO EOL-SPACE PRINT " " MOVE CBT,CHRTBL+" " ;RETURN BITS FOR SPACE MOVEI CHR,CONTCH ;STORE SPECIAL CHARACTER IN CBUF JRST FORMF1 ;GO SUPPRESS EOL PRINTING IF FLAG ON & JRST CCHR8 ;"CONTCH" IS USED BECAUSE MUST STORE A SINGLE BYTE BUT ;KNOW TO TRANSLATE IT TO 3 BYTES (&-EOL-SPACE) ON OUTPUT BY ;^A OR ^R. ;SUBROUTINE TO BACK UP ONE CHARACTER IN COMMAND STRING. ;UN-INCREMENTS "BFP" AND "CNT". UBP: SOJ CNT, ADD BFP,[7B5] ;UNCREMENT BYTE POINTER TLNE BFP,40B23 ;THIS FAILS FOR POINTERS TO BIT -1 SUB BFP,[43B5+1] ;(SUCH POINTERS SHOULD NEVER GET HERE) RET ;EOF WHILE READING COMMAND FILE ; THIS IS CALLED AT COMPUTE LEVEL, NOT PSI LEVEL CCHEOF: INTOFF GPJFN HLRZM 2,CRJFNI HRRZM 2,CRJFNO ;SAVE FOR * IN "RED" OR "DET" CMND MOVE 2,PRIMRY ;REVERT TO JFNS WE HAD AT ENTRY SPJFN MOVEI 1,100 MOVEM 1,CIJFN MOVEI 1,101 MOVEM 1,COJFN CCHEF1: TYPE <[EOF ON COMMAND INPUT FILE]> MOVE 1,CRJFNI CAIE 1,-1 ;PREVIOUS INPUT WAS CONTROLLING TTY? SKIPL CREDIF ;WAS INPUT REDIRECTED? JRST CCHEF2 ;YES OR NO CLOSF CALL SCREWUP CCHEF2: SETZM CREDIF ;SAY INPUT NOT NOW REDIRECTED CCHEF3: MOVE 1,CRJFNO CAIE 1,-1 SKIPL CREDOF JRST CCHEF4 CLOSF CALL SCREWUP CCHEF4: SETZM CREDOF INTON CALL RLJFNS ;RELEASE JFN'S JRST ERRET ;BACK TO MAIN LOOP (FOR NOW) ;SERVICE ROUTINE FOR OUTPUT STRING UUO ("TYPE" MACRO) ; UTYPE [ASCIZ @TEXT@] ;AND ;SUBROUTINE TO TYPE STRING FOR BYTE PTR IN A (CTYPE) %TYPE: PUSH P,A ;UUO SERVICE ENTRY HRR A,40 HRLI A,B53 ;FORM BYTE POINTER TO ARGUMENT TYP1: PUSH P,B TYP2: ILDB B,A JUMPE B,[POP P,B POP P,A RET] CALL CCHRO ;OUTPUT CHARACTER IN B JRST TYP2 CTYPE: PUSH P,A ;SUBR ENTRY JRST TYP1 ;SIMILAR BUT ALSO STORE TEXT IN COMMAND BUFFER. ;USE FOR NOISE WORDS & PRINTING REST ON ALT MODE, SO ^R PRINTS IT ALL %$TYPE: PUSH P,Z ;UUO ENTRY TLO Z,STCF ;FLAG TELLS "CCHRO" TO STORE CHARACTERS CALL %TYPE POP P,Z ;RESTORE PREVIOUS STATE OF STCF RET $CTYPE: PUSH P,Z ;SUBROUTINE ENTRY TLO Z,STCF CALL CTYPE POP P,Z RET ;SIMILAR BUT ONLY DO IT IF TERMINATOR (IN AC "TRM") IS ALT MODE. ;USED TO TYPE REST OF RECOGNIZED WORD, SPACES BEFORE ARGUMENTS, ETC. ;MACRO "ALTYPE", UUO "UALTYP". %ALTYP: CAIN TRM,ALTM JRST %$TYPE RET ;SEE ALSO "%ETYPE" IN S3.MAC ;COLLECT FILE NAMES: ;CINFN & COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON. ;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS. ;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS. ;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER ; 2 => USE LAST NAME INPUT AS DEFAULT NAME ; LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER ; 0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE ; 1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT ; 2 => LIKE -1 BUT USE EXT OF LAST FILE NAME INPUT AS ; DEFAULT EXT ; -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR * ; -2 LIKE -1 BUT GIVE R1 IF NO SUCH FILE ; ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0) ; RH: FLAGS FOR GTJFN PLUS: ; B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",". ; DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION), ; MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY) ; B16 & B17 ARE HAIRY: THE CASUAL READER SHOULD DISREGARD ; THEM. ; B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR ; SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED ; BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND ; INPUT REQUIRED). ; B15 SHOULD ALSO BE ON. ; ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN ; PRE-READ FOLLOWING FIELD HENCE WONT WORK WITH "CONFRC". ; B17: DEFAULTS NULL WITHOUT LETTING THE USER BE AWARE ; OF THIS (NO PRINTOUT, RETURN WITH BAKFF ON IF IT ; WAS ALT MODE). ; EG "DIRECTORY$$" AND "DIRECTORY$ *.*$$" ARE =. ; ALSO IF AT ENTRY PRECEDING FIELD ENDED IN COMMA OR EOL, ; BEHAVE AS THO THAT CHARACTER WERE INPUT HERE & ; DEFAULT ACCORDINGLY. ; EG "DIRECTORY,$", "DIRECTORY ,$" ARE SAME. ; B14: ALLOW * FOR NAME IN EMPTY DIRECTORY, RETURNING -2 ; IN PLACE OF JFN. ; (NOT WORKING 2/9/71 CAUSE GJFX32 NOT WORKING.) ; ; ; ALSO, F3 IN Z SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN ; AFTER INITIAL TRY FAILS -- FOR DEFAULT RUN ;COLLECT FILE NAMES COMMENTS... ;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT, ; OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A), ; OR TRM=EOL AT ENTRY (IN WHICH CASE NO INPUT), ; OR -2 IN LH OF A AND NO SUCH FILE, ; OR B16 ON AND LIST ENDED WITH COMMA. ; THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T ; BE USED IF B15, B16, OR B17 ON. ; +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF" ; (POINTER JBUFP). 1ST LOCATION IN THIS BUFFER ; (FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,... ; IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT ; (B11,15,16,OR 17 ON), SETS INIFH1 &2 TO 1ST & LAST USED ; LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF" ; IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT). ; EITHER: TERMINATOR IN "TRM" ;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF, ; AS %KEYW DOES. SEE %KEYW'S GLITCH NOTE (S1.MAC). ;FLAGS IN AC D ;RH: FROM CALLER ;LH: B0: NULL INPUT UNDER B17 OPTION ; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA ; B2: DITTO, DITTO, FOLLOWED BY COMMA ;COLLECT FILE NAMES... ENTRIES. ;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME). ;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION. COUTFN: PUSH P,B MOVEI B,440000 ;GTJFN FLAGS FOR OUTPUT FILE NAME JRST CFN1 ;INPUT (OLD FILE REQUIRED) CINFN: PUSH P,B MOVEI B,100000 ;FLAGS FOR GTJFN FOR INPUT FILE JRST CFN1 ;EDIT FILE NAME -- MAY OR MAY NOT EXIST YET CEDFN: PUSH P,B MOVE A,EDFILE ;POINTERS TO DEFAULT NAME AND EXT. MOVEI B,B3+B4 ;PRINT NEW/OLD, CONFIRM, NO SPEC OPTIONS JRST CFN1 ;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP. ;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA. ;NO SPECIAL RETURN FOR "*" OR NULL INPUT. ;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN". ;COLLECT FILE NAMES... GROUP ENTRIES ;.INFG ;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME - ; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW. ;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW, ; AS IN 1ST ARG TO "COPY". ;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP), ; VERSION TO HIGHEST. ;ONE RETURN ONLY. .INFG: PUSH P,B MOVEI B,B2+B11+B15 ;GTJFN & LOCAL FLAGS: OLD FILES, ;*'S FOR INPUT, MINIMUM COMMA OPTION. .INFG1: MOVE A,[XWD 2,2] CALL SPECFN JRST CERR JRST [ POP P,B RET] ;INFG ;SIMILAR BUT ALSO ALLOWS COMMAS AFTER ALTMODE OR SPACE AND ; ADDITIONAL NAMES WITHOUT COMMA AFTER ALTMODE OR SPACE. ;SUITABLE FOR USE ONLY AT END OF COMMAND, AS WITH "LIST". ;WARNING: CAN PRE-READ CONFIRMATION CHARACTER. INFG: PUSH P,B MOVEI B,B2+B11+B15+B16 JRST .INFG1 ;$INFG ;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT ;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT). $INFG: PUSH P,B MOVEI B,B2+B11+B15+B16 MOVE A,[XWD 2,2] JRST CFN1 ;DIRARG ;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT: ; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!). ; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS ; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER. ; ACCEPTS * FOR NAME IN EMPTY DIRECTORY DIRARG: PUSH P,B MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]] HRLI B,-3 ;DEFAULT VERSION: * HRRI B,B2+B8+B11+B14+B15+B16+B17 JRST CFN1 ;COLLECT FILE NAMES ENTRIES... ;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH. ; USED IN SPECIAL CASES, EG: ; DEFAULT TO LOWEST VERSION FOR "DELETE" (-2 IN LH B) ; DELETED FILE NAME FOR "UNDELETE" ; NEW NAME FOR "DEFINE" ; ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY". SPECFN: PUSH P,B ;END OF ENTRIES. CASES MERGE HERE. CFN1: SETZM CJFNBK+3 ;NO DEFAULT DIRECTORY CFN1A: PUSH P,C ;"CPFN" SETS DEFAULT DIR AND JOINS HERE. PUSH P,D HRRZ D,B ;SAVE GTJFN AND LOCAL FLAGS IN RH D ;NOTE: B0 OF LH D USED AS A FLAG IN CONJUNCTION WITH ;NULL INPUT UNDER B17 OPTION TRZ B,B15+B16+B17 ;DON'T GIVE LOCAL FLAGS TO GTJFN TRNE D,B11+B15+B16+B17 ;IF AN INPUT GROUP IS BEING REQUESTED, SETZM INIFH1 ;SAY NO NAMES HAVE BEEN INPUT YET. TRNE D,B17 TRNN CBT,TCOM+TEOL JRST CFN1B TLOE Z,BAKFF JRST CFN1B ;B17 OPTION ON AND LAST FIELD ENDED IN COMMA OR EOL. ;BEHAVE AS THO FIRST INPUT FIELD WAS JUST THAT CHARACTER MOVE .BFP,BFP CALL UBP ;UNINCREMENT BFP EXCH .BFP,BFP ;SET UP PTRS TO TERMINATOR ONLY MOVEI CNT,1 ;NULL FIELD. BAKFF ALREADY ON. MOVEI C," " TRNE CBT,TEOL ;CHANGE EOL TO SPACE SO GTJFN WON'T DPB C,BFP ;"ECHO" EXTRA CR CFN1B: TLNE Z,BAKFF ;IF THERE'S AN UNUSED FIELD, JRST .+3 ;THEN THE COMMAND HASN'T ENDED. TRNE CBT,TEOL ;LAST TERMINATOR CR OR ; ? JRST CFN9 ;YES, IT ENDED COMMAND, NO MORE INPUT ;COLLECT FILE NAMES... ;SET UP GTJFN PARAMETER BLOCK MOVSM B,CJFNBK ;FLAGS AND DEFAULT VERSION MOVE B,COJFN HRL B,CIJFN MOVEM B,CJFNBK+1 ;XWD INPUT JFN, OUTPUT JFN ;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP CFN2: TLZ D,B0 ; FORM "DEFAULT STRING POINTER" TO EXTENSION HRRZ B,A HRLZI C,B11 ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT CAIN B,2 ;2 SAYS USE EXT OF LAST FILE NAME INPUT CALL LFJFNS ;GET A STRING FOR LAST FILE'S EXT JUMPE B,.+2 HRLI B,B53 MOVEM B,CJFNBK+5 ; FORM "DEFAULT STRING POINTER" TO DEFAULT NAME HLRZ B,A HRLZI C,B8 ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT CAIN B,2 ;2 SAYS USE NAME OF LAST FILE NAME INPUT CALL LFJFNS ;GET A STRING FOR LAST FILE'S NAME CAIE B,-2 CAIN B,-1 SETZ B, JUMPE B,.+2 HRLI B,B53 MOVEM B,CJFNBK+4 ;COLLECT FILE NAMES... ;NOW WE MUST READ TEXT UP TO A FILE NAME FIELD TERMINATOR, ; TO ALLOW EDITING, THEN CHECK FOR SPECIAL CASES: NULL, "-", AND "*". ;RETURN HERE TO RETRY AFTER ERROR RETURN FROM GTJFN. CFN3: TLO Z,PUNCF+NEOLF ;SAY READ INPUT TO FILE FIELD TERMINATOR ;AND DON'T ECHO EOL (BECAUSE GTJFN PRINTS EOL ;WHEN APPROPRIATE EVEN IF IT WAS PRE-READ). INHELP ;INPUT FIELD, TYPE MESSAGE ON "?" TRNN CBT,TSPC+TALT+TEOL+TCOM JRST CFN4 ;END OF FIELD, NOT WHOLE NAME, NOT SPEC CASE CAIE CNT,1 JRST CFN3B ;NULL CASE ;NULL INPUT TERMINATING LIST UNDER B16 OPTION IS PROCESSED ;HERE RATHER THAN AFTER GTJFN FOR CORRECT BEHAVIOR AFTER ERROR: ;IE BAD FILE NAME TYPES "?", THEN IF JUST A CR IS INPUT, ;PRECEDING LIST IS PROCESSED AS THO IT WAS TERMINATED BY THE CR. TRNN CBT,TALT+TEOL JRST .+5 ;ANOTHER COMMA DOESN'T END LIST TLNE D,B2 ;B16 & PREV FIELD ENDED WITH COMMA? SOSA -3(P) ;YES, CANCEL AOS BELOW TO GIVE R1 AFTER ;GOING THRU GOOD RETURN CODE TLNE D,B1 ;B16 & NO COMMA AFTER PREV ARG? JRST [ PUSH P,A ;YES. INTERFACE TO EXIT CODE AT "CFN7Z" CAIN TRM,ALTM ;.. DON'T BUFFER ALT MODES, CAUSE CALL UBP ;.. OTHERWISE "ALTYPE ( )" SETS CNT TO ; 2 AND "CONF" GIVES AN ERROR. TLO Z,BAKFF ;RE-USE ALTM OR EOL AS CONFIRMING CHAR JRST CFN7Z] TRNE D,B17 ;B17 OPTION (SEE COMMENTS AT BEGINNING) TRNN CBT,TALT ;YES, NULL ONLY SPECIAL IF ALTMODE JRST CFN3A MOVEI B," " DPB B,BFP ;SUPPRESS PRINTOUT OF DEFAULT TLO D,B0 ;INVOKE ADDL SPECIAL STUFF AFTER GTJFN JRST CFN4 CFN3A: TLNE A,-2 ;DID CALLER GIVE A DEFAULT NAME, ;OR -1 TO SAY "NO SPEC CASE FOR NULL"? JRST CFN4 ;YES, GO GTJFN UALTYP [ASCIZ /-/] ;NO. PRINT "-" IF ALT MODE. JRST CFN9 ;RETURN +1 CFN3B: CAIN CNT,2 ;ONE-CHARACTER CASE JRST [ MOVE B,.BFP ;GET THE ONE CHARACTER ILDB B,B ;... CAIN B,"-" ;WAS IT "-"? JRST CFN9 ;YES, RETURN +1. CAIE B,"*" ;WAS IT ASTERISK? JRST .+1 ;NO, NOT SPECIAL, GO GTJFN. HLRZ B,A ;YES, DID CALLER REQUEST SPECIAL CAIE B,1 ;...HANLDING OF ASTERISK? JRST .+1 ;NO. MOVEI A,"*" ;YES, RETURN +1 WITH "*" IN A. JRST CFN9] ;COLLECT FILE NAMES... ;HERE WHEN EXCEPTIONS ELIMINATED AND MUST "GTJFN" CFN4: PUSH P,A ;SAVE FOR ERROR RETRY HLRZ B,JBUFP ;CHECK SPACE IN JFN BUFFER CAIN B,-1 ERROR MOVEI A,CJFNBK ;GTJFN PARAMETER BLOCK LOCATION MOVE B,.BFP ;POINTER TO STRING INCLUDING TERMINATOR GTJFN ;GET JFN FOR NAME. TAKES MORE INPUT FROM ; COMMAND FILE (TTY) IF NEEDED. CAIA ;1: FAILLED: TRY F3 JRST CFN4Z ;SUCCESS TLNN Z,F3 ;IF F3, THEN TRY AGAIN USING ; FIRST THE CONNECTED DIRECTORY ; AND NEXT THE LOGIN DIRECTORY ; USED FOR SUBSYSTEM NAME COMMAND ; IF STILL FAILS OR IF NOT F3 ; THEN CALL CFNE TO ADJUST PC FOR JERR JRST CFN4Y PUSH P,D GJINF ;GET CONNECTED DIRECTORY POP P,D CAMN 1,2 ;EQUALS LOGIN DIRECTORY? JRST CFN4X ;YES HRROI A,IUSRNM ;GET DIRECTORY STRING DIRST CALL [ SKIPG CUSRNO ;LOGGED-IN? JRST CERR JRST SCREWUP] ;YES, REAL SCREWUP MOVEI A,CJFNBK ;LONG GTJFN BLOCK HRROI B,IUSRNM ;NEW DEFAULT DIRECTORY MOVEM B,3(A) MOVE B,.BFP ;STRING POINTER FOR INPUT SO FAR GTJFN CAIA ;FAILED AGAIN, TRY LOGIN DIRECTORY JRST CFN4Z ;SUCCESS PUSH P,D GJINF POP P,D CFN4X: MOVE B,A HRROI A,IUSRNM DIRST ;GET DIRECTORY STRING CALL [ SKIPG CUSRNO JRST CERR JRST SCREWUP] MOVEI A,CJFNBK ;LONG GTJFN BLOCK HRROI B,IUSRNM ;NEW DEFAULT DIRECTORY MOVEM B,3(A) MOVE B,.BFP ;INPUT STRING SO FAR GTJFN ;TRY AGAIN CFN4Y: CALL CFNE ;ADJUST PC FOR JERR CFN4Z: MOVE B,JBUFP ;ADD JFN TO STACK. MUST HAPPEN PROMPTLY PUSH B,A ;SO IT WILL GET RELEASED ON ERRORS. MOVEM B,JBUFP ;PUT FILE NAME TEXT (UNFORTUNATELY NOT NECESSARILY AS INPUT) ; INTO COMMAND STRING BUFFER, FOR ^R. MOVE B,A ;JFN MOVE A,.BFP ;DEST: OVERWRITE WHAT WAS PRE-READ SETZ C, ;DEFAULT FORMAT CAME B,[-2] ;NULL TEXT FOR EMPTY DIRECTORY JFNS ;JFN TO STRING CONVERSION MOVE BFP,A ;NEW END OF COMMAND STRING CALL INTRM ;GET TERMINATING CHR OF FIELD GTJFN READ MOVE A,B ;JFN TO A TO RETURN ;COLLECT FILE NAMES... ;CODE FOR THE VARIOUS GROUP CASES TRNN D,B11+B15+B16+B17 JRST CFN8 ;NO SUCH OPTIONS ON TLZE D,B1+B2 ;B16 AND NOT FIRST ARG? TLO Z,GROUPF ;YES, SAY GROUP INPUT. HRRZ B,JBUFP SKIPN INIFH1 ;FIRST JFN IN GROUP? MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER TLNE A,<77B5>B53 ;ANY *'S INPUT OR DEFAULTED TO? TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED. TLNN D,B0 ;WAS IT ALTMODE ONLY & B17 OPTION ON? JRST CFN7A ;NO ;AFTER ALTMODE TO B17 OPTION RETURN IMMEDIATELY ;WITH BAKFF ON SO THE ALT MODE FUNCTIONS AS CONFIRMATION CHAR TLO Z,BAKFF JRST CFN7Z CFN7A: TRNE D,B15 CAIE TRM,"," JRST CFN7C ;COMMA TERMINATOR AND B15 ON HLRZ A,JBUFP ;JFN LIST PUSH POINTER CAIN A,-2 JRST [ UTYPE [ASCIZ /[FILE LIST FULL]/] MOVEI 1,^D500 DISMS MOVEI 1,100 CFIBF MOVEI TRM,33 ;FAKE ALTMODE AS TERMINATOR MOVEI CBT,TALT JRST CFN7Z] ;AND GET OUT TRNE D,B16 JRST CFN7D ;GO GET NEXT ARGUMENT OF LIST TLO Z,GROUPF ;SAY A GROUP HAS BEEN INPUT CFN7B: POP P,A ;RESTORE CALLER'S A JRST CFN2 ;GO RESETUP DEFAULTS AND READ ANOTHER ARG ;COLLECT FILE NAMES... GROUP CASES CODE... CFN7C: TRNE CBT,TALT+TSPC TRNN D,B16 JRST CFN7Z ;ALTMODE OR SPACE TERMINATOR AND B16 ON. ;PREREAD NEXT FIELD AND CHECK FOR COMMA. ALTYPE ( ) HLRZ A,JBUFP ;FILE LIST PUSH POINTER CAIN A,-2 JRST [ UTYPE [ASCIZ /[FILE LIST FULL]/] MOVEI 1,^D500 DISMS MOVEI 1,100 CFIBF JRST CFN7Z] TLO Z,NEOLF CALL CSTR CAIE CNT,1 JRST .+3 ;NON-NULL, ITS ANOTHER ARG TRNE CBT,TCOM JRST CFN7D ;NULL, COMMA, IS SEPARATOR, DONT REUSE TLO Z,BAKFF ;SAY RE-USE FIELD TLOA D,B1 ;SAY B16 AND NO COMMA & GET NEXT ARG ;B16 ON AND COMMA SEEN. CFN7D: TLO D,B2 ;SAY B16 AND COMMA SEEN JRST CFN7B ;GO GET NEXT ARG OR TERMINATE LIST ON NULL CFN7Z: HRRZ B,JBUFP MOVEM B,INIFH2 ;RETURN JBUFP VALUE FOR LAST NAME IN GROUP MOVE A,@INIFH1 ;RETURN FIRST, NOT LAST, JFN IN A ;COLLECT FILE NAMES... ;END OF GROUP CASES CODE. RETURN. CFN8: POP P,B ;THROW AWAY JUNK. JFN TO RETURN IS IN A AOS -3(P) ;+2 CFN9: TLZE Z,EOLNEF ;IF THERE'S UNECHOED EOL, JRST [ MOVE B,CJFNBK ;GET GTJFN BITS TLNN B,(1B3) ;WAS CONFIRMATION MESSAGE PRINTED? PRINT EOL ;NO, ECHO EOL NOW JRST CFN9A] ALTYPE ( ) ;TYPE SPACE IF IT ENDED WITH ALT MODE CFN9A: POP P,D POP P,C POP P,B ;+1 RET ;COLLECT FILE NAMES... ;GTJFN ERROR RETURN PUSHJ'S HERE WITH ERROR CODE IN A. ;MOST ERRORS ARE FILE NOT FOUND OR SELF-EVIDENT SYNTAX ERRORS. ; FOR THOSE TYPE " ? " AND REPEAT GTJFN. ;FIRST TEST ERROR CODE FOR EXCEPTIONS. CFNE: CAIN A,GJFX3 ERROR CAIN A,GJFX22 ERROR CAIN A,GJFX23 ERROR CAIN A,GJFX27 ERROR CAIN A,GJFX28 ERROR CAIN A,GJFX29 ERROR CAIN A,GJFX31 ERROR CAIN A,GJFX32 JRST [ ;IF FLAG B14 ON GIVE GOOD RETURN WITH -2 INSTEAD ;OF JFN WHEN GJFX32 ERROR OCCURS. ;USED FOR "DIRECTORY" (DIRARG). TRNN D,B14 UERR [ASCIZ /NO SUCH FILES IN THAT DIRECTORY/] HRROI A,-2 RET] ;RETURNS TO LOC(GTJFN) +2 SUB P,[XWD 1,1] ;DISCARD PC SAVED FOR JERR (NOT USED 6/29/70) TLZ Z,EOLNEF ;DON'T ECHO ANY "UNECHOED" EOL (GTJFN DID IT) PUSH P,.BFP CALL INTRM ;GET TERMINATOR HLRZ A,-1(P) ;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE CAIN A,-2 ;... -2 IN LH OF A. JRST [ POP P,.BFP ;(THIS FEATURE USED ONLY FOR POP P,A ; CPFN. 4/30/70) JRST CFN9] ;RETURN +1. TRNE CBT,TEOL JRST CERR ;NO RETRY AFTER CARRIAGE RETURN TYPE < ? >; MOVEI 1,^D500 DISMS MOVEI 1,100 CFIBF POP P,BFP ;OLD .BFP VALUE: CLEAR NAME FROM BUFFER POP P,A BTCHER ;STOP NON-CONVERSATIONAL JOB JRST CFN3 ;INTRM ;GET TERMINATOR AFTER GTJFN, ETC, BY RE-READING CHARACTER. INTRM: PUSH P,A MOVE A,CIJFN BKJFN ;"UN-INPUT" IT CALL JERR POP P,A MOVE .BFP,BFP ;INITIALIZE FIELD TO PREVENT EDITING SETZ CNT, ;(PROBABLY UNNECESSARY) CALL CCHRI ;READ CHARACTER CAIN CHR,ALTM CALL UBP ;DON'T BUFFER ALT MODES MOVE TRM,CHR RET ;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN. ;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING ; JFNS FORMAT SPECIFICATION IN C. ;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING ;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS ; COMMAND, RETURNS 0 IN B. LFJFNS: PUSH P,A HRRZ B,JBUFP ;JFN STACK POINTER CAIN B,JBUF-1 ;HAS A NAME BEEN INPUT YET? JRST LFJF9 ;NO, GO RETURN 0 POINTER HRRZ A,(B) ;PICK UP JFN OF LAST NAME INPUT CAIN A,-1 JRST LFJF9 ;-1 ISN'T A JFN BUT MIGHT GET HERE PUSH P,C DVCHR ;GET DEVICE CHARACTERISTICS FOR JFN POP P,C TLNN B,B2 JRST LFJF9 ;NOT A DIRECTORY DEVICE, RETURN 0 HRRZ A,CSBUFP ;STRING BUFFER POINTER RH ADD A,[POINT 7,1,-1] ;BEGINNING OF NEXT WORD MOVEM A,CSBUFP MOVE B,JBUFP MOVE B,(B) ;PICK UP JFN AGAIN JFNS ;DO THE JFN TO STRING CONVERSION SETZ B, IDPB B,A ;APPEND NULL TO STRING EXCH A,CSBUFP ;UPDATE BUFFER PTR, GET STRING BEGINNING SKIPA B,A ;RETURN STRING POINTER IN B LFJF9: SETZ B, ;RETURN 0 IF CAN'T RETURN A STRING POP P,A RET ;CPFN: COLLECT PROGRAM FILE NAME ;TAKES: A: 0 OR WORD POINTER TO DEFAULT DIRECTORY NAME. ;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV". ;RETURNS +1 ON GTJFN FAILURE. CPFN: PUSH P,B MOVEI B,100000 JUMPE A,.+2 HRLI A,B53 ;IF NON-0, FILL OUT BYTE PTR MOVEM A,CJFNBK+3 ;DEFAULT DIRECTORY HRRI A,[ASCIZ /SAV/] ;DEFAULT EXT HRLI A,-2 ;SAY RETURN +1 ON GTJFN FAILURE JRST CFN1A ;JOIN CINFN & COUTFN ;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP ; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT) ;RETURNS JFN IN A TYPIF: HRRZ A,@INIFH1 ;GET CURRENT JFN TLNE Z,GROUPF ;SKIP IF NON-GROUP ETYPE < %1S >; ;%S: TYPE NAME FOR JFN RET ;GNFIL ;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES. ;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A. ;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS). GNFIL: PUSH P,A PUSH P,B HRRZ A,@INIFH1 GTSTS JUMPGE B,GNFIL3 ;JUMP IF NOT OPEN TLO A,B0 ;SAY DON'T RELEASE JFN CLOSF CALL JERR GNFIL3: MOVE A,@INIFH1 TLNN A,<77B5>B53 ;NO *-FLAGS, SKIP GNJFN AND ITS BUGS JRST GNFIL5 CAME A,[-2] ;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES ;(THAT SHOULDN'T GET HERE ANYWAY) GNJFN ;STEP TO NEXT FILE IN *-GROUP JRST GNFIL5 ;NO MORE JRST GNFIL8 GNFIL5: AOS A,INIFH1 ;NEXT NAME IN GROUP CAMLE A,INIFH2 ;ARE THERE MORE? JRST [ POP P,B ;NO POP P,A RET] GNFIL8: HRRZ A,@INIFH1 ;RETURN NEXT JFN IN A AOS -2(P) POP P,B SUB P,[XWD 1,1] RET ;FRSTF AND NEXTF: ROUTINES FOR STANDARD USE OF INPUT FILE GROUP. ;CALL FRSTF BEFORE PROCESSING A FILE. ; IT TYPES NAME IF A GROUP IS BEING PROCESSED. ;AFTER PROCESSING FILE, JRST NEXTF. ; IF NO MORE FILES IN GROUP, GOES TO RLJFNS WHICH RETURNS TO COMMAND ; INPUT OR ANY OTHER ADDRESS WHICH HAS BEEN PUSHED. ; OTHERWISE, GETS HEXT JFN IN A, TYPES NEXT FILE NAME, AND RETURNS ; WHERE FRSTF LAST RETURNED. BEWARE OF PD LEVEL CHANGES! FRSTF: POP P,FRSTFR ;SAVE RETURN FOR CALLS TO NEXTF FRSTF1: CALL TYPIF ;TYPE FILE NAME IF GROUP PUSH P,FRSTFR ;RETURN RET NEXTF: CALL GNFIL ;NEXT FILE IN GROUP JRST RLJFNS ;R1: NO MORE. FAILS IF GARBAGE IN PD! JRST FRSTF1 ;DEVN ;INPUT AND VERIFY A DEVICE NAME. ;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI ; AS TERMINATOR. ;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS. ;RETURNS: ; A: DEVICE DESIGNATOR ; B: CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF: ; B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB ; B6: ON IF ASSIGNED ; BOTH B5 & B6 ON IF ASSIGNED TO SELF ; C: JOB # ASSIGNED TO IF B6 OF B ON ;ENTRY DEVN: ;RETURN HERE TO TRY AGAIN AFDER TYPING " ? " AFTER ERROR. DEVN1: TLO Z,PUNCF INHELP ALLOW TALT+TEOL+TSPC+TCOL PUSH P,CSBUFP ;SAVE POINTER INTO SPACE "BUFFF" USES CALL BUFFF ;BUFFER IT WITH NULL TERMINATOR, RET PTR IN A STDEV ;STRING TO DEVICE DESIG CONVERSION JRST DEVNE ;DESIGNATOR NOW IN B ;NEED WE CHECK FOR WHOLE STRING USED? POP P,CSBUFP ;RECLAIM SPACE IN BUFFER USED BY "BUFFF" CAIN TRM,ALTM CALL UBP ;REMOVE ALT MODE FROM COMMAND STRING BUFFER ALTYPE <: > MOVE A,B DVCHR ;GET CHARACTERISTICS WORD HLRE C,C RET ;ERROR RETURN FROM "STDEV". DEVNE: POP P,CSBUFP ;RECLAIM SPACE IN STRING BUFFER USED BY "BUFFF" MOVE A,B ;MOVE ERROR CODE TO 1 CAIE A,STDVX1 ;"UNRECOGNIZED DEVICE" CALL JERR ;(4/13/70: NO ERRORS BUT STDVX1) TRNE CBT,TEOL JRST CERR ;AFTER CR, ABORT COMMAND. TYPE < ? >; ;OTHER TERMINATORS: " ? " AND RETRY. MOVE BFP,.BFP ;BACK UP PTR INTO COMMAND BUFFER BTCHER JRST DEVN1 ;TRY AGAIN ;DIRNAM ;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION. ;RETURNS ENTIRE WORD FROM STDIR IN A, PTR TO BUFFERED STRING IN B. ;USED IN CONNECT, WHERE, ^EPRINT, MAIL WATCH, ETC. COMMANDS. ;PRESERVES E (FOR DIRECTORY). DIRNAM::SETZ A, ;INDICATE NO DEFAULT FOR DEFDIR ;DEFDIR ;SAME AS DIRNAM EXCEPT THAT A DEFAULT DIRECTORY NUMBER MAY BE PASSED ;IN A, AND WILL BE USED (AND ECHOED) IF THE USER INPUT IS EMPTY DEFDIR::PUSH P,A ;SAVE DEFAULT DIRECTORY NUMBER TLO Z,PUNCF ;ALLOW PUNCTUATION (LIKE O'SULLIVAN) TLNN Z,BAKFF ;LAST FIELD TERMINATED WITH EOL? TRNN CBT,TEOL CAIA ;NO TDZA CNT,CNT ;YES, CLEAR CNT AND DON'T DO INPUT INHELP ;READ NAME (REMEMBER "MORE" RETURNS HERE) ;CALLER MUST CHECK TERMINATOR MOVE B,0(P) ;GET BACK DEFAULT CAIG CNT,1 ;ANY INPUT? JUMPG B,[MOVE A,CSBUFP ;NO, USE DEFAULT IF ANY DIRST ;CONVERT DEFAULT DIRECTORY TO STRING CALL SCREWUP IBP A ;PRESERVE NULL AT END TRNE CBT,TALT ;WANT RECOGNITION? SKIPA A,CSBUFP ;YES, DON'T UPDATE CSBUFP EXCH A,CSBUFP ;NO, UPDATE CSBUFP, GET PTR TO STRING JRST DIRNA1] CALL BUFFF CAIN TRM,ALTM CALL UBP ;REMOVE ALT MODE FROM BUFFER DIRNA1: PUSH P,A ;SAVE TO BE RETURNED MOVE B,A MOVEI A,1 ;SAYS NO RECOG TRNE CBT,TALT TLO A,400000 ;ALT MODE: REQUEST RECOGNITION STDIR JRST CERR JRST [ TRNN CBT,TALT ;AMBIGUOUS JRST CERR CALL DING SUB P,[1,,1] ;FLUSH JUNK JRST MORE] PUSH P,A ;SAVE WHAT STDIR RETURNED TRNN CBT,TALT ;DID STDIR RETURN UPDATED PTR? JRST DIRNAX ;CSBUFP IS OK IBP B EXCH B,CSBUFP ;UPDATE STRING POINTER MOVE A,B BKJFN ;DECREMENT OLD BYTE PTR CALL JERR ;...TO GET TO APPENDED CHARS (OR NULL IF NONE). CALL $CTYPE ;ECHO AND BUFFER REST AFTER ALT MODE DIRNAX: POP P,A ;DIR # AND BITS FROM STDIR ;ALTYPE ( ) OR ALTYPE (>) MUST FOLLOW IN CALLING ROUTINE POP P,B SUB P,[1,,1] ;FLUSH DEFALT FROM STACK RET ;INPUT A TTY NUMBER. ; MAYBE FROM USER NAME ; USED BY LINK, ADVISE TTYNUM: INHELP ALLOW TEOL+TSPC+TALT CALL BUFFF MOVEM P,FRAME ;SAVE BEGINNING OF POSSIBITITES MOVE B,.BFP ;GET 1ST CHAR ILDB A,B MOVE C,CHRTBL(A) TRNE C,OCTDIG JRST TTYN10 ;TAKE AS TTY# TTYN1: TLO Z,BAKFF ;REUSE FIELD CALL DIRNAM ;INPUT AS USER NAME TLNE A,B0 JRST CERR ;CAN'T LINK TO FILES ONLY DIR. ALTYPE ( ) ALLOW TEOL+TSPC+TALT CONFIRM MOVEM A,DIRNO TTYN2: MOVEM P,FRAME ;SAVE BEG OF ARGS MOVE A,['JOBDIR'] CALL $SYSGT HLLZ D,B ;MAKE AOBJN PTR MOVEI E,0(B) TTYN3: GTB 0(E) XOR A,DIRNO MOVEI A,(A) JUMPN A,TTYN6 ;WRONG GUY HRLZ A,D GETAB CALL JERR MOVEI B,0(D) JUMPE B,TTYN6 ;IGNORE JOB0 JUMPL A,TTYN6 ;AND DETACHED JOBS HLRZS A PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY) TTYN4: MOVE A,['JOBNAM'] CALL $SYSGT SKIPN A,B JRST TTYN5 HRL A,D GETAB CALL JERR MOVE C,A MOVE A,['SNAMES'] CALL $SYSGT SKIPN A,B JRST TTYN5 HRL A,C GETAB CALL JERR TTYN5: PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.) TTYN6: AOBJN D,TTYN3 ;MAY HAVE MORE JOBS CAMN P,FRAME ;FOUND ANY? ERROR POP P,A ;SUBSYSTEM NAME POP P,B ;TTY# CAMN P,FRAME ;ONLY ONE POSSIBILITY? JRST [ MOVE A,B ;YES, USE IT JRST TTYN11] TTYN7: MOVE C,B ;SAVE FOR POSSIBLE DEFAULT ETYPE < TTY%2O%, > JUMPE A,[PRINT "?" ;NO SUBSYS NAME JRST TTYN8] CALL SIXPRT ;PRINT SUBSYSTEM TTYN8: PRINT EOL CAMN P,FRAME ;DONE ALL? JRST TTYN9 ;YES POP P,A POP P,B JRST TTYN7 TTYN9: $TYPE < TTY: > INHELP ALLOW TEOL+TSPC+TALT CAIN CNT,2 JRST [ MOVE B,.BFP ;ASKED FOR DEFAULT? ILDB B,B CAIE B,"-" JRST .+1 MOVE A,C ;NULL INPUT. USE FIRST JOB SEEN JRST TTYN11] TTYN10: TLO Z,BAKFF ;REUSE FIELD CALL OCTAL ;GOBBLE AS OCTAL NUMBER JRST [ ALTYPE <-> MOVE A,C JRST .+1] CONFIRM TTYN11: MOVE P,FRAME ;FLUSH BACK THE STACK PUSH P,A ;SAVE TTY# MOVE A,['TTYJOB'] CALL $SYSGT CALL [ JUMPE B,JERR RET] HLRES B MOVMS B POP P,A ;TTY# CAIGE A,0(B) CAIGE A,0 ERROR RET ;DATE AND TIME INPUT ;KWV1 MUST BE SET UP FOR "CONF" (0 OK). CLOBBERS A,B. ;DATE STRING IS PRE-READ BY EXEC (BECAUSE OF NOISE AND EDITING); ;IF DATE CONTAINS IMBEDDED SPACES, SEVERAL TRIES MAY BE NEEDED TO ;GET ENOUGH CHARACTERS. DATEIN: TLO Z,PUNCF CALL CSTR AOS CNT ;MAKES BUFFF INCLUDE TERMINATOR CALL BUFFF SOS CNT SETZ B, ;FORMAT: NORMAL, FULLY GENERAL IDTIM ;INPUT AND CONVERT DATE AND TIME CALL [ ;IDTIM ERR RETURN: CODE IN B, STRING PTR IN A. EXCH A,B ;ERR CODE TO A (FOR JERR), STR PTR TO B ;IF IT INPUT THE NULL, THEN IT NEEDS MORE CHARACTERS. CAIE A,DILFX1 ;"ILLEGAL DATE FORMAT" ? CAIN A,TILFX1 ;"ILLEGAL TIME FORMAT" ? JRST [ LDB B,B ;YES, GET LAST CHARACTER INPUT JUMPE B,[SUB P,[XWD 1,1] JRST MORE] ;GO BACK TO CSTR FOR MORE CHARS JRST CERR] ;ILLEG FORMAT B4 USING ALL CHARS CAIE A,DATEX3 ;BAD DAY OF MONTH (EG FEB 30) CAIN A,DATEX5 ;OUT OF RANGE (EARLY 1858 OR LATE 2576) JRST CERR ;"?" JRST JERR] ;GENERAL JSYS ERROR RETURN ROUTINE IBP A ;STEP STRING POINTER PAST THE NULL CAME A,CSBUFP ;ENTIRE STRING USED BY IDTIM? JRST CERR ;NO, TRAILING GARBAGE, ERROR. ALLOW TSPC+TALT+TEOL CONFIRM ;CHECK TERMINATOR, INPUT CR IF NECESSARY MOVE A,B ;DATE & TIME IN INTERNAL FORMAT RET ;"OCTAL": 18-BIT OCTAL NUMBER INPUT AND CONVERSION ;"BIGOCT": 36-BIT OCTAL (NOT EXTERNALLY USED 6/9/70) ;"DECIN": 36-BIT DECIMAL MAGNITUDE ;ALL RETURN VALUE IN A, TERMINATING CHARACTER IN "TRM". ;NO SKIP IF NULL INPUT. ;ERROR IF NON-DIGIT NON-TERMINATOR SEEN, OR IF OVERFLOW. ;ALLOWS ANY NON-ALPHNUMERIC AS TERMINATOR. CALLER MUST CHECK! ;DO NOT MAKE THIS A MONITOR FUNCTION BECAUSE OF DIFFICULTY OF ; CAPTURING EXACT INPUT STRING FOR ^R. DECIN: PUSH P,F ;ENTRY FOR 36-BIT DECIMAL MAGNITUDE INHELP MOVEI F,^D10 JRST INCON1 BIGOCT: INHELP <36-BIT OCTAL NUMBER>; ;ENTY FOR 36-BIT OCTAL MAGNITUDE BIGOC1: PUSH P,F MOVEI F,10 INCON1: PUSH P,B ;ENTRY FOR 36-BIT MAGNITUDE OF BASE IN F PUSH P,C PUSH P,D PUSH P,E MOVE D,.BFP HRREI C,-1(CNT) SETZ A, JUMPLE C,OCTAL7 ;NULL INPUT TLZ Z,F3 ;NO MINUS SIGN SEEN ILDB E,D ;GET FIRST CHAR CAIE E,"-" JRST OCTAL3 ;NOT MINUS, GOBBLE NUMBER TLO Z,F3 ;SAY NEGATION NEEDED AT END SOJLE C,OCTAL7 ;NULL, EXCEPT FOR - SIGN OCTAL2: ILDB E,D OCTAL3: CAIGE E,"0"(F) CAIGE E,"0" JRST CERR ;NON-DIGIT, NON-BLANK MUL A,F LSH B,1 LSHC A,-1 ADDI B,-60(E) JUMPN A, CERR ;OVERLFLOW MOVE A,B SOJG C,OCTAL2 TLNE Z,F3 MOVNS A ;RETURN NEGATIVE NUMBER IF - SEEN ALTYPE ( ) AOS -5(P) OCTAL7: POP P,E POP P,D POP P,C POP P,B POP P,F RET OCTAL: INHELP <18-BIT OCTAL NUMBER>;ENTRY FOR 18 BITS OCTAL (FOR ADDR) CALL BIGOC1 RET TLNE A,-1 JRST CERR AOS (P) RET ;"OCTCOM": 36-BIT OCTAL INPUT CONVERSION, ;ALLOWING ONE FIELD, OR TWO 18-BIT HALF-WORDS SEPARATED BY ; SPACE, ALT MODE, COMMA, OR TWO COMMAS. ;TERMINATORS ACCEPTED: ALT MODE, SPACE, EOL. ;CAN READ FIELD AFTER VALUE, HENCE GENERALLY ONLY VALID IF NUMBER ; IS LAST FIELD IN COMMAND. OCTCOM: CALL BIGOCT ;GET WHOLE VALUE OR LH RET ;NULL, GIVE RETURN 1 PUSH P,A ;VALUE IN PUSHDOWN TRNE CBT,TEOL JRST OCCOM8 ;EOL ENDS IT - ANOTHER HALF NOT ALLOWED. TRNN CBT,TALT+TSPC JRST OCCOM3 ;AFTER SPACE OR ALT MODE PERMIT RH. CALL OCTAL ;OPTIONAL 18-BIT VALEE FOR RH JRST [ TLO Z,BAKFF ;NULL FIELD, BACKUP & RETURN JRST OCCOM8] JRST OCCOM5 OCCOM3: ALLOW TCOM ;AFTER COMMA ALLOW ANOTHER AND REQUIRE RH CALL OCTAL JRST [ ALLOW TCOM ;NULL, NOT OCTAL, HAS TO BE 2ND COMMA. CALL OCTAL ;NOW RH IS MANDATORY JRST CERR JRST .+1] ;HAVE RH IN A. CHECK TERMINATOR, COMBINE OCCOM5: ALLOW TEOL+TSPC+TALT EXCH A,(P) TLNE A,-1 JRST CERR ;MORE THAN 18 BITS IN LH HRLM A,(P) ;COMBINE IN PUSHDOWN OCCOM8: POP P,A ;RETURN VALUE IN A AOS (P) ;SKIP RET ;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES. TOCT: PUSH P,A PUSH P,C MOVE A,COJFN ;DESTINATION MOVE C,[1B0+10] ;"MAGINITUDE" FLAG AND RADIX NOUT CALL JERRC ;GENERAL JSYS ERROR, CODE IN C POP P,C POP P,A RET ;BUFFF ;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND ; RETURN A BYTE PTR TO IT IN A. ;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END. ;BUFFS IS THE SAME AS BUFFF BUT THE STRING SOURCE IS SUPPLIED IN B BUFFS: PUSH P,B JRST BUFF0 BUFFF: PUSH P,B MOVE B,.BFP BUFF0: PUSH P,C PUSH P,D MOVE A,CSBUFP ;STRING BUFFER POINTER MOVEI C,^D8(A) ;POINTER + MAX STRING LENGTH CAIL C,CSBUFE ;COMPARE TO BUFFER END ERROR MOVE C,CNT CAILE C,^D40 ;THIS HELPS PROTECT AGAINST CSBUF OVERLFOW ERROR SOJLE C,BUFFF2 ;COUNT IS 1 FOR NULL FIELD BUFFF1: ILDB D,B CAIL D,141 ;ASCII LOWER CASE A CAILE D,172 ;..Z JRST .+2 SUBI D,40 ;TRANSLATE LOWER CASE TO UPPER CAIN D,CONTCH ;SPECIAL CHARACTER STORED WHEN "&" INPUT FOR MOVEI D," " ;..LINE CONTINUATION. TRANSLATE IT TO SPACE. IDPB D,A JUMPE D,BUFFF3 ;STOP ON NULL SOJG C,BUFFF1 ;OR IF ALL CHARACTERS MOVED BUFFF2: SETZ D, IDPB D,A ;TERMINATE WITH NULL BUFFF3: EXCH A,CSBUFP POP P,D POP P,C POP P,B RET ;SUBROUTINE TO SET BREAK SET TO "ANY CHARACTER" ALLBK: PUSH P,C MOVEI C,17 JRST BRKST1 ;SUBROUTINE TO SET BREAK SET TO WAKE UP ON NON-ALPHANUMERICS NALNBK: PUSH P,C MOVEI C,16 BRKST1: PUSH P,A ;ENTRY TO SET BREAK SET BITS FROM C PUSH P,B MOVE A,CIJFN RFMOD ;READ TELETYPE MODE WORD DPB C,[POINT 6,B,23] ;NEW BREAK SET BITS SFMOD ;SET MODE WORD POP P,B POP P,A POP P,C RET ;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT NOECHO: PUSH P,C TLO Z,NECHOF ;SAY ECHOING OFF (TESTED IN %NOI) MOVEI C,0 ;SAY NO ECHOING NOHOW JRST ECHOST ;JOIN "DOECHO" ;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT DOECHO: PUSH P,C TLZ Z,NECHOF ;SAY ECHOING NOT SUPPRESSED MOVEI C,2 ;SAY IMMEDIATE OR DEFERRED ECHOING ECHOST: PUSH P,A ;ENTRY TO SET ECHO BITS FROM C PUSH P,B MOVE A,CIJFN RFMOD ;READ TELETYPE MODE WORD DPB C,[POINT 2,B,25] SFMOD ;SET TTY MODE WORD POP P,B POP P,A POP P,C RET ;SUPPRESS EOL ECHOING: CHANGE CONTROL CHARACTER OUTPUT CONTROL ;BITS SO EOL'S DON'T PRINT. NOECEO: PUSH P,A PUSH P,B PUSH P,C MOVE A,COJFN RFCOC TRZ B,3B21+3B27 ;TURN OFF LF AND CR TRZ C,3B27 ;TURN OFF EOL NOECE1: SFCOC ;DOECEO JOINS HERE JRST [ POP P,C POP P,B POP P,A RET] ;TURN ON EOL ECHOING/PRINTING DOECEO: PUSH P,A PUSH P,B PUSH P,C MOVE A,COJFN RFCOC TLZ B,(3B15) TLO B,(2B15) ;TURN ON BELL TRO B,2B21+2B27 ;TURN ON LF AND CR TRO C,2B27 ;TURN ON EOL JRST NOECE1 ;LTTYMD - LOAD TELETYPE MODES ;AC E POINTS TO A BLOCK OF VALUES TO PUT INTO EFFECT: ; 0 FILE (TERMINAL) MODE WORD ; 1-3 TAB STOPS ; 4-5 CCOC WORDS ; 6 JOB TERMINAL INTERRUPT WORD ; 7 (NOT USED) ; 10 SUBSYSTEM NAME LTTYMD: PUSH P,A PUSH P,B PUSH P,C PUSH P,D SKIPN 0(E) ;WILL BE 0 IF DETACHED (AUTOSTART) JRST LTTYM8 ;SO JUST DO TIW AND SETNM MOVE A,COJFN MOVE B,(E) ;FILE MODE WORD SFMOD MOVE B,1(E) ;3 TAB STOPS WORDS MOVE C,2(E) MOVE D,3(E) STABS MOVE B,4(E) ;2 CCOC WORDS MOVE C,5(E) SFCOC LTTYM8: MOVEI A,400000 RPCAP JUMPGE C,LTTYM9 ;CAN'T SET TIW IF NO ^C PRIV MOVNI A,5 ;SAY JOBTIW MOVE B,6(E) ;INTERRUPT MASK STIW ;SAY WHICH ARE INT'S FOR EXEC OR USER LTTYM9: MOVE A,10(E) SETNM ;SUBSYSTEM NAME POP P,D POP P,C POP P,B POP P,A RET ;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC ; INTO BLOCK THAT AC E POINTS TO. RTTYMD: PUSH P,A PUSH P,B PUSH P,C PUSH P,D SKIPE ETTYMD+0 ;RETURNING FROM DETACHED STARTUP? JRST RTTYM1 GJINF ;YES CAMN 4,[-1] ;STILL DETACHED? JRST RTTYM9 ;YES MOVE 2,[1B4+^D66B10+^D72B17+17B23+2B25+1B26+1B29+1B31] MOVEM 2,ETTYMD+0 MOVE 1,COJFN STPAR RTTYM1: MOVE A,COJFN RFMOD MOVEM B,(E) GTABS MOVEM B,1(E) MOVEM C,2(E) MOVEM D,3(E) RFCOC MOVEM B,4(E) MOVEM C,5(E) MOVNI A,5 ;SAY JOB TIW RTIW MOVEM B,6(E) RTTYM9: GETNM MOVEM A,10(E) POP P,D POP P,C POP P,B POP P,A RET ;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS ;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT. ;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE; ;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET ; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70. ;INITIAL EXEC TTY STATE INETTY: 0 ;MODE WORD SAYS "DET" UNTIL WE GET A TTY 1B0+1B8+1B16+1B24+1B32 ;TABS 1B4+1B12+1B20+1B28 1B0+1B8+1B16+1B24+1B32 BYTE (2) 0,0,1,1,1,0,0,2,1,2,2,1,2,2,1,1,1,1 ;CCOC WORDS BYTE (2) 0,1,1,1,0,0,0,1,1,0,1,1,1,2,0,0,0,0 -1 ;JOB TERM. INT. WORD. 0 'EXEC ' ;SUBSYSTEM NAME ;INITIAL PROGRAM TTY MODES INPTTY: 0 1B0+1B8+1B16+1B24+1B32 1B4+1B12+1B20+1B28 1B0+1B8+1B16+1B24+1B32 BYTE (2) 0,0,1,1,1,0,0,2,1,2,2,1,2,2,1,1,1,1 BYTE (2) 0,1,1,1,0,0,0,1,1,0,1,1,1,2,0,0,0,0 -1 ;JOB TIW FOR PROGRAM 0 '(PRIV)' ;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS %PRINT: PUSH P,A PUSH P,B AOS TTYACF ;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE MOVE A,COJFN HRRZ B,40 CAIN B,37 ;TENEX EOL? JRST [ MOVEI 2,CR BOUT AOS TTYACF MOVEI 2,12 JRST PRIN1] ;THAT OUGHT TO KEEP THE FTP GUYS HAPPY PRIN1: BOUT AOS TTYACF ;AGAIN, MAYBE BLOCKED DUE TO FULL BUFFER POP P,B POP P,A RET ;SUBR TO OUTPUT CHARACTER FROM B. ;ALSO STORE IT IN CBUF (POINTER "CBP") IF FLAG "STCF" ON ; (AS DURING PRINTING AFTER ALT MODE). ;TRANSLATES SPECIAL INTERNAL CHARACTER FOR LINE CONTINUATION BACK ; TO &-EOL-SPACE, AS REQUIRED FOR ^R AND ^A EDITING CHARACTERS. CCHRO: CAIN B,CONTCH ;CONTINUATION CHARACTER JRST [ UTYPE [ASCIZ /& /] RET] TLNN Z,STCF JRST COUTC PUSH P,B MOVEI B,(BFP) CAIL B,CBUFE ERROR POP P,B IDPB B,BFP AOJ CNT, ;FOLLOWS CCHRO... ;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?) COUTC: PUSH P,A AOS TTYACF ;TELL AUTOLOGOUTTTY IS ACTIVE MOVE A,COJFN ;FILE NUMBER OF PRIMARY OUTPUT FILE BOUT AOS TTYACF POP P,A RET ;MAP A PAGE OF A FORK ;TAKES: AC A: AN ADDRESS IN THE PAGE, OR -1 TO CLEAR BUFFER ; CELL "FORK": FORK HANDLE ;RETS: AC A: ACCESS AND EXISTENCE BITS IN B2-5, RH PRESERVED ; BUFFER PAGEN: THE PAGE MAPPED MAPPF: PUSH P,C PUSH P,B PUSH P,A JUMPL A,MPPF1 MOVEI A,0(A) CAIG A,17 JRST MAPACS LSH A,-^D9 ;SEPARATE PAGE # HRL A,FORK ;FORK HANDLE OF PAGE WE WANT SKIPGE FORK ;IS THERE A CURRENT FORK? ERROR ; ;NO. TLO A,B0 ;SAY FORK HANDLE NOT JFN MPPF1: MOVEI B,PAGEN ;GENERATE DESTINATION PAGE IDENTIFIER LSH B,-^D9 ;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL TLO B,B0 ;...SAY THIS FORK HRLZI C,B2+B3+B4 ;REQUEST ALL ACCESS, NORMAL DISPOSAL CAME A,NPAGE ;SAVE TIME IF ALREADY MAPPED PMAP ;MAP IT MOVEM A,NPAGE ;SAY ITS MAPPED CAME A,[-1] RPACS ;GET ACCESS/EXISTENCE OF MAPPED PAGE MPPF8: POP P,A ;RH A TRANSPARENT HLL A,B ;ACCESS IN LH A POP P,B POP P,C RET ;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS". ;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION. MAPACS: SETO A, CALL MAPPF ;UNMAP PAGE IN BUFFER, IF ANY. SKIPGE A,FORK ERROR MOVEI B,PAGEN RFACS ;READ FORK ACS INTO "PAGEN" HRLZI B,B2+B3+B4+B5 ;SIMULATE ALL ACCESS BITS JRST MPPF8 ;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A LOADF: CALL MAPPF TLNN A,B5 ERROR TLNN A,B2 ERROR ANDI A,777 MOVE A,PAGEN(A) RET ;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A STOREF: CALL MAPPF TLNE A,B5 ;OK TO STORE IF PAGE NON-EXISTENT TLNE A,B3!B9 ;OR IF WRITE ACCESS PERMITTED CAIA ERROR ANDI A,777 MOVEM B,PAGEN(A) RET ;%GTB ;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE. ;TABLE # IN EFF ADDR, INDEX IN RH OF D, ONE RETURN WITH WORD IN A. ;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE ; FOR USE IN OTHER JSYS CALLS INSIDE LOOP. %GTB: HRL A,D HRR A,40 GETAB CALL JERR RET ;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF ;PSI ROUTINE FOR DATAPHONE CARRIER OFF (HANGUP). ;TERMINAL CODE ^D30, ASSIGNED TO CHANNEL 4, LEVEL 2. ;DETACHES JOB TO FREE UP DATAPHONE, KILLS JOB IF NOT LOGGED IN. HUPSI: PUSH P,A PUSH P,B PUSH P,C PUSH P,D GJINF JUMPL D,HUPSI9 ;DETACHED ALREADY, IGNORE IT. MOVEI A,-1 ;REFERENCE CONTROLLING TTY EVEN IF ; ITS NOT PRI I/O FILE RFMOD TRNE B,1B35 JUMPL D,HUPSI9 ;CARRIER NOT NOW OFF, IGNORE. DTACH ;DETACH CONTROLLING TERMINAL GJINF ;GETS TSS JOB # IN A JUMPG A,HUPSI8 ;JUMP IF LOGGED IN SETO A, ;NOT LOGGED IN, SAY SELF, LGOUT ;KILL JOB. CALL JERR HUPSI9: POP P,D POP P,C POP P,B POP P,A DEBRK ;HANGING UP ON LOGGED IN JOB RESULTS IN DETACH AND FREEZE. ;IF JOB IS NOT REATTACHED WITHIN N MINUTES, IT IS LOGGED OUT HUPSI8: MOVEI A,-4 TLNE Z,RUNF FFORK ;FREEZE ALL INFERIORS TIME MOVE 2,1 ADD 2,[^D3600000] ;60 MINUTES HUPSI7: PUSH P,2 MOVEI 1,^D3000 DISMS ;WAIT 3 SECONDS GJINF ;GET CONTROL TTY NOW TIME POP P,2 JUMPGE 4,[MOVEI A,-4 ;IF JOB NOW RE-ATTACHED, TLNE Z,RUNF RFORK ;RESUME RUNNING JRST HUPSI9] CAMGE 1,2 ;WAITED N MINUTES? JRST HUPSI7 ;NO, WAIT SOME MORE SETO A, ;YES, JOB IS DEFINED AS ABANDONED LGOUT ;SO LOG IT OUT CALL JERR ;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (^T) USEPSI: PUSH P,40 PUSH P,A PUSH P,B PUSH P,C MOVE A,COJFN RFCOC PUSH P,B ;SAVE CCOC WORDS PUSH P,C CALL DOECEO ;MAKE SURE CCOC IS SUCH THAT EOLS PRINT ;AND THAT BELLS DING MOVEI 2,BELL BOUT USEPS1: GTAD ;"NOW" CAMG 1,CTLIM0 ;2ND ^T WITHIN 15 SEC? CAMG 1,CTLIM1 ;AND AT LEAST A MIN SINCE LAST TYPEOUT? JRST USEPS3 ;NO USEPS2: MOVEI 2,CTTIM1 ;ONE MINUTE CALL TIMPSC ;TAD IN 1 PLUS SECONDS IN 2 MOVEM 1,CTLIM1 ;CLOSEST TIME OF NEXT FULL TYPEOUT JRST USEPS4 ;GO DO FULL TYPEOUT USEPS3: MOVEI 2,CTTIM0 ;SECONDS CALL TIMPSC MOVEM 1,CTLIM0 ;UPDATE 15 SECONDS BETWEEN ^T TIMER JRST USEPS6 ;AND SKIP FULL TYPEOUT USEPS4: SKIPGE A,FORK JRST USEPS5 ;NO INFERIOR PRINT " " CALL FSTAT ;PRINT STATUS & PC OF INF (HANDLE IN A) PRINT " " ;FSTAT IS IN XMAIN.MAC USEPS5: CALL LAPRNT ;PRINT LOAD AV. NEAR "RUNSTAT" ETYPE <, USED %V IN %C > USEPS6: MOVE A,COJFN POP P,C POP P,B SFCOC ;RESTORE CCOC POP P,C POP P,B POP P,A POP P,40 DEBRK ;DING ;SUBROUTINE TO RING BELL, CLEAR INPUT BUFFER, STOP NON-INTERACTIVE JOB. ;USED AFTER RECOGNITION AMBIGUITIES AND SUCH ERRORS. DING: PUSH P,A MOVE A,CIJFN ;COMMAND INPUT FILE JFN CFIBF ;CLEAR INPUT BUFFER BTCHERR ;THIS SHOULD STOP NON-CONVERSATIONAL JOB PRINT BELL ;OUTPUT BELL POP P,A RET ;REGULAR ERROR - SYNTAX OR OBVIOUS SEMANTIC ERROR CERR: $ERROR < ?> ;NOT IMPLEMENTED YET ERROR ;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO ; IF NO ROUTINE IS DEFINED FOR THE COMMAND. NIM: NIYE: ERROR ;INTERNAL ERROR SCREWUP:HRRZ E,(P) ;PC (GET HERE WITH PUSHJ) SUBI E,1 ERROR ;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1. ;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT. ;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS ; BEFORE COMING TO THIS GENERAL ROUTINE. ;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR" ; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE ; JSYS'S. 6/26/70. JERR: MOVEM A,ERCOD ;SAVE ERROR NUMBER JERR1: PUSH P,A INTON ;BE SURE INTERRUPTS ARE ON POP P,A CALL ERFRST ;GET SET TO TYPE MSG CALL CRIF ;EOL UNLESS AT LEFT TYPE HRRZ F,(P) ;PC (GOT TO JERR WITH PUSHJ) SUBI F,2 ;PROBABLE LOC OF JSYS PRINT EOL ETYPE < PC %6P ACS %1O %2O %3O> JRST SYSERA ;GO TYPE SYSTEM ERROR MESSAGE JERRC: MOVEM C,ERCOD ;"JERR" FOR ERROR CODE IN C JRST JERR1 ; (AS AFTER "NOUT") ;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE ;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING ;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT. ;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC", ; TYPE SYSTEM ERROR MESSAGE WITH ; REGULAR ROUTINE, AND RETURN TO COMMAND INPUT. %TRAP: PUSH P,D PUSH P,E HRRZ E,LEV1PC ;GET PC OF ERROR CIS ;CLEAR THIS INTERRUPT, ;ALSO CLEAR LOWER-LEVEL INTRPTS ;SUCH AS ^T AND CARRIER-OFF. ;NOPS IF NOT ON A PSI, ;WHICH CAN HAPPEN VIA SPECIAL CASE IL INST STUFF. MOVEI D,RERET ;CHANGE ERROR ROUTINE RETURN MOVEM D,CERET ;...TO "REGULAR" SETZM .JBUFP ;SAY FLUSH ALL JFNS ;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY. ;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP. MOVE D,40 ;SAVE TEXT ADDRESS CALL ERFRST ;DO THINGS NEEDED BEFORE TYPING MESSAGE CALL CRIF ;EOL IF CARRIAGE NOT AT LEFT MARGIN UTYPE (D) ;TYPE CHANNEL-SPECIFIC MESSAGE TYPE < TRAP IN EXEC> PRINT EOL ETYPE < PC %5P% ACS %1O %2O %3O>; POP P,E POP P,D JRST SYSERM ;GO TYPE SYSTEM ERROR MESSAGE. ;NOTE: IN THE EXEC THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT ;OF INTERRUPTION. HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET" ;BEING CHANGED. BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO ;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED. ;ILLEGAL INSTRUCTION PSI ;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE ;TREAT LIKE OTHER ERROR PSI'S. ;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM ; GTFDB JSYS. ;SPECIAL ROUTINE GETS PC IN ERPC, ERROR CODE IN ERCOD. ;IF SPECIAL ROUTINE ISN'T INTERESETED IN THIS PARTICULAR ERROR, ; IT CAN JRST TO ILIPSI AGAIN. ILIPSI: SKIPN ILIDSP ;IS THERE A SPECIAL DISPATCH? TRAP ; NO. NORMAL CASE. CIS ;CLEAR THE INTERRUPT (NOPS IF NONE), CLEAR LOWER ;LEVEL INTERRUPTS SUCH AS ^T AND CARRIER OFF. PUSH P,ILIDSP ;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELWOW PUSH P,A PUSH P,B HRRZ A,LEV1PC MOVEM A,ERPC ;LOCATION OF ERROR, FOR SPECIAL ROUTINE. MOVE A,[CALL CUUO] ;RESET UUO DISPATCH TO PROTECT MOVEM A,41 ;IT FROM MALICIOUS USERS SETZM ILIDSP ;CLEAR SPECIAL DISPATCH MOVEI A,B0 CALL $GETER ;DO GETER JSYS AND RESTORE 4-10 HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE POP P,B POP P,A RET ;DISPATCH TO SPECIAL ROUTINE ;END-OF-FILE INTERRUPT ;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR, ; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS. ;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS. EOFPSI: SKIPN EOFDSP TRAP ; NO SPEC DISPATCH, TREAT AS ERROR PUSH P,A MOVE A,EOFDSP ;CHANGE INTERRUPT RETURN HRRM A,LEV1PC ;OLD PC IS LOST SETZM EOFDSP ;FUTHER INTERRUPTS ARE ERRORS POP P,A DEBRK ;FILE DATA ERROR INTERRUPT ;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO. ;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND ; FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED. DATPSI: CIS ;CLEAR INTERRUPT (AND LOWER ONES!) MOVEI E,RERET MOVEM E,CERET ;REST ERROR RETURN TO "NORMAL" SETZM .JBUFP HRRZ E,LEV1PC ERROR ; ;SHOULD GET JFN (GETER?) AND PUT NAME IN ABOVE MESSAGE ;AND PROBOBLY ELIMINATE PC. ___________ ;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE. ;CHANNEL 1, LEVEL 1 CCPSI: TLOE Z,CTLCF1 ;SAY WE'VE SEEN AN ^C TLO Z,CTLCF2 ;IF ITS THE SECOND ONE, SAY SO ;(CTLCF2 CAUSES OUTBUF TO BE CLEARED). SETZM ILIDSP ;CLEAR SPECIAL IL INST DISPATCH ADDRESS CIS ;CLEAR THIS INTERRUPT ;AND ANY LOWER LEVEL ONES SUCH AS ;^T OR CARRIER OFF. ;DOING THIS RIGHT OFF CAUSES ;MULTIPLE ^C'S TO BE DETECTED ;PROPERLY AND MAKES IL ;INST TRAP WORK DURING ^C ROUTINE. MOVEI A,CCERET ;SET ERROR ROUTINE TO SPECIAL ^C VALUE MOVEM A,CERET ;.. SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41 ;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH). SKIPL A,EFORK ;IF EPHEMERON RUNNING, FFORK ;FREEZE IT JUMPGE A,CCDB4 ;AND SKIRT AROUND TTY STUFF TLNN Z,RUNF ;PROGRAM RUNNING? JRST CCDB3 ;NO. MOVE A,LFORK ;LAST PROGRAM RUN IS WHERE ^C CAME FROM FFORK ;FREEZE THE WORLD MOVEI E,PTTYMD CALL RTTYMD ;STORE TTY MODES FOR "CONTINUE". ;^C... CCDB2: TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ^C! CCDB3: MOVEI E,ETTYMD ;PUT EXEC'S TTY MODES INTO EFFECT. CALL LTTYMD ;MUST ALWAYS BE DONE ;EG GTJFN LEAVES THEM BAD. CCDB4: MOVE A,COJFN TLNE Z,CTLCF2 ;2ND ^C? CFOBF ;YES, CLEAR OUTPUT BUFFER. ;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS, ;AND GENERALLY CLEAN UP. ;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE. SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG ;ANOTHER ^C WHILE PROCESSING 1ST IS OK .$ERROR <^C> ;DON'T CLEAR INPUT BUFFER CCERET: MOVE A,COJFN TLNN Z,CTLCF2 ;BUT DON'T WAIT IF 2ND ^C DOBE ;2ND ^C MAY HAPPEN HERE TLZ Z,CTLCF1+CTLCF2 JRST ERRET ;RETURN TO COMMAND INPUT ;AUTOLOGOUT PSI AND ROUTINE ;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE ALOPSI: PUSH P,A PUSH P,B PUSH P,C PUSH P,D GJINF ;GETS LOGIN USER # IN A JUMPLE A,ALOPS1 ;NOT LOGGED IN - EXPECTED CASE. POP P,D ;USER GOT LOGGED IN DURING SCHEDUALING OF PSI POP P,C ;OR SOME SUCH STRANGE CASE, JUST IGNORE PSI. POP P,B POP P,A DEBRK ;DEBREAK TO INTERRUPTED LOCATION ALOPS1: CIS ;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT ;IS DONE NOT ON AN INTERRUPT LEVEL. ;EXEC'S MAIN FORK JRST'S HERE, ;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT. ;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT. AUTOLO: SKIPLE CUSRNO ;SKIP IF NOT LOGGED IN ERROR GJINF ;GETS CONTROLLING TTY # IN 4 CAMN D,[-1] ;-1 IF NONE (DETACHED) JRST AUTOL6 ;DETACHED, TYPING MESSAGE WOULD HANG JOB. ;CAN BE DETACHED IF DATAPHONE ;HUNG UP AND CARRIER-OFF PSI ;ISN'T FULLY PROCESSED, ;OR IF ATACH HAS SOMEHOW FAILED TO ;COMPLETE. CALL DOECEO ;MAKE EOL'S PRINT! TYPE < AUTOLOGOUT > MOVE A,COJFN DOBE ;MAKE SURE IT ALL TYPES (NEEDED?) AUTOL6: SETO A, ;SAY SELF LGOUT ;LOG JOB OUT CALL JERR ;SHOULDN'T BE ABLE TO HAPPEN. ;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS. ;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR) %ERR: %$ERR: TLZA Z,F1 %.$ERR: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1) PUSH P,40 ;TEXT ADDRESS AND UUO VALUE CALL ERFRS1 ;SETUP BEFORE TYPING ERROR MSG JRST ERR1 ;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD" ;MUST HAVE ALREADY CALLED "ERFRST" SYSERA: PUSH P,[-2] JRST ERR1 ;ENTER HERE TO TYPE MOST RECENT SYSTEM ERR MESSAGE SYSERM: PUSH P,[-1] ;INDICATE USE OF SYSTEM ERROR MESSAGE ;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN SPACE (ALWAYS), ;THEN TEXT, THEN CR, BUT NO INITIAL CR-SPACE IF "U$ERR" UUO. ERR1: PUSH P,A ;AC'S MUST BE SAVED FOR ETYPE OR ERSTR PUSH P,B HLRZ B,-2(P) ;-2 FOR SYSTEM MSG, OR UUO FOR EXEC MSG CAIE B,B53 CAIN B,B53 CAIA ;NO CR-SPC FOR U$ERR UUO ($ERROR MACRO) CALL CRIF ;TYPE EOL IF NOT ALREADY AT LEFT ERR5: INTOFF SKIPGE A,EFORK ;USE EPHEMERAL FORK IF IT EXISTS MOVEI A,400000 ;OR EXEC IF NOT MOVE B,-2(P) ;0, -1, -2, OR UUO-TEXT ADDRESS JUMPG B,ERR5A ;PRINT ASCIZ TEXT SUPPLIED WITH UUO JUMPE B,ERR6 ;PRINT NOTHING AOJE B,[CALL $GETER ;ERROR NUMBER TO B JRST ERR04] HRR B,ERCOD ;-2 SAYS USE SYSTEM ERR # FROM "ERCOD" ERR04: HRL B,A ;FORK HANDLE MOVE A,COJFN ;DESTINATION SETZ C, ;SAY PARAMETERS FROM PSB, NO LGTH LIMIT. ERSTR ;SYSTEM ERROR MESSAAGE TO STRING JRST [ UETYPE [ASCIZ /MESSAGE NOT FOUND FOR ERROR %2P/] JRST ERR6] ;R +1: BAD ERROR # JRST [ SETZ A, ;R +2: DESTINATION PROBLEM, HFORK] ;HALT. JRST ERR6 ;R +3: DONE. ERR5A: MOVE B,0(P) MOVE A,-1(P) ;ETYPE USES VALUES THAT CAME IN AC'S UETYPE @-2(P) ;TYPE MESSAGE FROM CORE ERR6: INTON PRINT EOL TLNE Z,LOGOFF TYPE < NOT LOGGED OFF >; ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE ;ERROR UUOS AND SYSERM... ;MESSAGE ALL TYPED. ERR7: CALL DOECHO ;MAKE SURE ECHOING IS ON CALL RLJFNS ;CLOSE AND RELEASE ALL JFNS USED IN CMD PUSH P,C PUSH P,D HLRZ A,-4(P) ;-1 OR UUO TLNN Z,CTLCF1 ;CHECK ^C COUNT (KLUDGE____) CAIE A,B53 ;DON'T CLEAR BUFFERS FOR .$ERROR CAIA JRST ERR7F ;(USED FOR RUBOUT, ^X (CCHRI)). ;CLEAR ALL PAGE WINDOWS, IE UNMAP PAGES OF OTHER FORKS OR FILES. SETO A, ;PAGE OF INFERIOR FORK CALL MAPPF CALL UNMAP ;FLUSH BUFFER PAGES TOO ERR7F: INTOFF ;AVOID RACE AGAINST WFORK AT CIN45 SKIPL 1,EFORK ;IS THERE AN EPHEMERAL FORK? KFORK ;YES. FLUSH IT SETOM EFORK ;AND SAY SO INTON POP P,D POP P,C BTCHER ;SHOULD STOP NON-CONVERSATIONAL JOB ERR8: POP P,B POP P,A SUB P,[1,,1] ;FORGET UUO ;RESTORE EARLIER (LESS FULL) PLUSHDOWN ;LEVEL IF LEVEL WAS SAVED IN ".P" . ;THIS IS GENERALLY USED DURING ;INPUT. SKIPE .P MOVE P,.P SETZM ERRMF ;NO LONGER PROCESSING AN ERROR JRST @CERET ;VARIABLE ERROR RETURN. MAY GO SPECIAL ;PLACES. SUCH AS SUB-COMMAND INPUT FOR ;"DIRECTORY" COMMAND. ;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE RERET: ;DO ANY OTHER CLEANING UP JRST ERRET ;GO BACK TO COMMAND INPUT ;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT ; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR. ERFRST: TLZ Z,F1 ;NORMAL ENTRY ERFRS1: ;ENTER HERE TO NOT CLEAR INBUF IF F1 ON SKIPN CINITF ;IS EXEX INITIALIZED? HALTF ;NO, TYPING MESSAGE MIGHT FAIL & PRODUCE ;INFINITE LOOP, SO JUST HALT. TLZ Z,BAKFF+STCF ;CLEAR FLAGS FOR: ; REUSE SAME INPUT FIELD ; STORE PRINTED CHARACTERS IN CMD BUFFER PUSH P,A PUSH P,B ERFRS2: INTOFF ;BE SURE ALL UPDATED SIMULTANEOUSLY GPJFN SKIPGE CREDIF ;IF INPUT WAS REDIRECTED, HLRZM 2,CRJFNI MOVMS CREDIF ;UPDATE FLAG SKIPGE CREDOF HRRZM 2,CRJFNO ;SAVE FOR * OPTION OF "RED" AND "DET" MOVMS CREDOF MOVE 2,PRIMRY ;RESTORE JFNS WE HAD AT ENTRY SPJFN MOVE A,[CALL CUUO] ;RESET UUO DISPATCH, BECAUSE OTHERWISE MOVEM A,41 ;MALICIOUS USERS CAN MAKE EXEC TRANSFER ;TO ANY CODE THEY WISH BY PATCHING ;PAGE 0 OF PMF INTON ERFRS3: CALL DOECEO ;MAKE SURE CCOC IS SUCH THAT EOLS PRINT SKIPE ERRMF ;ALREADY PROCESSING AN ERROR? JRST [ UTYPE [ASCIZ / ERROR WITHIN AN ERROR /] ;YES, GIVE UP JRST ERRET] SETOM ERRMF ;SAY PROCESSING AN ERROR MOVE A,CIJFN DOBE TLNN Z,F1 ;DONT CLR INBUF FOR RUBOUT, ^X (.$ERROR) CFIBF ;CLEAR FILE INPUT BUFFER POP P,B POP P,A RET ;TYPE EOL UNLESS CARRIAGE IS ALREADY AT LEFT. CRIF: PUSH P,A PUSH P,B MOVE A,COJFN RFPOS ;READ FILE POSITION MOVEI B,(B) CAILE B,2 PRINT EOL PRINT " " ;DON'T PRINT MSG IN COLUMN 0 JRST [ POP P,B POP P,A RET] ;SUBROUTINE TO DO "GETER" JSYS AND PRESERVE AC'S 4-10. ;A MUST BE SET BY CALLER, RETURNS RESULT IN B. $GETER: PUSH P,D PUSH P,E PUSH P,F PUSH P,G PUSH P,G+1 GETER POP P,G+1 POP P,G POP P,F POP P,E POP P,D RET ;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED -- ; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES. ;CLOSES AND RELEASES JFNS STACKED IN JBUF. ;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0 ; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN ; TO A SUBCOMMAND INPUT LOOP. RLJFNS: PUSH P,A PUSH P,B PUSH P,C MOVE C,JBUFP RJFNS1: CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK, CAMN C,.JBUFP ;OR AT SAVED POINTER LEVEL JRST [ POP P,C POP P,B POP P,A RET] ;PROCESS ONE WORD OF JBUF HRRZ A,(C) ;GET A JFN TO CONSIDER CAIE A,100 ;DON'T RELEASE PRIMARY CAIN A,101 JRST RJFNS8 CAIL A,0 ;DON'T RELEASE NEGATIVE, CAIL A,MAXJFN ;OR BIGGER IS GARBAGE JRST RJFNS8 CAME A,CRJFNI ;DON'T CLOSE SAVED INFILE, CAMN A,CRJFNO ;OR SAVED OUTFILE JFNS. JRST RJFNS8 GTSTS TLNN B,200 JRST RJFNS8 ;INVALID, FORGET IT TLNN B,B0 ;IS IT OPEN? JRST [ RLJFN ;NO, RELEASE IT CALL JERR JRST RJFNS8] CLOSF ;YES, CLOSE AND RELEASE CALL JERR ;DONE WITH THIS WORD RJFNS8: SETZM (C) ;ZERO JBUF WORD SUB C,[XWD 1,1] ;DECREMENT POINTER MOVEM C,JBUFP JRST RJFNS1 ;%ETYPE (ETYPE MACRO, UETYPE UUO) ;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES. ;SPECIAL CODES ARE OF FORM %NL% ; WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC ; L IS A LETTER: ; D: TYPE CURRENT DATE ; J: TYPE TSS JOB # ; O: TYPE CONTENTS OF INDICATED AC IN OCTAL ; SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST. %ETYPE: PUSH P,Z PUSH P,A PUSH P,B PUSH P,C PUSH P,D HRR A,40 HRLI A,B53 ;FORM BYTE PTR FROM EFF ADDR ETYP2: ILDB B,A ;NEXT CHARACTER ETYP2A: JUMPE B,[POP P,D ;NULL TERMINATES TEXT POP P,C POP P,B POP P,A SUB P,[XWD 1,1] ;FORGET SAVED Z VALUE RET] CAIE B,"%" JRST [ CALL CCHRO ;NOT A %, OUTPUT IT JRST ETYP2] ;%ETYPE... ;"%" SEEN SETZB C,D ;C: IF NO NUMBER, USE 0 ;D: INIT NUMBER TO 0. ETYP4: ILDB B,A ;CHARACTER AFTER % CAIG B,"9" CAIGE B,"0" JRST ETYP5 IMULI D,10 ADDI D,-"0"(B) ;ADD NEW DIGIT TO NUMBER MOVE C,D ;COMPUTE LOCATION TO GET AC FROM... CAIG C,D ;...AC'S 5-9 ARE PRESERVED, ADDI C,-4(P) ;...CONTENTS OF 0-4 ARE IN PUSHDOWN. MOVE C,(C) ;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR JRST ETYP4 ;GO CHECK FOR ADDITIONAL DIGIT(S) ETYP5: PUSH P,A ;SAVE BYTE PTR DURING PROCESSING CAIL B,"A" CAILE B,"Z" ;HIGHEST LETTER IN TABLE CALL UN% ;NOT LETTER, UNRECOGNIZED % CODE CALL @%LETS-"A"(B) ;DISPATCH WITH A PUSHJ THROUGH LETTER ;TABLE. AT THIS TIME C CONTAINS 0 OR ;C(INDICATED AC). ;DONE INTERPRETING A % CODE. MUST FOLLOW DISPATCH PUSHJ! END%: POP P,A ;GET TEXT POINTER BACK ILDB B,A ;NEXT CHARACTER CAIE B,"%" ;PASS FOLLOWING % MOVE A,1(P) JRST ETYP2 ;CONTINUE TYPING ;%ETYPE... ;DISPATCH TABLE FOR LETTERS AFTER % %LETS: %A ;CURRENT TIME %B ;CPU TIME USED %C ;CONNECT TIME %D ;CURRENT DATE %E ;SAME TIME AS LAST %D %F ;"FORK N " IF >1 INFERIOR %G ;CONNECTED DIR NAME %H ;DEVICE NAME FOR DESIGNATOR IN INDICATED AC %I ;NUMBER OF LOGGED IN USERS %J ;TSS JOB # %K ;UPTIME %L ;"LINE N" OR "DETACHED" %M ;ACCT # OR STRING POINTER, AS FOR LOGIN %N ;NAME UNDER WHICH USER IS LOGGED IN %O ;CONTENTS OF SPECIFIED AC IN OCTAL %P ;CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL %Q ;CONTENTS OF AC IN DECIMAL %R ;DIRECTORY NAME FOR DIR # IN AC %S ;FILE NAME FOR JFN IN AC %T ;CONTENTS OF AC AS PERCENTAGE OF UP TIME %U ;DECIMAL BIT NUMBERS, SEPARATED BY COMMAS %V ;CPU TIME WITH TENTHS OF SECONDS UN% %X ;TYPE ILLEG INST ERROR MSG %Y ;RETYPE COMMAND LINE, A LA ^R %Z ;TYPE KEYWORDS IN TABLE AC POINTS TO ;UNRECOGNIZED %-CODE UN%: SUB P,[XWD 1,1] ;FORGET RETURN POP P,A ;RECOVER TEXT POINTER TYPE <%> ;DIGIT, IF ANY, IS LOST. JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %. ;%ETYPE... ;ROUTINES FOR LETTERS AFTER %. ;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE. ;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY. ;CURRENT TIME %A: GTAD ;GET CURRENT DATE & TIME A1: HRLZI C,B0+B10+B17 ;NO DATE, NO SECONDS. 24-HR TIME. A2: MOVE B,A MOVE A,COJFN CAMN B,[-1] ;DOES SYSTEM HAVE DATE & TIME? HRLZI B,1 ;CHANGE TO CALL SCREWUP ________ ODTIM RET ;CPU TIME USED. ALSO SEE %V. %B: HRROI A,-5 ;SAY WHOLE JOB RUNTM %B1: IDIV A,B ;CONVERT TO SECS JRST TOUT ;TYPE AS H:MM:SS ;CONSOLE TIME USED %C: HRROI A,-5 RUNTM MOVE A,C JRST %B1 ;DATE %D: SKIPN A,C ;USE GIVEN QUANTITY IF ANY GTAD ;GET CURRENT DATE & TIME FROM SYSTEM MOVEM A,%EDAYT ;SAVE FOR %E HRLZI C,B9+B17 ;DATE ONLY, STANDARD CONCISE FORMAT JRST A2 ;GO PRINT DATE ;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE. %E: MOVE A,%EDAYT JRST A1 ;SEE %A ;ETYPE'S % ROUTINES ... ;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS. ; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "LFORK". ;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE. %F: RET ;CASTRATED TEMPORARILY BECAUSE GFRKS NOT DONE AND ;THERE'S NO WAY OF GETTING A HANDLE ON FORK MORE THAN ;ONE LEVEL DOWN YET AND THERE'S NO WAY THE EXEC CAN ;GET MORE THAN ONE IMMEDIATE INFERIOR. HENCE LFORK ;IS ALWAYS THE EXEC'S FIRST AND ONLY IMMED INFERIOR. ; 5/22/70. __________________________________________ MOVEI A,400000 ;SAY START AT SELF MOVEI B,CSBUF ;USE STRING BUFFER GFRKS ;GET FORK STRUCTURE HRRZ A,(B) ;PTR TO INFERIOR MOVE A,(A) ;XWD ITS PARELLEL, ITS INFERIOR JUMPE A,[RET] ;NEITHER EXISTS, PRINT NOTHING. TYPE ; SKIPG B,C ;USE GIVEN HANDLE IF SUPPLIED MOVE B,LFORK ;ELSE HANDLE OF LAST RUN FORK TRZ B,B0 ;PRINT ## NOT 4000##. CALL TOCT ;OCTAL OUTPUT FROM B PRINT " " RET ;DEVICE NAME FOR DESIGNATOR IN INDCATED AC. %H: MOVE A,C DVCHR ;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR MOVE B,A MOVE A,COJFN DEVST ;DEVICE TO STRING CALL JERR RET ;NUMBER OF USERS ON SYSTEM. ;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1. %I: SETZ B, ;COUNTER SETO D, ;TABLE WORD -1 IS LENGTH GTB 1 HRLZ D,A ;SET UP LOOP COUNTER/TABLE INDEX ; GTB 1 ; JUMPL A,%I1 ;NO JOB 0 ; GTB 0 ; JUMPL A,%I3 ;IGNORE DETACHED JOB 0 %I1: GTB 1 ;TABLE 1 IS POSITIVE IF JOB EXISTS JUMPL A,%I3 GTB 3 ;TABLE 3 ENTRY RH IS 0 IF NOT LOGGED IN TRNE A,-1 ;OMIT UNLOGGEDIN USERS FROM COUNT AOS B %I3: AOBJN D,%I1 JUMPE B,[UTYPE [ASCIZ /NO JOBS/] RET] CAIN B,1 JRST [ UTYPE [ASCIZ /ONE JOB/] RET] MOVE A,COJFN MOVEI C,^D10 NOUT ;PRINT NUMBER CALL JERRC ;ERROR NUMBER IN C CAIL B,^D25 PRINT "!" CAIL B,^D50 PRINT "!" CAIL B,^D60 PRINT "!" TYPE < JOBS> RET ;UPTIME %K: TIME ;TIME SINCE SYSTEM RESTARTED IDIV A,B ;CONVERT TO SECONDS CALL TOUT ;PRINT AS HH:MM:SS CAIL A,^D50*^D3600 PRINT "!" CAML A,[^D100*^D3600] PRINT "!" CAML A,[^D150*^D3600] PRINT "!" RET ;ETYPE'S % ROUTINES ... ;"TTY N" OR "DETACHED" %L: GJINF JUMPL D,[UTYPE [ASCIZ /DETACHED/] RET] TYPE ; MOVE A,COJFN MOVE B,D JRST TOCT ;TYPE OCTAL FROM B ;ACCOUNT ;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC, AS LOGIN. %M: MOVE A,COJFN LDB B,[POINT 3,C,2] CAIE B,5 JRST [ MOVE B,C SETZ C, SOUT RET] MOVE B,C TLZ B,700000 MOVEI C,^D10 NOUT CALL JERRC RET ;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N. %G: GJINF JRST .+3 ;USER (DIRECTORY) NAME LOGGED IN UNDER. %N: GJINF MOVE B,A ;LOGIN DIRECTORY NO MOVE A,COJFN DIRST PRINT "?" ;NASSIGNED DIR #, NO SYST ERR # IN A. RET ;ETYPE'S % ROUTINES... ;OCTAL NUMBER IN SPECIFIED AC. %O: MOVE B,C JRST TOCT ;TYPE OCTAL FROM B ;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC %P: HRRZ B,C JRST TOCT ;TSS JOB NUMBER. MUST PRECEDE %Q. %J: GJINF ;GETS JOB # IN C ;FLOATING PT OR DECIMAL NUMBER FROM AC. ;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100 ;BIT # IN DECIMAL %U3: AOS D LSH C,1 JUMPN C,%U1 RET ;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB. %V: HRROI A,-5 ;SAY WHOLE JOB RUNTM MOVE C,B ;TICKS PER SECOND IDIV A,B ;CONVERT TIME IN TICKS TO SECS CALL TOUT ;TYPE H:MM:SS IDIVI C,^D10 ;GET TICKS PER 1/10 SEC JUMPN D,[RET] ;NOT EVEN, DON'T PRINT TENTHS OF SECS IDIV B,C ;CONVERT REMAINDER OF TICKS TO TENTHS ETYPE <.%2Q>; ;TYPE TENTHS OF SECONDS RET ;ETYPE'S % ROUTINES... ;TYPE VALUE OF ILLEGAL INSTRUCTION, " AT" PC, AND, ; IF ILLEG INSTRUCTION WAS A JSYS, A SYSTEM ERROR MESSAGE. ;FORK HANDLE IN LFORK, PC IN AC. ;USED IN A MESSAGE IN TABLE "WHY" THAT IS USED BY "START", "RUNSTAT", ^T %X: SETZB B,D ;SAY HAVEN'T GOT INSTRUCTION YET MOVEI A,-1(C) ;MASK PC AND SUBTRACT 1 %X1: PUSH P,FORK SKIPGE EFORK ;USE EFORK IF THERE IS ONE, LFORK IF NOT PUSH P,LFORK ;MOVE-MOVEM WITHOUT USING AN AC SKIPL EFORK PUSH P,EFORK POP P,FORK ;SET "FORK" FOR MAPPF CALL MAPPF ;MAP PAGE OF FORK INTO BUFFER "PAGEN" POP P,FORK TLNE A,B5 ;NO SUCH PAGE (SHOULDN'T OCCUR) TLNN A,B2 JRST %X3 ;READ PROTECTED, FORGET IT ANDI A,777 ;MASK ADDRESS WITHIN PAGE JUMPN D,.+2 ;JUMP IF TRACING AN XCT MOVE D,PAGEN(A) ;PICK UP INST 1ST TIME THROUGH HLRZ B,PAGEN(A) ;FETCH LH OF INST THAT FAILED TRZ B,740 ;IGNORE AC FIELD CAIN B,B53 ;TRACE SIMPLE XCT'S. ;DON'T HANDLE INDEXING OR ;INDIRECT ADDRESSING. JRST [ MOVEI A,@PAGEN(A) ;GET EFF ADDR JRST %X1] ;GO BACK AND GET ADDRESSED WORD ETYPE <%4O > ;TYPE INSTRUCTION %X3: ETYPE ;PC CAIE B,B53 JRST %X9 ;NOT A JSYS, DONE TYPE < - JSYS ERROR: >; SKIPGE A,EFORK ;USE EPHEMERON IF IT EXISTS, ELSE LFORK SKIPL A,LFORK ;GET ERROR CODE NOW FOR ERSTR ERR RET CALL $GETER ;DO GETER JSYS, PRESERVING 4-10 MOVE A,COJFN SETZ C, ERSTR ;PRINT SYSTEM ERR MSG FOR CODE IN B JRST [ UETYPE [ASCIZ /ERROR MESSAGE NOT FOUND FOR ERROR %2P/] JRST .+2] ;R1: BAD ERROR NUMBER JRST .+1 ;R2: DESTINATION PROBLEM, FORGET IT. %X9: SETO A, JRST MAPPF ;UNMAP PAGE THEN RETURN ;ETYPE'S % ROUTINES... ;RETYPE CURRENT COMMAND INPUT LINE %Y: PRINT EOL PRINT " " MOVE B,BFP IDPB C,B ;TERMINATE WITH NULL: ASSUME C 0. UTYPE CBUF RET ;LIST ALL KEYWORDS IN TABLE AC POINTS TO %Z: SKIPN A,(C) ;PICK UP TABLE COUNT RET ;NULL TABLE %Z1: AOS C ;STEP TABLE POINTER HLRZ B,(C) ;LH OF TABLE WORD POINTS TO... MOVE B,(B) ;VALUE WORD TLNE B,INVIS JRST %Z2 ;DON'T PRINT IF "INVISIBLE" MOVE B,(C) ;RH OF TABLE WORD POINTS TO TEXT PRINT " " UTYPE (B) ;TYPE TEXT OF TABLE ENTRY PRINT EOL %Z2: SOJG A,%Z1 ;ENDTEST AND LOOP RET ;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS. ;HOURS ARE SUPPRESSED IF ZERO TOUT: PUSH P,A PUSH P,B PUSH P,C MOVEI C,^D10 ;SET RADIX, NO LEADING ZEROES IDIVI A,^D3600 ;COMPUTE HOURS PUSH P,B ;SAVE REMAINDER SKIPE A ;DON'T PRINT IF ZERO HOURS CALL TOUT1 ;PRINT HOURS POP P,A ;RESTORE REMAINDER IDIVI A,^D60 ;COMPUTE MINUTES PUSH P,B ;SAVE SECONDS CALL TOUT1 ;PRINT MINUTES POP P,A ;RESTORE SECONDS CALL TOUT1 ;PRINT SECONDS POP P,C POP P,B POP P,A RET ;INTERNAL ROUTINE TO PRINT NUMBER IN A TOUT1: MOVE B,A MOVE A,COJFN TLNE C,-1 ;PRINTING FIRST FIELD OF TIME? PRINT ":" ;NO NOUT CALL JERRC HRLI C,(1B2!1B3!2B17) ;SET TO PRINT 2 COLS, LEADING ZEROS RET ;ON NEXT CALL ; UNMAP ALL USELESS PRIVATE PAGES ; CALLED BY ERROR (^C), AND "RESET" ;PAGE 747 IS "RSYSTAT" PAGE FOR NETLOAD COMMAND ;PAGES 750 TO 767 INCLUDE BUF1, BUF2, DIRECTORY UNMAP: SETO A, MOVE B,[400000,,747] HRLZI C,1 PMAP MOVEI D,20 PUSH P,B UNMAP1: AOS A,0(P) RPACS TLNN B,(1B5) ;EXISTS? JRST UNMAPX ;NO, WE'RE DONE MOVE B,A SETO A, PMAP SOJG D,UNMAP1 UNMAPX: SUB P,[1,,1] RET ;$SYSGT SIMULATES A SYSGT JSYS BY TRYING A HASH LOOKUP IN A LOCAL TABLE ; FIRST, AND THEN THE SYSTEM IF IT IS NOT IN THE TABLE. NOTE ; THE SYSTEM DOES A (SLOW) LINEAR SEARCH PLUS CONTEXT SWITCHES. ; AC'S AT ENTRY AND EXIT ARE EXACTLY THOSE OF SYSGT $SYSGT: PUSH P,C ;SAVE FOR CALLER PUSH P,A ;SIXBIT OF TABLE NAME MOVEI C,SGTBLN ;COUNT THIS MANY PROBES (TABLE FULLNESS) TSC A,A LSH A,-1 ;FAST HASH IS BETTER THAN BURNED CYCLES IDIVI A,SGTBLN ;ON A BIG TABLE, AT LEAST. SYSGT1: SKIPN A,SGTNAM(B) ;GET NAME FROM HASH TABLE JRST SYSGT2 ;HIT A 0 -- TRY THE SYSTEM CAMN A,0(P) ;IS THIS THE ONE WE ARE LOOKING FOR? JRST SYSGT3 ;YES, USE IT. SOSGE B ;DO LINEAR SEARCH BACKWARDS MOVEI B,SGTBLN-1 ;RING THE POINTER SOJG C,SYSGT1 ;BEEN THRU THE WHOLE TABLE? CALL SCREWUP ;MAKE SGTBLN BIGGER!!!! SYSGT2: PUSH P,B ;SAVE THE INDEX MOVE A,-1(P) ;GET BACK THE NAME SYSGT ;TRY THE SYSTEM JUMPE B,SYSGT4 ;OH WELL EXCH B,0(P) ;GET BACK INDEX POP P,SGTAC2(B) ;INSERT ENTRY INTO HASH TABLE MOVEM A,SGTAC1(B) POP P,SGTNAM(B) MOVE B,SGTAC2(B) POP P,C RET SYSGT3: MOVE A,SGTAC1(B) MOVE B,SGTAC2(B) SUB P,[1,,1] POP P,C RET SYSGT4: SUB P,[2,,2] POP P,C RET ;FLOATING POINT NUMBER INPUT ;PRE-READS STRING IN ORDER TO DO EDITTING AND NOISE FPIN: CALL CSTR ;COLLECT A STRING CAIN TRM,"." JRST MORE ;GET MORE -- BACK INTO CSTR AOS CNT ;MAKE BUFFF INCLUDE THE TERMINATOR CALL BUFFF ;BUFFER UP, READY FOR A JSYS CALL SOS CNT FLIN ;INPUT FLOATING NUMBER FROM BUFFER CALL [ CAIN A,FLINX4 ;-.Q AND OTHER FUNNY FORMATS JRST [ LDB B,A ;GET THE LAST CHARACTER READ JUMPE B,[SUB P,[1,,1] ;READ IT ALL JRST MORE] ;GO BACK INTO CSTR JRST CERR] ;DIDN'T USE ALL CHARACTERS CAIN C,FLINX1 ;BAD FORMAT JRST CERR CAIE C,FLINX2 ;UNDER FLOW CAIN C,FLINX3 ;OVER FLOW JRST CERR JRST JERRC] ;ANYTHING ELSE BOMBS THE EXEC IBP A ;STEP OVER THE NULL CAME A,CSBUFP ;FLIN USED THE ENTIRE STRING? JRST CERR ;NO MOVE A,B ;HERE IS THE ANSWER RET ;CALLER IS TO DO TERM CHK AND CONF END