Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
4-sources/tv.mac
There are 20 other files named tv.mac in the archive. Click here to see a list.
;<4.UTILITIES>TV.MAC.233, 3-Jan-80 15:27:48, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;tco 4.2532 - Write correct file even when over quota interruption in middle
;<4.UTILITIES>TV.MAC.231, 8-Oct-79 14:21:41, EDIT BY OSMAN
;tco 4.2517 - Don't bomb out if error in TV.INI
;<4.UTILITIES>TV.MAC.229, 8-Oct-79 13:53:22, EDIT BY OSMAN
;tco 4.2516 - Don't allow double flagging
;<4.UTILITIES>TV.MAC.228, 8-Oct-79 13:40:11, EDIT BY OSMAN
;fix code at SCON5. It seems to have gotten shuffled.
;<4.UTILITIES>TV.MAC.227, 18-Sep-79 11:25:57, EDIT BY OSMAN
;more 4.2473 - Make LPF be even larger
;<4.UTILITIES>TV.MAC.226, 18-Sep-79 11:01:14, EDIT BY OSMAN
;more 4.2473 - Initialize PF with IOWD so LPF pushes can really be done
;<4.UTILITIES>TV.MAC.225, 18-Sep-79 10:32:51, EDIT BY OSMAN
;tco 4.2473 - Increase LPF to 36 decimal
;<4.UTILITIES>TV.MAC.223, 17-Sep-79 17:08:43, EDIT BY OSMAN
;more 4.2449 - prevent premature line-wrap
;<4.UTILITIES>TV.MAC.221, 14-Sep-79 13:58:44, EDIT BY OSMAN
;MORE 4.2449 - FIX FILSPC to not assume SKRCH preserves B
;<4.UTILITIES>TV.MAC.220, 14-Sep-79 13:42:55, EDIT BY OSMAN
;more 4.2449 - Fix NOREPL to not assume SKRCH preserves A
;<4.UTILITIES>TV.MAC.212, 7-Sep-79 15:15:47, EDIT BY OSMAN
;A better idea for 4.2449; Don't use literal jfn at all! (Use SFCOC)
;<4.UTILITIES>TV.MAC.211, 7-Sep-79 14:22:26, EDIT BY OSMAN
;tco 4.2449 - send even parity in DISCHR
;<4.UTILITIES>TV.MAC.210, 7-Sep-79 14:13:25, EDIT BY OSMAN
;ADD CH%EVN
;<4.UTILITIES>TV.MAC.209, 7-Sep-79 04:34:07, EDIT BY R.ACE
;FIX QGC UNDER EXTENDED ADDRESSING
;<4.UTILITIES>TV.MAC.208, 28-Aug-79 09:40:10, EDIT BY OSMAN
;tco 4.2425 - Fix wording of search error message.
;<4.UTILITIES>TV.MAC.206, 24-Aug-79 17:51:17, EDIT BY OSMAN
;tco 4.2422 - Make ^H return jiffies since midnight
;<4.UTILITIES>TV.MAC.204, 24-Aug-79 14:15:29, EDIT BY OSMAN
;tco 4.2420 - Remove ;F and ^I and F
;<4.UTILITIES>TV.MAC.203, 16-Aug-79 09:07:47, EDIT BY OSMAN
;MORE 4.2375 - Put crlf on appropriate LERROR calls (so search error prints on one line)
;<4.UTILITIES>TV.MAC.202, 14-Aug-79 13:53:06, EDIT BY OSMAN
;FIX 4.2375 - Do CRR in LERR0 instead of ERRMES
;<4.UTILITIES>TV.MAC.201, 13-Aug-79 11:27:29, EDIT BY OSMAN
;tco 4.2391 - Don't lose /\ from screen on long lines with tabs
;<4.UTILITIES>TV.MAC.200, 6-Aug-79 09:30:10, EDIT BY OSMAN
;tco 4.2375 - Put crlf's after error messages
;<4.UTILITIES>TV.MAC.199, 2-Aug-79 08:14:15, EDIT BY R.ACE
;FIXES FOR SAVER FORK UNDER EXTENDED ADDRESSING
;<4.UTILITIES>TV.MAC.198, 1-Aug-79 16:24:33, EDIT BY OSMAN
;TCO 4.2365 - DON'T ALLOW "A" COMMAND WHEN POINTER AT END
;<4.UTILITIES>TV.MAC.195, 31-Jul-79 15:39:24, EDIT BY OSMAN
;DON'T GET "?JFN IS NOT ASSIGNED" ON ;Y AFTER "CREATE" EXEC COMMAND
;<4.UTILITIES>TV.MAC.194, 30-Jul-79 20:51:22, EDIT BY R.ACE
;ADD CODE TO REE TO GET BACK INTO NON-ZERO SECTION IF THERE BEFORE
;FIX BUG IN XSIR - GET SECTION # IN RH OF D
;ADD SETX TO MAKE IT EASY TO RUN IN A NON-ZERO SECTION
;<4.UTILITIES>TV.MAC.193, 26-Jul-79 13:34:24, EDIT BY R.ACE
;TAKE OUT PSECN
;FORCE SCRNPT OUT OF BOUNDS AT CLRSCN WITH POSITIVE NUMBER INSTEAD OF 0
;TO FORCE WINIT TO BE CALLED AT UPDATE
;<4.UTILITIES>TV.MAC.189, 25-Jul-79 14:52:42, EDIT BY OSMAN
;tco 4.2344 - Fix long lines on display that have tab at right margin
;<4.UTILITIES>TV.MAC.187, 25-Jul-79 07:11:43, EDIT BY R.ACE
;MAKE XSIR ROUTINE CALLABLE MORE THAN ONCE
;<4.UTILITIES>TV.MAC.185, 24-Jul-79 16:08:58, EDIT BY OSMAN
;tco 4.2342 - Fix V command to display full window when space hit
;<4.UTILITIES>TV.MAC.184, 21-Jul-79 13:20:36, EDIT BY R.ACE
;FIX PMAPS TO USE 18-BIT PROCESS PAGE NUMBERS
;ADD EXTENDED SIR CODE
;MISCELLANEOUS EXTENDED ADDRESSING MACHINE-INSTRUCTION FIXES
;<4.UTILITIES>TV.MAC.183, 20-Jul-79 06:19:54, EDIT BY R.ACE
;FIX LUUO HANDLING FOR NON-ZERO SECTIONS
;<4.UTILITIES>TV.MAC.182, 19-Jul-79 09:22:08, EDIT BY R.ACE
;SETUP INDIRECT ADDRESSING FOR NONZERO SECTIONS
;<4.UTILITIES>TV.MAC.181, 16-Jul-79 16:10:29, EDIT BY OSMAN
;If error opening output file, don't bomb out on next attempt
;<4.UTILITIES>TV.MAC.180, 26-Jun-79 16:11:34, EDIT BY OSMAN
;tco 4.2312 - Prevent undeserved "No iteration loop currently in progress"
;<4.UTILITIES>TV.MAC.179, 19-Jun-79 15:45:25, EDIT BY OSMAN
;tco 4.2296 - don't say "?No file open for input" after many A's
;<4.UTILITIES>TV.MAC.176, 8-Jun-79 11:11:00, EDIT BY OSMAN
;tco 4.2279 - Don't leave typein in window area when fixing screen image
;<4.UTILITIES>TV.MAC.173, 6-Jun-79 10:43:26, EDIT BY OSMAN
;DON'T OPEN LATENT OUTPUT FILE UNTIL FIRST ACTUAL OUTPUT
;<4.UTILITIES>TV.MAC.164, 1-Jun-79 15:55:56, EDIT BY OSMAN
;tco 4.2269 - Make TV note CREATE or (OUTPUT AS) foo
;<4.UTILITIES>TV.MAC.163, 14-May-79 16:19:55, EDIT BY OSMAN
;FIX S[A,D]
;<4.UTILITIES>TV.MAC.162, 24-Apr-79 13:33:46, EDIT BY OSMAN
;ENFORCE /\---- 2S--$ ----/\ (INSTEAD OF ---/\-)
;<4.UTILITIES>TV.MAC.161, 23-Apr-79 19:33:28, EDIT BY OSMAN
;FIX ;G (BROKE WHEN PROMPT CHARACTER ADDED TO CBUF)
;<4.UTILITIES>TV.MAC.160, 20-Apr-79 15:16:58, EDIT BY OSMAN
;CALL WINCLS AT JSER SO SCREEN UPDATE DOESN'T WIPE OUT ERROR DIAGNOSTIC AFTER ;Y
;<4.UTILITIES>TV.MAC.159, 10-Apr-79 14:11:54, EDIT BY OSMAN
;ADJUST BOUNDS TO ACCOMODATE DDT USING MORE SPACE!
;<4.UTILITIES>TV.MAC.153, 9-Apr-79 14:18:22, EDIT BY OSMAN
;fix CTRL/X command (didn't prevail when defaulting subsequent search!)
;<4.UTILITIES>TV.MAC.152, 6-Apr-79 13:43:13, EDIT BY OSMAN
;MAKE CHRTAB ASSEMBLE FASTER
;<4.UTILITIES>TV.MAC.150, 20-Mar-79 09:37:10, EDIT BY OSMAN
;FIX "?jfn is not assigned" bug having to do with file structure full
;<4.UTILITIES>TV.MAC.148, 15-Mar-79 09:39:10, EDIT BY OSMAN
;FIX PROBLEM OF REDISPLAYING AFTER MANY T COMMANDS (ILLEGAL MEMORY WRITE)
;<4.UTILITIES>TV.MAC.147, 12-Mar-79 14:30:04, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>TV.MAC.146, 2-Mar-79 10:51:43, EDIT BY OSMAN
;FIX LOOKING AT .MEM FILES (WHICH HAVE LINEFEEDS WITHOUT CR'S)
;<4.UTILITIES>TV.MAC.145, 12-Feb-79 10:13:28, EDIT BY OSMAN
;BE PREPARED FOR COMCNT = -1 AT UERR0
;<4.UTILITIES>TV.MAC.144, 11-Feb-79 15:04:03, EDIT BY OSMAN
;FIX ; COMMAND WHICH BROKE
;<4.UTILITIES>TV.MAC.142, 9-Feb-79 14:45:34, EDIT BY OSMAN
;save and clear INTDPH at MAC so that 1<MY>$$ where Y contains 1<> succeeds
;<4.UTILITIES>TV.MAC.140, 30-Jan-79 10:43:24, EDIT BY OSMAN
;IMPROVE SCAN LOGIC ( IN -3CI...$, THE I HAS NO ARG!)
;<4.UTILITIES>TV.MAC.138, 29-Jan-79 16:55:14, EDIT BY OSMAN
;DON'T BOMB OUT IF ENTIRE FILE STRUCTURE FULL WHEN WRITING BACKUP FILE
;<4.UTILITIES>TV.MAC.129, 23-Jan-79 15:08:09, EDIT BY OSMAN
;FIX SCANNING OVER nnnI COMMAND
;<4.UTILITIES>TV.MAC.118, 16-Jan-79 15:18:58, EDIT BY OSMAN
;ONLY BACKUP TERMINAL INPUT, NOT DISK INPUT
;<4.UTILITIES>TV.MAC.117, 16-Jan-79 14:18:18, EDIT BY OSMAN
;MAKE WNOBACKUP$ NOT INFINITELY LOOP
;<4.UTILITIES>TV.MAC.116, 16-Jan-79 14:11:48, EDIT BY OSMAN
;tco 4.2163 - announce end of ;E stream
;<4.UTILITIES>TV.MAC.110, 2-Jan-79 16:40:00, EDIT BY OSMAN
;tco 4.2144 - check for unended iteration loop in macros
;<4.UTILITIES>TV.MAC.82, 22-Dec-78 16:19:31, EDIT BY OSMAN
;tco 4.2132 - Lots of stuff (DUMPF,SCANF,DOCE,TVBACK:)
;<4.UTILITIES>TV.MAC.70, 12-Dec-78 10:15:22, EDIT BY OSMAN
;Fix message to say "...more than 36 characters..." (put "s" on!)
;FIX TV NOT TO INFINITELY LOOP ON S$$
;<4.UTILITIES>TV.MAC.66, 11-Dec-78 10:34:33, EDIT BY OSMAN
;tc0 4.2117 - give clear error when search fails
;tco 4.2116 - display linefeeds at left margin as blank line instead of ^J
;<4.UTILITIES>TV.MAC.64, 25-Oct-78 11:19:28, EDIT BY OSMAN
;FIX W COMMANDS THAT TAKE ARGS (USED TO WORK)
;<4.UTILITIES>TV.MAC.58, 18-Oct-78 15:16:58, EDIT BY OSMAN
;FIX ;N COMMAND
;<4.UTILITIES>TV.MAC.56, 17-Oct-78 13:52:02, EDIT BY OSMAN
;tco 4.2046 - Make special characters work even after a non-special one is deleted
;<4.UTILITIES>TV.MAC.55, 2-Oct-78 17:55:05, EDIT BY OSMAN
;fix recovery of backup file after over-quota has been resolved.
;<4.UTILITIES>TV.MAC.54, 26-Sep-78 13:20:46, EDIT BY OSMAN
;FIX IFOO^G$$ TO DO THE INSERT
;<4.UTILITIES>TV.MAC.52, 14-Sep-78 16:47:39, EDIT BY OSMAN
;Fix displaying flagged characters
;<4.UTILITIES>TV.MAC.51, 14-Sep-78 13:48:17, EDIT BY OSMAN
;Put W table in alphabetical order
;REMOVE FLAGLOWERS (UNTIL SYSTEM SUPPORTS IT)
;IN INSERT STRINGS, MAKE CTRL/A CTRL/B FORCE UPPER LOWER CASE RESPECTIVELY.
;TWO IN A ROW LOCKS CASE, ONE IN A ROW MEANS NEXT CHARACTER ONLY. LOCK ENDS
;AT END OF INSERTION.
;MAKE CTRL/V BE THE QUOTING CHARACTER.
;<4.UTILITIES>TV.MAC.36, 5-Sep-78 14:54:23, EDIT BY OSMAN
;MAKE SURE AT LEFT MARGIN BEFORE CLEARING LINE!
;<4.UTILITIES>TV.MAC.28, 1-Sep-78 23:50:18, EDIT BY OSMAN
;ADD VT100 SMARTS
;<4.UTILITIES>TV.MAC.27, 30-Aug-78 15:32:13, EDIT BY OSMAN
;SET UP WINDOW SIZE WHEN TERMINAL TYPE DECLARED
;<4.UTILITIES>TV.MAC.26, 30-Aug-78 14:20:52, EDIT BY OSMAN
;TCO 4.2000 - MAKE WINDOW OUTPUT ON HARDCOPY NOT LOSE TABS
;<4.UTILITIES>TV.MAC.25, 28-Aug-78 16:42:46, EDIT BY OSMAN
;MAKE SURE ESCAPE ECHOES
;REMOVE WLOWER (IT DIDN'T WORK ANYWAY, NEEDS MONITOR SUPPORT)
;MAKE @J WORK IF END OF FILE IS ON SCREEN
;FIX OPERATION ON HARDCOPY TERMINALS
;<4.UTILITIES>TV.MAC.9, 17-Aug-78 09:45:31, EDIT BY OSMAN
;CLEAR SCANNER BEFORE EXECUTING TV.INI
;FIX "\" SO TRAILING "-" IS LIKE ANY OTHER NONDIGIT
;<OSMAN.TV>NEWTV.MAC.171, 14-Aug-78 16:37:45, EDIT BY OSMAN
;MAKE COMMANDS.TV BE STANDARD (NON-TEMP, NEXT HIGHER GENERATION)
;<OSMAN.TV>NEWTV.MAC.170, 13-Aug-78 16:25:14, EDIT BY OSMAN
;ALLOW COMMAND LINE TO BE "EDIT"
;<OSMAN.TV>NEWTV.MAC.169, 11-Aug-78 14:33:51, EDIT BY OSMAN
;TCO 4.1980 - PREVENT ZJ-SFOO$$ FROM LOOPING IF ;Y FILLED BUFFER
;<OSMAN.TV>NEWTV.MAC.167, 11-Aug-78 09:27:36, EDIT BY OSMAN
;GET RID OF PAGING/UNPAGE, SINCE NEW MTOPRS (.MORLC) TALLY LINES TYPED
;<OSMAN.TV>NEWTV.MAC.166, 26-Jul-78 10:32:51, EDIT BY OSMAN
;ON Y OR ;Y, LEAVE SOME ROOM IN BUFFER FOR INSERTIONS (DON'T READ UNTIL BUFFER COMPLETELY FULL)
;<OSMAN.TV>NEWTV.MAC.165, 26-Jul-78 10:15:28, EDIT BY OSMAN
;FIX TV TO NOT LOSE A CHARACTER IN MIDDLE OF BUFFER WHEN DOING Y OR P
;<OSMAN.TV>NEWTV.MAC.151, 4-Jun-78 13:56:47, EDIT BY OSMAN
;REMOVE COMEIN CELL (CBUFH IS SYNONOMOUS)
;<OSMAN.TV>NEWTV.MAC.149, 30-May-78 16:35:25, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.148, 28-Apr-78 10:32:46, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.141, 21-Apr-78 11:01:35, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.140, 20-Apr-78 16:49:15, EDIT BY OSMAN
;FIX MINOR SCREEN UPDATE BUG (BLT TO SCROLL SCREEN WAS BLTING TOO MUCH)
;<OSMAN.TV>NEWTV.MAC.139, 20-Apr-78 16:42:13, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.133, 20-Apr-78 11:33:55, EDIT BY OSMAN
;REMOVE SH FLAG
;<OSMAN.TV>NEWTV.MAC.121, 27-Mar-78 14:36:39, Edit by OSMAN
;INCREASE SIZE OF DEFNAM AREA TO HOLD REAL LONG FILESPEC
;<MURPHY.3MON>NEWTV.MAC.10, 23-Feb-78 13:23:38, EDIT BY MURPHY
;POLISH UP SOURCE--RAISE RANDOM LC, ALIGN COMMENTS
;<OSMAN.TV>NEWTV.MAC.114, 17-Feb-78 16:03:41, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.113, 17-Feb-78 16:00:33, Edit by OSMAN
;DON'T CLEAR FILE FLAGS ON ERROR (INPUT/OUTPUT IN PROGRESS)
;<OSMAN.TV>NEWTV.MAC.106, 17-Feb-78 13:21:25, Edit by OSMAN
;ONLY TYPE CRLF BEFORE ERROR MESS IF NOT YET AT MARGIN
;<OSMAN.TV>NEWTV.MAC.105, 17-Feb-78 13:10:53, EDIT BY OSMAN
;TREAT TV.INI AS THOUGH USER SAID ;MXTV.INI$MM, EXCEPT "X" IS REALLY A PHANTOM Q-REG
;REQUIRE ^E<n> IN SEARCH STRINGS. (DON'T ALLOW JUST ^En)
;GIVE ERROR IF S$ EXECUTED WHEN NO DEFAULT SEARCH STRING YET SET UP
;<OSMAN.TV>NEWTV.MAC.99, 14-Feb-78 17:17:10, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.98, 14-Feb-78 16:59:28, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.97, 14-Feb-78 13:08:01, Edit by OSMAN
;MAKE NEGATIVE ITERATION DO NOTHING AS 0 DOES.
;<OSMAN.TV>NEWTV.MAC.96, 13-Feb-78 22:38:23, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.94, 13-Feb-78 22:16:54, Edit by OSMAN
;<OSMAN>NEWTV.MAC.23, 13-Feb-78 19:38:21, EDIT BY OSMAN
;<OSMAN>NEWTV.MAC.22, 13-Feb-78 19:33:03, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.92, 6-Feb-78 16:11:56, EDIT BY OSMAN
;USE INTERRUPT INSTEAD OF SIBE.
;INTERRUPT SPACE ON COMMAND LINE INSTEAD OF AFTER "--MORE--"
;<OSMAN>NEWTV.MAC.20, 2-Feb-78 21:57:05, EDIT BY OSMAN
;<OSMAN>NEWTV.MAC.19, 2-Feb-78 21:52:42, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.84, 2-Feb-78 14:21:05, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.83, 2-Feb-78 11:46:59, Edit by OSMAN
;IF FIRST CHAR IS ALTMODE, ASSUME ESCAPE SEQUENCE (LIKE VT52 ARROWS)
;<OSMAN.TV>NEWTV.MAC.82, 2-Feb-78 11:34:21, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.64, 31-Jan-78 16:15:54, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.63, 31-Jan-78 15:17:23, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.61, 31-Jan-78 11:51:49, Edit by OSMAN
;<OSMAN.TV>NEWTV.MAC.60, 30-Jan-78 21:51:16, Edit by OSMAN
;WITH MVSTR (MOVE STRING) TO RETURN UPDATED POINTERS IN OU AND I
;<OSMAN.TV>NEWTV.MAC.58, 13-Jan-78 16:53:52, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.35, 11-Jan-78 14:40:22, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.34, 10-Jan-78 17:06:15, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.33, 10-Jan-78 17:03:36, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.32, 10-Jan-78 16:52:40, EDIT BY OSMAN
;USE TEXTI INSTEAD OF BIN. REMOVE ALL THE DISPLAY RUBOUT LOGIC
;<OSMAN.TV>NEWTV.MAC.31, 9-Jan-78 15:44:35, EDIT BY OSMAN
;REMOVE FANCY "TYO" ROUTINE AND "--MORE--" DURING "T" COMMANDS
;<OSMAN.TV>NEWTV.MAC.30, 6-Jan-78 17:43:40, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.29, 6-Jan-78 17:37:26, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.28, 6-Jan-78 17:23:27, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.27, 6-Jan-78 17:18:11, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.26, 6-Jan-78 17:12:57, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.25, 6-Jan-78 17:08:54, EDIT BY OSMAN
;USE BINARY CHANNEL ONLY FOR SCREEN MANIPULATION
;<OSMAN.TV>NEWTV.MAC.24, 6-Jan-78 16:45:15, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.23, 6-Jan-78 16:30:44, EDIT BY OSMAN
;DON'T USE BINARY TTY CHANNEL ANYMORE, AND DON'T DO EXTRA SFPOS'S
;<OSMAN.TV>NEWTV.MAC.22, 27-Dec-77 16:49:39, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.21, 27-Dec-77 16:39:41, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.20, 27-Dec-77 16:35:45, EDIT BY OSMAN
;TURN OFF PAGING DURING TV SO THAT ^Q, ^S CAN BE TYPED, AND TV WILL
;KNOW HOW MANY LINES HAVE SCROLLED. ENABLE ^C-TRAPPING SO TV CAN RESTORE
;PAGING WHEN USER EXITS.
;<OSMAN.TV>NEWTV.MAC.19, 22-Dec-77 16:57:11, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.18, 22-Dec-77 16:42:09, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.17, 22-Dec-77 16:35:36, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.16, 22-Dec-77 16:12:04, EDIT BY OSMAN
;<OSMAN>NEWTV.MACA.1, 22-Dec-77 16:03:10, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.14, 22-Dec-77 15:46:58, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.13, 22-Dec-77 15:33:42, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.12, 22-Dec-77 15:03:11, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.11, 22-Dec-77 14:54:47, EDIT BY OSMAN
;turn off paging so that lines can be counted, and sfpos not needed on every character
;note: ^c-trapping put in for this too, so that ^c causes paging to be restored
;<OSMAN.TV>NEWTV.MAC.10, 21-Dec-77 18:02:57, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.9, 21-Dec-77 17:51:23, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.8, 21-Dec-77 17:46:25, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.7, 21-Dec-77 17:31:04, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.6, 21-Dec-77 17:07:10, EDIT BY OSMAN
;DON'T ECHO TV.INI READIN
;<OSMAN.TV>NEWTV.MAC.5, 21-Dec-77 11:21:47, EDIT BY OSMAN
;REMOVE DEPOSITING OF 12 IN COMND BUFFER (IN GSCRIPT TO FOOL .CMINI)
;<OSMAN.TV>NEWTV.MAC.4, 18-Dec-77 22:09:37, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.3, 18-Dec-77 21:55:05, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.2, 18-Dec-77 21:52:18, EDIT BY OSMAN
;IF GTJFN FAILS ON ;Y-CLASS COMMAND, TRY WITHOUT DEFAULT.
;THIS SOLVES SOME OF THE "?NO SUCH FILE TYPE" FRUSTRATION
;<OSMAN.TV>TV.MAC.135, 18-Dec-77 21:21:52, EDIT BY OSMAN
;INCREASE CBUF FROM 40K TO 50K (SYMBOL TABLE RAN INTO IT!)
;<OSMAN.TV>TV.MAC.133, 18-Dec-77 18:03:50, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.132, 18-Dec-77 15:27:01, EDIT BY OSMAN
;INCREASE LENGTH OF PDL TO 200 (FROM 75)
;<OSMAN.TV>TV.MAC.131, 18-Dec-77 14:37:53, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.130, 17-Dec-77 18:31:24, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.129, 17-Dec-77 18:23:37, EDIT BY OSMAN
;PREVENT ;Y OF NUL: FROM BOMBING OUT (DON'T TRY TO PMAP NUL:!)
;<OSMAN.TV>TV.MAC.128, 17-Dec-77 18:10:49, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.127, 17-Dec-77 18:04:54, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.126, 17-Dec-77 17:54:46, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.125, 17-Dec-77 17:48:25, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.124, 17-Dec-77 17:41:51, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.123, 17-Dec-77 17:33:17, EDIT BY OSMAN
;PUT IN LJERR WHICH PRINTS JSYS ERROR BUT RETURNS
;WHEN SAVING CONTEXT AT BEGINNING OF COMMAND LINE, SAVE ENTIRE STACK
;use comnd to read names during ;y-class commands
;<OSMAN.TV>TV.MAC.103, 16-Dec-77 16:46:31, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.102, 16-Dec-77 16:30:44, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.101, 16-Dec-77 15:42:13, EDIT BY OSMAN
;CHANGE "Z" TO "ZEE", ELSE "FLDDB. .CMIFI" ASSEMBLES WRONG
;<OSMAN.TV>TV.MAC.100, 16-Dec-77 13:30:26, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.99, 16-Dec-77 10:35:52, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.98, 16-Dec-77 10:23:05, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.97, 16-Dec-77 10:18:26, EDIT BY OSMAN
;DON'T SET MESFLG WHEN ^L EXECUTED.
;<OSMAN.TV>TV.MAC.95, 15-Dec-77 17:29:17, EDIT BY OSMAN
;WHEN DEBRKING FROM OVER QUOTA, ALWAYS RESTART OFFENDING INSTRUCTION
;SPECIAL CASE HK (B,ZK) SO THAT HOLE ISN'T MOVED WHEN BUFFER GETS CLEARED
;<OSMAN.TV>TV.MAC.81, 14-Dec-77 15:00:15, EDIT BY OSMAN
;DON'T AUTO-EXPUNGE UNLESS WAUTO-EXPUNGE HAS BEEN DONE
;ADD WAUTO-EXPUNGE AND WNOAUTO-EXPUNGE
;<OSMAN.TV>TV.MAC.80, 14-Dec-77 14:18:42, EDIT BY OSMAN
;WHEN CHECKING FOR TV FILENAME, ALLOW "TV" TO BE TYPED IN EITHER CASE
;ALLOW GUIDE WORDS AFTER "TV"
;<OSMAN.TV>TV.MAC.79, 13-Dec-77 16:59:55, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.78, 13-Dec-77 11:39:29, EDIT BY OSMAN
;TRY TO DISPLAY FROM BEGINNING OF LINE
;<OSMAN.TV>TV.MAC.77, 9-Dec-77 20:55:53, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.76, 9-Dec-77 20:16:09, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.75, 9-Dec-77 16:32:40, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.74, 9-Dec-77 16:26:59, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.73, 9-Dec-77 16:20:12, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.72, 9-Dec-77 16:03:02, EDIT BY OSMAN
;SPEED UP INITIALIZATION BY DOING SIN INSTEAD OF BINS OF RSCAN BUFFER
;<OSMAN.TV>TV.MAC.58, 8-Dec-77 17:59:28, EDIT BY OSMAN
;<OSMAN.TV>LINO.TEC.2, 8-Dec-77 17:49:39, EDIT BY OSMAN
;ON ^D, MAKE SURE DDT IS LOADED
;ADD WDATE-AND-TIME, WHICH INPUTS CURRENT DATE AND TIME INTO BUFFER
;ADD WFILENAME, WHICH INPUTS LAST FILENAME INTO BUFFER, AS
;SPECIFIED IN MOST RECENT ;R ;W ;Y ;U ;D ;X ;S COMMAND.
;;<OSMAN.TV>TV.MAC.56, 8-Dec-77 16:24:39, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.54, 8-Dec-77 16:15:46, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.53, 8-Dec-77 16:07:19, EDIT BY OSMAN
;PREVENT WUPDATE FROM DOING "--MORE--"
;<OSMAN.TV>TV.MAC.52, 2-Dec-77 15:37:04, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.51, 2-Dec-77 14:19:01, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.50, 1-Dec-77 17:18:27, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.49, 1-Dec-77 16:35:42, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.48, 1-Dec-77 16:28:44, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.47, 1-Dec-77 16:24:48, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.46, 1-Dec-77 14:45:30, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.45, 1-Dec-77 14:30:47, EDIT BY OSMAN
;DO AUTOMATIC EXPUNGE IF OVER QUOTA DURING FILE OUTPUT
;<OSMAN.TV>TV.MAC.43, 28-Nov-77 13:13:23, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.42, 28-Nov-77 11:43:45, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.41, 28-Nov-77 11:18:52, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.40, 28-Nov-77 10:46:58, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.39, 28-Nov-77 10:44:59, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.38, 28-Nov-77 10:28:45, EDIT BY OSMAN
;FIX BUG WHEREBY ;Y FOLLOWED BY ;X CAUSED DATA DUPLICATION IF "?FILE TOO LARGE FOR BUFFER"
;<OSMAN.TV>TV.MAC.37, 14-Nov-77 23:23:56, EDIT BY OSMAN
;FIX TV TO NOT LEAVE GARBAGE (LIKE SCROLLED TYPE-IN) ON SCREEN
;<OSMAN.TV>TV.MAC.36, 10-Nov-77 11:07:46, EDIT BY OSMAN
;MAKE 0S AND 0R RETURN CORRECTLY
;<OSMAN.TV>TV.MAC.35, 10-Nov-77 00:27:15, EDIT BY OSMAN
;FIX R$BAR$ AFTER RFOO$BAR$ WHICH IS SUPPOSED TO REPLACE NEXT FOO BY BAR
;<OSMAN.TV>TV.MAC.34, 9-Nov-77 21:16:54, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.33, 9-Nov-77 19:33:06, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.32, 9-Nov-77 19:23:30, EDIT BY OSMAN
;MAKE SURE :S RETURNS -1 OR 0 REGARDLESS OF ARG!
;<OSMAN.TV>TV.MAC.31, 9-Nov-77 14:57:24, EDIT BY OSMAN
;FIX PROBLEM WHEREBY SPURIOUS CHARACTERS WERE BEING CLOBBERED IN LONG FILES
;(BECAUSE MVCST WAS MOVING ONE CHARACTER ASSUMING LEFT TO RIGHT WAS ALRIGHT, EVEN WHEN IT WASN'T)
;<OSMAN.TV>TV.MAC.30, 7-Nov-77 23:49:47, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.29, 7-Nov-77 23:26:36, EDIT BY OSMAN
;CAN'T USE TRVAR IN SEARCH ROUTINE BECAUSE -S CLOBBERS 15
;<OSMAN.TV>TV.MAC.28, 7-Nov-77 22:36:52, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.27, 7-Nov-77 21:44:04, EDIT BY OSMAN
;FIX ;D (IT WAS ACTING LIKE ;U IF GIVEN AFTER ;W)
;<OSMAN.TV>TV.MAC.26, 7-Nov-77 20:45:35, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.25, 7-Nov-77 20:42:23, EDIT BY OSMAN
;REPLACE P3 AND P4 BY OU AND CH SO THAT 15 AND 16 ARE AVAILABLE FOR TRVAR AND FRIENDS
;<OSMAN.TV>TV.MAC.24, 7-Nov-77 19:34:30, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.23, 7-Nov-77 18:52:47, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.22, 6-Nov-77 22:30:36, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.21, 6-Nov-77 22:22:23, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.20, 6-Nov-77 22:19:33, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.19, 6-Nov-77 22:14:49, EDIT BY OSMAN
;DON'T KEEP RECOMPILING SEARCH ON <SFOO$...> (I.E. RECOGNIZE THAT IT'S SAME SEARCH AS LAST TIME)
;REMOVE ^ES (SINCE TECO DOESN'T DO IT THAT WAY)
;<OSMAN.TV>TV.MAC.18, 6-Nov-77 21:05:42, EDIT BY OSMAN
;FIX ^S AND ^ES IN SEARCH STRING TO DO RIGHT THING (THEY WERE BROKE, AND HENCE DOING OPPOSITE)
;<OSMAN.TV>TV.MAC.17, 6-Nov-77 20:41:31, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.16, 6-Nov-77 20:28:38, EDIT BY OSMAN
;ADD ^ES IN SEARCH STRING TO MEAN SAME AS OLD ^S
;<OSMAN.TV>TV.MAC.15, 6-Nov-77 20:01:24, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.14, 6-Nov-77 19:17:29, EDIT BY OSMAN
;ADD WUPDATE$
;<OSMAN.TV>TV.MAC.13, 4-Nov-77 16:19:19, EDIT BY OSMAN
;MAKE 36-CHARACTER SEARCH STRING NOT CAUSE INFINITE LOOP
;<OSMAN.TV>TV.MAC.12, 4-Nov-77 01:37:14, EDIT BY OSMAN
;<OSMAN>TV.MAC.4, 4-Nov-77 01:21:22, EDIT BY OSMAN
;DISPLAY TABS INSTEAD OF LOTS OF SPACES AND REPLACE OR FIX ACCORDING TO WHICH IS BETTER
;<OSMAN>TV.MAC.3, 3-Nov-77 22:29:37, EDIT BY OSMAN
;<OSMAN>TV.MAC.2, 3-Nov-77 22:13:11, EDIT BY OSMAN
;BEFORE CLEARING TO EOL, GET BEYOND GOOD STUFF!!
;<OSMAN.TV>TV.MAC.11, 3-Nov-77 00:48:44, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.10, 3-Nov-77 00:38:39, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.9, 3-Nov-77 00:36:57, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.7, 3-Nov-77 00:02:55, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.6, 2-Nov-77 23:57:58, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.5, 2-Nov-77 23:41:34, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.4, 2-Nov-77 22:55:10, EDIT BY OSMAN
;<OSMAN.TV>TV.MAC.3, 2-Nov-77 22:50:20, EDIT BY OSMAN
;SMARTEN DISPLAY ROUTINE TO ONLY DISPLAY CHANGED CHARACTERS
;<OSMAN.TV>TV.MAC.2, 1-Nov-77 14:27:55, EDIT BY OSMAN
;CHANGE NAME BACK TO "TV.MAC"
;<OSMAN.TV>NEWTV.MAC.162, 1-Nov-77 14:24:59, EDIT BY OSMAN
;FIX V COMMAND SO THAT .,ZV SHOWS /\FOO, IF POINTER JUST BEFORE FOO
;(NOT A CHANGE. THAT'S WHAT IT USED TO DO!)
;<OSMAN.TV>NEWTV.MAC.161, 25-Oct-77 15:26:43, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.160, 25-Oct-77 14:21:21, EDIT BY OSMAN
;SPEED UP BACKWARDS SEARCH (LIKE FORWARD SEARCH)
;<OSMAN.TV>NEWTV.MAC.159, 24-Oct-77 22:56:41, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.158, 24-Oct-77 22:51:43, EDIT BY OSMAN
;SPEED UP SEARCH (AGAIN!) BY SKIPPING N CHECKS IF LAST CHAR OF N FROM BUFFER ISN'T PART OF SEARCH STRING
;<OSMAN.TV>NEWTV.MAC.157, 20-Oct-77 14:09:28, EDIT BY OSMAN
;MAKE "I1717$-C-S17$$" SUCCEED INSTEAD OF "?SEARCH FAILED"
;<OSMAN.TV>NEWTV.MAC.156, 13-Oct-77 11:15:25, EDIT BY OSMAN
;IF BACKUP JFN IS 0, DO GTJFN WITHOUT TRYING OPENF FIRST (AND SET SAVJFN TO 0 WHEN TV STARTS)
;OLD WAY WAS TO DEPEND ON DESX3 FROM OPENF TO MEAN HAVEN'T DONE GTJFN.
;HOWEVER, MONITOR BEING CHANGED TO GIVE DESX1 OR DESX3 DEPENDING ON
;INITIAL GARBAGE IN SAVJFN, SO CHANGE IS CALLED FOR; MIGHT AS WELL DO IT
;"BETTER WAY"
;<OSMAN.TV>NEWTV.MAC.155, 11-Oct-77 09:39:05, EDIT BY OSMAN
;CHANGE ALL REFERENCES OF CPOPJ TO R, AND CPOPJ1 TO RSKP
;<OSMAN.TV>NEWTV.MAC.154, 11-Oct-77 09:35:05, EDIT BY OSMAN
;ON P COMMAND (AND ALSO FOR ;D), CALL ERASE INSTEAD OF TRYING TO KILL BUFFER "MANUALLY"
;<OSMAN.TV>NEWTV.MAC.153, 2-Oct-77 15:26:02, EDIT BY OSMAN
;FIX MBLUP ROUTINE (LARGE BUFFERS DIDN'T WORK TOO WELL)
;<OSMAN.TV>NEWTV.MAC.152, 28-Sep-77 15:07:19, EDIT BY OSMAN
;FIX Y COMMAND TO STOP IF BUFFER IS FULL.
;<OSMAN.TV>NEWTV.MAC.151, 27-Sep-77 13:59:33, EDIT BY OSMAN
;MAKE MVSTR RETURN IMMEDIATELY IF NO CHARACTERS TO MOVE
;<OSMAN.TV>NEWTV.MAC.150, 27-Sep-77 12:29:35, EDIT BY OSMAN
;CHECK FOR LENGTH 0 BEFORE DOING SOUT. (SOUT THINKS 0 MEANS GO UNTIL NULL)
;<OSMAN.TV>NEWTV.MAC.149, 27-Sep-77 12:15:52, EDIT BY OSMAN
;START FIXING "Y" COMMAND
;<OSMAN.TV>NEWTV.MAC.148, 25-Sep-77 20:40:34, EDIT BY OSMAN
;FIX THE GARBAGE COLLECTION BUG ( "<" ROUTINE FORGOT TO STACK COMAX WITH CPTR,COMCNT)
;<OSMAN.TV>NEWTV.MAC.147, 24-Sep-77 01:00:55, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.146, 24-Sep-77 00:58:38, EDIT BY OSMAN
;MAKE SCRNPT AND SCNEND BE CHARACTER ADDRESSES INSTEAD OF BYTE POINTERS
;<OSMAN.TV>NEWTV.MAC.145, 21-Sep-77 23:38:27, EDIT BY OSMAN
;MOVE DIRECT: TO SAVER FORK AREA
;<OSMAN.TV>NEWTV.MAC.144, 21-Sep-77 23:28:28, EDIT BY OSMAN
;REMOVE PRIVATE RSKP: AND R: SO THAT REFERENCES GO TO MACREL
;<OSMAN.TV>NEWTV.MAC.143, 21-Sep-77 23:20:39, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.142, 21-Sep-77 17:12:32, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.141, 21-Sep-77 17:08:06, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.140, 21-Sep-77 16:45:45, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.139, 21-Sep-77 16:08:18, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.138, 21-Sep-77 15:21:00, EDIT BY OSMAN
;MAKE SAVER AND MEMORY IT NEEDS BE CONTIGUOUS AND DO MINIMAL PMAP TO GET IT STARTED
;<OSMAN.TV>NEWTV.MAC.137, 21-Sep-77 14:30:43, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.136, 20-Sep-77 16:13:55, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.135, 20-Sep-77 15:46:35, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.134, 20-Sep-77 01:55:58, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.133, 20-Sep-77 01:48:47, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.132, 20-Sep-77 01:46:59, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.131, 19-Sep-77 21:45:12, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.129, 19-Sep-77 18:36:43, EDIT BY OSMAN
;FINISH CODE THAT RESUMES S AFTER Y DURING _ AND N
;PUT IN NEW FAST SEARCH TO THE LEFT
;TEACH MVSTR HOW TO SHIFT A STRING TO THE RIGHT
;<OSMAN.TV>NEWTV.MAC.79, 13-Aug-77 17:21:14, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.78, 13-Aug-77 17:13:32, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.77, 13-Aug-77 17:04:47, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.75, 13-Aug-77 15:09:00, EDIT BY OSMAN
;MAKE DEFAULTING STRING TO SAME AS LAST TIME WORK
;<OSMAN.TV>NEWTV.MAC.74, 13-Aug-77 14:49:59, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.73, 13-Aug-77 14:46:59, EDIT BY OSMAN
;CHANGE BACKWARDS SEARCH TO NOT USE ADJBP
;MAKE DTB: ENTRY FOR SEARCH COMMAND BE "HRROI"
;MAKE TEXT BUFFER START AT MTBUF0, FLUSH MTBUF
;<OSMAN.TV>NEWTV.MAC.42, 5-Aug-77 20:00:20, EDIT BY OSMAN
;MAKE Z A STANDARD CELL, NO LONGER Z=400000
;REMOVE MYSTERIOUS CHANNEL 2 THAT WAS BEING ENABLED
;<OSMAN.TV>NEWTV.MAC.40, 2-Aug-77 12:21:01, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.38, 1-Aug-77 22:01:30, EDIT BY OSMAN
;MAKE SEARCHING FASTER. ALSO, ALLOW SPECIAL ^E HACK IN SEARCHES
;<OSMAN.TV>NEWTV.MAC.35, 25-Jul-77 22:14:00, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.34, 25-Jul-77 21:05:59, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.33, 25-Jul-77 18:14:32, EDIT BY OSMAN
;REMEMBER THAT SOUTING ENTIRE BUFFER HAS TO BE TWO PARTS TO AVOID HOLE!
;MAKE SCREEN LINE POINTERS IN LINNEW,LINBEG BE CHARACTER ADDRESSES SO
;THAT THEY ARE NOT DEPENDENT ON WHERE HOLE IS.
;<OSMAN.TV>NEWTV.MAC.14, 24-Jul-77 12:58:16, EDIT BY OSMAN
;MAKE SURE PTR2AD ASSURES THAT POINTER ISN'T IN HOLE!
;PUT HOLE IN BUFFER
;<OSMAN.TV>NEWTV.MAC.5, 22-Jul-77 00:37:38, EDIT BY OPERATOR
;<OSMAN.TV>NEWTV.MAC.4, 22-Jul-77 00:22:25, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.3, 21-Jul-77 23:58:49, EDIT BY OSMAN
;<OSMAN.TV>NEWTV.MAC.2, 21-Jul-77 23:45:52, EDIT BY OSMAN
;RESET RELOCATION COUNTER AT END, SO SYS:MACREL GETS LOADED CORRECTLY
;<OSMAN>NEWTV.MAC.2, 21-Jul-77 23:11:59, EDIT BY OSMAN
;ADD ".REQUIRE SYS:MACREL"
;<OSMAN>NEWTV.MAC.1, 21-Jul-77 23:09:40, EDIT BY OSMAN
;ISOLATE ALL INSERTING INTO ONE PLACE: I G N\ NI R ;G
;MAKE "PF" NON-AC, SO THAT AC CAN BE USED AS "P3"
;<OSMAN>TV.MAC.8, 12-Jul-77 12:04:26, EDIT BY OSMAN
;RENAME AC'S TO BE MORE STANDARD.
;<OSMAN>TV.MAC.3, 1-Jun-77 13:10:51, EDIT BY OSMAN
;<OSMAN>TV.MAC.2, 1-Jun-77 12:30:45, EDIT BY OSMAN
;ADD ENTRY VECTOR WITH VERSION NUMBER
;<OSMAN>TV.MAC.1, 17-May-77 14:14:26, EDIT BY OSMAN
;<OSMAN>TV.MAC.129, 17-May-77 13:51:57, EDIT BY OSMAN
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE TV
SEARCH MONSYM,MACSYM
EXTERNAL .RLEND ;SYMBOL SHOWING END OF MACREL
SALL
;TECO FOR TOPS20
WHTV==0 ;LAST EDITED BY DEC
VRTV==4 ;MAJOR VERSION #
RVTV==0 ;REVISION #
EDTV==465 ;EDIT NUMBER
%%RVER==: EDTV ;RHS FOR LINK
%%LVER==: <WHTV>B20+<VRTV>B29+RVTV ;LHS
MAXWTH==^D255 ;MAXIMUM VALUE ALLOWABLE FOR SWIDTH
CPP==5000 ;CHARACTERS PER HARDWARE PAGE
;ACCUMULATOR ASSIGNMENTS
FF=0 ;CONTROL FLAGS
;*** A, b AND c MUST BE CONTIGUOUS AND IN THAT ORDER ***
A=1
B=2 ;BYTE POINTER TO COMMAND BUFFER
;*** c AND d MUST BE ADJACENT AND c .L. 11 ***
C=3 ;COMMAND BUFFER END ADDRESS
D=4
P1=5
P2=6
;*** OU AND CH MUST BE CONSECUTIVE
OU=7
CH=10
T=11
;*** TT AND TT1 MUST BE ADJACENT ***
TT=12
TT1=13
I=14
;*** 15 AND 16 RESERVED FOR TRVAR AND FRIENDS, EXCEPT FOR SEARCH ROUTINE
;*** SAC1 AND SAC2 MUST BE CONSECUTIVE
SAC1=15
SAC2=16
CX=16
P=17
.JBUUO==40 ;UUO WORD
.JB41==41 ;INSTRUCTION EXECUTED BY UUO
OPDEF UERR [01B8]
OPDEF UPSTR [02B8] ;PRINT STRING UUO
OPDEF ULDB [03B8] ;LDB BUT ADJUST BYTE POINTER IF NECESSARY TO AVOID HOLE
OPDEF UILDB [04B8] ;SAME FOR ILDB
OPDEF ULERR [05B8] ;LOCAL ERROR
OPDEF UJERR [06B8] ;JSYS ERROR
OPDEF UJERR [07B8] ;LOCAL JSYS ERROR
OPDEF UIERR [8B8] ;INTERNAL ERROR
OPDEF UCTYPE [9B8] ;SINGLE CHARACTER
;ERROR MACRO
DEFINE ERROR ($MSG)< UERR [ASCIZ \$MSG\]>
;INTERNAL ERROR (NOT USER ERROR)
DEFINE IERROR ($MSG)< UIERR [ASCIZ \TV: internal error - $MSG\]>
;JSYS ERROR
DEFINE JERROR ($MSG)< UJERR [ASCIZ \$MSG\]>
;LOCAL JSYS ERROR
DEFINE LJERR ($MSG)< UJERR [ASCIZ \$MSG\]>
;LOCAL ERROR MACRO (LIKE ERROR, BUT RETURNS)
DEFINE LERROR ($MSG)< ULERR [ASCIZ \$MSG\]>
;PRINT STRING MACRO
DEFINE PSTR ($MSG)< UPSTR [ASCIZ \$MSG\]>
;PRINT LITERAL CHARACTER
DEFINE CTYPE (CHAR)< UCTYPE "CHAR">
;MACROS WHICH EXPAND INTO COMND JSYS FUNCTION BLOCKS...
DEFINE NOISEX (MESSAG)
< FLDDB. .CMNOI,,<-1,,[ASCIZ /MESSAG/]>
>
DEFINE C.(WHAT)
<DEFINE WHAT'X
< FLDDB. .'WHAT
>>
C. CMINI
C. CMCFM
C. CMIFI
C. CMFIL
C. CMFLD
C. CMCFM
C. CMOFI
UMODF==1B5 ;USER MODE FLAG IN PC WORD
;MAJOR BUFFER ASSIGNMENTS
CBUF=50000 ;BUFFER FOR TYPIN AND QREG TEXT
MTBUF0==400000 ;MAIN TEXT AREA
BBUF1==100000 ;BACKUP BUFFERS IN LOWER FORK (LOWER FORK COPY'S ONE TO DISK WHILE WE USE OTHER ONE)
BBUF2==400000
EMTBUF=765000 ;END OF MAIN BFR AREA (FIRST PAGE BEYOND END OF BUFFER, LEAVE ROOM FOR DDT!)
;CONTROL FLAGS
ALTF==1 ;ALT-MODE SEEN
ARG2==2 ;THERE IS A SECOND ARGUMENT
ARG==4 ;THERE IS AN ARGUMENT
;10 AVAILABLE
;USED TO BE ITERF, BUT INTDPH SEEMED TO MAKE ITERF REDUNDANT
SLSL==20 ;@ SEEN
PCHFLG==40 ;N SEARCH
COLONF==100 ;COLON SEEN
SYLF==200 ;SYLLABLE FLAG
RUBCF==400 ;RUBOUT IN OUTPUT TO FILE
;1000 AVAILABLE
FINDR==2000 ;LEFT ARROW SEARCH
RPLFG==4000 ;I REPLACE COMMAND
NOTF==10000 ;^N SEARCH MODIFIER
TRACEF==20000 ;? SEEN
DDTMF==200000 ;NEED TO TYI IN DDT MODE
FORM==400000 ;FORM FEED TERMINATED LAST Y OR A
RSCNF2==1,,0 ;SAYS RESCANNED DATA AVAILABLE
RSCANF==2,,000000 ;SAYS WE'RE USING RESCANNED DATA
FINF==100,,0 ;INPUT CLOSED BY EOF
UREAD==1B10 ;INPUT FILE IS OPEN
UWRITE==1B9 ;OUTPUT FILE IS OPEN
DUMPF==1B8 ;FULL FILE OPERATION IN PROGRESS (LIKE ;U ;X)
SCANF==1B7 ;SET IF SCANNING (LIKE FOR CLOSE ANGLE BRACKET OR APOSTROPHE)
PCHAR=="*" ;PROMPT CHARACTER
CFLAG=="'" ;CHAR FOR FLAGGING "WRONG CASE" CHARACTERS
C.CAD=="N"-100 ;vt05 cursor addressing character
C.LM==37 ;add column or row to get there on vt05
C.MORE==40 ;CHARACTER TO CONTINUE DISPLAY
C.TOP==37 ;same
C.QUOT=="V"-100 ;QUOTE ONE CHARACTER
C.LOWR=="A"-100 ;LOWERCASE SHIFT
C.RAIS=="B"-100 ;UPPERCASE SHIFT
;VT05 ESCAPE CODES...
C.UP=="Z"-100 ;-L
C.DOWN=="K"-100 ;+L
C.LEFT=="H"-100 ;-c
C.RITE=="X"-100 ;+c
C.EOL=="^"-100 ;CLEAR TO END OF LINE
;VT50, VT52 ESCAPE CODES, MUST BE PRECEDED BY ALTMODE
V52.ES==33
V52.UP==101
V52.DN==102
V52.RT==103
V52.LT==104
V52.EL==113 ;CLEAR TO END OF LINE
;STORAGE
LPDL=200
GCTBL=100
LPF=200 ;At least enough room for saving all the qregs
OTABL=110 ;LENGTH FOR TAGS FOR "O" COMMAND
LOC 140
;ENTRY VECTOR
GOGO: JRST TECO ;START ADDRESS
JRST REE ;REENTER ADDRESS
%%LVER,,%%RVER ;VERSION NUMBER
ENLEN==.-GOGO ;LENGTH OF ENTRY VECTOR
;CHARACTER TABLE. ALLOWS RAISING, LOWERING, ETC. IN ONE INSTRUCTION.
CH%Q==1B0 ;Q-REG COMMANDS
CH%UPR==1B1 ;BIT TO MEAN CHARACTER IS CAPITAL LETTER
LWRFLD==177B8
UPRFLD==177B15
MSKSTR LWRCOD,CHRTAB,LWRFLD ;LOWERCASE VERSION OF CHARACTER
MSKSTR UPRCOD,CHRTAB,UPRFLD ;UPPERCASE VERSION
CH%CAR==1B16 ;CARE IS NEEDED WHEN SCANNING THIS CHARACTER AS A COMMAND
CH%SCR==1B17 ;CARE NEEDED FOR THIS CHARACTER AS A SEMI-COLON COMMAND
CH%VAL==1B18 ;COMMAND SOMETIMES RETURNS A VALUE (SEE CH%TOR)
CH%SVL==1B19 ;SEMI-COMMAND RETURNS A VALUE
CH%TOR==1B20 ;COMMAND TAKES OR RETURNS A VALUE (BUT NOT BOTH!)
CH%ANA==1B21 ;ARGUMENT NOT ALLOWED
CH%SNA==1B22 ;SEMI-COLON FLAVOR CAN'T TAKE AN ARG
;... ;ADD OTHER GOODIES, LIKE BITS TO TEST CHARACTER FLAVOR
CHRTAB: FLD(0,LWRFLD)!FLD(0,UPRFLD)
FLD(1,LWRFLD)!FLD(1,UPRFLD)!CH%CAR
FLD(2,LWRFLD)!FLD(2,UPRFLD)
FLD(3,LWRFLD)!FLD(3,UPRFLD)
FLD(4,LWRFLD)!FLD(4,UPRFLD)
FLD(5,LWRFLD)!FLD(5,UPRFLD)!CH%VAL!CH%TOR
FLD(6,LWRFLD)!FLD(6,UPRFLD)
FLD(7,LWRFLD)!FLD(7,UPRFLD)
FLD(10,LWRFLD)!FLD(10,UPRFLD)!CH%VAL
FLD(11,LWRFLD)!FLD(11,UPRFLD)!CH%CAR!CH%VAL!CH%TOR!CH%ANA
FLD(12,LWRFLD)!FLD(12,UPRFLD)
FLD(13,LWRFLD)!FLD(13,UPRFLD)
FLD(14,LWRFLD)!FLD(14,UPRFLD)
FLD(15,LWRFLD)!FLD(15,UPRFLD)
FLD(16,LWRFLD)!FLD(16,UPRFLD)
FLD(17,LWRFLD)!FLD(17,UPRFLD)
FLD(20,LWRFLD)!FLD(20,UPRFLD)
FLD(21,LWRFLD)!FLD(21,UPRFLD)
FLD(22,LWRFLD)!FLD(22,UPRFLD)
FLD(23,LWRFLD)!FLD(23,UPRFLD)
FLD(24,LWRFLD)!FLD(24,UPRFLD)
FLD(25,LWRFLD)!FLD(25,UPRFLD)
FLD(26,LWRFLD)!FLD(26,UPRFLD)
FLD(27,LWRFLD)!FLD(27,UPRFLD)
FLD(30,LWRFLD)!FLD(30,UPRFLD)!CH%VAL!CH%TOR
FLD(31,LWRFLD)!FLD(31,UPRFLD)
FLD(32,LWRFLD)!FLD(32,UPRFLD)
FLD(33,LWRFLD)!FLD(33,UPRFLD)
FLD(34,LWRFLD)!FLD(34,UPRFLD)
FLD(35,LWRFLD)!FLD(35,UPRFLD)
FLD(36,LWRFLD)!FLD(36,UPRFLD)!CH%CAR!CH%VAL
FLD(37,LWRFLD)!FLD(37,UPRFLD)
FLD(40,LWRFLD)!FLD(40,UPRFLD)!CH%CAR
FLD(41,LWRFLD)!FLD(41,UPRFLD)!CH%CAR
FLD(42,LWRFLD)!FLD(42,UPRFLD)!CH%CAR
FLD(43,LWRFLD)!FLD(43,UPRFLD)!CH%CAR
FLD(44,LWRFLD)!FLD(44,UPRFLD)
FLD(45,LWRFLD)!FLD(45,UPRFLD)!CH%VAL
FLD(46,LWRFLD)!FLD(46,UPRFLD)!CH%CAR
FLD(47,LWRFLD)!FLD(47,UPRFLD)!CH%CAR
FLD(50,LWRFLD)!FLD(50,UPRFLD)!CH%CAR
FLD(51,LWRFLD)!FLD(51,UPRFLD)!CH%CAR
FLD(52,LWRFLD)!FLD(52,UPRFLD)!CH%CAR
FLD(53,LWRFLD)!FLD(53,UPRFLD)!CH%CAR
FLD(54,LWRFLD)!FLD(54,UPRFLD)!CH%CAR
FLD(55,LWRFLD)!FLD(55,UPRFLD)!CH%CAR
FLD(56,LWRFLD)!FLD(56,UPRFLD)!CH%CAR
FLD(57,LWRFLD)!FLD(57,UPRFLD)!CH%CAR
FLD(60,LWRFLD)!FLD(60,UPRFLD)!CH%CAR
FLD(61,LWRFLD)!FLD(61,UPRFLD)!CH%CAR
FLD(62,LWRFLD)!FLD(62,UPRFLD)!CH%CAR
FLD(63,LWRFLD)!FLD(63,UPRFLD)!CH%CAR
FLD(64,LWRFLD)!FLD(64,UPRFLD)!CH%CAR
FLD(65,LWRFLD)!FLD(65,UPRFLD)!CH%CAR
FLD(66,LWRFLD)!FLD(66,UPRFLD)!CH%CAR
FLD(67,LWRFLD)!FLD(67,UPRFLD)!CH%CAR
FLD(70,LWRFLD)!FLD(70,UPRFLD)!CH%CAR
FLD(71,LWRFLD)!FLD(71,UPRFLD)!CH%CAR
FLD(72,LWRFLD)!FLD(72,UPRFLD)
FLD(73,LWRFLD)!FLD(73,UPRFLD)!CH%CAR
FLD(74,LWRFLD)!FLD(74,UPRFLD)!CH%CAR
FLD(75,LWRFLD)!FLD(75,UPRFLD)
FLD(76,LWRFLD)!FLD(76,UPRFLD)!CH%CAR
FLD(77,LWRFLD)!FLD(77,UPRFLD)
FLD(100,LWRFLD)!FLD(100,UPRFLD)!CH%CAR
CH%UPR!FLD(141,LWRFLD)!FLD(101,UPRFLD)!CH%VAL
CH%UPR!FLD(142,LWRFLD)!FLD(102,UPRFLD)!CH%CAR
CH%UPR!FLD(143,LWRFLD)!FLD(103,UPRFLD)
CH%UPR!FLD(144,LWRFLD)!FLD(104,UPRFLD)
CH%UPR!FLD(145,LWRFLD)!FLD(105,UPRFLD)!CH%SCR
CH%UPR!FLD(146,LWRFLD)!FLD(106,UPRFLD)!CH%CAR!CH%SCR
CH%Q!CH%UPR!FLD(147,LWRFLD)!FLD(107,UPRFLD)
CH%UPR!FLD(150,LWRFLD)!FLD(110,UPRFLD)!CH%CAR
CH%UPR!FLD(151,LWRFLD)!FLD(111,UPRFLD)!CH%CAR
CH%UPR!FLD(152,LWRFLD)!FLD(112,UPRFLD)
CH%UPR!FLD(153,LWRFLD)!FLD(113,UPRFLD)
CH%UPR!FLD(154,LWRFLD)!FLD(114,UPRFLD)
CH%Q!CH%UPR!FLD(155,LWRFLD)!FLD(115,UPRFLD)!CH%SCR
CH%UPR!FLD(156,LWRFLD)!FLD(116,UPRFLD)!CH%CAR!CH%SVL
CH%UPR!FLD(157,LWRFLD)!FLD(117,UPRFLD)!CH%CAR
CH%UPR!FLD(160,LWRFLD)!FLD(120,UPRFLD)!CH%SVL
CH%UPR!FLD(161,LWRFLD)!FLD(121,UPRFLD)!CH%CAR!CH%VAL
CH%UPR!FLD(162,LWRFLD)!FLD(122,UPRFLD)!CH%CAR!CH%SCR
CH%UPR!FLD(163,LWRFLD)!FLD(123,UPRFLD)!CH%CAR
CH%UPR!FLD(164,LWRFLD)!FLD(124,UPRFLD)!CH%SCR
CH%Q!CH%UPR!FLD(165,LWRFLD)!FLD(125,UPRFLD)!CH%SNA
CH%UPR!FLD(166,LWRFLD)!FLD(126,UPRFLD)
CH%UPR!FLD(167,LWRFLD)!FLD(127,UPRFLD)!CH%CAR!CH%SCR
CH%Q!CH%UPR!FLD(170,LWRFLD)!FLD(130,UPRFLD)
CH%UPR!FLD(171,LWRFLD)!FLD(131,UPRFLD)
CH%UPR!FLD(172,LWRFLD)!FLD(132,UPRFLD)!CH%CAR
CH%Q!FLD(133,LWRFLD)!FLD(133,UPRFLD)
FLD(134,LWRFLD)!FLD(134,UPRFLD)!CH%VAL!CH%TOR
CH%Q!FLD(135,LWRFLD)!FLD(135,UPRFLD)
FLD(136,LWRFLD)!FLD(136,UPRFLD)
FLD(137,LWRFLD)!FLD(137,UPRFLD)!CH%CAR
FLD(140,LWRFLD)!FLD(140,UPRFLD)
FLD(141,LWRFLD)!FLD(101,UPRFLD)!CH%VAL
FLD(142,LWRFLD)!FLD(102,UPRFLD)!CH%CAR
FLD(143,LWRFLD)!FLD(103,UPRFLD)
FLD(144,LWRFLD)!FLD(104,UPRFLD)
FLD(145,LWRFLD)!FLD(105,UPRFLD)!CH%SCR
FLD(146,LWRFLD)!FLD(106,UPRFLD)!CH%CAR!CH%SCR
CH%Q!FLD(147,LWRFLD)!FLD(107,UPRFLD)
FLD(150,LWRFLD)!FLD(110,UPRFLD)!CH%CAR
FLD(151,LWRFLD)!FLD(111,UPRFLD)!CH%CAR
FLD(152,LWRFLD)!FLD(112,UPRFLD)
FLD(153,LWRFLD)!FLD(113,UPRFLD)
FLD(154,LWRFLD)!FLD(114,UPRFLD)
CH%Q!FLD(155,LWRFLD)!FLD(115,UPRFLD)!CH%SCR
FLD(156,LWRFLD)!FLD(116,UPRFLD)!CH%CAR!CH%SVL
FLD(157,LWRFLD)!FLD(117,UPRFLD)!CH%CAR
FLD(160,LWRFLD)!FLD(120,UPRFLD)!CH%SVL
FLD(161,LWRFLD)!FLD(121,UPRFLD)!CH%CAR!CH%VAL
FLD(162,LWRFLD)!FLD(122,UPRFLD)!CH%CAR!CH%SCR
FLD(163,LWRFLD)!FLD(123,UPRFLD)!CH%CAR
FLD(164,LWRFLD)!FLD(124,UPRFLD)!CH%SCR
CH%Q!FLD(165,LWRFLD)!FLD(125,UPRFLD)!CH%SNA
FLD(166,LWRFLD)!FLD(126,UPRFLD)
FLD(167,LWRFLD)!FLD(127,UPRFLD)!CH%CAR!CH%SCR
CH%Q!FLD(170,LWRFLD)!FLD(130,UPRFLD)
FLD(171,LWRFLD)!FLD(131,UPRFLD)
FLD(172,LWRFLD)!FLD(132,UPRFLD)!CH%CAR
FLD(173,LWRFLD)!FLD(173,UPRFLD)
FLD(174,LWRFLD)!FLD(174,UPRFLD)
FLD(175,LWRFLD)!FLD(175,UPRFLD)
FLD(176,LWRFLD)!FLD(176,UPRFLD)
FLD(177,LWRFLD)!FLD(177,UPRFLD)
;START HERE FOR DEBUGGING. THIS ENTRY MAKES TV THINK YOU STARTED
;IT WITH THE COMMAND "TV FOO.BAR"
DEBUG: HRROI A,[ASCIZ /TV FOO.BAR
/]
RSCAN
JSHLT
SETOM VIRGIN ;SO RSCAN STUFF HAPPENS ON RESTART
JRST TECO
;STARTUP TIME INITIALIZATION
TECO: RESET
AOS VIRGIN ;VIRGIN 0 MEANS PROGRAM HASN'T BEEN RUN
MOVE A,[XWD FIRSTV,FIRSTV+1]
SETZM FIRSTV ;CLEAR VARIABLES AREA
BLT A,TOP
;SET UP LUUO DISPATCH FOR SECTION 0 AND ALL OTHER SECTIONS
MOVE A,[CALL S0UUOH] ;SETUP SECTION 0 UUO DISPATCH
MOVEM A,.JB41
XMOVEI A,S1UUOH ;SETUP NON-ZERO SECTION UUO DISPATCH
MOVEM A,UUOB+.ARNPC
MOVEI A,.FHSLF
MOVEI B,.SWLUT ;FUNCTION CODE
XMOVEI C,UUOB ;ADDRESS OF LUUO BLOCK
SWTRP% ;REQUEST UUO TRAPPING IN NON-0 SECTIONS
;MISCELLANEOUS SET UP
MOVE P,[XWD -LPDL,PDL-1]
MOVEI A,"!"
MOVEM A,LASTCH ;DISPLAY CONTINUATION CHARACTER
MOVSI A,(ASCII A/\A)
MOVEM A,PTRCHR ;WHAT POINTER LOOKS LIKE ON SCREEN
SETOM BAKFLG ;DEFAULT IS TO SAVE COMMAND STRINGS.
SETOM LPM ;GUARANTEE INITIAL PMAP
SETOM LPM2
MOVX A,RD%JFN+RD%BBG+RD%BEG ;JFNS AND DESTINATION POINTER GIVEN, RETURN WHEN EVERYTHING DELETED
MOVEM A,RDFLG ;STORE FLAGS
MOVEI A,RDEND-RDCWB ;CALCULATE SIZE OF TEXTI BLOCK
MOVEM A,RDCWB
MOVEI A,[EXP 1B<.CHESC>,0,0,0] ;WAKE UP ON ALTMODE
MOVEM A,RDBRK
MOVSI A,(<RET>)
MOVEM A,TRACS
MOVEI A,CBUF+200 ;ADR OF TEXT BUFFER
IMULI A,5 ;CHR ADDR OF BEGINNING
MOVEM A,QRBUF
MOVEM A,EQRBUF ;SETUP END OF QREG BUF
MOVEI A,MTBUF0 ;SETUP MAIN TEXT BUFFER ADDRESSES
IMULI A,5
MOVEM A,BEG
MOVEM A,PT
MOVEM A,ZEE
MOVE I,BEG
MOVEM I,SCRNPT ;FOR DISPLAY ROUTINE
MOVEI A,CBUF+77
MOVEM A,CBUFH
MOVEI A,CBUF
MOVEM A,LSTCB
MOVEM A,LSTCE
MOVEI A,SYL
MOVEM A,DLIM
MOVEI FF,0 ;CLEAR FLAG REGISTER
MOVEI A,.PRIOU ;GET CONTROL SETTINGS BEFORE THEY GET CHANGED
RFCOC ;GET CONTROL CHARACTER SETTINGS
TRO C,600000 ;MAKE SURE ALTMODE ECHOES AS $
DMOVEM B,REGCWD ;REMEMBER SETTING
MOVSI A,(CR%CAP+CR%ACS)
XMOVEI B,[SAVPDL]-17 ;LOAD SAVER'S AC17 WITH STACK ADDRESS
CFORK ;COMMAND SAVER WITH INITIALIZED STACK POINTER, SAME CAPABILITIES AS US
JSHLT
SETOM SDONEF ;ASSUME SAVER IS INITIALLY "DONE"
MOVEM A,SAVFRK ;REMEMBER FORK HANDLE
SETZM SAVJFN ;SAY NO JFN YET ON BACKUP FILE
XMOVEI A,SAVBEG ;GET ADDRESS OF START OF WINDOW
LSH A,-11 ;CONVERT TO PROCESS PAGE #
HRLI A,.FHSLF ;SOURCE FORK HANDLE ,, PAGE #
MOVEI B,SAVBEG_-9 ;CREATE WINDOW FROM SAVER FORK TO US
HRL B,SAVFRK
MOVE C,[PM%CNT+PM%RD+PM%WR+PM%EX+<SAVEND-SAVBEG>_-9+2]
PMAP
CALL HK ;KILL THE ENTIRE BUFFER
MOVEI A,^D50 ;DEFAULT NUMBER OF CHARACTERS BETWEEN SAVES
MOVEM A,BAKLEN
SETZM BBLEN ;NOTHING IN BACKUP BUFFER YET
SETZM OBBLEN
MOVE A,[440700,,BBUF1] ;INITIALIZE POINTER TO BACKUP BUFFER
MOVEM A,BBPTR
MOVEM A,BBUFX
SETZM WTOGGL ;START WITH FIRST WINDOW
HRROI A,-1 ;GET INFO ABOUT OUR JOB.
MOVE B,[-1,,P2] ;GET ONE PIECE OF INFORMATION INTO "p2"
MOVEI C,.JILNO ;LOGGED-IN DIRECTORY NUMBER
GETJI ;GET LOGGED-IN DIR NUMBER INTO p2
JSHLT
GDS: HRROI A,DIRECT ;PUT DIRECTORY NAME IN "DIRECT"
MOVE B,P2 ;b HOLDS DIRECTORY NUMBER
DIRST ;GET DIRECTORY NAME FROM MONITOR
JSHLT
CALL SETIO ;RESET IO
MOVEI A,101 ;USE PRIMARY OUTPUT
MOVEM A,TTYOUT ;SAVE CHANNEL
CALL CMDINI ;INITIALIZE FOR COMND JSYS
CALL RESCAN ;MAKE RESCANNED DATA AVAILABLE
DMOVE A,[EXP INIFIL,<-1,,DIRECT>]
GTJFN ;TRY TO ACCESS <USER>TV.INI
JRST NOINI ;ASSUME NONE
MOVE B,[70000,,200000]
OPENF ;OPEN IT FOR READING
JRST NOINI ;COULDN'T, SO ASSUME NONE EXISTS
MOVEM A,INIJFN ;REMEMBER JFN OF INI FILE
NOINI: CALL SYSMOD ;get system's terminal characteristics
CALL SETMOD ;SET UP CTRL/CHARACTER ECHOING (RESET DOESN'T DO THAT!)
SKIPE SCRNF ;LEAVE WINDOW SIZE 0 UNLESS TERMINAL IS A SCREEN
CALL WINSTN ;SET WINDOW SIZE UP (ONLY HERE, SO AFTER REENTER, CUSTOM WINDOW SIZE DOESN'T GET CLOBBERED)
JRST GOX
;ROUTINE TO ENABLE RESCANNED DATA IF AVAILABLE
ENARES: TXZN FF,RSCNF2 ;RESCANNED DATA AVAILABLE?
RET ;NO
TXO FF,RSCANF ;YES, ENABLE IT
RET
;THE FOLLOWING CODE SUPPORTS THE OPTION OF THE USER INITIATING THIS
;PROGRAM WITH AN EXEC COMMAND LINE LOOKING LIKE:
;
; @NAME FILE.EXT
;
;WHERE "NAME" IS WHATEVER NAME THIS VERSION OF TECO IS SAVED AS AND
;"FILE.EXT" IS THE FILE THE USER WISHES TO EDIT. THE EFFECT IS JUST
;AS THOUGH THE TYPESCRIPT HAD ORIGINALLY BEEN:
;
; @NAME
; *;Y$
; INPUT FILE: FILE.EXT
;
RESCAN: CALL RESC1 ;DO MOST OF THE WORK
CAIA ;IF NOT RESCANNING, THROW AWAY REST OF LINE
RET
CALL RSCNT ;NO, SEE HOW MANY CHARACTERS LEFT TO READ
JUMPE A,R ;JUST RETURN IF NONE
MOVN C,A ;THAT MANY TO READ
MOVEI A,100 ;READ FROM PRIMARY
MOVEI B,0 ;DON'T REALLY READ THEM TO ANYWHERE
SIN ;THROW THEM AWAY
RET
;ROUTINE TO RETURN IN A NUMBER OF RSCAN CHARACTERS LEFT TO READ
RSCNT: MOVEI A,.RSCNT ;CODE FOR GETTING NUMBER
RSCAN ;ASK SYSTEM WHAT NUMBER IS
MOVEI A,0 ;SAY 0 IF ERROR
RET
RESC1: STKVAR <CREAF>
SKIPE VIRGIN
RET ;IF PROGRAM IS RESTARTED, NO MESSING AROUND ALLOWED
SETZM CREAF ;NOT CREATE COMMAND YET
MOVEI A,0
RSCAN ;CAUSE ORIGINAL COMMAND LINE TO BE AVAILABLE AS INPUT
RET ;COULDN'T EVEN DO THAT !!
CALL RSCNT ;GET NUMBER OF CHARACTERS AVAILABLE
JUMPE A,R ;JUMP IF NONE
MOVEI A,0 ;NO PROMPT
CALL READY ;INITIALIZE FOR COMND JSYS
MOVEI A,[CMFLDX] ;READ PROGRAM NAME AS FIELD
CALL RFIELD ;READ IT INTO ATOM BUFFER
RET ;IF CAN'T, GIVE UP
GETNM ;FIND OUT WHAT PROGRAM NAME WE'RE RUNNING AS
MOVE C,A ;PUT OU SIXBIT NAME IN c
MOVE P1,[440600,,C] ;AND A BYTE POINTER TO IT IN p1
MOVE P2,[440700,,ATMBFR] ;PREPARE TO READ CHARACTERS FROM PROGRAM NAME
RSCANR: CAMN P1,[600,,C] ;THEY AGREED BUT WEREN'T SPACES, SO NOW
JRST RSCAN2 ;IF ENTIRE NAME HAS MATCHED, STOP COMPARING
ILDB B,P1 ;PICK UP A LETTER FROM OUR NAME
JUMPE B,RSCAN2 ;JUMP IF NAME MATCHES (BECAUSE WE RAN OUT BEFORE SIX CHARS)
ILDB CH,P2 ;READ A CHARACTER OF THE COMMAND LINE
LOAD CH,UPRCOD,(CH) ;DO ALL COMPARISONS IN UPPER CASE
CAIN CH,"A"-'A'(B) ;SEE IF LETTER FROM COMAND LINE IS SAME AS OUR NAME LETTER
JRST RSCANR ;CONTINUE COMPARING NAME
HRROI A,ATMBFR ;NAME DIFFERED, LOOK AT COMMAND LINE AGAIN
HRROI B,[ASCIZ /EDIT/]
STCMP ;IS IT AN "EDIT" COMMAND?
JUMPE A,RSCAN2 ;YES, O.K.
HRROI A,ATMBFR ;NOT "EDIT", MAYBE "CREATE"
HRROI B,[ASCIZ /CREATE/]
STCMP
JUMPE A,[ SETOM CREAF ;YES, "CREATE"
JRST RSCAN2]
RET ;NOT RECOGNIZABLE COMMAND, DON'T USE RESCANNED DATA
RSCAN2: MOVEI A,[NOISEX (FILE)]
CALL RFIELD ;CHECK FOR NOISE WORDS
RET ;DON'T DO RESCANNING IF FAILS
CALL CONFRM ;see if end of line
CAIA ;NO END OF LINE
RET ;END OF LINE, SO NO FILESPEC COMING
SKIPE CREAF ;DOING CREATE COMMAND?
JRST RSOUT ;YES, PARSE OUTPUT SPEC
MOVEI A,[CMIFIX] ;read input file
CALL READFL ;read filespec from terminal
SKIPE GTJERR ;DID WE GET A SUCCESSFUL INPUT SPEC?
JRST RS3 ;NO, SO DON'T PARSE OUTPUT SPEC
MOVEI A,[NOISEX (OUTPUT AS)]
CALL RFIELD ;PERHAPS AN OUTPUT SPEC SUPPLIED
JRST RS3 ;NO
RSOUT: MOVEI A,[CMOFIX] ;READ OUTPUT SPEC
CALL RFIELD
JRST RS3 ;DON'T OPEN OUTPUT FILE IF CAN'T READ NAME
MOVEM B,CREJFN ;REMEMBER JFN FOR CREATE COMMAND
RS3: SKIPN CREAF ;NO RESCANNED DATA AVAILABLE IF CREATE COMMAND
TXO FF,RSCNF2 ;NOTE THAT RESCANNED DATA AVAILABLE
RETSKP ;SKIP TO MARK THAT COMMAND LINE WAS GIVEN
;ROUTINE TO INITIALIZE FOR COMMAND LINE. IT TAKES EITHER 0 OR A BYTE POINTER
;IN A TO PROMPT STRING.
READY: CAIN A,0 ;ANY PROMPT?
HRROI A,[0] ;NO, POINT TO A NULL STRING
MOVEM A,SBK+.CMRTY ;SAVE POINTER TO PROMPT
POP P,REPARA ;REMEMBER REPARSE ADDRESS
DMOVEM 0,CMDACS+0 ;SAVE AC'S
MOVE 1,[2,,CMDACS+2]
BLT 1,CMDACS+17
MOVE A,[PDL,,CMDPDL] ;PREPARE TO SAVE ENTIRE STACK
HRRZI B,-PDL(P) ;FIGURE HOW MANY WORDS TO SAVE (MINUS 1)
BLT A,CMDPDL(B) ;SAVE THE STACK
PUSH P,REPARA ;MAKE STACK LIKE IT WAS
HRL A,TYIJFN ;SOURCE OF COMMAND
HRRI A,101 ;REGULAR PRIMARY OUTPUT
MOVEM A,SBK+.CMIOJ
MOVEI A,[CMINIX] ;TYPE PROMPT
CALL RFIELD
JFCL ;SHOULDN'T FAIL
RET ;RETURN TO CALLER
;COME HERE IF REPARSE IS NEEDED (BECAUSE USER EDITED INTO PARSED STUFF)
REPARS: MOVE P,CMDACS+P ;RESTORE P FIRST SO WE KNOW HOW MUCH STACK TO RESTORE
MOVE A,[CMDPDL,,PDL] ;PREPARE TO RESTORE STACK
BLT A,(P) ;RESTORE THE STACK
MOVSI 16,CMDACS
BLT 16,16 ;RESTORE AC'S
HRRZ 16,REPARA ;GET LOCAL ADDRESS TO RETURN TO
JRST (16) ;RETURN TO BEGINNING OF COMMAND LINE
;routine which checks for line confirmation (cr or lf) and skips
;if so
CONFRM: MOVEI A,[CMCFMX] ;CHECK FOR END OF LINE
CALL RFIELD
RET ;no skip if no confirmation
RETSKP
;READ A FIELD ROUTINE. GIVE IT ADDRESS OF FUNCTION BLOCK IN A.
;IT SKIPS IFF COMND GIVES A SUCCESSFUL RETURN. A AND B WILL HAVE
;RESULT OF COMND JSYS IN THEM.
RFIELD: STKVAR <CFCN>
SETOM WINFLG ;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL PREVIOUS OUTPUT
MOVEM A,CFCN ;SAVE FUNCTION
RF1: MOVE B,CFCN ;PUT FUNCTION BLOCK POINTER IN B
MOVEI A,SBK ;POINTER TO STATE BLOCK IN A
COMND ;READ FIELD OF COMND
ERJMP CMDERR ;ERROR IN COMND JSYS
TXNE A,CM%NOP ;DID COMMAND PARSE CORRECTLY?
RET ;NO, SO SINGLE RETURN
RETSKP ;YES, SO SKIP RETURN
CMDERR: CALL %GETER ;GET REASON FOR ERROR
HRRZ B,A ;LEAVE ERROR CODE IN B
CAIN B,IOX4 ;END OF FILE?
JRST CMDE1 ;YES, GO HANDLE IT
TXO A,CM%NOP ;DESIGNATE NO PARSE
RET ;RETURN NON-SKIP
CMDE1: CALL TYIPOP ;GET BACK TO LAST INPUT STREAM
JRST RF1 ;RETRY COMND JSYS
;ROUTINE TO RETURN LAST ERROR FOR OURSELF IN A.
%GETER: MOVEI A,.FHSLF ;OURSELF
GETER ;GET ERROR CODE
HRRZ A,B ;RETURN CODE IN A
RET
;COMND JSYS INITIALIZATION ROUTINE. CALL ONLY ONCE AT BEGINNING OF
;PROGRAM.
CMDINI: MOVEI A,REPARS ;REPARSE ADDRESS
MOVEM A,SBK+.CMFLG
HRROI A,CMDBFR ;POINTER TO COMMAND BUFFER
MOVEM A,SBK+.CMBFP
MOVEM A,SBK+.CMPTR ;POINTER TO NEXT FIELD
MOVEI A,CMDBLN*5 ;ROOM FOR TYPIN
MOVEM A,SBK+.CMCNT
SETZM SBK+.CMINC ;NO UNPARSED CHARACTERS YET
HRROI A,ATMBFR ;POINTER TO ATOM BUFFER
MOVEM A,SBK+.CMABP
MOVEI A,ATMBLN*5
MOVEM A,SBK+.CMABC ;ROOM IN ATOM BUFFER
MOVEI A,CJFNBK ;POINTER TO JFN BLOCK
MOVEM A,SBK+.CMGJB
RET
;CALL THE FOLLOWING TO RESET TERMINAL IO (AT STARTUP AND REENTER)
SETIO: MOVEI A,100
MOVEM A,TYIPDL ;PUSH TTY INPUT ONTO TYPIN STACK
MOVEM A,TYIJFN ;INITIAL TYPIN JFN IS TERMINAL
MOVE A,[1-TYILEN,,TYIPDL] ;INITIALIZE IO STACK
MOVEM A,TYIP
SETOM TERIO ;ASSUME INITIAL INPUT IS A TERMINAL
RET
;CALL HERE DURING STARTUP TO ENABLE CTRL/C TRAPPING.
ENACC: MOVEI A,.FHSLF ;OURSELF
RPCAP ;GET CURRENT CAPABILITIES
TXO C,SC%CTC
EPCAP ;ENABLE CTRL/C TRAPPING
MOVE A,[3,,2] ;CTRL/C TRAPPING IS ON CHANNEL 2
ATI ;TRY TO ENABLE CTRL/C
ERJMP .+1 ;QUIETLY FAIL IF USER SAID "SET NO CONTROL-C"
RET
REE: DMOVE A,[EXP PC%USR,REE0] ;GET FLAGS AND PC
HLL B,LEVTAB ;MERGE SECTION # INTO PC
XJRSTF A ;GET TO REE0 IN PROPER SECTION
REE0: MOVE P,[XWD -LPDL,PDL-1] ;INITIALIZE PUSHDOWN LIST
TXZ FF,RSCANF+RSCNF2 ;NO MORE RESCANNING ON REENTER
CALL SETIO ;ALWAYS RESET IO ON REENTER
CALL SYSMOD ;get system's terminal modes
CALL SETMOD ;SET UP CTRL/CHARACTER ECHOING, ^C OUT OF JSYS MAY LEAVE IT WRONG
SETZM INIJFN ;NO LONGER DOING INITIALIZATION
GOX: SETZM UPDATF ;NOT DOING WUPDATE YET
SETZM QUOJFN ;NO JFN CURRENTLY BEING OUTPUT TO
CALL CLRSCN ;MAYBE CLEAR THE SCREEN
SETOM WINFLG ;SO DISPLAY HAPPENS ON REENTER
CALL XSIR ;SET UP LEVTAB, CHNTAB, AND DO SIR
MOVEI A,.FHSLF
CIS ;CLEAR PENDING INTERRUPTS
MOVE 2,[17B3+1B11+1B12] ;SELECT CHANNELS 0,1,2,11,12
AIC ;ACTIVATE CHANNELS
MOVSI 1,.TICCG ;CONTROL-G TO CHANNEL 0
ATI
MOVE 1,[.TICCO,,1] ;CONTROL-O TO CHANNEL 1
ATI
CALL ENACC ;ENABLE CTRL/C TRAPPING
GO: MOVE P,[XWD -LPDL,PDL-1] ;INITIALIZE PUSHDOWN LIST
TXZ FF,-1-TRACEF-FORM-UREAD-UWRITE-RSCNF2-DUMPF
TXNE FF,DUMPF ;INTERRUPTED OUT OF LARGE OUTPUT?
CALL FIXOUT ;YES
MOVEI A,.FHSLF
EIR ;MAKE SURE INTERRUPTS ARE ON
MOVEI A,12
MOVEM A,RADIX ;initialize typeout to decimal
SETZM ABORTF ;CLEAR INTERRUPT FLAGS
SETZM LISNF
CALL UPDATE ;UPDATE THE SCREEN
CLEARM LEV
MOVE A,[IOWD LPF,PFL] ;MAKE STACK POINTER
MOVEM A,PF ;INITIALIZE QREG STACK
JRST CLIS
;THIS ROUTINE CALLED IF INTERRUPT OR REENTER FROM A ;U-CLASS COMMAND THAT
;WAS IN THE MIDDLE OF WRITING THE FILE
FIXOUT: SKIPGE A,OUTJFN
JRST FIX1 ;NO OUTPUT! (OPENF IN OPNOUT PROBABLY FAILED)
TXO A,CZ%ABT ;FLUSH THE OUTPUT OPERATION
CLOSF
ERJMP .+1 ;IGNORE FAILURE
FIX1: TXZ FF,DUMPF!UWRITE ;FORGET THAT FILE WAS OPEN
RET
;ROUTINE TO SET UP CHNTAB AND LEVTAB, THEN DO SIR JSYS
;(TEMPORARY) IN NON-ZERO SECTIONS, EXTENDED SIR JSYS IS USED
XSIR: XMOVEI D,20
HLRZS D ;GET SECTION # IN D. IN SECTION 0 ?
JUMPE D,[MOVEI A,.FHSLF ;YES
MOVE B,[LEVTAB,,CHNTAB] ;GET TABLE ADDRESSES
SIR ;COMMUNICATE THEM TO THE MONITOR
RET]
;FIX LEVTAB AND CHNTAB FOR EXTENDED SIR JSYS
HRLM D,LEVTAB
HRLM D,LEVTAB+1
HRLM D,LEVTAB+2
MOVSI A,-^D36 ;FORM AOBJN POINTER
XSIR1: HLRZ B,CHNTAB(A) ;IS THIS ENTRY BEING USED?
TRNN B,770000 ;DON'T DO IF LEVEL # ALREADY SET UP
JUMPN B,[DPB B,[POINT 6,CHNTAB(A),5] ;YES, LEVEL # IN BITS 0-5
DPB D,[POINT 12,CHNTAB(A),17] ;SECTION # IN BITS 6-17
JRST .+1]
AOBJN A,XSIR1 ;LOOP THRU ALL ENTRIES OF CHNTAB
;PERFORM EXTENDED SIR JSYS
MOVE A,[1,,.FHSLF] ;EXTENDED VERSION, THIS FORK
XMOVEI B,LEVTAB ;GLOBAL ADDRESS OF LEVTAB
XMOVEI C,CHNTAB ;GLOBAL ADDRESS OF CHNTAB
SIR
RET
;SETX - RUN TV IN A NON-ZERO SECTION
;REPLACE RESET AT TECO WITH JRST SETX
;RETURNS +1: ALWAYS, WITH PC IN A NON-ZERO SECTION AND SECTION
; 0 MAPPED INTO THAT SECTION
SETX: MOVSI A,.FHSLF ;GET SOURCE FORK HANDLE ,, SECTION#
MOVE B,[.FHSLF,,3] ;DESTINATION F.H. ,, SECTION#
MOVE C,[PM%RD+PM%WR+1] ;ACCESS,,COUNT
SMAP% ;MAP SECTION 0 INTO ANOTHER SECTION
MOVSI A,(PC%USR) ;BUILD PC
MOVSS B
HRRI B,TECO+1
XJRSTF A ;GET TO TECO+1 IN NON-ZERO SECTION
;INTERRUPT HANDLING ROUTINES
;COME HERE IF QUOTA EXCEEDED OR DISK FULL...
OVRQUO: PUSH P,CX ;SAVE CX SINCE "SAVEAC" CLOBBERS IT
CALL OVR2 ;DO THE WORK (THIS WAY SO SAVEAC CAN BE USED)
POP P,CX
DEBRK ;GO BACK AND CONTINUE TRYING TO WRITE FILE
OVR2: SAVEAC <A,B,C> ;DON'T CLOBBER AC'S
SKIPE EXPFLG ;DON'T EXPUNGE UNLESS USER ALLOWS IT
SKIPN B,QUOJFN ;FIRST TIME THROUGH HERE?
JRST OVR1 ;NO, DON'T LOOP!
PSTR <
% TV: Quota exceeded or disk full - expunging deleted files
>
SETZM QUOJFN ;CLEAR CELL SO WE DON'T LOOP
MOVEI A,0 ;NO SPECIAL BITS
RCDIR ;SEE WHICH DIRECTORY WE'RE WRITING TO
ERJMP OVR1 ;FAILED, SO GIVE REAL ERROR
MOVEI A,0 ;NO SPECIAL BITS (AGAIN)
MOVE B,C ;GET DIRECTORY BEING EXPUNGED
DELDF ;EXPUNGE IT
ERJMP OVR1 ;FAILED, SO GIVE REAL ERROR
RET
;COME HERE IF OVER QUOTA OR DISK FULL, BUT EXPUNGE DOESN'T OR CAN'T
;HELP
OVR1: LERROR <Over quota or disk full - After some files are EXPUNGEd, type CONTINUE
>
CALL DOHALT ;LET USER FIX PROBLEM
RET ;CONTINUE WRITING THE FILE
;WAUTO-EXPUNGE ALLOWS EXPUNGE TO BE DONE WHEN OVER QUOTA
AUTO: SETOM EXPFLG
RET
;NOAUTO-EXPUNGE DISALLOWS AUTO-EXPUNGE TO BE DONE WHEN OVER QUOTA
NOAUTO: SETZM EXPFLG
RET
;COME HERE WHEN USER TYPES ^C.
CTRL.C: CALL SAVACS ;SAVE THE ACS
PSTR <^C> ;SHOW USER THE ^C
SETOM MESFLG ;ASSUME SCREEN MESSED UP IF WE'VE BEEN BACK TO EXEC
SKIPE SCRNF ;ARE WE ON A SCREEN
CALL EOS ;YES, SO CLEAR TO END OF SCREEN
CALL DOHALT ;HALT
JRST DEBRK. ;DISMISS INTERRUPT
;ROUTINE TO HALT. IT RESTORES TERMINAL MODES TO WHAT THEY WERE LAST
;TIME USER ENTERED TV. ALSO, IF USER CONTINUES, IT REMEMBERS NEW
;TERMINAL MODES, AND RESTORES TV'S MODES.
DOHALT: HALTF ;STOP
CALL SYSMOD ;USER CONTINUED, GET NEW MODES
RET ;RETURN TO CALLER
;INTERRUPT TO HERE WHEN USER TYPES CTRL/G
TTYINT: CALL SAVACS
MOVEI 1,101
CFOBF ;CLEAR OUTPUT BUFFER ALWAYS
SKIPN LISNF ;DOING COMMAND INPUT?
JRST TTYI1 ;NO
SKIPE ABORTF ;YES, FIRST INTERRUPT?
JRST REE1 ;YES, START COMMAND INPUT OVER.
TTYI3: AOS ABORTF ;NOTE INTERRUPT REQUEST
MOVEI 1,"G"-100
PBOUT ;DO DING
JRST IOER1 ;RETURN
TTYI1: MOVEI 1,100
CFIBF ;CLEAR INPUT BUFFER
SKIPE ABORTF ;FIRST REQUEST?
JRST TTYI2 ;NO, STOP IMMEDIATELY
JRST TTYI3
ABORT: PSTR <
ABORTED
>
JRST REE1
TYOQT: MOVEI 1,101 ;QUIT FROM TYPEOUT, CLEAR OUTPUT BUFFER
CFOBF
JRST REE1
;IMMEDIATE STOP
TTYI2: MOVEI 1,400000
CIS
JRST REE1
REE1: JRST REE ;CODE AT REENTER WILL TRY TO SAVE MODES AWAY
;ROUTINE WHICH SKIPS IFF BACKING UP IS CURRENTLY HAPPENING
SKBACK: SKIPE TERIO ;DON'T BACK UP CHARACTERS NOT TYPED ON TERMINAL
SKIPN BAKFLG ;IF BAKFLG IS 0
RET ;SINGLE SKIP FOR NO INITIALIZATION
RETSKP ;SKIP RETURN FOR BACK UP GOING ON
;CALL THIS ROUTINE IN ORDER TO WAIT FOR ALL COMMAND STRINGS FED TO SAVER
;SO FAR TO BE SAFELY OUT ON THE DISK. MAINLY USED FOR EXITING BACK TO
;THE EXEC.
SINK: CALL SKBACK ;MAKE SURE WE'RE DOING BACKUP
RET
MOVEI A,0 ;NO NONPERMANENTS
CALL BUPDAT
SKIPN SDONEF ;WAIT FOR LAST UPDATE TO COMPLETE
CALL HANG
SKIPL SDONEF ;WAS THERE AN ERROR?
JRST BUPERR ;YES, GO REPORT IT
RET ;WHEN COMPLETE, RETURN
;THE FOLLOWING ROUTINE ALLOWS FOR WAITING FOR A SOMETHING TO HAPPEN
;WITHOUT TYING DOWN THE SYSTEM.
;WHAT YOU REALLY WANT HOW YOU DO IT
;-------------------- -------------
;
; HAS-"IT"-HAPPENED?? HAS-"IT"-HAPPENED??
; JRST .-1 ;NO CALL HANG ;NO, WAIT FOR IT
; ... ;YES ... ;YES
HANG: MOVEI A,^D50 ;SLEEP FOR A WHILE
DISMS
POP P,A ;GET ADDRESS WE WOULD HAVE RETURNED TO
JRST -2(A) ;GO BACK AND SEE IF EVENT HAS HAPPENED YET
;CONTROL-O INTERRUPT, SUPRESS OUTPUT BUT DON'T STOP PROCESSING
CTRL.O: AOSN COFLG ;COMPLEMENT FLAG - NOW CLEAR?
DEBRK ;YES, DO NOTHING FURTHER
CALL SAVACS
MOVEI 1,101
CFOBF ;FLUSH OUTPUT
PSTR <^O...
>
SETOM COFLG ;SET FLUSH FLAG
XMOVEI 2,20 ;GET SECTION # IN LEFT HALF
HRRZ 1,LEV3PC ;SEE WHERE WE CAME FROM
TLNE 2,-1 ;NON-ZERO SECTION?
HRRZ 1,LEV3PC+1 ;YES, PC IS IN 2ND WORD
MOVSI 2,(PC%USR)
CAIN 1,TYOLOC+1 ;THE BOUT?
IORM 2,LEV3PC ;YES, SET PC NOT TO RESUME BOUT
JRST IOER1
;IO ERROR INTERRUPT
IOERR: CALL SAVACS ;SAVE ACS DURING INTERRUPT
PSTR <
IO DATA ERROR, >
MOVE 2,IAC+1 ;ASSUME JFN IN 1
CAMN 2,INJFN ;THE INPUT ONE?
JRST IOERI ;YES
CAMN 2,OUTJFN ;THE OUTPUT ONE?
JRST IOERO ;YES
PSTR <UNEXPLAINED
>
IOER1: JRST DEBRK.
;SAVACS SAVES AC'S FOR DURING INTERRUPT ROUTINES
;LEAVES AC0 ALONE, SINCE IT HAS FLAGS IN IT
SAVACS: MOVEM 1,IAC+1 ;SAVE AC 1
MOVE 1,[2,,IAC+2]
BLT 1,IAC+16 ;SAVE ACS 2 THROUGH 16
RET
;COME HERE TO RESTORE AC'S AND DISMISS INTERRUPT
DEBRK.: MOVE 16,[IAC+1,,1]
BLT 16,16 ;restore ac's
DEBRK
IOERI: PSTR <INPUT FILE: >
IOER2: MOVEI 1,101
SETZ 3,
JFNS ;TYPE FULL NAME OF FILE
HRROI 1,[ASCIZ /
/]
PSOUT
AOS ABORTF ;REQUEST ABORT
JRST IOER1
IOERO: PSTR <OUTPUT FILE: >
JRST IOER2
;(REST OF INTERRUPT TABLES MOVED INTO SAVER FORK AREA)
;ROUTINE TO POP UP ONE TYPIN JFN.
TYIPOP: PSTR <
End of >
MOVEI A,.PRIOU ;OUTPUT TO PRIMARY
MOVE B,TYIJFN ;TYPE FILESPEC BEING ENDED
MOVEI C,0 ;PRINT IT IN STANDARD FORMAT
JFNS
CALL CRR
MOVE A,TYIJFN ;GET JFN WE'RE GETTING RID OF.
CLOSF ;CLOSE THE FILE.
JFCL ;COULDN'T BUT DON'T SWEAT.
MOVE A,TYIP ;POP UP TO LAST INPUT JFN BECAUSE EOF.
POP A,TYIJFN
MOVEM A,TYIP ;SAVE NEW POINTER
MOVE A,TYIJFN ;GET NOW CURRENT INPUT JFN.
HRRM A,RDIOJ ;STORE LATEST JFNS FOR TEXTI
HRLM A,RDIOJ
HRRM A,SBK+.CMIOJ ;STORE FOR COMND JSYS TOO
HRLM A,SBK+.CMIOJ
DVCHR ;SEE IF THIS JFN IS A TERMINAL
MOVE A,TERIO ;REMEMBER WHETHER ENDING STREAM IS A TERMINAL
MOVEM A,OTERIO
SETZM TERIO ;FIRST ASSUME IT'S NOT.
LDB A,[221100,,B] ;GET DEVICE TYPE NUMBER
CAIN A,.DVTTY ;SKIP IF IT IS A TERMINAL
SETOM TERIO ;REMEMBER THAT IT'S A TERMINAL
RET
;ROUTINE TO CAUSE CHAR TO BE REAVAILABLE FOR INPUT.
RECHAR: MOVE A,TYIJFN ;CORRECT JFN IN A
BKJFN ;PUT CHARACTER BACK IN STREAM
JSHLT
RET
;ROUTINE TO INPUT A CHARACTER BUT NOTHING ELSE(I.E. NO BACKUP)
TYIX: SETOM WINFLG ;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL PREVIOUS OUTPUT
MOVE A,TYIJFN ;GET APPROPRIATE INPUT JFN
BIN ;READ THE CHARACTER
ERJMP TYIEOF ;IF FAILS, PROBABLY END OF FILE
MOVE A,B ;RETURN IT IN A
RET
TYIEOF: CALL %GETER ;GET REASON FOR FAILURE
CAIE A,IOX4 ;END OF FILE?
JSHLT ;NO, UNEXPECTED ERROR
CALL TYIPOP ;YES, GET BACK TO LAST INPUT LEVEL
JRST TYIX ;CONTINUE READING
;ROUTINE TO BACKUP A CHARACTER IN A.
BCHAR: STKVAR <SHCHR>
LSH A,1 ;SHIFT CHARACTER TO MAKE IT ASCII
MOVEM A,SHCHR
CALL SKBACK ;MAKE SURE WE'RE BACKING UP
RET
AOS B,BBLEN ;ACCUMULATE CHARACTER IN BACKUP BUFFER
HRLI B,100700 ;MAKE POINTER TO CHARACTER
HRRI B,SHCHR
MOVE A,BBPTR ;POINTER TO WHERE CHARACTER GOES
MOVEI C,1 ;ONLY DOING ONE CHARACTER
CALL TUTHER ;COPY CHARACTER INTO BACKUP BUFFER
IBP BBPTR ;STORE UPDATED POINTER
MOVE A,BBLEN
SUB A,OBBLEN ;SEE HOW MANY ACCUMULATED CHARS SINCE LAST UPDATE
CAMGE A,BAKLEN ;ENOUGH MORE CHARACTERS YET TO DO UPDATE?
RET
MOVEI A,0 ;NO NONPERMANENT CHARS
CALLRET BUPDAT ;YES, INITIATE AN UPDATE
;ROUTINE WHICH INITIATES UPDATE OF BACKUP FILE. PASS IT NUMBER OF
;NONPERMANENT CHARACTERS TO UPDATE IN A.
BUPDAT: STKVAR <NONPER,SAVPAG,SAVCNT>
MOVEM A,NONPER ;REMEMBER NUMBER OF NONPERMANENT CHARS
MOVE A,BBLEN
MOVEM A,OBBLEN ;REMEMBER NUMBER OF BACKUP CHARACTERS AT TIME OF THIS UPDATE
SKIPN SDONEF ;MAKE SURE SAVER IS DONE WITH LAST CHUNK
CALL HANG ;NOT, SO WAIT FOR IT TO BE
SKIPL SDONEF ;MAKE SURE THERE WERE NO ERRORS
JRST BUPERR ;THERE WAS, PROBABLY OVER QUOTA
MOVE A,BBLEN
MOVEM A,SAVPER ;SAVER NEEDS TO NO NUMBER OF PERMANENT CHARS
ADD A,NONPER ;GET TOTAL NUMBER OF CHARACTERS
MOVEM A,SAVTOT ;SAVER NEEDS THAT
MOVE A,BBPTR ;FIGURE OUT WHERE NONPERMANENT CHARACTERS GO
MOVE B,RDBFP ;GIVE SAVER NONPERMANENT CHARACTERS
MOVE C,NONPER ;GET PERMANENT NUMBER OF CHARACTERS
CALL TUTHER ;APPEND NONPERMANENTS TO PERMANENTS
MOVE A,BBUFX
MOVEM A,SAVX ;TELL SAVER WHICH BUFFER TO USE
CALL SAVGO ;START THE SAVER
SETZM BBLEN ;THERE'S NO CHARACTERS LEFT IN BACKUP BUFFER
SETZM OBBLEN ;RESET OLD COUNT SO NEXT SAVE HAPPENS AT RIGHT TIME
MOVE A,[<440700,,BBUF1>+<440700,,BBUF2>]
SUB A,BBUFX ;SWITCH TO OTHER BACKUP BUFFER
MOVEM A,BBUFX
MOVEM A,BBPTR
SETCMM WTOGGL ;TOGGLE TO OTHER WINDOW BUFFER
RET
;COME HERE IF SAVER ENCOUNTERED ERROR DURING TRYING TO BACKUP LAST
;SEGMENT. ASSUME THE ERROR CAN BE CORRECTED BY USER, LIKE "OVER QUOTA".
;HENCE PRINT THE ERROR MESSAGE, BUT OTHERWISE JUST RETRY THE LAST SAVE
;AND DON'T TRY TO BACKUP ANY NEW CHARACTERS YET.
BUPERR: PSTR <
%TV backup file not updated yet - >
MOVE B,SDONEF ;GET ERROR CODE
HRL B,SAVFRK ;USE SAVER'S FORK HANDLE (PROBABLY DOESN'T MATTER WHAT HANDLE WE USE!)
MOVE A,TTYOUT ;DIRECT OUTPUT TO TERMINAL
MOVEI C,0 ;NO CHARACTER COUNT LIMITATION
ERSTR ;PRINT SYSTEM'S REASON FOR ERROR
JFCL
JFCL
CALL CRR
CALLRET SAVGO ;MAYBE UNDER QUOTA AGAIN, RETRY THE SAVE
;ROUTINE TO CALL WHEN DESTINATION BUFFER STARTING ADDRESS IS SET UP.
;THIS ROUTINE CONJURES UP AN INITIAL OLD COMMAND POINTER BASED ON HOW MANY
;CHARACTERS HAVE BEEN TYPED THAT HAVE NOT YET BEEN BACKED UP, SUCH THAT
;WHEN SAVLEN'S WORTH HAVE ACCUMULATED, A BACKUP WILL HAPPEN
SETOCP: MOVN A,BBLEN ;GET NEGATIVE NUMBER OF CHARACTERS TYPED AND NOT BACKED UP
ADJBP A,RDBFP ;INITIALIZE PLACE IN COMMAND STRING AT WHICH LAST UPDATE HAPPENED
MOVEM A,OCP ;REMEMBER
RET
;ROUTINE TO START UP SAVER FORK
SAVGO: MOVE A,SAVFRK ;START UP THE SAVER
MOVEI B,SAVST
SETZM SDONEF ;SAY SAVER ISN'T DONE YET
SFORK
RET
;FOLLOWING ROUTINE TAKES PAGE NUMBER IN RIGHT HALF OF A, AND DOES PMAP SUCH THAT
;A WRITE INTO OUR PAGE AT FRKWI2 OR FRKWIN ACTUALLY CAUSES A WRITE INTO PAGE
;GIVEN IN A OF OTHER FORK
SFW: HRRZ A,A ;KEEP ONLY PAGE NUMBER
MOVEI D,LPM ;FIRST ASSUME FIRST WINDOW
SKIPE WTOGGL ;OTHER?
MOVEI D,LPM2 ;YES
CAMN A,(D) ;SAME AS LAST PAGE MAPPED?
RET ;YES SO NOTHING TO DO
HRL A,SAVFRK ;GET CORRECT FORK HANDLE
MOVE B,[.FHSLF,,FRKWPN] ;GET WINDOW PAGE NUMBER
SKIPE WTOGGL
HRRI B,FRKWP2 ;KEEP WINDOW NUMBER CORRECT
XMOVEI C,20 ;GET SECTION # IN LH
LSH C,-11 ;GET SECTION # IN BITS 18-26
TDO B,C ;PUT SECTION # IN PMAP DESTINATION
MOVX C,PM%WR ;WE WANT TO WRITE INTO THE PAGE
PMAP ;MAP FROM OTHER FORK TO US
HRRZM A,(D) ;REMEMBER NEW MAPPED PAGE
RET
;ROUTINE TO COPY CHARACTERS "TO OTHER" FORK. GIVE IT DESTINATION POINTER
;IN A (PLACE IN OTHER FORK TO WHICH CHARACTERS ARE GOING), SOURCE
;POINTER IN B, AND NUMBER OF CHARACTERS IN C.
;THIS ROUTINE ASSUMES ASCII POINTERS
TUTHER: STKVAR <TFROM,TWHERE,TCNT,INUM,TPTR>
TLC B,-1
TLCN B,-1
HRLI B,440700 ;CHANGE -1 TO 440700
TLC A,-1
TLCN A,-1
HRLI A,440700 ;CHANGE -1 TO 440700
MOVEM B,TFROM
MOVEM A,TWHERE
MOVEM C,TCNT
TU1: JUMPE C,R ;RETURN IF EVERYTHING MOVED
MOVE A,[010700,,FRKWIN+777] ;GET POINTER TO END OF WINDOW
SKIPE WTOGGL ;USING OTHER WINDOW?
MOVE A,[010700,,FRKWI2+777] ;YES, GET POINTER TO IT
MOVE B,TWHERE ;GET PLACE WE'RE MOVING DATA TO
IBP B ;CHANGE 010700,,F-1 TO 440700,,F
ADD B,[70000,,]
MOVEM B,TWHERE ;REMEMBER THE 440700 VERSION
TRZ B,777000 ;GET RID OF PAGE NUMBER
SKIPN WTOGGL ;CHOOSE APPROPRIATE WINDOW
TRO B,FRKWIN ;GET BYTE POINTER AS TRANSLATED FOR OTHER FORK
SKIPE WTOGGL
TRO B,FRKWI2
MOVEM B,TPTR ;REMEMBER TRANSLATED POINTER
CALL SUBBP ;CALCULATE NUMBER OF BYTES WE CAN DO BEFORE UPING PAGE NUMBER
MOVEM A,INUM ;REMEMBER HOW MANY WE CAN DO
LDB A,[111100,,TWHERE] ;GET PAGE OF FORK TO BE MAPPED
CALL SFW ;SET UP FORK WINDOW
MOVE P1,INUM ;GET NUMBER OF CHARACTERS WE CAN DO ON THIS PAGE
CAMLE P1,TCNT ;MAKE SURE LESS THAN ENTIRE AMOUNT DESIRED
MOVE P1,TCNT ;MORE. ONLY DO WHAT WAS REQUESTED
MOVEM P1,INUM ;REMEMBER NUMBER WE'RE ACTUALLY DOING
MOVE I,TFROM ;TRANSFER FROM WHERE WE'RE SUPPOSED TO
MOVE OU,TPTR ;USE TRANSLATED POINTER FOR DESTINATION
CALL MVSTR ;TRANSFER AS MUCH AS CAN BE
MOVE A,INUM ;GET NUMBER WE JUST DID
ADJBP A,TFROM ;CALCULATE POINTERS FOR NEXT SECTION
MOVEM A,TFROM
MOVE A,INUM
ADJBP A,TWHERE
MOVEM A,TWHERE
MOVN C,INUM
ADDB C,TCNT ;UPDATE COUNT OF LEFT TO DO
JRST TU1 ;LOOP TO FINISH
;ROUTINE WHICH INPUTS COMMAND STRING USING TEXTI
DTEXTI: STKVAR <CCL>
SETOM WINFLG ;IF RECEIVING INPUT, ASSUME USER HAS SEEN ALL PREVIOUS OUTPUT
DTXTI1: MOVEI A,RDCWB ;ASSUME EVERYTHING ELSE CORRECT
TEXTI ;READ SOME MORE INPUT
JRST MEOF ;MAYBE END OF FILE
SETZM ABORTF ;SO IFOO^G$$ DOES THE INSERT
MOVE A,RDDBP
MOVE B,RDBFP ;YES, SEE HOW LONG COMMAND STRING IS
CALL SUBBP
MOVEM A,CCL ;REMEMBER NEW COMMAND STRING LENGTH
MOVE A,RDDBP ;GET RIGHTMOST POSITION OF COMMAND
MOVE B,OCP ;GET OLD POSITION, AT LAST UPDATE
CALL SUBBP ;SEE HOW MUCH TYPED SINCE LAST UPDATE
CAMGE A,BAKLEN ;ENOUGH FOR A BACKUP?
JRST DTNOG ;NO, NOT YET
MOVE A,RDDBP ;YES, SO REMEMBER WHERE THIS UPDATE HAPPENED
MOVEM A,OCP
CALL SKBACK ;BACKING UP?
JRST DTNOG ;NO, CHARACTERS NOT FROM TTY OR USER SAID WNOBACKUP$
MOVE A,CCL ;GET CURRENT COMMAND STRING LENGTH
CALL BUPDAT ;UPDATE THE BACKUP FILE
DTNOG: MOVE A,RDFLG ;SEE WHY TEXTI STOPPED INPUTTING
TXNN A,RD%BTM ;BREAK CHARACTER?
RET ;NO, LET CALLER HANDLE IT
CALL TYIX ;YES, ESCAPE TYPED, SEE IF NEXT ESCAPE ALSO
CAIN A,.CHESC ;IS IT ESCAPE?
CALLRET STFCHR ;STUFF THE SECOND ESCAPE INTO THE STRING AND RETURN
CALL RECHAR ;NOT AN ESCAPE, CAUSE IT TO BE REREAD
JRST DTXTI1 ;GO BACK AND KEEP READING
;HERE IF ERROR DURING TEXTI
MEOF: CAIE A,IOX4 ;END OF FILE REACHED?
JSHLT ;NO, SOME OTHER ERROR
CALL TYIPOP ;YES, POP BACK TO PREVIOUS LEVEL OF IO
SKIPE OTERIO ;ENDING A NON-TERMINAL STREAM?
RET ;NO
MOVE A,RDDBP ;YES, DON'T LET TYPIST DELETE CHARACTERS RECEIVED FROM NON-TERMINAL
MOVEM A,RDBFP
MOVEI B,0
IDPB B,A ;DON'T LET PSOUT GO TOO FAR
MOVEI A,PCHAR ;DISPLAY PROMPT CHARACTER
SKIPE TERIO ;BUT NOT IF READING FROM NON-TERMINAL
PBOUT
MOVE A,CPTR ;SHOW USER COMMAND SO FAR
SKIPE TERIO ;DON'T BOTHER DISPLAYING COMMAND SO FAR IF STILL READING FROM NON-TERMINAL
PSOUT
MOVE A,RDBFP ;SEARCH BACK TO BEGINNING OF CURRENT LINE
MEOF1: CAMN A,RDRTY ;ARE WE BACK TO THE BEGINNING OF BUFFER?
JRST MEOF2 ;YES
LDB B,A ;NO, SEE IF WE'VE FOUND BEGINNING OF LINE
CAIN B,.CHLFD ;HAVE WE?
JRST MEOF2 ;YES
MOVNI B,1 ;NO, SEARCH BACKWARDS FOR IT
ADJBP B,A
MOVE A,B
JRST MEOF1
MEOF2: MOVEM A,RDRTY ;SET UP SO ^R ONLY SHOWS CURRENT LINE
CALL SETOCP ;SET UP THE OLD COMMAND POINTER
JRST DTXTI1 ;GO CONTINUE READING FROM PREVIOUS SOURCE
;ROUTINE TO STUFF CHARACTER INTO COMMAND STRING.
STFCHR: IDPB A,RDDBP ;STUFF THE CHARACTER IN
SOS RDDBC ;ASSUME THERE WAS ROOM!!!
RET
;JSYS ERROR REPORT
JSER: CALL WINCLS ;DON'T LET SCREEN UPDATE WIPE OUT ERROR MESSAGE
PSTR <
?>
CALL CLRINP ;CLEAR TYPEAHEAD
MOVE 2,[400000,,-1] ;THIS FORK, MOST RECENT ERROR
SETZ 3,
ERSTR ;PRINT ERROR MSG
JFCL
JFCL
CALL CRR
RET
;THIS ROUTINE PRINTS A CRLF AND A ? AND THE ERROR CODE CORRESPONDING TO
;THE ERROR NUMBER IN 1.
JSER1: MOVE B,A ;PUT ERROR CODE IN 2
MOVEI A,101 ;AND SAY TO PRINT ERROR ON TTY
MOVEI C,0 ;SAY TO PRINT WHOLE MESSAGE
PSTR <
?>
TLO B,(1B0)
ERSTR ;PRINT MESSAGE
JFCL
JFCL
CALLRET CRR
;ROUTINE TO CLEAR TYPEAHEAD. THIS IS DESIRABLE WHEN AN ERROR OCCURS,
;SINCE USER PROBABLY DOES NOT WANT HIS TYPEAHEAD EXECUTED IF PREVIOUS
;COMMAND FAILS.
CLRINP: MOVEI 1,101
DOBE ;WAIT FOR PRESENT OUTPUT TO BE SEEN
CFIBF ;CLEAR EXTRA TYPING
RET
;OUTPUT A CHARACTER. TAKES CHARACTER IN A.
TYO: MOVE B,A ;CHARACTER TO B
MOVE A,TTYOUT ;GET OUTPUT CHANNEL
TYOLOC: BOUT ;PRINT IT; THIS TAG IS FOR INTERRUPT SYSTEM
RET
;SERVICE ROUTINE FOR CTYPE MACRO, TYPES ONE LITERAL CHARACTER
UCTYP0: HRRZ A,UUOB+.AREFA ;GET THE CHARACTER (EFF ADDR OF UUO)
CALLRET TYO ;TYPE IT AND RETURN
;PRINT STRING SUBROUTINE - SEE MACRO DEFINITION
; HRROI TT,[ASCIZ /STRING/]
; CALL PSTR0
PSTR0: HRLI TT,(POINT 7,0) ;MAKE BYTE PTR
ILDB A,TT ;GET CHAR FROM STRING
JUMPN A,[CALL TYO ;OUTPUT IF IF NOT NULL
JRST .-1]
RET ;OTHERWISE, DONE
;ROUTINE TO OUTPUT DECIMAL INTEGER
;CALL MOVE c, DECIMAL INTEGER
; MOVEI A,ADDRESS OF OUTPUT ROUTINE
; HRRM A,LISTF5
; CALL DPT
; RETURN
DPT0: HRRM A,LISTF5 ;SETUP CHAR DISPATCH ADR
DPT: MOVSI CH,(IFIW)
HLLM CH,LISTF5 ;SET FOR LOCAL INDIRECT REFERENCE
MOVEI A,"-"
SKIPGE C ;NEGATIVE NUMBER?
CALL @LISTF5 ;YES, OUTPUT MINUS SIGN
MOVMS C ;c:=ABSOLUTE VALUE OF c
DPT2: IDIV C,RADIX ;d:=DIGIT
PUSH P,D ;STACK THE DIGIT
SKIPE C ;DONE?
CALL DPT2 ;NO.
POP P,A ;YES, RETRIEVE DIGIT
ADDI A,60 ;CONVERT IT TO ASCII.
JRST @LISTF5 ;PRINT IT
;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL CALL CRR
; RETURN
CRR: MOVEI A,.CHCRT
CALL TYO
MOVEI A,.CHLFD
CALLRET TYO
;ROUTINE TO GET TO LEFT MARGIN
LM: CALL CHKLM ;AT LEFT MARGIN?
CALLRET CRR ;NO, GET THERE
RET ;YES, ALREADY THERE
;SKIP IF AT LEFT MARGIN
CHKLM: MOVE A,TTYOUT ;GET OUTPUT CHANNEL
RFPOS ;GET POSITION ON LINE
TRNE B,-1 ;AT LEFT MARGIN?
RET ;NO
RETSKP ;YES
;HERE TO GET NEXT COMMAND STRING FROM TTY
CLIS: SKIPN A,INIJFN ;IS THERE A TV.INI?
JRST CLIS3 ;NO, OR WE'VE ALREADY EXECUTED IT
MOVEI B,1 ;INITIALIZE A NULL COMMAND
MOVEM B,COMCNT
MOVEM B,COMAX
MOVE B,[BYTE(7)177]
MOVEM B,CBUF
MOVE B,[440700,,CBUF]
MOVEM B,CPTR
CALL MFILE0 ;READ FILE INTO Q-REG AREA
JRST MAC0 ;EXECUTE THE FILE
CLIS3: CALL ENARES ;MAKE RESCANNED DATA AVAILABLE
CLIS1: HRRZ A,LSTCB ;PREPARE TO SAVE LAST COMMAND STRING
HRRZ B,LSTCE
CAIG A,CBUF
JRST CSAV1 ;IS ALREADY IN RIGHT PLACE
SUBI B,0(A)
CAIG B,3
JRST CRST ;NOT USEFULLY LONG
ADDI B,CBUF
MOVEI A,CBUF
HRL A,LSTCB
BLT A,-1(B) ;MOVE TO CBUF
CSAV1: HLL B,LSTCE ;NUMBER OF CHARS
MOVEM B,LSTCB
JRST CSAV2
CRST: MOVE B,LSTCB ;RESET COMMAND STRING
CSAV2: HRLI B,10700 ;MAKE BYTE POINTER
SOJ B, ;MAKE PROPER BYTE POINTER
MOVEM B,RDRTY ;SET UP RETYPE BUFFER (CONTIGUOUS TO MAIN BUFFER)
MOVEI A,PCHAR ;SET UP PROMPT
IDPB A,B
MOVEM B,CPTR
MOVEM B,RDBFP ;MARK BEGINNING OF INPUT BUFFER
MOVEM B,RDDBP ;DESIGNATE CURRENT END OF INPUT BUFFER
MOVEM B,RDBKL ;MARK BACKUP LIMIT SO WE'LL KNOW IF EVERYTHING GETS DELETED
CALL TYO ;TYPE THE PROMPT
MOVE A,TYIJFN
HRL A,TYIJFN ;INPUT AND ECHO COME FROM INPUT JFN
MOVEM A,RDIOJ ;TELL TEXTI WHERE CHARACTERS COMING FROM
MOVEM A,SBK+.CMIOJ ;TELL COMND JSYS TOO
SETOM LISNF ;NOTE NOW DOING COMMAND INPUT
SETOM ABORTF ;CAUSES ^G TO ACT IMMEDIATELY HERE
MOVEI 1,101
DOBE ;WAIT FOR ALL OUTPUT.IN CASE ^G
SETZM COFLG ;CLEAR TYPEOUT FLAG
SETZM ABORTF ;CLEAR ABORT FLAG
SETZM DUNFLG ;DON'T PUT OUT HEADING AGAIN
SKIPGE WINFLG
SKIPN SCRNF ;NO SCREEN CLEARING FOR NON-DISPLAY !!
CAIA ;NO SCREEN CLEARING IF PRESERVED OUTPUT !!
CALL EOS ;CLEAR PAD FOR COMMAND TYPEIN
SKIPE SCRNF
CALL EOL ;ALWAYS CLEAR LINE IF DISPLAY TERMINAL.
TRZ FF,ALTF ;NO ALTMODES SEEN YET ...
CLEARM INTDPH ;INTDPH:=0
CLEARM SYMS
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVE C,CBUFH
CALL SETOCP ;CALCULATE INITIAL OLD COMMAND POINTER
TXNN FF,RSCANF ;ARE WE RESCANNING?
JRST LINRS ;NO
MOVE B,[440700,,[ASCII /;Y/]] ;GOBBLE INPUT BEFORE OUTPUT IN CASE "EDIT A..3 A..3"
JRST LIFAKE ;FORCE THIS COMMAND STRING
LINRS: CALL TYIX ;INPUT FIRST CHARACTER
MOVEM A,FCHAR ;SAVE SINCE EOS CLOBBERS A
SKIPE SCRNF ;DON'T CLEAR SCREEN ON NON-SCREENS
CALL EOS ;CLEAR PREVIOUS PRESERVED OUTPUT
MOVE A,FCHAR
MOVEI B,0
SKIPN EOBFLG ;IF END OF BUFFER ALREADY DISPLAYED, SPACE DOES NOTHING
SKIPN SLENTH ;USING A DISPLAY WINDOW?
JRST LINRS1 ;NO, SO SPACE ISN'T SPECIAL
CAIN A,C.MORE ;MAGIC "MORE" CHARACTER?
JRST DMORE ;YES, GO DO IT
LINRS1: CAIE A,.CHLFD ;FIRST CHARACTER LINEFEED ??
JRST LI69NL ;NO.
MOVE B,[440700,,[ASCII /LT/]] ;
SKIPE SLENTH ;DON'T DO THE "T" IF A WINDOW IS BEING USED.
MOVE B,[440700,,[ASCII /L/]]
LI69NL: CAIE A,"^" ;UP ARROW ??
JRST LI69NU ;NO.
MOVE B,[440700,,[ASCIZ /-LT/]]
SKIPE SLENTH ;NO "T" IF A WINDOW IS BEING USED.
MOVE B,[440700,,[ASCII /-L/]]
LI69NU: MOVE C,TRMTYP
CAIE C,12 ;ONLY VT05 HAS FUNNY ARROW BUTTONS.
JRST LI83
CAIN A,C.UP
MOVE B,[440700,,[ASCII /-L/]] ;FIRST CHARACTER IS "UP ARROW" BUTTON
CAIN A,C.DOWN
MOVE B,[440700,,[ASCII /+L/]] ;FIRST CHARACTER IS "DOWN ARROW"
CAIN A,C.RITE
MOVE B,[440700,,[ASCII /+c/]] ;FIRST CHARACTER IS "RIGHT ARROW"
CAIN A,C.LEFT
MOVE B,[440700,,[ASCII /-c/]] ;"LEFT ARROW"
JRST LI96 ;FOR VT05, DON'T RECOGNIZE CONTROL-H AS -LT
LI83: CAIN C,.TT100 ;VT100?
JRST LIV100 ;YES
CAIE C,.TTV50 ;VT50?
CAIN C,.TTV52 ;OR VT52?
CAIA ;YES
JRST LI84 ;NO
LIV100: CAIE A,.CHESC ;ESCAPE SEQUENCE COMING? (ARROWS)
JRST LI84 ;NO
MOVE C,TRMTYP
CAIE C,.TT100 ;VT100?
JRST LIN100 ;NO
CALL TYIX ;YES, READ THE "[" BEFORE THE ARROW DESIGNATOR
CAIE A,"[" ;PROPER ESCAPE SEQUENCE COMING?
JRST LINONE ;NO
LIN100: CALL TYIX ;LOOK AT NEXT CHARACTER
MOVE CH,A
LOAD CH,UPRCOD,(CH) ;GET RAISED VERSION OF IT
CAIN CH,V52.UP
MOVE B,[440700,,[ASCII /-L/]] ;YES
CAIN CH,V52.DN
MOVE B,[440700,,[ASCII /+L/]]
CAIN CH,V52.LT
MOVE B,[440700,,[ASCII /-C/]]
CAIN CH,V52.RT
MOVE B,[440700,,[ASCII /+C/]]
CAIN B,0 ;ANY ESCAPE SEQUENCE CALCULATED?
LINONE: MOVE B,[440700,,[ASCII / /]] ;NO, SO DO NOTHING
LIFAKE: MOVE P1,B ;POINTER TO CHARACTERS IN P1
LIF1: ILDB A,P1 ;GET CHARACTER OF FAKE COMMAND
JUMPE A,LI89 ;ENTIRE COMMAND STUFFED IF NULL FOUND
CALL STFCHR ;STUFF NEXT CHARACTER OF COMMAND
JRST LIF1 ;LOOP FOR ALL CHARACTERS
LI85: CALL RECHAR ;CAUSE NON-SPECIAL CHARACTER TO BE REAVAILABLE FOR INPUT
MOVEI A,.TICTI ;DISABLE TYPEIN INTERRUPT
DTI ;SO THEY DON'T KEEP HAPPENING DURING COMMAND INPUT
LI1: MOVE C,CBUFH
MOVE B,RDDBP
CAIG C,(B) ;COMMAND BUFFER EXCEEDED?
CALL LIXPND ; YES, EXPAND
MOVE A,CBUFH
MOVE B,RDDBP
HRLI A,010700 ;MAKE BYTE POINTER
CALL SUBBP ;SEE HOW MANY CHARACTERS THERES ROOM FOR
MOVE P1,A ;REMEMBER ROOM LEFT BEFORE EXPANSION REQUIRED
MOVE A,RDDBP ;GET RIGHTEND OF COMMAND STRING
MOVE B,OCP ;GET PLACE AT LAST BACKUP
CALL SUBBP ;GET NUMBER OF UNBACKED UP CHARS
MOVE B,BAKLEN ;GET NUMBER ALLOWED BEFORE BACKUP REQUIRED
SUB B,A ;GET NUMBER TO INPUT BEFORE BACKUP REQUIRED
CAML P1,B ;EXPANSION BEFORE BACKUP?
MOVE P1,B ;NO, BACKUP WILL HAPPEN FIRST
MOVEM P1,RDDBC ;REMEMBER HOW MANY CHARS TO INPUT
CALL DTEXTI ;INPUT SOME OF THE COMMAND STRING
MOVE A,RDFLG ;GET FLAGS FROM TEXTI
TXNE A,RD%BLR ;DID USER DELETE EVERYTHING?
JRST LINRS ;YES, GO CHECK FOR SPECIAL FIRST CHARACTER AGAIN
TXNN A,RD%BTM ;TWO ALTMODES SEEN?
JRST LI1 ;NO, GET MORE INPUT
LI89: MOVE A,[.TICTI,,TICHN] ;WE WANT TO KNOW WHEN USER TYPES
ATI ;CAN'T LEAVE ON ALL THE TIME, BECAUSE WE'LL GET TOO MANY WAKEUPS
MOVE A,RDDBP
MOVE B,CPTR
CALL SUBBP ;SUBTRACT POINTERS TO CALCULATE LENGTH OF COMMAND
MOVEM A,COMCNT ;REMEMBER LENGTH
CALL SKBACK ;MAKE SURE WE'RE BACKING UP
JRST LINB ;NO
MOVE A,RDDBP
MOVE B,RDBFP
CALL SUBBP ;CALCULATE LENGTH OF ACTUAL TYPED STRING (ENTIRE COMMAND MINUS PERHAPS SOME PARTIAL COMMAND FROM OLD BACKUP FILE!)
MOVE C,A
ADDM C,BBLEN ;BACKUP BUFFER IS NOW LONGER
MOVE A,BBPTR ;APPEND COMMAND TO BACKUP BUFFER
MOVE B,RDBFP
MOVE D,C
ADJBP D,BBPTR ;UPDATE POINTER TO END OF BACKUP BUFFER
MOVEM D,BBPTR
CALL TUTHER ;IT IS, COPY THE STRING
LINB: MOVEI CH,177 ;END OF COMMAND STRING MARKER
AOS A,COMCNT ;MARK END OF COMMAND STRING WITH ASCII 177
IDPB CH,RDDBP
MOVEM A,COMAX
MOVE P1,RDDBP ;SAVE END OF THIS COM STRING
IBP P1 ; FOR POSSIBLE LATER USE
IBP P1 ;POINTER BEFORE LAST THREE CHARS
HRLI P1,-3(A)
MOVEM P1,LSTCE
SETZM LISNF ;NO LONGER DOING COMMAND INPUT
SKIPN SLENTH ;IF NO WINDOW,
CALL LM ;MAKE SURE AT LEFT MARGIN
LINOCR: TRNE FF,TRACEF ;ARE WE TRACING ??
CALL WINCLS ;YES, SO DON'T LET SCREEN WIPE OUT TRACINGS !!
JRST CRET ;DECODE COMMAND
;SUBBP ROUTINE SUBTRACTS TWO ASCII BYTE POINTERS GIVEN IN A AND B,
;YIELDING CHARACTER DIFFERENCE IN B
SUBBP: LDB C,[360600,,A] ;C TELLS HOW FAR FROM RIGHT EDGE A IS
LDB D,[360600,,B] ;D SHOWS HOW FAR FROM RIGHT EDGE B IS
SUB C,D ;BITS DIFFERENT A AND B ARE
IDIVI C,7 ;CHARACTERS DIFFERENT A AND B ARE (IF ADRESSES THE SAME)
SUB A,B ;CALCULATE HOW MANY WORDS APART A AND B ARE
IMULI A,5 ;CHANGE FROM WORDS TO CHARACTERS
SUBI A,(C) ;GET TOTAL CHARACTER DIFFERENCE
HRRZ A,A ;GET RID OF GARBAGE IN LEFT HALF
RET
LIXPND: MOVEI C,100
ADDM C,CBUFH ;ALLOW COMMAND TO EXTEND FURTHER
MOVE P1,EQRBUF
IDIVI P1,5 ;p1:=QREG BUFFER END WORD ADDRESS.
MOVE P2,QRBUF
IDIVI P2,5 ;p2:=Q-REG BUFFER BASE WORD ADDRESS.
SUBM P1,P2 ;NO. OF WORDS IN Q-REG AND DATA BUFFER.
MOVE CH,(P1)
MOVEM CH,100(P1) ;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
SOS P1
SOJGE P2,.-3
MOVEI P1,500
ADDM P1,QRBUF ;QRBUF:=p1(QRBUF)+500
ADDM P1,EQRBUF ;UPDATE END OF QREG BUF
RET
;ROUTINE TO SKIP IF CHARACTER SHOULD BE FLAGGED(wrONG CASE OR CONTROL)
SFLAGC: CAIL CH,37 ;IS CHARACTER CONTROL?
JRST SFNC ;NO
CAIN CH,.CHESC ;IS CHARACTER AN ESCAPE
RET ;YES, SO NO FLAG
RETSKP ;CONTROL, NOT ESCAPE, FLAG IT
SFNC: SKIPN FLAGF ;CASE SWITCH UPPER ??
RET ;CASE SWITCH 0, NO FLAG
MOVX A,CH%UPR ;FLAGGING UPPERASE, GET UPPERCASE BIT
TDNE A,CHRTAB(CH) ;IS CHARACTER UPPERASE?
RETSKP ;YES SO SKIP
RET
LI84: CAIN A,C.LEFT
MOVE B,[440700,,[ASCIZ /-LT/]] ;FOR NON-VT05, "BACKSPACE" IS -LT.
CAIE A,C.LEFT
JRST LI96 ;JUMP IF FIRST CHARACTER IS NOT A "BS"
SKIPE SLENTH
MOVE B,[440700,,[ASCII /-L/]] ;DON'T DO THE "T" IF WE'RE USING A NON-0 WINDOW SIZE.
LI96: JUMPN B,LIFAKE ;JUMP IF CHARACTER IS SPECIAL
JRST LI85 ;GO PUT IT BACK INTO INPUT STREAM
;DECREMENT ASCII BYTE PTR
DBP: CAMN TT,HOLEPT ;SITTING JUST TO RIGHT OF HOLE?
MOVE TT,HOLBPT ;YES, SO GET TO LEFT OF IT
ADD TT,[7B5] ;BACK UP POINTER
JUMPGE TT,.+2 ;SKIP IF P NOT NOW 44 OR MORE
SUB TT,[43B5+1] ;FIX FUNNY POINTERS
RET
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER AND ERROR IF EMPTY.
;CALL CALL SKRCH
; RETURN WITH CHARACTER IN CH
;GOES TO ERR IF COMMAND BUFFER IS EMPTY
SKRCH: SKIPN COMCNT ;COMMAND BUFFER EMPTY?
ERROR <MISSING COMMAND CHARACTER(S) OR TERMINATOR>
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL CALL RCH
; RETURN ALWAYS WITH CHARACTER IN CH
RCH: SOSGE COMCNT ;DECREMENT COMMAND BUFFER CHARACTER COUNT
;IS COMMAND BUFFER EMPTY?
JRST RCH2 ;YES. POP UP TO HIGHER MACRO LEVEL.
ILDB CH,CPTR ;NO. GET COMMAND CHARACTER IN CH
TXNE FF,SCANF ;DON'T PRINT CHARACTERS BEING SCANNED OVER
RET
MOVE A,CH ;TYO WANTS CHARACTER IN A
XCT TRACS ;RETURN OR JRST TYO IN TRACE MODE
RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH
SKIPE INTDPH ;MAKE SURE ITERATIONS HAVE ENDED!
ERROR <Unended iteration loop>
POP P,INTDPH ;RESTORE PREVIOUS NESTING DEPTH
CALL RESCMD ;RESTORE PREVIOUS COMMAND STATE
PUSH P,CH ;GET RETURN BACK ON PDL.
JRST RCH ;TRY AGAIN.
;ROUTINE TO PEEK AT NEXT CHARACTER IN COMMAND STRING WITHOUT ACTUALLY
;READING IT. SKIPS IFF THERE WAS ONE TO READ, RETURNS IT IN CH.
PEEKCH: MOVE CH,COMCNT ;see if more command
SOJL CH,R ;jump if there isn't
MOVE CH,CPTR ;there is, so peek at next character
ILDB CH,CH
RETSKP
;GET CHARACTER W/O TRACE - USED WHEN SKIPPING IN CONDITIONALS
SKRCH1: SOSGE COMCNT ;ANY CHARACTERS LEFT?
ERROR <MISSING COMMAND CHARACTER(S) OR TERMINATOR>
ILDB CH,CPTR ;YES. GET A CHARACTER.
RET ;RETURN.
CRET: TRZ FF,ARG2+ARG+FINDR+PCHFLG+SLSL+COLONF
CD1: CLEARM NUM
;ADD TAKES ONE OR TWO ARGUMENTS
CD2: MOVSI A,(<ADD C,>)
CD3: HLLM A,DLIM
CLEARM SYL
CD5: SKIPE ABORTF
JRST ABORT ;RUBOUT, ^G OR IO ERROR
CALL RCH ;READ COMMAND CHAR AND CHECK
MOVE A,CHRTAB(CH) ;CHECK ARGUMENTS
TXNE A,CH%ANA ;ARGUMENT ALLOWED?
JRST [ TRNE FF,ARG+ARG2 ;ARGUMENT?
ERROR <ARGUMENT GIVEN WHERE NOT ALLOWED>
JRST .+1] ;NOT ALLOWED AND NOT GIVEN, SO O.K.
CAIN CH,177 ;MAGIC EOC CHARACTER?
JRST [ SETZM INIJFN ;END OF COMMAND, TV.INI IS DONE NOW
JRST GO]
CAIN CH,.CHESC ;ALTMODE OR
JRST CRET ;IGNORED
CAIE CH,140 ;SOME CODES
CAILE CH,172
ERROR <UNDEFINED COMMAND>
CAIL CH,141 ;LOWER CASE IS CONVERTED TO UPPER CASE
SUBI CH,40
CD4: TXNE FF,SCANF ;ARE WE JUST SCANNING?
JRST CDSCAN ;YES
CD9: XCT DTB(CH) ;A:=XWD VALUE FLAG,DISPATCH ADDRESS
;OR DISPATCH DIRECTLY
CD6: MOVE C,NUM
TRZE FF,SYLF ;VALUE OR DIGIT
XCT DLIM ;YES. NUM:=NUM (DLIM OPERATOR) SYL
MOVEM C,NUM
MOVE P1,SARG ;SAVE SECOND ARGUMENT IN C.
TRZ FF,NOTF
JUMPGE A,(A) ;DISPATCH IF VALUE RETURN COMMAND.
CALL (A) ;DISPATCH FOR NON-VALUE RETURN COMMANDS.
JRST CRET
;HERE WITH COMMAND CHARACTER IN CH AND WE'RE SCANNING
CDSCAN: MOVE A,CHRTAB(CH) ;GET BITS FOR CHARACTER
TXNE A,CH%CAR ;IS CARE NEEDED WHILE SCANNING?
JRST CD9 ;YES
PUSH P,A ;REMEMBER FLAG BITS
TXNE A,CH%Q ;IS IT A Q-REG COMMAND?
CALL QREGVI ;YES, SCAN OVER Q-REG NAME
POP P,A ;RESTORE BITS
CDS1: TXNE A,CH%TOR ;DOES COMMAND TAKE OR RETURN A VALUE?
JRST [ TXNE FF,ARG ;YES, WAS THERE AN ARG?
JRST CRET ;YES, SO DON'T RETURN ONE
JRST VALRET] ;NO, SO PRETEND COMMAND RETURNED ONE
TXNE A,CH%VAL ;DOES COMMAND RETURN A VALUE?
JRST VALRET ;YES, DUMMY UP ONE
JRST CRET ;NO, CLEAR ARG TO THIS COMMAND
SEMICL: CALL RCH ;SEMICOLON COMMANDS
MOVE A,CHRTAB(CH) ;GET CHARACTER'S SPECIAL BITS
TXNE A,CH%SNA ;ARGUMENT ALLOWED?
JRST [ TRNE FF,ARG+ARG2 ;NO, GIVEN?
ERROR <Argument given where not allowed>
JRST .+1] ;NOT ALLOWED AND NOT GIVEN, SO O.K.
TXNE FF,SCANF ;SCANNING?
JRST [ TXNE A,CH%SCR ;MUST WE TAKE CARE WITH THIS SEMI-COLON COMMAND?
JRST .+1 ;YES, SO "EXECUTE" IT
TXNN A,CH%SVL ;DOES COMMAND RETURN A VALUE?
JRST CRET ;NO
JRST VALRET] ;YES, SO CONJURE UP ONE
CAIGE CH,40
MOVEI CH,40
CAIL CH,140
SUBI CH,40
ADDI CH,SEMTAB-DTB-40 ;OFFSET TABLE
JRST CD9 ; AND DISPATCH
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: MOVE A,SYL
IMULI A,12
ADDI A,-60(CH)
MOVE P1,A ;DON'T ASSUME THAT RCH PRESERVES A
MOVE CH,COMCNT ;get number of command characters left to read
SOJL CH,VALRET ;if no more left, there isn't a point after the number
MOVE CH,CPTR ;there's at least one more character
ILDB CH,CH ;look at it
CAIE CH,"." ;if it's a decimal point
JRST VALRET ;(it's not)
CALL RCH ;then read it...
MOVE A,P1 ;GET NUMBER BEING CHANGED
CALL CHANGE ;and reinterpret digits as octal number
;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET: MOVEM A,SYL
CD7: TRO FF,ARG+SYLF
JRST CD5
;routine to change decimal number in a to octal..
CHANGE: IDIVI A,12 ;get least significant decimal digit
PUSH P,B ;save it on the stack
CAIE A,0 ;and stop dividing if all digits on stack
CALL CHANGE ;more digits, go get them
IMULI A,8 ;retrieve digits one at a time
POP P,B ;and reconfigure number
ADD A,B ;until all digits
RET ;have been poped
;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: CALL SKRCH ;GET NEXT COMMAND CHARACTER.
TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER
JRST CD4 ;DISPATCH
;FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.
;SEMICOLON X COMMAND IS LIKE EX COMMAND IN STANDARD TECO. IT DOES
;SEMICOLON U COMMAND, AND RETURNS TO EXEC.
EXCOM: CALL UNLOAD ;DO A ;U COMMAND
;SEMICOLON H COMMAND JUST RETURNS TO EXEC
DECDMP: CALL SINK ;WAIT FOR COMMAND STRINGS TO BE SAVED BEFORE EXITING
CALL CLRSCN ;CLEAR THE SCREEN
SETOM MESFLG ;ASSUME SCREEN MESSED UP IF RETURNING TO EXEC
CALL DOHALT ;DO A HALT
RET ;IF USER CONTINUES, CONTINUE COMMAND STRING EXECUTION
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM
COMMA: MOVEM C,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TRZN FF,ARG ;HAVE ARGUMENT NOW?
ERROR <NO ARGUMENT BEFORE COMMA>
TROE FF,ARG2 ;HAVE SECOND ARG ALREADY?
ERROR <MORE THAN TWO ARGUMENTS>
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;LOGICAL AND
CAND: MOVSI A,(<AND C,>)
JRST CD3
;LOGICAL OR
COR: MOVSI A,(<IOR C,>)
JRST CD3
;SUBTRACT TAKES ONE OR TWO ARGUMENTS
MINUS: MOVSI A,(<SUB C,>)
JRST CD3
;MULTIPLY TAKES TWO ARGUMENTS
TIMES: MOVSI A,(<IMUL C,>)
JRST CD3
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,(<IDIV C,>)
JRST CD3
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: MOVNI A,1 ;FIRST ASSUME WE'RE RETURNING -1
TRNE FF,FORM ;IS IT SET?
JRST VALRET ;YES, RETURN A -1
;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.
BEGIN: MOVEI A,0
JRST VALRET
;AN ABBREVIATION FOR B,ZEE
HOLE: CLEARM SARG ;SET SECOND ARGUMENT TO 0.
TRZN FF,ARG ;ANY ARGS BEFORE H?
TRNE FF,ARG2 ; ..
ERROR <ARGUMENTS PRECEEDING 'H'>
TROA FF,ARG2
;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER
PNT: SKIPA A,PT
;Z=NUMBER OF CHARACTERS IN THE BUFFER
END1: MOVE A,ZEE
SUB A,BEG
JRST VALRET
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN
OPEN: PUSH P,NUM ;PUSH CURRENT ARGUMENT.
HLLZ A,DLIM ;GET CURRENT OPERATOR.
PUSH P,A ;PUSH CURRENT OPERATOR.
AOS LEV ;INCREMENT ( LEVEL.
JRST CRET
CLOSE: SOSGE LEV ;IS THERE A (?
ERROR <UNMATCHED RIGHT PAREN>
MOVEM C,SYL ;YES. SAVE CURRENT ARGUMENT.
POP P,CH ;RESTORE OPERATOR.
HLLM CH,DLIM
POP P,NUM ;RESTORE ARGUMENT.
JRST CD7
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TRNN FF,ARG ;HERE ON "=" COMMAND
ERROR <NO ARGUMENT GIVEN>
CALL WINCLS ;ANNOUNCE BEGINNING OF DATA TO BE PRESERVED
MOVEI A,TYO
PUSH P,RADIX ;save current radix
HRRM A,LISTF5 ;CONSOLE
CALL PEEKCH ;PEEK AT NEXT CHARACTER
JRST PRNT1 ;ISN'T ONE
CAIE CH,"=" ;and if "==" seen,
JRST PRNT1 ;(it wasn't)
CALL RCH ;then print number in octal
MOVEI A,8
MOVEM A,RADIX
PRNT1: MOVE C,NUM ;GET NUMBER (SUBROUTINES MAY HAVE CLOBBERED C)
CALL DPT
MOVEI A,"." ;get decimal point
MOVE B,RADIX ;and radix number was printed in
CAIN B,8 ;octal printout ??
CALL TYO ;yes, so print decimal point
POP P,RADIX ;restore original base
CALLRET CRR ;CRLF AND RETURN TO CALLER
;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.
SPTYI: CALL TYIX
MOVEM A,SYL ;REMEMBER CHARACTER
CALL BCHAR ;BACKUP THE CHARACTER
JRST CD7
;WDATE-AND-TIME INPUTS CURRENT DATE AND TIME INTO BUFFER
WDATIM: HRROI A,DATBUF ;POINT TO DATA BUFFER
HRROI B,-1 ;WE WANT CURRENT DATE AND TIME
MOVEI C,0 ;NO SPECIAL FLAGS
ODTIM ;GET THE DATE AND TIME
MOVE A,[440700,,DATBUF] ;GET POINTER TO THE STRING
CALLRET INSRTZ ;INSERT IT AND RETURN
;HAS THE VALUE OF ELAPSED TIME, IN JIFFIES, SINCE MIDNITE.
;THERE ARE SOME BUGS HERE: FIRST OF ALL, SINCE WE WORK FROM SECONDS, THIS
;NUMBER HAS CRAPPY RESOLUTION. SECONDLY, JIFFIES ARE SUPPOSED TO BE 50THS
;OR 60THS DEPENDING ON LINE FREQUENCY. HOWEVER, WE'RE ALWAYS ASSUMING 60 HERTZ.
GTIME: HRROI B,-1 ;SAY WE WANT CURRENT TIME
MOVEI D,0 ;NO SPECIAL FEATURES
ODCNV
MOVEI A,^D60 ;PREPARE TO CONVERT SECONDS TO SIXTIETHS
IMULI A,(D) ;OBTAIN SIXTIETHS
JRST VALRET
;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.
CNTRUP: CALL RCH ;^^ HAS VALUE OF CHAR FOLLOWING IT
MOVE A,CH
JRST VALRET
;^X - SET SEARCH SWITCH
;INITIALED TO 0, 1 MEANS EXACT MATCH REWUIRED ON SEARCHES, 0
;MEANS LOWER AND UPPER CASE LETTERS MATCH TO EITHER LOWER OR UPPER
SSERCH: MOVE A,EXACTF ;GET PRESENT VALUE
TRNN FF,ARG ;ARG GIVEN?
JRST VALRET ;NO, RETURN PRESENT VALUE
CAIL C,0
CAILE C,1
ERROR <SEARCH MODE MUST BE 0 OR 1.>
MOVEM C,EXACTF ;SET NEW VALUE
SETOM SRPF ;REMEMBER TO REPARSE SEARCH
JRST CRET
;wflaguppers$ - flag upper case letters
FLAGU: SETOM FLAGF ;SAY FLAGGING
MOVEI A,100
RFMOD
TXO B,TT%UOC ;FLAG UPPER CASE CHARACTERS
TXZ B,TT%LCA ;SYSTEM BUG PREVENTS FLAGGING UNLESS THIS BIT OFF
STPAR ;TELL SYSTEM
RET
;wnoflag$ - flag nothing
NOFLAG: SETZM FLAGF
MOVEI A,100
RFMOD
TXZ B,TT%UOC ;CLEAR FLAG BIT
STPAR
RET
;wnoshift$ - don't change case of input
NSHIFT: MOVEI A,100
RFMOD
TXZ B,TT%LIC ;CLEAR "RAISE" BIT
STPAR
RET
;wraise$ - raise typed in lower case letters
TERRAS: MOVEI A,100
RFMOD
TXO B,TT%LIC ;SET "RAISE" BIT
STPAR
RET
;WSAVLEN$ - SET OR GET NUMBER OF CHARACTERS TO INPUT BETWEEEN SAVES.
BETSAV: MOVE A,BAKLEN ;GET CURRENT SETTING
TRNN FF,ARG ;DID USER SUPPLY ARGUMENT ??
JRST VALRET ;NO, SO RETURN ONE.
CAIL C,1
CAILE C,MAXBAK
ERROR <ARG MUST BE POSITIVE AND LESS THAN OR EQUAL TO MAXBAK>
MOVEM C,BAKLEN ;SET NEW VALUE
RET
;WWIDTH$ - SET OR GET TERMINAL WIDTH
WTHSET: MOVE A,SWIDTH ;GET CURRENT SETTING
TRNN FF,ARG ;DID YOU SUPPLY ARG ??
JRST VALRET ;NO, SO RETURN CURRENT VALUE.
CAIGE C,0 ;MAKE SURE WIDTH IS LEGAL.
ERROR <NEGATIVE WIDTH SETTING NOT ALLOWED>
MOVE A,C
PUSH P,C
CALL SETWID ;GO SET NEW WIDTH
JERROR <Couldn't set up terminal width>
POP P,SWIDTH ;SET UP NEW WIDTH
RET
;ROUTINE TO SET TERMINAL WIDTH
;ACCEPTS: A/ NEW WIDTH
;RETURNS: +1: FAILED
; +2: WON
SETWID: MOVE C,A
MOVEI A,101 ;PRIMARY OUTPUT
MOVEI B,.MOSLW ;SET LINE WIDTH
MTOPR ;TRY TO DO IT
ERJMP R ;FAILED
RETSKP ;SUCCEEDED
;GET WIDTH INTO A, SKIP IFF SUCCESS
GETWID: MOVEI A,101
MOVEI B,.MORLW
MTOPR
ERJMP R
MOVE A,C
RETSKP
;GET PAGE (SCREEN) SIZE INTO A, SKIPS IFF SUCCESSFUL
GETLEN: MOVEI A,101
MOVEI B,.MORLL
MTOPR
ERJMP R
MOVE A,C
RETSKP
;WWINDOW$ - SET OR RETURN NUMBER OF SCREEN LINES USED FOR WINDOW
WINSET: MOVE A,SLENTH ;GET CURRENT SIZE OF WINDOW IN LINES
TRNN FF,ARG ;ARGUMENT TO COMMAND ???
JRST VALRET ;NO, SO RETURN ONE
MOVE B,SSIZE ;FOR SCREENS, SCREEN SIZE IS MAXIMUM
SKIPN SCRNF
MOVEI B,MAXLEN ;FOR NONSCREENS, INTERNAL BUFFER SIZE IS LIMIT
CAIL C,0
CAMLE C,B ;MAKE SURE ARG IS REASONABLE
ERROR <Invalid window size>
WINSOK: MOVEM C,SLENTH ;SET NUMBER OF LINES TO USE
RET
;WSCREENSIZE - SET OR RETURN NUMBER OF LINES EXISTING ON ENTIRE SCREEN.
SCNSET: MOVE A,SSIZE ;GET CURRENT SETTING
TRNN FF,ARG ;DID USER SUPPLY ARG TO COMMAND ??
JRST VALRET ;NO, SO RETURN CURRENT SETTING.
CAIL C,0
CAILE C,MAXLEN ;MAKE SURE NEW SETTING IS REASONABLE.
ERROR <ILLEGAL SCREEN SIZE SETTING>
MOVEM C,SSIZE ;SET NEW SCREEN SIZE
CALLRET WINSTN ;SET UP STANDARD WINDOW SIZE
;WEDITBASIC$ - DON'T FILTER LINE NUMBERS WHEN READING IN FILES, BECAUSE
;THE FILES NEED THEM, LIKE FOR INSTANCE THEY ARE BASIC PROGRAMS.
EBASIC: SETOM BASICF ;SET THE FLAG TO REMEMBER NOT TO FILTER LINE NUMBERS.
RET
;WEDITREGULAR$ - FILTER LINE NUMBERS AS USUAL.
ERGLR: SETZM BASICF ;SAY TO FILTER THE LINE NUMBERS.
RET
;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN)
;FOLLOWING THE POINTER IN THE BUFFER. THE SCAN TERMINATES ON ANY OTHER
;CHARACTER. THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY).
BAKSL: TRNE FF,ARG ;WHICH KIND OF BACKSLASH?
JRST BAKSL1 ;ARG TO MEMORY
MOVEI A,5+5 ;SPECIFY DECIMAL
PKNM1: CALL PKNUM ;DO THE WORK
JRST VL1 ;PROCEED WITH REST OF COMMAND
;ROUTINE TO PICK UP NUMBER FROM BUFFER IN BASE SPECIFIED IN A, LEAVING POINTER
;AFTER THE NUMBER AND NUMBER IN A
PKNUM: STKVAR <NEGF,PBASE>
MOVEM A,PBASE ;REMEMBER BASE
SETZM SYL ;START WITH NO NUMBER
MOVE I,PT ;MEMORY TO VALRET
CAML I,ZEE ;ANY CHARS?
JRST BAKSL3 ;NO, SO CAN'T POSSIBLY BE A "-"
CALL GETINC ;SOME CHARS, SEE IF "-"
SETZM NEGF ;NO MINUS SEEN YET
CAIE CH,"-" ;IS IT?
JRST BAKSL5 ;NO
SETOM NEGF ;YES, REMEMBER
BAKSLA: CAML I,ZEE ;OVERDID IT ?
JRST BAKSL3 ;YES. EXIT
CALL GETINC ;NO. GET A CHAR
BAKSL5: MOVE A,PBASE ;GET BASE
CAIGE CH,"0"(A) ;DIGIT IN CORRECT BASE?
CAIGE CH,"0" ;DIGIT?
SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP
SUBI CH,"0" ;CONVERT TO NUMBER
EXCH CH,SYL
IMUL CH,PBASE
ADDM CH,SYL ;SYL:= 10.*SYL+CH
JRST BAKSLA ;LOOP
BAKSL3: MOVE I,ZEE ;HERE ON OVERFLOW
BAKSL2: SKIPE NEGF ;MINUS SIGN SEEN?
MOVNS SYL ;YES. NEGATE
MOVEM I,PT ;MOVE POINTER PAST #
MOVE A,SYL ;RETURN NUMBER IN A
RET
;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.
ACMD: TRNN FF,ARG ;DOES AN ARGUMENT PRECEED A?
JRST APPEND ;NO. THIS IN AN APPEND COMMAND.
MOVE I,PT ;YES.
PICK1: CAML I,ZEE ;MAKE SURE THERE'S A CHARACTER AFTER POINTER
ERROR <Pointer is at end of buffer>
CALL GET ;CH:=CHARACTER TO THE RIGHT OF PT.
MOVE A,CH ;RETURN CH AS VALUE.
JRST VALRET
PICKUP: MOVE I,PT ; ;P COMMAND, PICKUP CODE AND INC PNTR
CAMGE I,ZEE
AOS PT ;DON'T ALLOW POINTER OUT OF BOUNDS
JRST PICK1
; ;N picks up a positive number from the data (base 10)
; n;N picks it up in base n. PT is left at first non-number.
PIKNUM: TRNN FF,ARG
MOVEI C,12
MOVE A,C ;GET BASE
JRST PKNM1 ;DO THE WORK
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
USE: TRNN FF,ARG ;DID AN ARGUMENT PRECEED U?
ERROR <NO ARGUMENT GIVEN>
CALL QREGVI ;YES. CH:=Q-REGISTER INDEX.
USEA1: MOVEM C,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
RET
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: CALL QREGVI
JRST VALRET
;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
;CALL CALL QREGVI
; RETURN
;ASSUMES COMCNT,CPTR AND COMAX ARE SET UP.
;IF NEXT CHARACTER IN COMMAND STRING
;IS NOT A LETTER OR A DIGIT, DOES NOT RETURN.
;FROM USEA,PCNT,OPENB+1,MAC,QGET
QREGVI: CALL RCH ;CH:=NEXT COMMAND STRING CHARACTER.
CAIL CH,140 ;LC LETTER?
TRZ CH,40 ;MAKE UC
CAIL CH,"0" ;LETTER OR DIGIT?
CAILE CH,"Z"
ERROR <ILLEGAL Q-REG NAME>
CAILE CH,"9"
CAIL CH,"A" ;CHECK FOR LONELY 7 BETWEEN DIGITS AND LETTERS
CAIA
ERROR <ILLEGAL Q-REG NAME>
CAIL CH,1+"9" ;YES. DIGIT?
SUBI CH,"A"-"9"-1 ;NO. TRANSLATE LETTERS DOWN BY NUMBER OF
;CHARACTERS BETWEEN 9 AND A.
MOVE A,QTAB-"0"(CH) ;A:=CONTENTS OF Q-REGISTER.
RET
;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER IN AND STANDS FOR THE
; NEW VALUE
PCNT: CALL QREGVI ;CH:=Q-REGISTER INDEX.
AOS A,QTAB-"0"(CH) ;INCREMENT Q-REG.
JRST VALRET ;RETURN NEW VALUE.
;m,nXi MOVES A PORTION OF THE BUFFER INTO Q-REGISTER i.
; IT SETS Q-REGISTER IN TO A DUPLICATE OF THE (M+1)TH
; THROUGH NTH CHARACTERS IN THE BUFFER.
;nXi INTO Q-REGISTER i IS COPIED THE STRING OF CHARACTERS STARTING
; IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
; THE NTH LINE FEED.
X: STKVAR <XARG1,XARG2,OLDEBF,SAVEBF,QNAM>
SETZM XARG1 ;CLEAR SO QGC DOESN'T TRIP OVER TRASH
SETZM QNAM
SOSG GCCNT ;TIME FOR GC?
CALL QGC ;YES
CALL GETARG ;p1:=FIRST STRING ARGUMENT ADDRESS
;c:=SECOND STRING ARGUMENT ADDRESS.
MOVEM P1,XARG1
MOVEM C,XARG2
MOVE A,C
CALL MOVHOL ;GET HOLE OUT OF WAY OF STUFF BEING MOVED INTO Q-REG
;**NOTE: PUTTING HOLE AFTER TEXT AS OPPOSED TO BEFORE IT IS IMPORTANT
;FOR EFFICIENCY, AS SUBSEQUENT DELETION PUTS HOLE THERE.
MOVE A,EQRBUF
MOVEM A,OLDEBF ;SAVE OLD BUFFER ADDRESS
X0: MOVE P1,XARG1
MOVE C,XARG2
SUBM C,P1 ;COMPUTE LENGTH OF STRING
ADDI P1,4 ;PLUS 4 OVERHEAD CHARS
MOVE C,EQRBUF ;COMPUTE NEW END OF QREG BUF
ADD C,P1
MOVE A,C
ADDI A,^D35+5 ;LEAVE ROOM FOR SEARCH ROUTINE TO USE
CAML A,BEG ;OVERLAPS MAIN BUFFER?
JRST [ MOVE A,EQRBUF
MOVEM A,SAVEBF ;SAVE PRESENT QREG FREE PTR
CALL QGC ;YES, DO GC
MOVE C,SAVEBF
CAMN C,EQRBUF ;DID GC DO ANYTHING?
ERROR <QREG STRING STORAGE FULL>
JRST X0] ;TRY AGAIN
MOVE OU,EQRBUF ;GET ADDRESS TO PUT STRING
MOVEM OU,OLDEBF ;SAVE IT FOR QREG
MOVEM C,EQRBUF ;UPDATE END OF AREA
MOVEI CH,141 ;FIRST CHARACTER OF BUFFER := 141
CALL PUT
AOS OU
MOVE I,[POINT 7,P1,14] ;TO GET LAST 3 CHARS IN p1
MOVEI P2,3
X3: ILDB CH,I ;GET PART OF COUNT
CALL PUT ;WRITE ONTO STORAGE STRING
AOJ OU,
SOJG P2,X3 ;DO FOR THREE CHARS = 21 BITS
MOVE OU,TT ;SAVE BYTE POINTER FROM LAST PUT
SUBI P1,4
MOVE I,XARG1 ;RECOVER SOURCE PTR
CALL GETX ;CONSTRUCT BYTE PTR TO SOURCE
CALL DBP ;BACKUP TO BEGINNING
MOVE I,TT ;SAVE IT
CALL MVSTR ;MOVE STRING FROM I TO OU
MOVE P1,XARG1
MOVE C,XARG2 ;RECOVER ARGS
CALL QREGVI ;GET POINTER TO Q-REG AND MAKE SURE NAME IS LEGAL
MOVEM CH,QNAM ;SAVE Q-REG NAME
CALL KLBUF1
MOVE CH,QNAM
MOVE C,OLDEBF
SUB C,QRBUF ;ADDRESS RELATIVE TO C(QRBUF)
TLO C,400000
CALLRET USEA1 ;MAKE QTAB ENTRY.
;GI THE TEXT IN Q-REGISTER IN IS INSERTED INTO THE BUFFER AT THE
; CURRENT LOCATION OF THE POINTER. THE POINTER IS THEN PUT JUST
; TO THE RIGHT OF THE INSERTION. THE Q-REGISTER IS NOT CHANGED.
QGET: CALL QREGVI ;A:=QTAB ENTRY, CH:=Q-REG INDEX
MOVE C,A
PUSH P,CH
CALL QGET2 ;GET NUMBER OF CHARS
POP P,C ;Q-REG INDEX
JUMPLE P1,CRET ;QUIT IMMEDIATELY IF NULL STRING
MOVE I,QTAB-"0"(C)
TLZ I,(-1B14)
ADD I,QRBUF
ADDI I,3
MOVE A,I ;PUT CHARACTER ADDRESS INTO A
CALL ADDPTR ;CHANGE ADDRESS TO POINTER
MOVE B,P1 ;STRING LENGTH INTO B
CALL INSRT0 ;INSERT Q-REG INTO BUFFER
JRST CRET ;DONE
; ;T - TYPE CONTENTS OF Q REG
TPREG: TXNN FF,SCANF ;DON'T "DO" ANYTHING IF SCANNING (EXCEPT SKIM OVER STRING, IF ANY)
CALL WINCLS ;START PRESERVED OUTPUT
TRNN FF,ARG
JRST COMM ;TYPE LITERAL STRING IF NO ARG
MOVE C,NUM ;C GETS CLOBBERED BY SUBROUTINES
CALL QGET2
TXNE FF,SCANF ;SCANNING?
JRST CRET ;YES, WE'RE DONE
TPR1: JUMPE P1,CRET
CALL GETINC
MOVE A,CH
CALL TYO
SKIPE ABORTF ;ABORTING?
JRST TYOQT ;YES
SOJA P1,TPR1
QGET2: TLZN C,377770 ;DOES Q-REG CONTAIN TEXT?
TLZN C,400000
ERROR <QREG DOES NOT CONTAIN TEXT>
ADD C,QRBUF ;YES
MOVE I,C ;I:=Q-REG BUFFER ADDRESS
CALL GETINC ;IS FIRST CHARACTER IN BUFFER 141?
CAIE CH,141
ERROR <QREG DOES NOT CONTAIN TEXT>
CALL GETINC ;p1:=LENGTH OF STRING
MOVEM CH,P1
CALL GETINC
LSH P1,7 ;RECONSTRUCT CHAR COUNT,
IOR P1,CH ;MOST SIGNIFICANT CHARS FIRST
CALL GETINC
LSH P1,7
IOR P1,CH
SUBI P1,4
RET
;]I POPS Q-REGISTER IN OFF THE Q-REGISTER PUSHDOWN LIST.
; THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED.
CLOSEB: SKIPA P1,[POP A,]
;[I PUSHES Q-REGISTER IN ONTO THE Q-REGISTER PUSHDOWN LIST.
OPENB: MOVSI P1,(<PUSH A,>)
CALL QREGVI
HRRI P1,QTAB-"0"(CH) ;p1:=Q-REGISTER INDEX.
MOVE A,PF ;GET STACK POINTER
XCT P1 ;PUSH OR POP Q-REGISTER.
MOVEM A,PF ;SAVE NEW POINTER
TRNE FF,ARG ;IS THERE AN ARGUMENT?
JRST CD2 ;YES. DON'T DESTROY IT.
JRST CRET ;NO. CLEAR FLAGS.
;UNLOAD (;U, ;D) COMMANDS
DNLOAD: SKIPE WRITEF ;MAKE SURE WE'RE AT BEGINNING OF OUTPUT FILE
ERROR <;Invalid ;D command - output file already partially written>
SETOM DUNFLG ;SAY ;D MODE
SKIPA
UNLOAD: SETZM DUNFLG ;SAY ;U MODE
CALL SKPWRT ;FILE OPEN?
CALL UNLD1 ;NO, GO OPEN ONE
MOVE A,OUTJFN ;GET HANDLE ON OUTPUT DEVICE
SKIPE DUNFLG ;PUT IN HEADING IF REQUESTED
CALL HEDING ;PUT HEADING IN OUTPUT FILE
MOVSI C,1 ;A LARGE NUMBER OF PAGES
TRO FF,ARG ;MAKE BELIEVE IT WAS TYPED IN
CALL PUNCH ;PUNCH THOSE PAGES
CALL CLOSEF ;CLOSE AND RENAME FILES
RET
UNLD1: HRROI B,[ASCIZ /OUTPUT FILE: /]
MOVX A,GJ%FOU+GJ%MSG ;specify output file spec
CALL GETCFM ;GET FILE NAME FROM USER AND ASSIGN JFN
TXO FF,DUMPF ;REMEMBER DOING LARGE DUMP
JRST OPNOUT ;OPEN FILE AND RETURN
;GET FILESPEC AND CONFIRMATION. CALL WITH GTJFN BITS IN A, PROMPT
;POINTER IN B. RETURNS WITH JFN IN A.
GETCFM: STKVAR <<QUAG,2>,<ARGS1,2>,NAMPTX>
DMOVEM A,ARGS1 ;SAVE GTJFN BITS
GETCF1: DMOVE A,ARGS1
CALL GSCRIP ;DO THE GTJFN
DMOVEM A,QUAG ;SUCCESS, SAVE GTJFN DATA
TXNE FF,RSCANF ;RESCANNING?
JRST GETCF2 ;YES, SO DON'T WAIT FOR CONFIRMATION
CALL CONFRM ;confirm
JRST GETCFB ;BAD CONFIRMATION
GETCF2: MOVE C,[440700,,NAMBFR] ;GET POINTER TO BEGINNING OF NAME AREA
MOVEM C,NAMPTX
NAMSTR: ILDB A,NAMPTX ;PICK UP CHARACTER FROM SCRIPT
JUMPE A,NAMS1 ;LEAVE LOOP WHEN NULL HIT
CALL BCHAR ;PUT CHARACTER IN LOG FILE
JRST NAMSTR ;LOOP FOR REST OF NAME.
NAMS1: MOVEI A,15
CALL BCHAR ;FINISH WITH CRLF
MOVEI A,12
CALL BCHAR
MRETYP: TXNE FF,RSCANF
JRST MRTYP1 ;ALWAYS RETYPE NAME IF RESCANNING
SKIPE TERIO
JRST MR1 ;ON TERMINAL IO AND NOT RESCANNING, DON'T RETYPE NAME.
MRTYP1: MOVE B,GTJJFN ;PUT RECEIVED JFN IN 2
MOVEI A,101 ;AND DIRECT OUTPUT TO TTY
MOVEI C,0 ;STANDARD PRINTOUT
JFNS ;PRINT FILE NAME
CALL CRR
MR1: MOVE A,GTJJFN ;PUT JFN BACK IN 1
RET ;SUCCESS RETURN
GETCFB: LERROR <Carriage return required after filespec
>
JRST GETCF1
;ROUTINE WHICH SAVES FILENAME DEFAULT STRING. GIVE IT JFN IN A.
;NOTE THAT IF ONLY THE JFN BLOCK DEFAULTS ARE DEPENDED ON, THEN COMND
;WILL JUST REPROMPT FOR FILESPEC IF YOU TRY TO DEFAULT IT BY TYPING
;<CR>.
SETFDS: MOVE B,A ;JFN IN B
HRROI A,DEFSPC ;POINT TO DEFAULT SPEC AREA
MOVX C,1B8+1B11+JS%PAF ;JUST NAME, EXTENSION, PUNCTUATE ALL FIELDS
JFNS ;STORE THE STRING
RET
;ROUTINE TO DO LONG FORM GTJFN AND STORE TYPED NAME IN LOG FILE.
;CALL ROUTINE WITH GTJFN BITS IN A
;give it pointer to prompt string in b.
;THE JFN IS RETURNED IN "A". THE ROUTINE RETURNS WHEN THE GTJFN SUCCEEDS
GSCRIP: STKVAR <PROMPT,FAILF>
SETOM FAILF ;SAY WE HAVEN'T HAD A FAILURE YET
MOVEM A,CJFNBK+.GJGEN ;remember GTJFN code
MOVEM B,PROMPT ;remember pointer to prompt
MOVSI B,774000 ;MASK FOR SEEING IF STRINGS EXIST
HRROI A,DEFNAM ;GET POINTER TO DEFAULT NAME
TDNE B,DEFNAM ;IS THERE ONE?
MOVEM A,CJFNBK+.GJNAM ;YES, USE IT
HRROI A,DEFEXT ;SAME SCHTUCK WITH EXTENSION
TDNE B,DEFEXT
MOVEM A,CJFNBK+.GJEXT
GSR2: MOVE A,PROMPT ;GET POINTER TO PROMPT STRING
TXNN FF,RSCANF ;ARE WE RESCANNING??
JRST GSR3 ;NO
PSOUT ;YES, PRINT THE PROMPT
JRST GSR1
GSR3: CALL READY ;type prompt
MOVX A,CM%DPP ;FIRST ASSUME THERE'S A DEFAULT STRING
IORM A,FILCBK+.CMFNP ;TURN ON DEFAULT BIT
MOVSI B,774000 ;MASK FOR FIRST CHARACTER OF DEFAULT
TDNN B,DEFSPC ;IS THERE A DEFAULT?
ANDCAM A,FILCBK+.CMFNP ;NO, TURN OFF DEFAULT BIT
GSR4: MOVEI A,FILCBK ;POINT TO FILE FUNCTION BLOCK
CALL READFL ;read filespec
GSR1: SKIPN GTJERR ;WAS THERE AN ERROR?
RET ;NO, JUST RETURN
AOSE FAILF ;FIRST FAILURE?
JRST GSR5 ;NO, SO DON'T TRY AGAIN
SETZM CJFNBK+.GJNAM ;YES, SEE IF REMOVING DEFAULTS HELP
SETZM CJFNBK+.GJEXT
JRST GSR4 ;GO BACK AND REINTERPRET INPUT
GSR5: TXZ FF,RSCANF ;IF RESCANNED NAME FAILS, MAKE USER TYPE IT
MOVE A,GTJERR ;GET REASON FOR FAILURE
MOVEM A,LSTERR ;SAVE FOR ERROR ROUTINE
LJERR <CAN'T ACCESS FILE>
JRST GSR2 ;GO BACK AND TRY AGAIN
;ROUTINE TO READ FILESPEC USING COMND JSYS.
;PASS IT THE COMND FUNCTION BLOCK ADDRESS IN A.
READFL: SETZM GTJERR ;FIRST ASSUME NO GTJFN ERROR
CALL RFIELD ;READ FILESPEC
HRRZM B,GTJERR ;SAVE ERROR CODE
MOVEM B,GTJJFN ;REMEMBER JFN
MOVE A,GTJJFN ;GET THE JFN
SKIPN GTJERR ;DO WE HAVE ONE?
CALL STORNM ;YES, REMEMBER ITS NAME
RET
;ROUTINE TO DO GTJFN AND STORE THE FILENAME SO THAT WFILENAME WILL
;BE ABLE TO GET IT. ASSUMES THE AC'S ARE ALREADY SET UP FOR GTJFN.
;IT RETURNS +1 ON FAILURE, +2 SUCCESS, GTJFN DATA IN A AND B.
DOGTJ: STKVAR <<GTJDAT,2>>
GTJFN ;DO THE GTJFN
RET ;RETURN IF FAILURE
DMOVEM A,GTJDAT ;REMEMBER GTJFN DATA
CALL STORNM ;store file name
DMOVE A,GTJDAT ;return gtjfn data in a and b
RETSKP
;routine to store filename string in nambfr. pass it the jfn in a.
STORNM: MOVE B,A ;JFN IN B
HRROI A,NAMBFR ;PREPARE TO STORE NAME
MOVX C,1B2+1B5+1B8+1B11+1B14+JS%PAF ;WE WANT ALL FIELDS PUNCTUATED
JFNS ;STORE THE FILESPEC FOR WFILENAME
RET
;LOAD ENTIRE FILE COMMAND - ;Y
YLOAD: TRNE FF,ARG+ARG2
ERROR <ARGUMENT GIVEN WHERE NOT ALLOWED>
TXNN FF,UREAD ;FILE OPEN?
CALL YLD1 ;NO, GO OPEN ONE
CALL SINLD
MOVE C,ZEE ;NUMBER OF CHARS NOW IN BUFFER
SUB C,BEG
MOVEI A,TYO ;SAY WHERE TO OUTPUT CHARS
CALL DPT0 ;DECIMAL PRINT FROM c
PSTR < CHARS
>
RET
YLD1: HRROI B,[ASCIZ /INPUT FILE: /]
MOVX A,GJ%OLD ;input file
CALL GETCFM ;GET FILE NAME
MOVE B,TYIJFN ;SEE WHERE INPUT CAME FROM
CAIN B,100 ;DON'T CLEAR RESCAN FLAG YET IF NOT PRIMARY INPUT DEVICE.
TXZ FF,RSCANF ;NOTE THAT WE'RE NOT RESCANNING ANYMORE.
JRST OPNIN ;GO OPEN THE FILE.
;FAST LOAD OF FILE USING SIN
SINLD: STKVAR <LCS,FSPC>
SINLD2: TRZ FF,FORM
MOVE A,ZEE
CALL MOVHOL ;PUT HOLE AT END OF BUFFER
CALL FILFRE ;GET NUMBER OF CHARACTERS WE CAN READ IN
MOVEM A,FSPC
MOVE 1,INJFN
MOVE OU,ZEE ;PUT FILE AT END OF BFR
CALL PUT ;COMPUTE BYTE PTR
CALL DBP ;BACKUP 1
MOVE 2,TT ;SET IT FOR SIN
MOVE C,FSPC ;GET NUMBER OF CHARACTERS WE CAN READ
JUMPLE 3,[ERROR (<FILE TOO LARGE FOR BUFFER>)]
MOVN 3,3 ;MAKE NEG FOR SIN
PUSH P,3
SIN ;DO ALL OF FILE OR AS MUCH AS FITS
POP P,TT
SUBM 3,TT ;COMPUTE AMOUNT DONE
ADDM TT,ZEE ;UPDATE Z
ADDM TT,HOLBEG ;NOTE THAT HOLE STARTS FURTHER TO THE RIGHT
LDB CH,2 ;GET LAST CHAR STORED
MOVEM CH,LCS ;REMEMBER IT
SUB TT,INBYC ;CALCULATE AMOUNT LEFT IN FILE
MOVNM TT,INBYC ;REMEMBER IT
MOVE A,INJFN ;GET HANDLE ON FILE
RFPTR ;FIND OUT HOW FAR WE'VE READ
JSERR ;SHOULDN'T FAIL, BUT PRINT ERROR IF DOES
IDIVI B,CPP ;GET CURRENT PAGE NUMBER AND POSITION WITHIN PAGE
MOVE D,C ;D HOLDS BYTE POSITION WITHIN PAGE FOR NEXT BYTE TO BE READ
ADJBP D,IBUFPT ;GET CORRECT POINTER INTO INTERNAL BUFFER
MOVEM D,IBFRP ;REMEMBER IT
SUBI C,CPP ;CALCULATE NUMBER OF BYTES LEFT TO READ ON PAGE
MOVNM C,IBFRC ;REMEMBER POSITIVE NUMBER OF BYTES LEFT
HRRZM B,INFPG ;REMEMBER CURRENT INPUT PAGE
HRR A,B ;GET PAGE NUMBER
MOVE D,FBIN ;SEE WHAT SORT OF INPUT WE'RE DOING
CAIN D,FBIN1 ;DON'T DO PMAP IF IT'S NOT A PMAPABLE FILE
CALL PMAPIN ;PMAP IN THE CURRENT PAGE
CALL SETHPT ;SET HOLE POINTERS
MOVE A,INJFN ;RESTORE CLOBBERED JFN
GTSTS
TLNN 2,(1B8) ;NOW AT END OF FILE?
JRST SINLD2 ;NO, TRY AGAIN
MOVE CH,LCS ;GET LAST CHARACTER STORED
CAIN CH,"L"-100 ;IS LAST CHAR FORMFEED?
TRO FF,FORM ;YES
TXO FF,FINF ;YES
CALL CLSINF ;CLOSE INPUT FILE
RET
;ER PREPARE TO READ FILE
OPNRD: TXNE FF,SCANF ;JUST SCANNING?
CALLRET SCSTR ;YES, JUST FIND END OF STRING
TXNE FF,UREAD ;FILE NOW OPEN?
CALL CLSINF ;CLOSE INPUT FILE
CALL FILSPC ;GET FILE SPEC
MOVSI 1,(1B2+1B17) ;OLD FILE+SHORT FORM
CALL DOGTJ ;DO GTJFN, AND REMEMBER FILENAME
JRST TYINPT
DPB CH,CPTR ;PUT ESCAPE BACK IN
OPNIN: HRRZM 1,INJFN
HRROI 1,DEFNAM ;GET COMPLETE NAME OF FILE JUST OPENED
MOVE 2,INJFN ;FOR POSSIBLE LATER USE AS DEFAULT
MOVSI 3,(1B8) ;NAME ONLY
JFNS
HRROI A,DEFEXT
MOVSI 3,(1B11) ;EXTENSION ONLY
JFNS
MOVE A,INJFN ;GET THE JFN
CALL SETFDS ;SET FILENAME DEFAULT STRING
MOVE 1,INJFN
MOVE 2,[7B5+1B19] ;BYTE SIZE+READ
SKIPE BASICF ;ARE WE FILTERING OUT LINE NUMBERS ??
TRO B,OF%PLN ;NO. (MAYBE A "BASIC" FILE).
OPENF
JRST TYNOPN
TXO FF,UREAD ;FILE OPEN
TXZ FF,FINF ;NOT EOF
DVCHR
TLNN 2,(1B4) ;MULT DIR DEVICE?
JRST [ MOVEI 1,FBIN0 ;NO, USE REGULAR BIN
MOVEM 1,FBIN
RET]
MOVE 1,INJFN
MOVE 2,[XWD 2,11]
MOVEI 3,3
GTFDB ;GET BYTE SIZE AND COUNT
LDB 3,[POINT 6,3,11] ;GET BYTE SIZE
CAIN 3,7 ;SIZE WE WANT?
JRST OPNT1 ;YES, NO CONVERSIN
MOVEI 2,^D36 ;NO, MUST CONVERT TO 7-BIT EQUIV
IDIVI 2,0(3) ;GIVES N-BIT BYTES PER WORD
IDIVI 4,0(2) ;GIVES WORDS IN FILE
IMULI 4,5 ;GIVES 7-BIT BYTES IN FILE
OPNT1: MOVEM 4,INBYC ;SETUP BYTE COUNT
SETOM INFPG ;START WITH PAGE 0 AFTER AOS
SETZM IBFRC
MOVEI 1,FBIN1
MOVEM 1,FBIN ;FIRST CALL WILL DO THE REST
RET
;TYPE INPUT DEVICE ERROR
TYNOPN: MOVE 1,INJFN ;RELEASE JFN
RLJFN
JFCL
CAIA
TYINPT: DPB CH,CPTR ;UNCLOBBER COMMAND STRING
SETOM INJFN
CALL JSER
ERROR <FILE OPERATION FAILED>
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)
OPNWR: TXNE FF,SCANF ;JUST SCANNING?
CALLRET SCSTR ;YES, JUST FIND END OF STRING
CALL SKPWRT ;OUTPUT FILE NOW OPEN?
CAIA ;NO
CALL CLOSEF ;CLOSE IT
CALL FILSPC
MOVSI 1,(1B0+1B3+1B17) ;WRITE+PRINT OLD/NEW+SHRT
CALL DOGTJ ;DO GTJFN AND REMEMBER FILESPEC
JRST OPNBAD
DPB CH,CPTR
OPNOUT: HRRZM 1,OUTJFN
HRROI 1,DEFNAM ;GET COMPLETE NAME OF FILE JUST OPENED
MOVE 2,OUTJFN ;FOR POSSIBLE LATER USE AS DEFAULT
MOVSI 3,(1B8) ;NAME ONLY
JFNS
HRROI 1,DEFEXT ;EXTENSION STRING
MOVSI 3,(1B11) ;EXTENSION ONLY
JFNS
MOVE A,OUTJFN
CALL SETFDS ;SET FILENAME DEFAULT STRING
MOVE 1,OUTJFN
DVCHR
TLZ 2,(1B4) ;THIS CODE IS A MESS BUT "WORKS"
PUSH P,2 ;SAVE FOR LATER TEST
TLNN 2,(1B4) ;PMAP-ABLE DEVICE?
SKIPA 2,[7B5+1B20] ;NO. OPEN ONLY FOR WRITING
MOVE 2,[7B5+3B20] ;YES. BLT AND IDPB NEED READ ACCESS
MOVE 1,OUTJFN
OPENF
JRST OUTER1
SETZM WRITEF ;MARK THAT NO OUTPUT HAS HAPPENED YET
TXO FF,UWRITE ;SAY WE HAVE OUTPUT FILE OPEN
POP P,2 ;GET BACK DEVICE CHARACTERISTICS
TLNN 2,(1B4) ;MULT DIR DEVICE?
JRST [ MOVEI 1,FBOUT0
MOVEM 1,FBOUT ;USE REGULAR BOUT
RET]
SETZM OBFRC ;YES, SETUP FOR PMAP
SETOM OUFPG
MOVNI 1,CPP ;1 BUFFERLOAD OF CHARS
MOVEM 1,OUBYC ;WILL BE SET TO 0 ON FIRST CALL
MOVEI 1,FBOUT1
MOVEM 1,FBOUT
RET
OPNBAD: DPB CH,CPTR ;UNCLOBBER COMMAND STRING
JRST OUTERR
;SKPWRT SKIPS IFF AN OUTPUT FILE IS OPEN. IF UWRITE IS OFF AND CREJFN IS
;NON-0, SKPWRT SILENTLY OPENS THE OUTPUT FILE AND SKIPS. THIS IS SO THAT
;IF THE USER GIVES THE EXEC COMMAND "EDIT A.B.1 A.B.1", ^C WILL LEAVE A.B.1
;INTACT. NOTE THAT OPENING THE OUTPUT FILE AT STARTUP WOULD FLUSH ITS
;CONTENTS.
SKPWRT: SKIPN CREJFN ;ANY OUTPUT SPEC WAITING TO BE OPENED?
TXNE FF,UWRITE ;OUTPUT FILE, OR LATENT ONE?
CAIA
RET ;NEITHER, SO DON'T SKIP
TXNE FF,UWRITE ;OUTPUT FILE ALREADY OPEN?
RETSKP ;YES, SO SKIP TO SAY SO
SKIPE INIJFN ;STILL DOING TV.INI?
RET ;YES, SO DON'T OPEN LATENT FILE YET
MOVE A,CREJFN ;DOING CREATE, SO CREATE THE FILE NOW
CALL OPNOUT ;OPEN IT FOR OUTPUT
SETZM CREJFN ;THERE'S NO MORE LATENT OUTPUT SPEC
RETSKP ;SAY OUTPUT FILE OPEN
;ROUTINE USED DURING SCANNING TO FIND ESCAPE AND RETURN
SCSTR: CALL SKRCH ;READ NEXT CHARACTER
CAIE CH,.CHESC ;FIND IT YET?
JRST SCSTR ;NOT YET
RET ;YES
;PUT HEADING INTO OUTPUT FILE
HEDING: MOVEI 2,";"
CALL BOUTX
HRRZ 2,OUTJFN
MOVE 3,[1B5+1B8+1B11+1B14+1B35]
CALL JFNSX
HRROI 2,[ASCIZ /, /]
SETZ 3,
CALL SOUTX
SETO 2,
SETZ 3,
CALL ODTIMX
HRROI 2,[ASCIZ /, EDIT BY /]
CALL SOUTX
PUSH P,1 ;SAVE STRING POINTER
GJINF
MOVE 2,1
POP P,1
CALL DIRSTX
JFCL
MOVEI 2,15
CALL BOUTX
MOVEI 2,12
CALL BOUTX
RET
OUTER1: MOVE 1,OUTJFN
RLJFN ;RELEASE JFN
JFCL
SETZM CREJFN ;DON'T LET NEXT ATTEMPT USE SAME JFN
OUTERR: SETOM OUTJFN
CALL JSER
ERROR <FILE OPERATION FAILED>
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: CALL SKPWRT ;OPEN LATENT OUTPUT FILE NOW
JFCL ;WE DON'T CARE WHETHER THERE WAS ONE
TXZN FF,UWRITE!DUMPF
RET
MOVE 1,FBOUT
CAIE 1,FBOUT1 ;PMAP CASE?
JRST CLOS2 ;NO
SETO 1, ;YES, CLEAR OUT LAST PAGE
XMOVEI 2,OBFPGA
LSH 2,-11 ;GET PROCESS PAGE #
HRLI 2,.FHSLF ;FORK HANDLE ,, PAGE #
SETZ 3,
PMAP
MOVE 1,OUTJFN
HRLI 1,11
MOVSI 2,(77B11) ;SET FILE BYTE SIZE TO 7
MOVSI 3,(7B11) ;SEVEN COME ELEVEN ...
CHFDB
HRLI 1,12
SETO 2,
MOVE 3,OUBYC ;SET FILE BYTE COUNT
ADDI 3,5000 ;LAST BUFFER CONTAINS 5000-OBFRC CHARS
SUB 3,OBFRC
CHFDB
CLOS2: MOVE 1,OUTJFN
CLOSF
JFCL
SETZM WRITEF ;MARK THAT NO DATA WRITTEN IN OUTPUT FILE (ANYMORE...YET...WHAT HAVE YOU)
SETOM OUTJFN
RET
;CLOSE INPUT FILE
CLSINF: TXZN FF,UREAD
RET
SETO 1,
XMOVEI 2,IBFPGA
LSH 2,-11 ;GET PROCESS PAGE #
HRLI 2,.FHSLF ;FORK HANDLE ,, PAGE #
SETZ 3,
PMAP ;UNMAP LAST PAGE IF ANY
MOVE 1,INJFN
CLOSF
JFCL
SETOM INJFN
RET
;GATHER FILE NAME
FILSPC: STKVAR <SAVFPT>
MOVE B,CPTR ;GET POINTER TO BEGINNING OF FILESPEC
MOVEM B,SAVFPT ;REMEMBER IT
FILS2: CALL SKRCH
CAIE CH,.CHESC ;FIND THE ESC
JRST FILS2
SETZ CH, ;SMASH IT TO 0
DPB CH,CPTR
MOVEI CH,.CHESC ;prepare to unclobber command string
MOVE B,SAVFPT ;RETURN POINTER IN B
RET ;RETURN ORIGINAL CPTR
;Y RENDER THE BUFFER EMPTY. READ INTO THE BUFFER UNTIL
; (A) A FORM FEED CHARACTER IS READ, OR
; (B) THE BUFFER IS WITHIN ONE THIRD OR
;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR
; (C) AN END OF FILE IS READ, OR
; (D) THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES ENTER THE BUFFER.
YANK:
YANK1: TXNN FF,UREAD ;HAS AN INPUT FILE BEEN SPECIFIED?
JRST YANK09 ;NO.
SKIPE ABORTF ;ABORT REQUEST?
RET ;YES, DON'T CLOBBER BUFFER
CALL HK ;KILL ENTIRE BUFFER
MOVE OU,BEG ;SPECIFY THAT NEW DATA GOES AT BEGINNING OF BUFFER
YANK2: STKVAR <OLDZ,MAX,WHERE2>
TXNE FF,FINF ;ALREADY AT END OF FILE?
RET ;YES, NOTHING TO READ!
MOVEM OU,WHERE2 ;REMEMBER WHERE INPUT IS BEING PUT
MOVE A,OU ;SEE WHERE WE'RE PUTTING THE DATA
CALL MOVHOL ;POSITION THE HOLE HERE
CALL FILFRE ;SEE HOW MANY CHARACTERS WE'RE ALLOWED TO INSERT
MOVEM A,MAX ;REMEMBER
MOVE OU,WHERE2 ;GET PLACE WE'RE PUTTIN DATA
MOVE A,ZEE ;GET Z BEFORE THE EXPANSION
MOVEM A,OLDZ ;REMEMBER IT SO NEW HOLE SIZE WILL BE KNOWN
TRZ FF,FORM ;RESET THE YANK,APPEND FORM FEED FLAG
CALL PUT ;CONSTRUCT BYTE PTR FOR DESTINATION
CALL DBP ;DECREMENT IT BECAUSE IDPB USED BELOW
MOVE P1,TT
TXNN FF,UREAD ;HAS AN INPUT FILE BEEN SPECIFIED?
JRST YANK09 ;NO.
YANK3: SOSGE MAX ;ROOM FOR ANOTHER CHARACTER?
JRST YANK51 ;NO, STOP INPUTTING NOW
Y1: HRRZ CX,FBIN
CALL (CX)
JUMPE CH,Y1 ;FLUSH NULLS
IDPB CH,P1 ;PUT CHAR IN BUFFER
ADDI OU,1
SKIPE ABORTF ;ABORT REQUEST?
JRST YANK51 ;YES, QUIT WITH WHAT WE HAVE
CAIE CH,14 ;FORM FEED?
JRST YANK3
TRO FF,FORM ;Y OR A TERMINATED ON FORM FEED
YANK51: MOVEM OU,ZEE ;YES. SET END OF DATA BUFFER AND RETURN
SUB OU,OLDZ ;OU HAS NUMBER OF CHARACTERS WE ADDED
ADDM OU,HOLBEG ;HOLE STARTS FURTHER TO RIGHT NOW
CALLRET SETHPT ;SET HOLE POINTERS
YANK59: POP P,CH ;FLUSH LOCAL RETURN
TXO FF,FINF ;YES
JRST YANK51 ;END INPUT
FBIN0: PUSH P,1
MOVE 1,INJFN ;REGULAR BIN CASE
MOVE CH,2
FBIN2: BIN
JUMPE 2,[GTSTS ;POSSIBLE EOF
TLNN 2,(1B8)
JRST FBIN2 ;NULL, TRY AGAIN
POP P,1
JRST YANK59]
EXCH CH,2
POP P,1
RET
FBIN1: SOSGE IBFRC ;FAST CASE, ANY CHARS LEFT?
JRST FBI1 ;NO, GO REFILL PAGE
ILDB CH,IBFRP
SOS INBYC ;KEEP TRACK OF BYTES LEFT
RET
FBI1: SKIPG INBYC ;EOF?
JRST YANK59 ;YES
PUSH P,1
PUSH P,2
PUSH P,3
AOS 1,INFPG ;NO, MAP IN NEXT PAGE OF FILE
CALL PMAPIN ;MAP IN NEXT INPUT FILE PAGE
MOVEI 1,CPP ;NO. CHARS IN BFR
CAML 1,INBYC ;FULL BUFFER LEFT IN FILE?
MOVE 1,INBYC ;NO, USE ONLY WHATS LEFT
MOVEM 1,IBFRC ;SETUP COUNT FOR THIS BUFFER
MOVE 1,IBUFPT
MOVEM 1,IBFRP ;FRESH POINTER
POP P,3
POP P,2
POP P,1
JRST FBIN1
IBUFPT: POINT 7,IBFPGA,-1
YANK09: ERROR <NO FILE FOR INPUT>
;ROUTINE TO MAP IN INPUT FILE PAGE INTO OUR INTERNAL BUFFER. ACCEPTS
;FILE PAGE NUMBER IN RIGHT HALF OF A.
PMAPIN: HRL 1,INJFN
XMOVEI 2,IBFPGA
LSH 2,-11 ;GET PROCESS PAGE #
HRLI 2,.FHSLF ;FORK HANDLE ,, PAGE #
MOVSI 3,(PM%RD) ;READ ACCESS
PMAP
RET
;A APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT
; TERMINATING THE READ IN THE SAME MANNER AS Y. THE POINTER
; IS NOT MOVED BY A.
APPEND: MOVE OU,ZEE ;STORE DATA AT END OF BUFFER.
CALL YANK2
JRST CRET
;^ITEXT$ INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB)
; AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE
; ALT MODE. THE POINTER IS PUT TO THE RIGHT OF THE INSERTED
; MATERIAL.
TAB: MOVE A,[440700,,[BYTE (7).CHTAB]] ;PREPARE TO INSERT TAB
MOVEI B,1 ;ONLY ONE CHARACTER
CALL INSRT0 ;INSERT THE TAB
;... ;FALL INTO STANDARD INSERT CODE
;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
; THE IN UP TO BUT NOT INCLUDING THE FIRST ALT. MODE. THE
; POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
;NOTE: The I command can't just blindly insert its characters, since there
;may be case control characters in the string. Therefore the I command doesn't
;use INSRT0. If you are looking for the general text insertion routine, please
;see INSRT0.
INSERT: TRNE FF,ARG ;IS THERE AN ARGUMENT?
JRST INS1A ;YES. NI COMMAND.
;ENTRY FROM REPLACE COMMAND
RPINS: STKVAR <IBEG,IDSPTR,UUF,LLF,ITERM,ICNT,IBEG>
SKIPE ABORTF ;ABORT REQUEST?
RET ;YES, DON'T START INSERT
MOVEI CH,.CHESC ;NO. CH:=ALT-MODE.
TRNE FF,SLSL ;DID @ PRECEED I?
CALL RCH ;YES. CH:=USER SELECTED TERMINATOR.
MOVEM CH,ITERM ;A:=INSERTION TERMINATOR.
SETZM UUF ;SAY NO CASE CONTROL HAPPENING YET
SETZM LLF
MOVE A,PT
TXNN FF,SCANF ;DON'T MOVE HOLE IF SCANNING
CALL MOVHOL ;PUT HOLE WHERE WE'RE INSERTING
MOVE A,PT
CALL ADDPTR ;MAKE BYTE POINTER TO DESTINATION OF INSERTION
MOVNI B,1 ;BACK UP 1 SINCE IDPB BEING DONE
ADJBP B,A
MOVEM B,IDSPTR ;REMEMBER DESTINATION POINTER
MOVEM B,IBEG ;REMEMBER BEGINNING FOR MEASURING
CALL NFREE ;SEE HOW MANY CHARACTERS WE'RE ALLOWED TO INSERT
MOVEM A,ICNT
INXT: CALL SKRCH ;GET NEXT CHARACTER
CAIN CH,C.QUOT ;QUOTE REQUEST?
JRST [ CALL SKRCH ;YES, READ CHARACTER BEING QUOTED
JRST II] ;GO INSERT IT
CAMN CH,ITERM ;FOUND THE TERMINATOR?
JRST ITDON ;YES
CAIN CH,C.LOWR ;FORCE LOWERCASE?
JRST [ CALL SKRCH ;YES LOOK AT NEXT
CAIN CH,C.LOWR ;LOCK LOWERCASE?
JRST [ SETOM LLF ;YES
SETZM UUF ;UNLOCK UPPERS
JRST INXT]
LOAD CH,LWRCOD,(CH) ;NO, JUST MAKE ONE CHARACTER LOWERCASE
JRST II] ;AND GO INSERT THE ONE BEING LOWERED
CAIN CH,C.RAIS ;FORCING UPPER?
JRST [ CALL SKRCH ;YES, LOOK AT NEXT CHARACTER
CAIN CH,C.RAIS ;LOCKING INTO UPPERCASE?
JRST [ SETOM UUF ;YES, REMEMBER
SETZM LLF ;AND UNLOCK LOWERS
JRST INXT] ;GO GET NEXT CHARACTER
LOAD CH,UPRCOD,(CH) ;NOT LOCKING UPPERCASE, JUST MAKE ONE CHARACTER UPPERCASE
JRST II] ;GO INSERT IT
SKIPE UUF ;FORCING UPPER?
LOAD CH,UPRCOD,(CH) ;YES, GET UPPERCASE
SKIPE LLF ;FORCING LOWER?
LOAD CH,LWRCOD,(CH) ;YES, GET LOWERCASE
II: SOSGE ICNT ;ROOM FOR THIS CHARACTER?
JRST IERR ;NO, FAIL
TXNN FF,SCANF ;DON'T REALLY INSERT IF SCANNING
IDPB CH,IDSPTR ;STORE CHARACTER IN INSERTION STRING
JRST INXT ;LOOP FOR REST OF INSERTION
ITDON: TXNE FF,SCANF ;SCANNING?
RET ;YES, DON'T CHANGE POINTER ETC.
MOVE A,IDSPTR ;GET PLACE TEXT RAN TO
MOVE B,IBEG ;GET PLACE WE STARTED
CALL SUBBP ;SEE HOW MANY CHARACTERS GOT INSERTED
ADDM A,ZEE ;SHOW INCREASE IN BUFFER SIZE
ADDM A,PT ;POINTER HAS ALSO MOVED TO RIGHT
ADDM A,HOLBEG ;HOLE STARTS FURTHER TO RIGHT NOW (IT'S SMALLER)
CALL SETHPT ;UPDATE HOLE DATA
RET ;DONE
;ASCIZ INSERT ROUTINE. INSERTS THE ASCIZ STRING (ONE MARKED BY
;(NULL AT END
;CALL:
; A/ POINTER TO ASCIZ STRING
; CALL INSRTZ
;RETURN:
; +1 ALWAYS
INSRTZ: MOVE C,A ;GET COPY OF INSERTION POINTER
MOVEI B,0 ;FIRST ASSUME 0 CHARACTERS
INZ1: ILDB D,C ;GET CHARACTER
CAIE D,0
AOJA B,INZ1 ;LOOP UNTIL NULL FOUND
CALLRET INSRT0 ;DO INSERTION NOW THAT STRING HAS BEEN MEASURED
;GENERAL INSERT ROUTINE. IT ALWAYS INSERTS TEXT AT THE POINTER.
;THE CALL:
; A/ POINTER TO INSERTION
; B/ NUMBER OF CHARACTERS
; CALL INSRT0
;RETURNS:
; +1 ALWAYS
; UPDATED POINTER IN A POINTING TO END OF INSERTION
INSRT0: STKVAR <IPT,IC>
MOVEM A,IPT ;SAVE POINTER
MOVEM B,IC ;SAVE COUNT
MOVE A,PT
CALL MOVHOL ;put hole where insert is going
MOVE P1,IC ;get size of insert
CALL NFREE ;SEE HOW MANY MORE CHARACTERS WILL FIT IN BUFFER
CAMGE A,IC ;MAKE SURE THERE'S ROOM FOR THE INSERTION
IERR: ERROR <No room in buffer>
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE I,IPT ;GET BEGINNING OF INSERTION
JUMPE P1,INS1C ;IN CASE SOURCE IS NULL
MOVE OU,PT
ADDM P1,PT ;UPDATE POINT
CALL PUT ;COMPUTE DEST BYTE PTR
CALL DBP ;BACKUP TO BEGINNING OF DEST
MOVE OU,TT
CALL MVSTR ;MOVE STRING FROM I TO OU
MOVE A,IC ;GET SIZE OF INSERTION
ADDM A,HOLBEG ;HOLE STARTS AT A LARGER ADDRESS NOW
ADDM A,ZEE ;THERE'S MORE IN BUFFER NOW TOO!
CALL SETHPT ;SET HOLE POINTERS
INS1C: MOVE A,IC ;RETURN UPDATED INSERTION POINTER IN A
ADJBP A,IPT
RET
; ;G INSERT LAST COMMAND STRING (OF .G. 15 CHARS) INTO BUFFER
GETOB: HLRZ B,LSTCB ;NUMBER OF CHARS
JUMPE B,CRET ;NO SAVED STRING
MOVEI A,1 ;SKIP OVER THE PROMPT CHARACTER
ADJBP A,[POINT 7,CBUF] ;CONSTRUCT PTR TO SAVED STRING
CALL INSRT0 ;INSERT COMMAND STRING INTO BUFFER
JRST CRET
;WBACKUP$ - TURN ON BACKUP SYSTEM
BACKUP: SETOM BAKFLG
RET
;WNOBACK$ - TURN OFF BACKUP SYSTEM
NOBACK: SETZM BAKFLG
RET
;TERMINAL INITIALIZATION ROUTINES
DEFINE TERINI (TABNAM)
<
TABNAM:
%%Z==0
BLOCK 100 ;MAKE SURE UNUSED ENTRIES ARE 0
DEFINE TER (SYMBOL,ADDRES)
< LOC TABNAM+SYMBOL
ADDRES
IFG SYMBOL-%%Z,<
%%Z==SYMBOL
>
LOC %%Z+TABNAM+1
>>
;TABLE OF TERMINAL INITIALIZATION ROUTINES, INDEXED BY TERMINAL TYPE
TERINI TRMINI
TER .TTV05,VT05 ;VT05
TER .TT100,VT100 ;VT100
TER .TTV50,VT50 ;VT50
TER .TTV52,VT52 ;VT52
;TABLE OF TERMINAL STANDARD CHARACTERISTICS
LB==7
WB==^D15
SB==^D16
;DEFSTRS TO ACCESS THE VARIOUS TERMINAL STANDARD FIELDS
DEFSTR STDLEN,TERSTD,LB,8
DEFSTR STDWTH,TERSTD,WB,8
DEFSTR SF,TERSTD,SB,1
DEFINE TCR(TYPE,LENGTH,WIDTH,SFF)
< TER TYPE,<LENGTH>B<LB>+<WIDTH>B<WB>+<SFF>B<SB>
>
TERINI TERSTD
RADIX 5+5
TCR .TTV05,20,72,1
TCR .TTV50,12,80,1
TCR .TT100,24,80,1
TCR .TTV52,24,80,1
RADIX 8
;SET UP FOR VT52...
VT52: MOVEI A,.TTV52 ;TERMINAL TYPE
MOVEM A,TRMTYP
CALLRET SETPAR ;SET UP PARAMETERS
;INITIALIZATION FOR VT50
VT50: MOVEI A,13
MOVEM A,TRMTYP ;SET VT50 TERMINAL TYPE.
CALLRET SETPAR
;WVT100 - DECLARE VT100 FLAVOR
VT100: MOVEI A,.TT100
MOVEM A,TRMTYP
SETOM SCRNF
CALLRET SETPAR
;WVT05$ - TELL TECO WE'RE ON A VT05.
VT05: MOVEI A,12
MOVEM A,TRMTYP ;SET VT05 TERMINAL TYPE NUMBER.
SETOM SCRNF ;SET SCREEN FLAG
CALLRET SETPAR ;set up parameters for vt05
;ROUTINE CALLED AT STARTUP AND REENTER TO RESTORE TERMINAL
;CHARACTERISTICS THAT AREN'T INITIALIZED BY RESET JSYS, AND THAT MAY
;HAVE TO BE RESTORED AT REENTER, SINCE JSYS'S SUCH AS COMND MAY HAVE
;CLOBBERED THEM.
SETMOD: MOVEI A,1
MOVEM A,COCNST ;FORCE REGCOC TO DO SOMETHING
CALL REGCOC ;SET UP REGULAR CONTROL CHARACTER STUFF
MOVE A,TTYOUT ;STANDARD OUTPUT CHANNEL
RFMOD ;GET WAKEUP MODES
TXO B,TT%WAK ;WAKE ON EVERYTHING (FOR READING FIRST CHARACTER OF COMMAND)
SFMOD
RET
;REGCOC SETS CONTROL CHARACTER ECHOS TO THAT FOR STANDARD OUTPUT.
REGCOC: SOSE A,COCNST ;SEE HOW MANY TIMES WE'RE NESTED AFTER THIS
RET ;NOTHING TO DO IF OUTER ROUTINE STILL WANTS DISCOC
MOVE A,TTYOUT ;STANDARD OUTPUT
SKIPE FLAGF ;ARE WE SUPPOSED TO FLAG?
JRST [ RFMOD ;YES, GET SETTINGS
TXO B,TT%UOC ;YES, TURN FLAGGING BACK ON
STPAR
JRST .+1]
DMOVE B,REGCWD ;GET STANDARD CONTROL CHARACTER SETTINGS
SFCOC
MOVE B,COCPOS
SFPOS ;UNDO SYSTEM-ACCOUNTING OF ESCAPE SEQUENCE
MOVE A,SWIDTH
CALL SETWID ;RESTORE CORRECT TERMINAL WIDTH
JSHLT ;BETTER NOT FAIL!
RET
;DISCOC CAUSES ALL CONTROL CHARACTERS TO ECHO LITERALLY, AS IS NEEDED BY
;VIDEO DISPLAY FUNCTIONS
DISCOC: AOS A,COCNST ;REMEMBER HOW MANY TIMES WE'VE NESTED
CAIE A,1 ;IS THIS THE FIRST TIME?
RET ;NO, SO NOTHING TO DO
MOVE A,TTYOUT ;STANDARD OUTPUT CHANNEL
SKIPE FLAGF ;IS FLAGGING ON?
JRST [ RFMOD ;YES, TURN IT OFF
TXZ B,TT%UOC ;SINCE WE'LL DO OUR OWN FLAGGING.
STPAR
JRST .+1]
DMOVE B,[EXP 525252525252,525252525252]
SFCOC
RFPOS ;SEE WHERE ON LINE WE ARE
MOVEM B,COCPOS ;REMEMBER SO THAT WE CAN UNDO ERRONEOUS SYSTEM ACCOUNTING OF ESCAPE SEQUENCES
MOVEI A,0 ;DON'T ALLOW LINEWRAP
CALL SETWID
JSHLT ;SHOULDN'T EVER FAIL
RET
;THE FOLLOWING ROUTINE IS CALLED EVERY TIME WE TRANSFER FROM
;THE EXEC (BACK) TO TV. IT ASKS THE SYSTEM WHAT THE CURRENT TERMINAL
;TYPE IS, AND THEN SETS UP ALL THE TERMINAL PARAMETERS.
SYSMOD: MOVEI A,100
GTTYP ;get terminal type
MOVEM B,TRMTYP ;SAVE TERMINAL TYPE
SYSMD1: CALL GETMOD ;GET THE REST OF THE TERMINAL MODES
MOVE A,SLENTH ;GET WINDOW SIZE
CAMLE A,SSIZE ;MAKE SURE WITHIN RANGE
CALL WINSTN ;IF NOT, RESET IT TO A STANDARD SETTING
RET
;CALL THE FOLLOWING AFTER SETTING UP TRMTYP FOR NEW TERMINAL TYPE
SETPAR: MOVEI A,100 ;primary input
MOVE B,TRMTYP ;get new terminal type
STTYP ;tell monitor new terminal type
SETOM MESFLG ;IF TERMINAL TYPE CHANGED, ASSUME SCREEN MESSED UP
CALL SYSMD1 ;go get all the new modes
CALLRET WINSTN ;SET UP STANDARD WINDOW SIZE
;THE FOLLOWING ROUTINE ASSUMES THE SYSTEM'S TERMINAL PARAMETERS
;HAVE BEEN SET UP, AND THIS ROUTINE SETS UP TV'S INTERNAL DATA TO
;REFLECT THE CURRENT TERMINAL SETTINGS
GETMOD: MOVEI A,100 ;primary input device
RFMOD ;get tty info
SETZM FLAGF ;first assume not flagging uppers
TRNE B,TT%UOC
SETOM FLAGF ;system says we're flagging uppers.
CALL GETWID ;GET SYSTEM TERMINAL WIDTH
MOVEI A,0 ;ASSUME DEFAULT IF CAN'T READ IT
MOVE B,TRMTYP ;get terminal type
CAIN A,0 ;IF ZERO,
LOAD A,STDWTH,(B) ;use standard width
MOVEM A,SWIDTH ;set up terminal width
CALL GETLEN ;GET SCREEN SIZE
MOVEI A,0 ;USE STANDARD IF CAN'T
MOVE B,TRMTYP ;get terminal type
CAIG A,MAXLEN ;DON'T ALLOW TOO LARGE SCREEN SIZE
CAIN A,0 ;non-0 length?
LOAD A,STDLEN,(B) ;no, so use standard length
MOVEM A,SSIZE ;remember screen size
LOAD A,SF,(B) ;SEE IF TERMINAL IS A SCREEN
SETZM SCRNF ;FIRST ASSUME NOT
CAIE A,0
SETOM SCRNF ;BUT MAYBE SO!
RET
;ROUTINE TO SET UP STANDARD WINDOW SIZE TO 3 LESS THAN SCREEN SIZE
WINSTN: MOVE A,SSIZE ;GET SCREEN SIZE
SUBI A,3 ;LEAVE ROOM FOR COMMAND LINES AT BOTTOM OF SCREEN
CAIG A,MAXLEN ;MAKE SURE WINDOW SIZE IS LEGAL
CAIGE A,0 ;NEVER CREATE A ZERO WINDOW SIZE FOR STANDARD
MOVEI A,0 ;USE NO WINDOW IF IT'S NEGATIVE AFTER NORMALIZATION
MOVEM A,SLENTH ;STORE WINDOW SIZE
RET
;NI INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
; (BASE 10). THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.
INS1A: TXNE FF,SCANF ;SCANNING?
RET ;YES, DON'T REALLY INSERT ANYTHING
MOVE A,[070700,,NUM] ;POINTER TO "STRING"
MOVEI B,1 ;WE'RE ONLY INSERTING ONE CHARACTER
CALLRET INSRT0 ;INSERT IT AND RETURN
;@IJTEXTJ INSERT, AT THE CURRENT POINTER POSITION, THE TEXT
; SURROUNDED BY THE INSTANCES OF THE TERMINATOR J, WHICH MAY BE AT
; THE USER'S CHOICE ANY CHARACTER NOT APPEARING IN THE TEXT.
; THE POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
ATSIGN: TRO FF,SLSL ;SLSL:=1
JRST CD5
;NBACKSLASH INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
; EQUAL TO N.
BAKSL1: MOVE T,[XWD 700,BAKTAB-1]
MOVEI P1,0 ;COUNT # DIGITS IN P1.
MOVEI CH,BAKSL4 ;SET DPT TO RETURN TO BAKSL4
HRRM CH,LISTF5
CALL DPT ;CONVERT NUMBER TO ASCII, STORE IN BAKTAB.
MOVE A,[440700,,BAKTAB] ;POINT TO NUMBER
MOVE B,P1 ;COUNT OF CHARACTERS
CALL INSRT0 ;INSERT THE NUMBER
JRST CRET
BAKSL4: IDPB A,T ;STORE DIGIT IN BAKTAB
AOJA P1,R ;P1:=P1+1. RETURNS TO DPT CALL+1
;NT TYPE OU THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
; POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
; IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T SAME AS 1T.
;I,JT TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.
TYPE: CALL WINCLS ;START PRESERVED OUTPUT
CALL TVINIT ;GET AND CHECK ARGS
TYPE3: SKIPN COFLG ;^O REQUEST?
CAML I,C ;DONE?
RET
UILDB A,P2 ;GET NEXT CHAR
CALL TYO ;OUTPUT IT
SKIPN ABORTF ;ABORT REQUEST?
AOJA I,TYPE3 ;NO
JRST TYOQT ;YES, QUIT
;TVINIT ROUTINE RETURNS ILDB POINTER TO BUFFER IN P2, LEFTMOST
;CHARACTER ADDRESS IN I, AND ONE MORE THAN LAST CHARACTER ADDRESS IN
;IN C
TVINIT: CALL GETARG ;p1:=FIRST STRING ARGUMENT ADDRESS.
;c:=SECOND STRING ARGUMENT ADDRESS.
MOVE I,P1 ;START GETTING CHARACTERS AT C.
CALL GET
MOVSI P2,(07B5) ;BACKUP 1 BECAUSE ILDB BELOW
ADD P2,TT
RET
PPA: CALL SKPWRT ;MAKE SURE FILE IS OPEN FOR WRITING
JRST PPA09 ;NO!
HRRZ CX,FBOUT
JRST (CX)
FBOUT0: PUSH P,1 ;REGULAR BOUT CASE
MOVE 1,OUTJFN
EXCH CH,2
BOUT
EXCH CH,2
POP P,1
RET
CALL FBO1
FBOUT1: SOSGE OBFRC ;FAST CASE, CHAR LEFT?
JRST .-2 ;NO, REFILL BUFFER PAGE
IDPB CH,OBFRP
RET
FBO1: PUSH P,1
PUSH P,2
PUSH P,3
AOS 1,OUFPG ;MAP NEXT FILE PAGE
HRL 1,OUTJFN
XMOVEI 2,OBFPGA
LSH 2,-11 ;GET PROCESS PAGE #
HRLI 2,.FHSLF ;FORK HANDLE ,, PAGE #
MOVSI 3,(PM%RD+PM%WR) ;READ AND WRITE ACCESS
PMAP
MOVE 1,[XWD OBFPGA,OBFPGA+1]
SETZM OBFPGA ;CLEAR PAGE SO NO GARBAGE AT END
BLT 1,OBFPGA+777
MOVEI 1,CPP ;FULL PAGE OF CHARACTERS
MOVEM 1,OBFRC ;ROOM COUNT
ADDM 1,OUBYC ;TOTAL BYTES OUTPUT SO FAR
MOVE 1,[POINT 7,OBFPGA,-1]
MOVEM 1,OBFRP ;FRESH PTR
POP P,3
POP P,2
POP P,1
RET
PPA09: ERROR <NO FILE FOR OUTPUT>
;PW OUTPUT THE ENTIRE BUFFER,
; TO THE SELECTED OUTPUT DEVICE. BUFFER IS UNCHANGED AND POINTER
; IS UNMOVED.
;P IS IDENTICAL TO PWY.
;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER. NO FORM
; FEED IS PUT AT THE END. BUFFER UNCHANGED; POINTER UNMOVED.
PUNCH:
PUNCHA: MOVEI P2,PPA ;SELECT PPA FOR OUTPUT.
TRZ FF,RUBCF
TRNE FF,ARG2 ;I,JP?
JRST PCH0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
TRNN FF,ARG
MOVEI C,1
MOVE D,C ;NO. d:=N
JUMPL D,R ;IF N .L. 0, IGNORE P.
STKVAR <DCNT> ;(HOLDS DE COUNT)
MOVEM D,DCNT ;REMEMBER HOW MANY PAGES TO DO
PUN1: CALL PUNCHR ;PUNCH OU BUFFER
SKIPE ABORTF ;ABORT?
RET ;YES, DON'T CLOBBER BUFFER
CALL HK ;KILL ENTIRE BUFFER
TXNE FF,UREAD
TXNE FF,FINF
RET
SKIPN DCNT ;DONE?
RET ;YES
CALL YANK1 ;RENEW BUFFER
SKIPE ABORTF ;ABORT?
RET ;YES
MOVE P1,ZEE
CAMN P1,BEG ;EMPTY BUFFER?
TXNN FF,FINF ;YES. QUIT ON EOF
SOSG DCNT ;DONE ENOUGH PAGES?
POPJ P,
JRST PUN1 ;NO, KEEP GOING
PUNCHR: MOVE P1,BEG ;OUTPUT DATA BUFFER.
MOVE C,ZEE
WRBF2: MOVEI P2,PPA
TRZ FF,RUBCF
JRST PCH1
; ;W - WRITE OU BUFFER AND DELETE
WRBUF: TRNN FF,ARG
JRST [ MOVE P1,BEG ;ASSUME B,ZEE IF NO EXPLICIT ARG
MOVE C,ZEE
JRST WRBUF1]
CALL GETARG
WRBUF1: PUSH P,C ;SAVE ARGS
PUSH P,P1
CALL WRBF2
POP P,P1 ;RECOVER ARGS FOR KLBUF
POP P,C
JRST KLBUF
;DO OUTPUT VIA ROUTINE ADDRESS IN p2
; p1 = START ADDRESS
; c = END ADDRESS
PCH0: CALL GETARG ;GET STRING ARGS
PCH1: CAIE P2,PPA ;OUTPUT ??
JRST PCH2 ;NO, DO SINGLE CHARACTER OUTPUT
STKVAR <WRBEG,WREND> ;START AND 1+END CHARACTER ADDRESS
MOVEM P1,WRBEG ;STORE STARTING ADDRESS
MOVEM C,WREND ;AND END ADDRESS
CALL SKPWRT ;CAN DO SOUT
JRST PPA09 ;UNLESS FILE ISN'T OPEN...
MOVE A,WRBEG ;GET STARTING ADDRESS
CAML A,HOLBEG ;MAKE SURE NOT IN HOLE
ADD A,HOLSIZ ;IN HOLE, GET OUT
MOVEM A,WRBEG
MOVE A,WREND ;SAME FOR END ADDRESS
CAMLE A,HOLBEG ;ALLOWED TO BE HOLBEG BECAUSE NOT WRITTEN
ADD A,HOLSIZ
MOVEM A,WREND
MOVE A,WRBEG ;GET STARTING ADDRESS
CAML A,HOLBEG ;IS IT TO LEFT OF HOLE?
JRST DOAFT ;NO, THERE'S NOTHING TO LEFT OF HOLE BEING WRITTEN
MOVE A,HOLBEG ;GET LESSER OF END ADDRESS
CAML A,WREND ;AND BEGINNING OF HOLE
MOVE A,WREND ;END ADDRESS MORE LEFT
SUB A,WRBEG ;A:= # OF CHARS IN FIRST PART
MOVN C,A ;C GETS MINUS NUMBER OF CHARS
MOVE I,WRBEG ;I GETS STARTING ADDRESS
CALL SOUT1 ;DUMP STUFF TO LEFT OF HOLE
DOAFT: MOVE A,WREND ;MAKE SURE RIGHT MARGIN IS TO RIGHT
CAMG A,HOLEND ;OF END OF HOLE
JRST NOAFT ;NOTHING TO WRITE TO RIGHT OF HOLE
MOVE C,HOLEND ;GET GREATER OF BEGINNING OF OUTPUT
CAMGE C,WRBEG ;AND END OF HOLE
MOVE C,WRBEG
MOVE I,C ;SAVE STARTING ADDRESS
SUB C,WREND ;CALCULATE MINUS NUMBER OF CHARS IN SECOND PART
CALL SOUT1 ;WRITE SECOND PART
NOAFT: RET ;DONE!
SOUT1: JUMPE C,R ;DO NOTHING IF NO CHARACTERS
STKVAR <SVCNT>
MOVEM C,SVCNT ;SAVE NEGATIVE CHARACTER COUNT
CALL GET1 ;GET LDB POINTER TO START IN TT
MOVNI B,1 ;BACK UP BY ONE BYTE
ADJBP B,TT ;TO GET ILDB POINTER IN B
MOVE C,SVCNT ;GET CHARACTER COUNT
MOVE A,OUTJFN ;GET JFN TO USE FOR OUTPUT
CALL SOUTX ;WRITE THE BLOODY DATA
SETOM WRITEF ;SHOW THAT OUTPUT FILE HAS SOME DATA IN IT
RET ;DONE
PCH2: UILDB CH,I ;GET NEXT CHAR
CALL 0(P2) ;OUTPUT IT
SKIPN ABORTF ;ABORT REQUEST?
SOJG P1,PCH2 ;COUNT CHARS AND LOOP
RET ;YES, STOP
;THE MUMBLX ROUTINES DO JSYS'S THAT MAY CAUSE OVER QUOTA TRAPS, AND
;WHICH OVER QUOTA CAN BE CORRECTLY CONTINUED FROM. AT TIME OF THIS
;WRITING, FOR EXAMPLE, A MULTIPLE PAGE PMAP COPYING FROM CORE TO A FILE
;COULD NOT BE CORRECTLY CONTINUED FROM AFTER AN OVER QUOTA TRAP.
;IT WOULD ERRONEOUSLY DO ALL THE PAGES OVER AGAIN, OR FALL THROUGH AND
;NEVER DO THE ONES THAT COME AFTER THE OVER QUOTA TRAP
DEFINE FOOX(WHAT)
<WHAT'X: MOVE CX,[WHAT]
CALLRET JSYSX
>
FOOX BOUT
FOOX SOUT
FOOX JFNS
FOOX DIRST
FOOX ODTIM
JSYSX: MOVEM A,QUOJFN ;STORE JFN IN CASE OVER QUOTA
XCT CX ;DO THE JSYS
SETZM QUOJFN ;CLEAR THIS, SO BAD JSYS'S DON'T CAUSE AUTO-EXPUNGE
RET
;THE ;S COMMAND SAVES THE ENTIRE BUFFER AND CLOSES THE OUTPUT FILE,
;WITHOUT ALTERING THE BUFFER OR THE POINTER. IF NO FILE IS OPEN
;FOR WRITING WHEN ;S IS EXECUTED, ONE IS OPENED. WITH ARGUMENT(S),
;THE ;S COMMAND INTERPRETS THE ARGS LIKE K, T, X ETC. AND DOES THE
;SAME AS ;S WITH NO ARGS, EXCEPT ONLY THE SPECIFIED BUFFER PORTION IS
;SAVED.
BSAVE: TRNE FF,ARG+ARG2 ;IF USER TYPED ARGUMENTS,
CALL GETARG ;USE THEM.
TRNE FF,ARG+ARG2
JRST BSAVE1 ;SKIP NEXT INSTRUCTIONS IF USER TYPED ARGS
MOVE P1,BEG
MOVE C,ZEE ;USE (W)HOLE BUFFER IF NO ARGS SUPPLIED.
BSAVE1: PUSH P,C
PUSH P,P1 ;SAVE THE BUFFER ADDRESS RANGE.
CALL SKPWRT ;IS AN OUTPUT FILE ALREADY OPEN ??
CALL UNLD1 ;NO, SO OPEN ONE.
POP P,P1
POP P,C ;RESTORE BUFFER RANGE TO BE OUTPUT.
MOVEI P2,PPA ;NEEDED BY PCH0 ROUTINE.
CALL PCH1 ;OUTPUT THE SPECIFIED BUFFER PORTION
CALLRET CLOSEF ;CLOSE THE OUTPUT FILE AND RETURN.
;NJ MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE
; BUFFER. (I.E., GIVE "." THE VALUE N.)
;J SAME AS 0J.
JMP: TRZE FF,SLSL ;@J ??
JRST ATSGNJ ;YES.
ADD C,BEG ;PT:=N+BEG
JRST JMP1
; R - REPLACE ... BY ...
REPLAC: CALL CHK2
TRO FF,RPLFG
TRZ FF,ARG+ARG2 ;SO AS NOT TO CONFUSE S K AND I
MOVEM C,REPARG ;REMEMBER ARGUMENT TO R COMMAND
RPLC3: CALL SAVCMD ;REMEMBER CURRENT COMMAND STATE FOR GARBAGE COLLECTOR
SKIPE ABORTF ;ABORT?
JRST RPLC4 ;YES, STOP
MOVEI A,1 ;WANT 1ST OCCURENCE
SKIPGE REPARG ;IS ARG NEGATIVE ??
MOVNI A,1 ;YES, SO WANT -FIRST OCCURANCE
CALL SERCH0 ;SEARCH AND ADVANCE PT
TRNN FF,SLSL ;SEE IF @ BEFORE R
JRST RNOHAK ;NO @
MOVE TT,CPTR ;THERE WAS @, SO BACK UP COMMAND POINTER SO INSERT CAN READ DELIMITER
CALL DBP ;DECREMENT COMMAND STRING BYTE POINTER
AOS COMCNT ;AND REMEMBER ONE MORE CHARACTER IN COMMAND STRING
MOVEM TT,CPTR ;SAVE NEW POINTER
RNOHAK: TXNN FF,SCANF ;IF SCANNING, PRETEND SEARCH FAILED
SKIPL SFINDF ;DID SEARCH SUCCEED ??
JRST NOREPL ;NO, SO :RFOO$BAR$ WAS REQUESTED, BUT NO FOO FOUND
MOVN P1,SCHLNN ;GET NUMBER OF CHARACTERS TO DELETE
SKIPLE REPARG ;IF -ARG, WE ARE ALREADY AT BEG OF STRING
ADDM P1,PT ;BACKUP PT TO BEG OF SEARCH STRING
PUSH P,PT
MOVM A,P1 ;SPECIFY HOW MANY CHARACTERS TO DELETE
CALL ERASE ;DELETE THEM
CALL RPINS ;INSERT THE NEW STUFF
POP P,C
SKIPGE REPARG ;SKIP IF REPLACING IN FORWARD DIRECTION
MOVEM C,PT ;RESTORE PT IF -ARG
SKIPLE REPARG ;REPLACING TO THE RIGHT?
SOS REPARG ;YES, SO APPROACH 0 FROM ABOVE
SKIPGE REPARG ;REPLACING TO THE LEFT?
AOS REPARG ;YES, SO APPROACH 0 FROM BELOW
SKIPN REPARG ;DONE ENOUGH REPLACEMENTS?
JRST RPLC4 ;YES
CALL RESCMD ;RESTORE COMMAND STATE
JRST RPLC3
NOREPL: MOVEI CH,.CHESC ;FIRST ASSUME TERMINATOR IS ALTMODE
TRNE FF,SLSL ;SEE IF @
CALL RCH ;YES, SO READ TERMINATOR
MOVE P1,CH ;SAVE TERMINATOR
CALL SKRCH ;READ NEXT CHARACTER FROM COMMAND BUFFER
CAME CH,P1 ;IS IT THE TERMINATOR ??
JRST .-2 ;NO, SO KEEP LOOKING
RPLC4: ADJSP P,-CBLEN ;GET RID OF SAVED COMMAND STATE
TRZ FF,RPLFG
MOVE A,SFINDF ;RETURN SEARCH SUCCESS VALUE
JRST SRET ;GO RETURN CORRECT VALUE
;NC SAME AS .+NJ. NOTE THAT N MAY BE NEGATIVE.
CHARAC: CALL CHK2 ;MAKE SURE THERE IS AN ARGUMENT
ADD C,PT ;c:=PT+p1(c)
;IF c LIES BETWEEN BEG AND Z, STORE IT IN PT.
JMP1: CALL CHK ;IS p1(c) WITHIN DATA BUFFER?
MOVEM C,PT ;YES. PT:=p1(c)
JRST CRET
;NL IF N .G. 0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
; PASSED OVER N LINE FEEDS.
; IF N .L. 0: MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
; OVER N+1 LINE FEEDS AND THEN MOVE IT TO THE RIGHT OF
; THE LAST LINE FEED PASSED OVER.
;L SAME AS 1L.
LINE: TRNE FF,ARG2 ;IS THERE A SECOND ARGUMENT?
ERROR <SECOND ARGUMENT NOT ALLOWED>
CALL GETARG ;NO. p1:=FIRST STRING ARGUMENT ADDRESS,
;c:=SECOND STRING ARGUMENT ADDRESS.
XOR C,P1
XORM C,PT
JRST CRET
;"d" - ENDLINE, GOES TO END OF SAME LINE THAT "L" GOES TO BEGINNING
;OF, EXCEPT DEFAULT ARG IS 0, I.E. GO TO END OF CURRENT LINE
ELINE: TRNE FF,ARG2 ;SECOND ARG?
ERROR <SECOND ARGUMENT NOT ALLOWED>
TRON FF,ARG ;FIRST ARG?
MOVEI C,0 ;NO, DEFAULT TO 0
CALL GETARG
XOR C,P1 ;SET PT TO WHICHEVER ARG ISN'T PT
XORM C,PT
CALL TOEOL ;MOVE PT TO END OF CURRENT LINE
JRST CRET
;SUBROUTINE TO MOVE PT TO END OF CURRENT LINE
TOEOL: MOVE I,PT
MOVE P1,ZEE
SUB P1,I ;COMPUTE MAX NUMBER CHARS TO SKIP
JUMPE P1,R ;NOP IF AT END OF BUFFER
CALL GET ;GET FIRST CHAR
TOEOL1: AOS PT ;SKIP ONE CHAR
CAIN CH,.CHLFD ;JUST PASSED END OF LINE?
JRST TOEOL2 ;YES
UILDB CH,TT ;NO, GET NEXT CHAR
SOJG P1,TOEOL1 ;COUNT CHARS
RET ;AT END OF BUFFER
;BACKUP OVER END OF LINE CHARACTER AND ANY CR'S WHICH MAY HAVE
;PRECEEDED IT
TOEOL2: SOS C,PT ;BACKUP OVER CHAR
CAMG C,BEG ;AT TOP OF BUFFER?
RET ;YES, DONE
CALL DBP
LDB CH,TT ;GET PRECEEDING CHAR
CAIN CH,.CHCRT ;A CR?
JRST TOEOL2 ;YES, BACK OVER IT TOO
RET ;NO, DONE
;ROUTINE TO RETURN CURRENT ARGUMENT IN c
;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR
;IF THERE IS NO CURRENT ARGUMENT
;CALL CALL CHK2
; RETURN WITH c:=CURRENT ARG.,+1 OR -1
CHK2: TRNN FF,ARG ;IS THERE AN ARGUMENT?
JRST CHK22 ;NO, GO CONJURE ONE UP
MOVE C,NUM ;YES, GET IT
RET ;DONE
CHK22: LDB C,[XWD 340200,DLIM] ;c:=1 WITH SIGN OF LAST OPERATOR.
MOVNS C
AOJA C,R
;NK PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER.
;M,NK DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER.
; THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE.
;K SAME AS 1K
KILL: CALL GETARG ;p1:=FIRST STRING ARG. ADDRESS
;c:=SECOND STRING ARG. ADDRESS
KLBUF: CAMN P1,BEG
CAME C,ZEE
CAIA
CALLRET HK ;KILLING ENTIRE BUFFER
MOVEM P1,PT ;PT:=C(p1)
SUB C,P1 ;c:=NO. OF CHARACTERS TO KILL.
JUMPE C,R ;NONE
JRST KLB1
KLBUF1: TRO FF,RPLFG
CALL KLBUF
TRZ FF,RPLFG
RET
;ND DELETE N CHARACTERS FROM THE BUFFER: IF N IS POSITIVE, DELETE
; THEM JUST TO THE RIGHT OF THE POINTER; IF N IS NEGATIVE, DELETE
; THEM JUST TO ITS LEFT.
;D SAME AS 1D
DELETE: CALL CHK2 ;MAKE SURE c CONTAINS AN ARGUMENT
KLB1: SKIPE ABORTF ;ABORT?
RET ;YES
MOVE A,C ;GET NUMBER OF CHARACTERS TO DELETE
CALLRET ERASE ;ERASE CHARACTERS FROM BUFFER
;ROUTINE TO KILL ENTIRE BUFFER. THIS IS CODED AS A SPECIAL CASE SO
;THAT WE DON'T WASTE TIME MOVING THE HOLE TO THE POINT WHERE THE
;DELETION IS TAKING PLACE.
HK: MOVE A,BEG
MOVEM A,ZEE ;RESET END OF BUFFER TO BEGINNING
MOVEM A,PT ;PUT POINTER AT BEGINNING TOO
CALLRET MAKHOL ;RECREATE THE HOLE AND RETURN
;ROUTINE TO ERASE CHARACTERS FROM BUFFER AT THE POINTER. TAKES NUMBER
;OF CHARACTERS IN A, WHERE POSITIVE MEANS DELETE THEM TO RIGHT OF
;POINTER AND NEGATIVE MEANS DELETE THEM TO LEFT OF POINTER.
ERASE: STKVAR <COUNT> ;CELL TO HOLD NUMBER OF CHARACTERS BEING DELETED
MOVEM A,COUNT ;REMEMBER HOW MANY
MOVE C,A
ADD C,PT ;c:=PT+c
CALL CHK ;STILL IN DATA BUFFER?
MOVE A,PT
SKIPL B,COUNT
ADD A,B
;**NOTE: HIGH EFFICIENCY "X" OPERATION ASSUMES THAT THE ERASE ROUTINE
;POSITIONS THE HOLE TO THE RIGHT OF THE DELETION-ELECT.
CALL MOVHOL ;PUT THE HOLE TO RIGHT OF DELETION-ELECT
MOVM A,COUNT ;GET EXTRA HOLE SIZE
MOVN A,A ;GET NEGATIVE
ADDM A,ZEE ;Z ALWAYS GOES DOWN FOR A DELETION
ADDM A,HOLBEG ;HOLE STARTS FURTHER LEFT AFTER DELETION
SKIPGE A,COUNT ;DELETING TO LEFT OF POINTER?
ADDM A,PT ;YES, SO POINTER MOVES LEFT TOO
CALL SETHPT ;SET HOLE POINTERS
RET ;DONE
;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE c,POINTER
; CALL CHK
; RETURN IF c LIES BETWEEN BEG AND Z
CHK: CAMG C,ZEE
CAMGE C,BEG
ERROR <ARGUMENT OUT OF RANGE>
RET
;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL MOVE p1,FIRST STRING ARGUMENT ADDRESS
; MOVE c,SECOND STRING ARGUMENT ADDRESS
; CALL CHK1
; RETURN
;p1:=MAX*_xC),BEG), c:=MIN(p1(c),Z)
;IF p1 .G. c, DOES NOT RETURN.
CHK1: CAMG P1,BEG ;p1:=MAX(p1(p1),BEG)
MOVE P1,BEG
CAML C,ZEE ;c:=MIN(p1(c),Z)
MOVE C,ZEE
CAMLE P1,C ;p1 .G. c?
ERROR <SECOND ARG NOT GREATER THAN FIRST>
RET ;NO
;ROUTINE TO PARSE A SEARCH STRING.
;ACCEPTS: A/ 0 FOR PARSING FROM COMMAND STRING, NON-0 FOR REPARSING
;
;RETURNS: +1 ALWAYS
SPARSE: TRVAR <RPCNT,RPPTR,RPRSF,RBEG,REND,<SMAT0,4>> ;200(8) BITS, ONE FOR EACH CHARACTER
MOVEM A,RPRSF ;REMEMBER WHETHER REPARSING
JUMPN A,[ MOVE A,[440700,,SCHBUF] ;SET UP POINTER TO STRING BEING REPARSED
MOVEM A,RPPTR
MOVE A,SSLEN ;REMEMBER HOW MANY CHARACTERS TO REPARSE
MOVEM A,RPCNT
JRST .+1]
SETZM SMAT ;CLEAR THE MATRIX
MOVE A,[SMAT,,SMAT+1]
BLT A,SMAT+SMATLN-1
MOVX P1,1B0 ;BIT POSITION TO SET IN TABLE
TXZ FF,NOTF ;NO "NOT" SEEN YET
MOVE A,[440700,,SCHBUF] ;POINTER TO SEARCH STRING BUFFER
MOVEM A,SCHPTR
SETZM SSLEN ;INITIALIZE THE SEARCH STRING LENGTH
SER1: SKIPE RPRSF ;REPARSING?
JRST [ SOSGE RPCNT ;YES, HAVE WE REACHED END OF STRING?
JRST SP1 ;YES
CALL GETSCH ;NO, GET NEXT CHARACTER
JRST SER2] ;DON'T CHECK FOR TERMINATOR!
CALL GETSCH ;GET NEXT CHARACTER FROM SEARCH STRING
CAMN CH,SDELIM ;END OF SEARCH STRING?
JRST SP1 ;YES
SER2: JUMPE P1,[ERROR <Search string more than 36 character positions long>]
CALL SCHST1 ;STUFF SEARCH CHARACTER INTO STRING
CALL SCHAR ;GET BITS FOR CHARACTER
MOVSI T,-200 ;COPY BITS INTO P1TH COLUMN OF SMAT
MOVE TT,[440100,,A] ;1-BIT BYTE POINTER TO BITS
SER3: ILDB CH,TT ;GET NEXT BIT
CAIE CH,0 ;SET THIS BIT?
IORM P1,SMAT(T) ;YES
AOBJN T,SER3
LSH P1,-1 ;STEP TO NEXT COLUMN IN MATRIX
JRST SER1 ;LOOP FOR REST OF SEARCH STRING
SP1: MOVE A,P1
JFFO A,SEOS3 ;GET NUMERICAL LENGTH OF SEARCH STRING
MOVEI B,^D36 ;IF A IS 0, THEN SEARCH STRING LENGTH IS 36
SEOS3: MOVEM B,SCHLNN ;REMEMBER IT
SETOB A,B ;A ACCUMULATES BITS THAT ARE 1 FOR ALL CHARACTERS MATCHING FIRST FIVE, B ACCUMULATES 0'S
MOVSI C,-SMATLN ;POINTER TO SEARCH MATRIX
ZLUP1: LDB D,[370500,,SMAT(C)] ;GET WHICH POSITIONS THIS CHARACTER MAY MATCH IN
HRRZ P1,C ;GET THE CHARACTER
MUL P1,[<BYTE(7)1,1,1,1,1>];MAKE FIVE COPIES
LSH P2,1
LSHC P1,-1 ;GET ALL FIVE COPIES IN ONE WORD
MOVE P1,P2 ;COPY OF CHARACTERS IN P1
ORCM P1,MSKTAB(D) ;TURN ALL BITS ON IN POSITIONS WHERE THIS CHARACTER ISN'T SUPPOSED TO MATCH
AND P2,MSKTAB(D) ;TURN ALL BITS OFF IN COLUMNS THAT AREN'T SUPPOSED TO MATCH THIS CHARACTER
AND A,P1 ;ACCUMULATE BIT POSITIONS THAT ARE ON FOR ALL CHARACTERS THAT MAY MATCH
ANDCM B,P2 ;ACCUMULATE BITS THAT ARE OFF FOR ALL CHARACTERS THAT MAY MATCH THIS POSITION
AOBJN C,ZLUP1 ;LOOP FOR ALL CHARACTERS
IOR A,B ;NOW A HOLDS ALL BITS THAT ARE THE SAME FOR ALL CHARACTERS THAT MATCH IN FIRST FIVE POSITIONS
MOVE B,SCHLNN ;SEE HOW LONG SEARCH STRING IS
CAIG B,5 ;LESS THAN 5?
TDZ A,DNTCAR(B) ;GET RID OF BITS WE DON'T CARE ABOUT
LSH A,-1 ;WORD DURING SEARCH WILL BE RIGHT-JUSTIFIED
MOVEM A,CARBTS ;REMEMBER BIT POSITIONS WE CARE ABOUT
MOVSI A,-SMATLN ;LOOP TO GET SOME STRING THAT MATCHES
MOVEI B,0 ;THIS WILL BECOME SOME STRING THAT'S A MATCH FOR THE FIRST FIVE CHARACTERS OF THE SEARCH STRING
HRROI C,-1 ;THIS SHOWS POSITIONS YET TO BE FILLED
GEN0: SKIPN P1,SMAT(A) ;DOES THIS CHARACTER MATCH ANYWHERE?
JRST GEN1 ;NO
TLNE P1,(1B0) ;IS THIS CHARACTER A MATCH FOR THE FIRST POSITION
TLNN C,(1B0) ;DOES FIRST POSITION NEED FILLING?
JRST GEN2 ;NO
DPB A,[350700,,B] ;FOUND A CHARACTER FOR FIRST POSITION
TLZ C,(177B6) ;REMEMBER THAT WE FOUND ONE
GEN2: TLNE P1,(1B1) ;SAME FOR SECOND CHARACTER POSITION
TLNN C,(1B7)
JRST GEN3
DPB A,[260700,,B]
TLZ C,(177B13)
GEN3: TLNE P1,(1B2)
TLNN C,(1B14)
JRST GEN4
DPB A,[170700,,B]
TDZ C,[177B20]
GEN4: TLNE P1,(1B3)
TRNN C,1B21
JRST GEN5
DPB A,[100700,,B]
TRZ C,177B27
GEN5: TLNE P1,(1B4)
TRNN C,1B28
JRST GEN1
DPB A,[010700,,B]
TRZ C,177B34
GEN1: AOBJN A,GEN0 ;LOOP FOR ALL CHARACTERS
MOVE A,SCHLNN ;SEE HOW MANY POSITIONS WE SHOULD HAVE FOUND CHARACTERS FOR
TRZ C,1 ;GET RID OF B35
CAIG A,5
TDZ C,DNTCAR(A) ;GET RID OF BITS WE DON'T CARE ABOUT
JUMPN C,SFAIL ;IF SOME BITS DIDN'T GET CLEARED, THERE'S NO POSSIBLE STRING THAT COULD MATCH THE SEARCH!
MOVEM B,MATCH ;REMEMBER STRING THAT MATCHES THE SEARCH
LSH B,-1 ;RIGHT-JUSTIFY
AND B,CARBTS ;KEEP ONLY BITS WE CARE ABOUT
MOVEM B,SMASK ;REMEMBER MASK FOR SEARCH LOOP
;WHEN SEARCHING IN REVERSE, THE LSHC'S SHIFT THE UNUSED B35 THROUGH THE
;WORD WE'RE TESTING. ONE WAY TO AVOID THIS IS COLLAPSE THE TWO WORDS
;BEFORE SHIFTING. HOWEVER, THIS IS AN EXTRA INSTRUCTION EVERY TIME
;THROUGH THE SEARCH LOOP. INSTEAD, AFTER EVERY SHIFT, WE'LL USE A
;DIFFERENT SET OF MASKS TO TEST THE WORD, MASKS WHICH ASSUME THE
;B35 MOVES THROUGH THE WORD. THE FOLLOWING TWO CALLS TO GENTAB
;GENERATE THE SPECIAL VERSIONS OF THE TWO MASKS.
MOVE P1,CARBTS ;MASK SHOWING BIT POSITIONS WE CARE ABOUT
MOVEI P2,CARTAB ;ADDRESS OF TABLE TO RECEIVE VERSIONS OF THE MASK
CALL GENTAB ;GENERATE THE DIFFERENT VERSIONS
MOVE P1,SMASK ;MASK SHOWING WHAT WE'RE LOOKING FOR
MOVEI P2,SMTAB ;TABLE TO RECEIVE DIFFERENT VERSIONS
CALLRET GENTAB
;ROUTINE TO READ NEXT CHARACTER FROM COMMAND STRING AND STUFF IT INTO
;SEARCH STRING
SCHSTF: CALL GETSCH ;READ CHARACTER
SCHST1: AOS A,SSLEN ;SEE HOW MANY CHARACTERS THIS WILL BE
CAILE A,SMAXLN ;STILL WITHIN RANGE?
ERROR <Too many characters in search string>
IDPB CH,SCHPTR ;STORE CHARACTER IN SEARCH STRING
RET
;ROUTINE CALLED DURING SEARCH PARSING TO GET NEXT CHARACTER FROM SEARCH
;STRING. DURING A SEARCH COMMAND.
GETSCH: SKIPN RPRSF ;REPARSING?
CALLRET SKRCH ;NO, GO READ CHARACTER FROM COMMAND STRING
ILDB CH,RPPTR ;YES, GET NEXT CHARACTER BEING REPARSED
RET
;CALL HERE TO SAVE COMMAND STATE ON STACK
SAVCMD: POP P,B ;GET RETURN ADDRESS
HRRI A,1(P) ;GET STACK ADDRESS FOR SAVING ARGS
ADJSP P,CBLEN ;ALLOCATE ROOM FOR BLOCK
HRLI A,CBBLK ;GET STARTING ADDRESS OF BLOCK
BLT A,(P) ;PUT COMMAND STATE ON STACK
JRST (B) ;RETURN TO CALLER
;HERE TO RESTORE PREVIOUS COMMAND STATE
RESCMD: POP P,A ;GET RETURN ADDRESS
HRLI B,1-CBLEN(P) ;GET ADDRESS OF SAVED STATE
HRRI B,CBBLK ;ADDRESS OF STATE BLOCK
BLT B,CBBLK+CBLEN-1 ;RESTORE STATE
ADJSP P,-CBLEN ;RELEASE STACK SPACE
JRST (A) ;RETURN TO CALLER
;GET HERE WITH DELIMITER IN SDELIM, IF WE'RE JUST SCANNING. FIND THE
;DELIMITER AND RETURN
SCSRCH: CALL SKRCH ;FIND DELIMITER
CAME CH,SDELIM ;FIND IT YET?
JRST SCSRCH ;NO
TXNE FF,RPLFG ;CALLED FROM REPLACE CODE?
RET ;YES, RETURN TO IT
JRST CRET ;NO, GO BACK TO MAIN COMMAND
;ROUTINE TO TURN ON CORRECT BITS IN MATRIX ACCORDING TO WHAT THE NEXT CHARACTER
;IS.
;CALL WITH CHARACTER IN CH.
SCHAR: STKVAR <NOTFLG,<SAVSM,4>>
HRLI A,SMAT0 ;SAVE AWAY MATRIX WHILE WE USE IT
HRRI A,SAVSM
BLT A,3+SAVSM
SETZB A,SMAT0 ;CLEAR OUT THE BIT TABLE
SETZB B,1+SMAT0
DMOVEM A,2+SMAT0 ;SLIGHTLY CLEVER
SETZM NOTFLG ;HAVEN'T SEEN ^N YET
SCHNOT: CAIN CH,"" ;NOT?
JRST [ SETCMM NOTFLG ;YES, REVERSE DECISION OF WHETHER TO NEGATE
CALL SCHSTF ;READ AND STUFF NEXT CHARACTER
JRST SCHNOT] ;MAYBE DOUBLE NEGATIVE
CAIE CH,21 ;^Q?
CAIN CH,C.QUOT ;QUOTING THE NEXT CHARACTER?
JRST [ CALL SCHSTF ;YES, READ CHARACTER BEING QUOTED
CALL SETBIT ;SET BIT FOR LITERAL CHARACTER
JRST SCHOUT] ;DONE
CAIN CH,"" ;IS IT SPECIAL SEARCH OPTION CHARACTER?
JRST DOCE ;YES, GO HANDLE IT
CAIN CH,"" ;NO. ^X?
JRST CNTRX ;YES
CAIN CH,23 ;NO. ^S?
JRST CNTRB ;YES
CALL SETBIT ;SET BIT FOR CHARACTER
SKIPE EXACTF ;EXACT MATCH ONLY?
JRST SCHOUT ;YES, DON'T SET OTHER CASE
LOAD CH,UPRCOD,(CH) ;NO, GET UPPERCASE VERSION
CALL SETBIT ;SET BIT FOR UPPERCASE
LOAD CH,LWRCOD,(CH) ;GET LOWERCASE VERSION
CALL SETBIT ;SET BIT FOR LOWERCASE
SCHOUT: DMOVE A,SAVSM
DMOVE C,2+SAVSM ;GET PRESERVED SMAT0 FROM PREVIOUS LEVEL
EXCH A,SMAT0 ;RESTORE PRESERVED SMAT0, GET OURS
EXCH B,1+SMAT0
EXCH C,2+SMAT0
EXCH D,3+SMAT0
SKIPE NOTFLG ;WAS "NOT" SPECIFIED?
JRST [ SETCA A, ;YES, COMPLEMENT ALL THE BITS
SETCA B,
SETCA C,
SETCA D,
RET]
RET
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)
CNTRB: MOVEI CH,SMATLN-1 ;START WITH HIGHEST ASCII CHARACTER
CNTRB1: CALL SEPER ;SKIP IF CHARACTER A SEPERATOR
CAIA
CALL SETBIT
SOJGE CH,CNTRB1 ;DO FOR ALL CHARACTERS
JRST SCHOUT
;CNTR X MATCHES ANY ARBITRARY CHARACTER
CNTRX: SETOB A,SMAT0
SETOB B,1+SMAT0 ;MATCH EVERYTHING
DMOVEM A,2+SMAT0
JRST SCHOUT
;HERE TO HANDLE ^E. THIS ROUTINE RECURSES FOR USEFUL THINGS LIKE
;^E[A,B,^E<12>] ( FIND A OR B OR LINEFEED) AND USELESS THINGS LIKE ^E[A,B,^E[C,D]] ( FIND A OR B OR C OR D)
DOCE: CALL SCHSTF ;PUT CHARACTER IN SEARCH STRING
CAIE CH,"<" ;NUMBER COMING UP?
JRST SNOTDG ;NO
;OCTAL DIGITS AFTER CTRL/E MEANS CHARACTER WITH SPECIFIED ASCII VALUE
MOVX P2,1B0 ;START WITH 1B0 SO WE'LL KNOW IF ANYTHING TYPED
SDIG1: CALL PEEKCH ;PEEK AT NEXT CHARACTER
JRST SDIGE ;AREN'T ANY MORE!
CALL DIG8Q ;IS IT A DIGIT?
JRST SDIGE ;NO
LSH P2,3 ;YES, MAKE ROOM FOR IT
CALL SCHSTF ;REALLY READ IT THIS TIME!
IORI P2,-"0"(CH) ;ACCUMULATE DIGIT
JRST SDIG1 ;GET REST OF DIGITS
SDIGE: CALL SCHSTF ;MAKE SURE THERE'S A CLOSING BRACKET
CAIE CH,">"
ERROR <Angle bracket missing after number in search string>
JUMPL P2,R ; MAKE ^E<> BE A NOOP
MOVE CH,P2 ;SPECIFY WHICH CHARACTER TO SET
CALL SETBIT
JRST SCHOUT
;^E NOT FOLLOWED BY OCTAL DIGIT
SNOTDG: LOAD CH,UPRCOD,(CH) ;GET UPPERCASE
CAIN CH,"[" ;SEE IF OPEN BRACKET...
JRST SBRAK ;YES, GO PROCESS
CAIN CH,"A"
JRST SBALPH ;ANY ALPHABETIC
CAIN CH,"C"
JRST SBSYM ;ANY SYMBOL CONSTITUENT
CAIN CH,"D"
JRST SBDIG ;ANY DIGIT
CAIN CH,"V"
JRST SBLOW ;ANY LOWERCASE LETTER
CAIN CH,"W"
JRST SBHGH ;ANY UPPERCASE
CAIN CH,"X"
JRST CNTRX ;ANYTHING
ERROR <Illegal character after CTRL/E in search string>
;^EA MATCHES ANY ALPHABETIC
SBALPH: CALL SBUP ;DO UPPERS
CALL SBLO ;DO LOWERS
JRST SCHOUT
;^EC MATCHES ANY SYMBOL CONSTITUENT (SAME AS ^N^S)
SBSYM: SETCMM NOTFLG ;SAY "NOT"
JRST CNTRB ;DO SAME AS ^N^S
;^ED MATCHES ANY DIGIT
SBDIG: MOVEI A,"0" ;DO FROM 0
MOVEI B,"9" ;THROUGH 9
CALL SBRANG ;FILL IN THE RANGE
JRST SCHOUT
;^EV MATCHES ANY LOWERCASE LETTER
SBLOW: CALL SBLO ;DO THE WORK
JRST SCHOUT
;^EW MATCHES ANY UPPERCASE LETTER
SBHGH: CALL SBUP ;DO THE WORK
JRST SCHOUT
;FILL IN UPPERCASE LETTERS
SBUP: MOVEI A,"A" ;FROM CAP A
MOVEI B,"Z" ;TO CAP Z
CALLRET SBRANG ;DO THE RANGE
;FILL IN LOWERCASE LETTERS
SBLO: MOVEI A,"a" ;FROM SMALL A
MOVEI B,"z" ;TO SMALL Z
CALLRET SBRANG ;DO THE RANGE
;DO RANGE FROM C(A) THROUGH C(B)
SBRANG: MOVEM A,RBEG ;REMEMBER RANGE
MOVEM B,REND
MOVE CH,A ;START AT BEGINNING OF RANGE
SBR1: CALL SETBIT ;SET BIT FOR CHARACTER
CAMGE CH,REND ;DID WE JUST DO HIGHEST REQUESTED?
AOJA CH,SBR1 ;NO, DO REST.
RET
;SET THE BIT INDICATED BY CH IN SMAT0
SETBIT: MOVE A,CH
IDIVI A,44 ;FIGURE OUT WHICH WORD AND BIT
ADDI A,SMAT0 ;GET ADDRESS TO MODIFY
MOVE B,SBITS(B) ;GET CORRECT BIT
IORM B,(A) ;TURN ON BIT
RET
;^E FOLLOWED BY [CH1,CH2,CH3...] MEANS MATCH ANY OF THE LISTED ITEMS
SBRAK: CALL SCHSTF ;READ ITEM
CALL SCHAR ;ACCUMULATE IT AS A MATCH
IORM A,SMAT0 ;ACCUMULATE CHOICES
IORM B,1+SMAT0
IORM C,2+SMAT0
IORM D,3+SMAT0
CALL SCHSTF ;READ CLOSING BRACKET OR COMMA
CAIN CH,"," ;COMMA?
JRST SBRAK ;YES, GO GET NEXT ITEM
CAIE CH,"]" ;IF NOT COMMA, BETTER BE CLOSING BRACKET
ERROR <Comma or "]" required>
JRST SCHOUT
;TABLE OF BIT POSITIONS WE DON'T CARE ABOUT, USED TO MASK OUT
;CHARACTER POSITIONS WHEN SEARCH STRING IS LESS THAN 5 CHARACTERS.
DNTCAR: -1
<BYTE(7)0,177,177,177,177>!1;LENGTH IS ONE, LEEP ONLY FIRST POSITION
<BYTE(7)0,0,177,177,177>!1 ;KEEP 2 FOR 2 ETC.
<BYTE(7)0,0,0,177,177>!1
<BYTE(7)0,0,0,0,177>!1
1 ;FOR 5 OR OVER, KEEP ALL
;TABLE OF MASKS FOR CHARACTER POSITIONS. WORD N OF THIS TABLE
;CONTAINS BYTE(7)M,M,M,M,M WHERE N IN BINARY IS MMMMM, EXCEPT THAT
;INSTEAD OF 0'S AND 1'S FOR THE M'S, 0'S AND 177'S ARE USED.
MSKTAB:
DEFINE GENMSK(N)
<
BYTE(7)<<N_-4>*177>,<<N_-3>&1*177>,<<N_-2>&1*177>,<<N_-1>&1*177>,<N&1*177>
>
%%X==0
%%X==0
REPEAT 2*2*2*2*2,<
GENMSK(%%X)
%%X==%%X+1
>
;ROUTINE WHICH TAKES A WORD IN P1 AND A TABLE ADDRESS IN P2, AND
;STORES THE CONTENTS OF P1 IN THE 5 ELEMENTS OF THE TABLE, EACH COPY
;HAVING A GAP IN A DIFFERENT BIT POSITION
GENTAB: MOVE B,P1 ;GET COPY OF WORD
LSH B,1 ;GET GAP AT B35
MOVEM B,(P2) ;STORE IN TABLE
MOVE B,(P2)
LSHC A,7
LSH B,-1
LSHC A,-7 ;PUT GAP AT B7
MOVEM B,1(P2)
MOVE B,(P2)
LSHC A,^D14
LSH B,-1
LSHC A,-^D14 ;PUT IT AT B14, ETC.
MOVEM B,2(P2)
MOVE B,(P2)
LSHC A,^D21
LSH B,-1
LSHC A,-^D21
MOVEM B,3(P2)
MOVE B,(P2)
LSHC A,^D28
LSH B,-1
LSHC A,-^D28
MOVEM B,4(P2)
RET
;ROUTINE WHICH SKIPS IF DIFFERENT SEARCH BEING DONE THIS TIME THAN
;LAST
NOTSAM: MOVE A,CPTR ;GET POINTER TO CURRENT COMMAND STRING
MOVE T,SSLEN ;GET LENGTH OF LAST SEARCH STRING
MOVE B,[440700,,SCHBUF] ;GET POINTER TO LAST SEARCH STRING
MOVE C,COMCNT ;GET MAXIMUM CHARACTERS TO COMPARE
NOTS1: SOJL C,RSKP ;SAY NOT THE SAME IF CURRENT RUNS OUT
ILDB D,A ;GET CHARACTER FROM COMMAND STRING
CAMN D,SDELIM ;HAVE WE COME TO DELIMITER IN COMMAND STRING?
JRST NOTS2 ;YES, MAYBE SEARCH IS SAME AS LAST TIME
SOJL T,RSKP ;STRINGS DIFFERENT IF LAST ONE SHORTER
ILDB CH,B ;AND ONE FROM LAST SEARCH STRING
CAME D,CH ;THE SAME?
RETSKP ;DIFFERENT SEARCH, SKIP RETURN
JRST NOTS1 ;LOOP TO CHECK REST OF STRINGS
NOTS2: JUMPE T,R ;IF LAST SEARCH STRING RUNS OUT WHEN WE FIND DELIMITER IN BUFFER, WE'VE GOT SAME SEARCH AS LAST TIME
RETSKP ;NEW SEARCH SHORTER, SO IT'S DIFFERENT
;COME HERE WHEN WE KNOW THE CURRENT SEARCH IS THE SAME AS THE LAST ONE,
;BECAUSE THE SPECIFIED STRING IS EXACTLY THE SAME AS THE LAST ONE.
;WE MUST NOW SKIP OVER THE SEARCH STRING IN THE COMMAND BUFFER.
SERCH3: ILDB C,CPTR ;GET CHARACTER FROM SEARCH STRING
SOS COMCNT ;ACCOUNT FOR IT BEING READ (WE'VE ALREADY MADE SURE WE'LL FIND A DELIMITER)
CAME C,SDELIM ;THE DELIMITER YET?
JRST SERCH3 ;NOT YET
JRST SERCH9 ;GO DO SAME SEARCH AS LAST TIME
;ENTER AT SERCH0 WITH ARG FOR SEARCH IN A.
SERCH0: MOVEM A,SCHARG ;SAVE ARG
JRST SERCH1 ;FALL INTO COMMON CODE
LARR: TROA FF,FINDR ;FINDR:=1 FOR LEFT ARROW SEARCH
SERCHP: TRO FF,PCHFLG ;PCHFLG:=1 FOR N SEARCH
;ENTRY FOR S COMMAND IS HERE...
SERCH: CALL CHK2 ;MAKE SURE THERE IS AN ARG
MOVEM C,SCHARG ;REMEMBER ARG
SERCH1: MOVEI CH,.CHESC ;USE ALT-MODE DELIMITER IF NO @ SEEN
TRNE FF,SLSL ;@ SEEN?
CALL RCH ;YES. CH:=USER SPECIFIED DELIMITER.
MOVEM CH,SDELIM ;REMEMBER DELIMITER
TXNE FF,SCANF ;SCANNING?
JRST SCSRCH ;YES, JUST SCAN FOR DELIMITER AND MOVE ON
;SET UP SEARCH TABLE
SERCH2: CALL PEEKCH ;PEEK AT NEXT CHARACTER
JRST SERCH4 ;IF THERE ISN'T ONE, IT'S NOT THE ONE WE'RE LOOKING FOR!
CAME CH,SDELIM ;THE DELIMITER?
JRST SERCH4 ;NO, PERHAPS DIFFERENT SEARCH
CALL SKRCH ;YES, REALLY READ IT!
JRST SERCH9 ;GO DO SAME SEARCH AS LAST TIME
SERCH4: CALL NOTSAM ;SKIP IF DIFFERENT SEARCH BEING DONE
JRST SERCH3 ;SAME ONE, GO DO IT
MOVEI A,0 ;SAY WE'RE READING SEARCH FROM COMMAND STRING
CALL SPARSE ;PARSE THE SEARCH STRING
SETZM SRPF ;IF JUST READ FROM COMMAND STRING, NO REPARSE NEEDED
SERCH9: SKIPN SSLEN ;MAKE SURE WE'VE DONE A SEARCH BEFORE!
ERROR <No default search string set up yet>
MOVEI A,1
SKIPE SRPF ;REPARSE DEFAULTED SEARCH IF 1^X OR 0^X TYPED
CALL SPARSE ;CAN'T CALL SPARSE AT SSERCH, SINCE IT MAY GO TO SFAIL!
SETZM SRPF ;NO MORE REPARSE NEEDED
MOVE B,SCHARG ;GET ARG BEFORE IT GETS COUNTED TO 0
MOVEM B,SOARG ;REMEMBER IT
JUMPE B,SRET1 ;RETURN IMMEDIATELY IF 0S OR 0R
;ENTER HERE IF SEARCH MASKS ARE ALREADY SET UP. FOR INSTANCE, DURING
; N OR _ OR F COMMAND, SEARCH IS RESUMED HERE AFTER NEW PAGE IS READ
;IN. R COMMAND COULD BE MADE QUICKER IF IT WERE TAUGHT TO ENTER HERE
;TOO, ESPECIALLY FOR LARGE NUMERICAL ARGS TO R.
SERCHS: MOVE A,PT ;REMEMBER WHERE CURRENT SEARCH STARTS
MOVEM A,S0PT
SKIPG SCHARG ;SEARCHING FORWARD?
JRST SETBAK ;NO, BACKWARDS
; IN ORDER TO KNOW WHEN WE'VE HIT
;THE BUFFER HOLE, SO THAT WE CAN SKIP OVER IT, WE'LL PLANT A COPY OF A STRING
;THAT MATCHES THE SEARCH JUST AT THE HOLE BOUNDARY. THIS WILL ALLOW
;US TO DETECT THE HOLE BECAUSE WE'LL GET A FALSE ALARM SEARCH MATCH.
;ALSO, WE'LL COPY A SMALL PART OF THE BUFFER THAT'S BEFORE THE HOLE
;INTO THE HOLE, SO THAT EVEN IF WHAT WE'RE LOOKING FOR CROSSES THE
;HOLE, WE'LL FIND IT.
;IN ADDITION, WE'LL PUT A MATCH AT THE END OF THE BUFFER TO CATCH
;FAILING SEARCHES - THAT IS, SEARCHES REALLY ALWAYS SUCCEED!
MOVE I,HOLEND ;POINTER TO CHARS AFTER HOLE
MOVE OU,HOLBEG ;WE WANT TO COPY THEM TO BEGINNING OF HOLE
MOVE P1,SCHLNN ;WE NEED ONLY COPY ONE LESS THAN NUMBER
SOJ P1, ;OF CHARACTERS IN THE SEARCH STRING
CALL MVCST ;COPY THE CHARACTERS
MOVE I,[5*MATCH] ;POINTER TO STRING GUARANTEED TO MATCH
MOVE OU,SCHLNN ;WE WANT TO PUT IT ALMOST THIS MANY CHARACTERS IN
SOJ OU, ;ONE LESS BECAUSE N-1 CHARS WERE COPIED
ADD OU,HOLBEG ;FIGURE WHERE TO COPY TO
MOVEI P1,5 ;ONLY COPY 5 CHARACTERS
CALL MVCST ;COPY THE MATCH
MOVE OU,[010700,,EMTBUF-1];WE ALSO WANT TO PUT MATCH AT END OF BUFFER
MOVE I,[010700,,MATCH-1]
MOVEI P1,5
CALL MVSTR ;TO CATCH FAILING SEARCHES
MOVE A,SCHLNN ;GET NUMBER OF CHARACTERS IN SEARCH STRING
CAILE A,5
MOVEI A,5 ;FOR THIS CALCULATION, WE WANT 5 OR LESS
MOVE B,A ;MAKE COPY FOR BYTE POINTER CALCULATION
IMULI A,7 ;FIGURE OUT HOW MANY BITS TO SHIFT FOR GETTING TO NEXT FRAME
MOVEM A,SLIDE ;REMEMBER HOW MANY
MOVE C,FNXTAB-1(B) ;FIGURE OUT WHERE TO TRANSFER TO WHEN GOING TO NEXT FRAME
MOVEM C,NXTFRM ;REMEMBER
ADJBP B,[000700,,A-1] ;MAKE BYTE POINTER TO RIGHTMOST CHARACTER IN FRAME
MOVEM B,SLAST ;REMEMBER POINTER TO LAST CHARACTER IN FRAME
MOVE A,PT ;GET FIRST CHARACTER POSITION TO BE EXAMINED
CAML A,HOLBEG ;ARE WE IN HOLE?
ADD A,HOLSIZ ;GET ABSOLUTE CHARACTER ADDRESS
FSRCH: IDIVI A,5 ;NOW A SHOWS WHICH WORD CONTAINS FIRST CHARACTER
MOVE C,FSTAB(B) ;C TELLS WHERE TO ENTER SEARCH LOOP
MOVEM C,SADD ;REMEMBER WHERE TO ENTER LOOP
IMULI B,7 ;CALCULATE HOW MUCH TO SHIFT TO LEFT-JUSTIFY FIRST CHARACTER
MOVEI D,1(A) ;WORD POINTER TO BUFFER FOR SEARCH LOOP
MOVEM D,SPTR ;REMEMBER WORD POINTER
MOVE P1,B ;P1 NOW HOLDS HOW MUCH TO SHIFT AT THE START
DMOVE A,-1(D) ;GET PRIMARY DATA
LSH A,-1 ;GET RID OF GAP AT B35
LSHC A,(P1) ;SHIFT INTO CORRECT POSITION TO START SEARCH
DMOVEM A,SDAT ;INITIALIZE SEARCH DATA
JRST FLSALM ;INITIALIZE SEARCH BY SAYING "FALSE ALARM"
;TABLE OF PLACES TO TRANSFER TO IN FORWARD SEARCH LOOP WHEN WE'VE JUST
;SHIFTED OUR DATA OVER TO THE NEXT FRAME UPON DECIDING THAT SINCE
;RIGHTMOST CHARACTER OF LAST FRAME ISN'T ANYWHERE IN THE SOUGHT STRING,
;WE CAN SAVE TIME BY SKIPPING N CHARACTERS IN BUFFER WHERE N IS NUMBER
;OF CHARACTERS IN SEARCH STRING.
FNXTAB: IFIW!S1 ;SEARCH STRING IS ONE CHARACTER LONG
IFIW!S2 ;TWO CHARACTERS LONG
IFIW!S3 ;GET THE PATTERN?
IFIW!S4
IFIW!S5
;TABLE OF PLACES TO TRANSFER WITHIN THE BACKWARD SEARCH LOOP, AND DURING
;THE BACKWARD SEARCH LOOP, WHEN THE LEFTMOST CHARACTER OF THE CURRENT
;FRAME ISN'T ANYWHERE IN THE SOUGHT STRING. IF THIS IS THE CASE,
;WE CAN SKIP N CHARACTERS OF THE BUFFER.
BNXTAB: IFIW!BS1 ;CAN ONLY SKIP 1 IF 1 CHARACTER LONG
IFIW!BS2
IFIW!BS3
IFIW!BS4
IFIW!BS0 ;(PROBABLY SHOULD BE CALLED BS5 FOR CONSISTENCY)
;TABLE OF ENTRIES INTO THE FORWARD SEARCH LOOP. SHOWS FIVE ENTIRES
;TO USE DEPENDING ON WHETHER FIRST CHARACTER TO BE CHECKED IS IN POSITION
;0,1,2,3, OR 4 IN THE FIRST WORD TO BE EXAMINED.
FSTAB: IFIW!S0 ;CHARACTER IS LEFT-JUSTIFIED
IFIW!S1 ;CHARACTER IS ONE CHARACTER TO RIGHT OF LEFT EDGE OF WORD
IFIW!S2
IFIW!S3
IFIW!S4 ;CHARACTER IS AT RIGHT MARGIN
;HERE'S THE SEARCH LOOP FORWARD (TO THE RIGHT). IT GETS ENTERED AT
;VARIOUS PLACES ACCORDING TO WHERE THE FIRST CHARACTER TO BE EXAMINED
;IS LOCATED WITH RESPECT TO WORD BOUNDARIES.
S00: MOVE B,(D) ;START OF FORWARD SEARCH LOOP. GET WORD FROM BUFFER
S0: LDB C,SLAST ;GET RIGHTMOST CHARACTER IN FRAME
SKIPE SMAT(C) ;IS THAT CHARACTER ANYWHERE IN THE SEARCH STRING?
JRST S0A ;YES, SO WE MUST EXAMINE THE FRAME
LSHC A,@SLIDE ;NO, SLIDE TO NEXT FRAME IMMEDIATELY
JRST @NXTFRM ;GO EXAMINE NEXT FRAME
S0A: MOVE C,A ;GET COPY OF CHARACTERS FROM BUFFER
AND C,P1 ;KEEP ONLY BITS WE CARE ABOUT
CAMN C,P2 ;SEE IF IT'S WHAT WE'RE LOOKING FOR
CALL SWIN1 ;MAYBE, CHECK REST OF STRING AND LOCATION
LSHC A,7 ;SLIDE FRAME TO RIGHT ONE POSITION
S1: MOVE C,A
AND C,P1
CAMN C,P2
CALL SWIN2 ;DUPLICATE RATHER THAN LOOP FOR SPEED
LSHC A,7
S2: MOVE C,A
AND C,P1
CAMN C,P2
CALL SWIN3
LSHC A,7
S3: MOVE C,A
AND C,P1
CAMN C,P2
CALL SWIN4
LSHC A,7
S4: MOVE C,A
AND C,P1
CAMN C,P2
CALL SWIN5
LSHC A,7
S5: AOJA D,S00 ;ALL 5 POSITIONS FAILED. GET NEW WORD
SWIN1: MOVEI C,0 ;C IS HOW MANY TIMES WE SHIFTED BEFORE GETTING A MATCH
JRST SWIN
SWIN2: MOVEI C,1
JRST SWIN
SWIN3: MOVEI C,2
JRST SWIN
SWIN4: MOVEI C,3
JRST SWIN
SWIN5: MOVEI C,4
JRST SWIN
;GET HERE WHEN SEARCH MATCHES FIRST FIVE CHARACTERS. WE MUST CHECK
;THAT THE REST OF THE CHARACTERS MATCH, AND THAT WE ARE STILL IN THE BUF
;FER. IF WE'RE IN BUFFER BUT REST DON'T MATCH, KEEP SEARCHING. IF OUT
;OF BUFFER, SEARCH FAILED.
SWIN: POP P,SADD ;REMEMBER WHERE TO RESUME SEARCH IF WE'RE NOT REALLY DONE YET
DMOVEM A,SDAT ;SAVE DATA FOR RESTORING SEARCH LOOP
MOVEM D,SPTR ;SAVE SEARCH POINTER
SKIPG SCHARG ;SEARCHING TO THE RIGHT?
JRST BSWIN ;NO, TO THE LEFT
MOVEI A,-1(D) ;WE HAVE TO GET CHARACTER ADDRESS OF FIRST CHARACTER IN STRING
IMULI A,5 ;NOW WE'VE GOT CHARACTER ADDRESS IF WE DID NO SHIFTING
ADD A,C ;ADD NUMBER OF TIMES WE SHIFTED TO GET EXACT CHARACTER ADDRESS
MOVEM A,SENDPT ;SAVE CHARACTER ADDRESS OF FIRST CHARACTER OF STRING
CAML A,HOLBEG ;SEE IF WE'RE IN HOLE
CAMLE A,HOLEND
JRST SWNIH ;NO
MOVE B,SCHLNN ;YES, SEE WHERE FAKE MATCH WAS PUT
ADD B,HOLBEG
SOJ B,
CAMN A,B ;DID WE JUST HIT THE FAKE MATCH?
JRST GETOUT ;YES, GET OUT OF HOLE AND RESUME SEARCH
SWNIH: CAML A,HOLEND ;ARE WE TO RIGHT OF HOLE?
SUB A,HOLSIZ ;YES, MAKE VIRTUAL CHARACTER ADDRESS
MOVE B,A ;GET COPY OF CHARACTER ADDRESS OF FIRST CHARACTER
ADD B,SCHLNN ;GET CHARACTER ADDRESS OF CHARACTER AFTER LAST
CAMLE B,ZEE ;DID WE MATCH IN THE BUFFER?
JRST SFAIL ;NO, SO THE SEARCH FAILED COMPLETELY
CALL SCHK ;MAKE SURE REST OF CHARACTERS MATCH
JRST FLSALM ;THEY DON'T, GO KEEP SEARCHING
MOVE A,SENDPT ;GET CHARACTER ADDRESS OF LEFTMOST CHARACTER THAT MATCHED
ADD A,SCHLNN ;GET CHARACTER POSITION OF END OF STRING
CAML A,HOLEND ;ARE WE TO RIGHT OF HOLE?
SUB A,HOLSIZ ;YES, CHANGE TO VIRTUAL CHARACTER ADDRESS
MOVE B,A ;GET A COPY
SUB B,S0PT ;SEE HOW FAR WE'VE PROGRESSED
CAMGE B,SCHLNN ;AT LEAST THE LENGTH OF THE STRING?
JRST FLSALM ;OTHERWISE /\---- 2S--$ WOULD GO ONLY TO ---/\-
MOVEM A,S0PT ;REMEMBER WHERE THIS SEARCH BRINGS US TO
SRWIN: SKIPGE SCHARG ;IS SEARCH ARGUMENT NEGATIVE?
AOS SCHARG ;YES, SO APPROACH 0 THIS WAY
SKIPLE SCHARG ;IF SEARCH ARG IS POSITIVE?
SOS SCHARG ;APPROACH 0 THIS WAY
SKIPE SCHARG ;HAVE WE FOUND STRING ENOUGH TIMES?
JRST FLSALM ;NO, KEEP SEARCHING
MOVEM A,PT ;STORE NEW VALUE OF POINTER
SRET1: SETOB A,SFINDF ;SET FLAG SAYING SEARCH SUCCEEDED
TXNE FF,RPLFG ;JUST RETURN IF DOING REPLACE COMMAND
RET ;ALL DONE!
SRET: TXNN FF,COLONF ;NOT REPLACE, :S ??
JRST CRET ;NO, DON'T RETURN VALUE
;...
;COME TO HERE ON A COMMAND SUCH AS "-:SFOO$" OR "4;N" WHERE THE COMMAND TAKES
;AN ARG, AND ALSO RETURNS ONE.
VL1: MOVSI B,(ADD C,) ;IN CASE -S,
HLLM B,DLIM ;GET RID OF "SUB" SO VALUE ISN'T NEGATED
SETZM NUM ;CLEAR SEARCH ARG
JRST VALRET ;YES, RETURN VALUE
;COME HERE WHEN WE WANT TO SEARCH TO THE LEFT
SETBAK: MOVE I,HOLBEG ;GET LEFT EDGE OF HOLE
SUB I,SCHLNN
AOJ I,
MOVE OU,HOLEND
SUB OU,SCHLNN
AOJ OU,
MOVE P1,SCHLNN
SOJ P1,
CALL MVCST ;COPY CHARACTERS FROM TO LEFT OF HOLE TO INTO HOLE AT RIGHT EDGE (IN CASE SEARCH MATCHES ACROSS THE HOLE)
MOVE OU,HOLEND
SUB OU,SCHLNN
SUBI OU,4
MOVE I,[5*MATCH]
MOVEI P1,5
CALL MVCST ;PUT MATCH AT HOLE SO WE'LL KNOW DURING SEARCH LOOP WHEN WE HIT THE HOLE
MOVE OU,BEG
SUBI OU,5
MOVE I,[5*MATCH]
MOVEI P1,5
CALL MVCST ;PUT MATCH AT BEGINNING OF BUFFER SO WE'LL KNOW WHEN SEARCH FAILS
MOVE A,SCHLNN ;GET LENGTH OF SEARCH STRING
CAILE A,5
MOVEI A,5 ;WE CAN SKIP AT MOST 5 CHARACTERS AT A TIME
MOVE B,BNXTAB-1(A) ;FIGURE OUT WHERE TO JUMP TO WHEN FIRST CHARACTER DOESN'T MATCH
MOVEM B,NXTFRM ;REMEMBER FOR SEARCH LOOP
IMUL A,[-7] ;FIGURE OUT HOW MANY BITS TO THE RIGHT TO SHIFT
SOJ A, ;WHEN FIRST CHARACTER EXAMINED ISN'T IN SEARCH STRING AT ALL (ONE EXTRA FOR B35!)
HRRZM A,SLIDE ;REMEMBER, BUT CLEAR LEFT HALF BECAUSE REFERENCED WITH @
MOVE A,PT
SOJ A, ;FIGURE OUT WHICH CHARACTER TO START SEARCHING WITH
CAML A,HOLBEG
ADD A,HOLSIZ ;MAKE ABSOLUTE ADDRESS
BSRCH: IDIVI A,5 ;FIND WHICH WORD TO START WITH
MOVE C,BSTAB(B) ;GET PLACE TO START SEARCH LOOP WITH
MOVEM C,SADD ;REMEMBER
MOVEI D,(A) ;D ALWAYS SHOWS NEXT WORD TO LOOK AT
MOVEM D,SPTR ;REMEMBER WHICH WORD TO PICK UP FIRST
MOVE P1,B ;P1 REMEMBERS HOW MUCH TO INITIALLY SHIFT
DMOVE A,(D) ;GET INITIAL DATA TO START SEARCH WITH
LSHC A,@SHFTAB(P1) ;RIGHT JUSTIFY FIRST 5 CHARS IN A'B
DMOVEM A,SDAT ;INITIALIZE THE SEARCH DATA
JRST FLSALM ;INITIALIZE SEARCH BY PRETENDING WE JUST HAD A FALSE MATCH
;GET HERE WHEN SEARCHING LEFT FINDS A MATCH ON FIRST 5 CHARACTERS.
BSWIN: MOVE A,D ;GET WORD ADDRESS OF WORD CONTAINING LEFTMOST CHARACTER IN STRING
IMULI A,5
ADDI A,5
SUB A,C ;A HOLDS LEFTMOST CHARACTER ADDRESS OF THE 5 THAT MATCHED
MOVE B,HOLEND
SUB B,SCHLNN
SUBI B,4 ;GET TO CHARACTER ADDRESS OF PLANTED STRING
CAMN A,B ;DID WE JUST MATCH IN THE HOLE?
JRST BGETOT ;YES, GO GET OUT OF HOLE AND KEEP SEARCHING
CAML A,HOLBEG
SUB A,HOLSIZ ;GET VIRTUAL ADDRESS
MOVEM A,SENDPT ;REMEMBER WHERE SEARCH MAY HAVE MATCHED
CAMGE A,BEG ;DID IT MATCH IN THE BUFFER AT ALL?
JRST SFAIL ;NO, SO SEARCH FAILED
ADD A,SCHLNN ;GET CHARACTER ADDRESS OF CHARACTER TO RIGHT OF ENTIRE STRING
CAMLE A,S0PT ;STRING BETTER ENTIRELY FIT TO LEFT OF POINTER AS OF LAST SEARCH
JRST FLSALM ;DOESN'T
SUB A,SCHLNN ;GET FIRST CHARACTER ADDRESS AGAIN
CALL SCHK ;MAKE SURE ENTIRE STRING MATCHES
JRST FLSALM ;DOESN'T
MOVE A,SENDPT ;GET WHAT TO SET PT TO IF STRING HAS BEEN FOUND ENOUGH TIMES
MOVEM A,S0PT ;REMEMBER WHERE WE'VE PROGRESSED TO DURING SEARCHING
JRST SRWIN
;TABLE OF HOW MUCH TO SHIFT INITIAL DATA TO RIGHT-JUSTIFY FIRST 5 CHARACTERS
;WE'RE TESTING
SHFTAB: ,-^D36 ;CHARACTER IS LEFT-JUSTIFIED
,-^D29 ;CHARACTER IS ONE CHARACTER TO THE RIGHT
,-^D22 ;2
,-^D15 ;ONE FROM THE RIGHT
,-^D8 ;CHARACTER RIGHT-JUSTIFIED
;TABLE OF ADDRESS IN LEFTWARD SEARCH LOOP AT WHICH TO ENTER ACCORDING
;TO HOW MUCH INITIAL DATA HAD TO BE SHIFTED TO RIGHT-JUSTIFY FIRST
;CHARACTER IN B
BSTAB: IFIW!BS0
IFIW!BS4
IFIW!BS3
IFIW!BS2
IFIW!BS1
;THE BACKWARD SEARCH LOOP. IT MERELY LOADS A WORD FROM MEMORY,
;SEES IF ANY OF THE 5 POSITIONS OF THAT DATA MATCHES THE FIRST
;FIVE CHARACTERS OF THE SOUGHT STRING, AND THEN PROCEDES TO THE NEXT
;WORD TO THE LEFT IN MEMORY.
BS00: MOVE A,(D) ;GET NEXT WORD FROM BUFFER
LDB C,[350700,,B] ;GET LEFTMOST CHARACTER OF FRAME
SKIPE SMAT(C) ;IS CHARACTER ANYWHERE IN SEARCH STRING
JRST BS0A ;YES, SO WE MUST EXAMINE FRAME
LSHC A,@SLIDE ;NO, SO WE CAN SKIP UP TO FIVE POSITIONS
JRST @NXTFRM ;SKIP SOME.
BS0A: MOVE C,B ;GET COPY OF DATA
AND C,P1 ;KEEP ONLY BITS EQUAL IN ALL POSSIBLE MATCHES
CAMN C,T ;SEE IF WE HAVE A MATCH
CALL SWIN1 ;WE DO. THE "CALL" REMEMBERS HOW MANY TIMES WE HAD TO SHIFT TO GET A MATCH
LSHC A,-8 ;INSTEAD OF 7, WHICH WOULD GET ONLY 6 BITS AND B35
BS1: MOVE C,B
AND C,P2 ;DIFFERENT MASK SINCE B35 IS EMBEDDED!
CAMN C,TT
CALL SWIN2
LSHC A,-7 ;ONLY 7 NOW SINCE WE'VE SKIPPED OVER B35
BS2: MOVE C,B
AND C,OU
CAMN C,TT1
CALL SWIN3
LSHC A,-7
BS3: MOVE C,B
AND C,CH
CAMN C,I
CALL SWIN4
LSHC A,-7
BS4: MOVE C,B
AND C,SAC1
CAMN C,SAC2
CALL SWIN5
LSHC A,-7 ;NO POSITIONS MATCHED
BS0: SOJA D,BS00 ;GO GET NEXT WORD FROM BUFFER
;FOLLOWING ROUTINE TAKES ABSOLUTE CHARACTER ADDRESS IN A, ASSUMED
;TO BE LEFTMOST CHARACTER IN STRING, AND SKIPS IFF STRING MATCHES
;ONE BEING SEARCHED FOR
SCHK: SOJ A, ;BACK UP ONE CHARACTER BECAUSE WE WANT TO DO ILDB
MOVE I,A
CALL GET ;MAKE ILDB POINTER IN TT TO BEGINNING OF SUPPOSED MATCHING STRING IN BUFFER
MOVSI A,400000 ;BIT BEING CHECKED IN SEARCH TABLE
MOVE B,SCHLNN ;B SHOWS HOW MANY CHARACTERS TO TEST
SCHECK: SOJL B,SCHEK2 ;IF ALL MATCH WE'RE REALLY DONE!
UILDB C,TT ;GET CHARACTER FROM BUFFER
TDNN A,SMAT(C) ;IS THIS CHARACTER A MATCH?
RET ;STRING DOESN'T MATCH
LSH A,-1 ;STEP TO NEXT BIT POSITION
JRST SCHECK ;YES, CHECK THE REST
SCHEK2: RETSKP
;GET HERE WHEN WE JUST HIT THE HOLE WHILE SEARCHING TO THE RIGHT.
;THE FOLLOWING CODE GETS US OUT OF THE HOLE AND CONTINUES THE SEARCH.
GETOUT: MOVE A,HOLEND ;FIRST CHARACTER TO CHECK NEXT
JRST FSRCH ;GO RESTART FORWARD SEARCH
;GET HERE WHEN SEARCHING TO THE LEFT, AND WE JUST HIT THE RIGHT
;EDGE OF THE HOLE
BGETOT: MOVE A,HOLBEG
SOJ A, ;SKIP OVER HOLE (TO LEFT EDGE OF IT)
JRST BSRCH ;START SEARCHING AGAIN
;COME HERE IF SEARCH ISN'T THROUGH YET BECAUSE ALTHOUGH FIRST FIVE
;CHARACTERS MATCHED, THE REST OF THE STRING DIDN'T. HOPEFULLY THIS
;RARELY HAPPENS, AS IT WOULD GROSSLY SLOW DOWN THE SEARCH. OBVIOUSLY
;SUCH SUCKY CASES CAN BE CONSTRUCTED, BUT AS BENJAMIN FRANKLIN ONCE
;SAID: "TO GAMBLE IS TO COAPUTE THE GREGS OF FRETRICAL INACQUICIES
; WITHOUT THE CRUX OF PLEGANOUS FINALITY"
;BUT AS GEORGE RAFT REPLIED: "WHAT DOES BENJAMIN FRANKLIN KNOW?"
;(PAT PAULSON SAID IT ALL ACTUALLY)
FLSALM: DMOVE A,SDAT ;GET SEARCH DATA BACK
MOVE D,SPTR ;GET BUFFER WORD INDEX
SKIPG SCHARG
JRST FLSB ;SEARCH TO LEFT, DIFFERENT INITIALIZATION
MOVE P1,CARBTS ;GET BITS WE CARE ABOUT
MOVE P2,SMASK ;GET VALUE THOSE BITS ARE SUPPOSED TO BE
JRST @SADD ;RESUME THE SEARCH
FLSB: DMOVE P1,CARTAB ;LOAD UP MASKS OF BITS WE'RE TESTING
DMOVE OU,CARTAB+2
MOVE SAC1,CARTAB+4 ;THERE 5 DIFFERENT VERSIONS
DMOVE T,SMTAB ;LOAD UP THE 5 VERSIONS OF SOUGHT VALUES FOR THE BITS
DMOVE TT1,SMTAB+2
MOVE SAC2,SMTAB+4
JRST @SADD ;(RE)ENTER SEARCH LOOP
;TABLE TO TRANSFORM CHARACTER RANK INTO SINGLE BIT MASK. FOR INSTANCE,
;CHARACTER 1 (THE FIRST) CORRESPONDS TO 1B0, CHARACTER 2 CORRESPONDS
;TO 1B1 ETC. HENCE "MOVE A,SBITS(P1)" GETS CORRECT BIT LOADED INTO A
;FOR P1TH CHARACTER (WELL 'CONTENTS OF P1'TH ACTUALLY)
SBITS:
%%X==1B0
REPEAT ^D36,<
%%X
%%X==%%X_-1
>
;GET HERE WHEN SEARCH FAILS
SFAIL: SETZM SFINDF ;CLEAR FLAG SAYING SEARCH SUCCEEDED
TRNE FF,PCHFLG+FINDR ;S SEARCH?
JRST NOFND1 ;NO.
TRNN FF,COLONF ;YES. COLON MODIFIER?
JRST NOFND2 ;NO
TRZ FF,PCHFLG+FINDR ;YES.
TRNE FF,RPLFG ;ARE WE DOING A REPLACE COMMAND ??
POPJ P, ;YES, SO JUST RETURN
JRST BEGIN ;RETURN VALUE OF 0
NOFND1: SKIPGE SOARG ;POSITIVE SEARCH?
JRST NOFND2 ;CAN'T DO BEG BACKARROW OR NEG N
SKIPN ABORTF ;ABORT?
TXNN FF,UREAD ;INPUT FILE SELECTED?
JRST NOFND2 ;NO. DONE.
MOVEI C,1 ;PUNCH 1 PAGE ONLY
TRNE FF,PCHFLG ;N SEARCH?
CALL PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TRNE FF,FINDR ;LEFT ARROW SEARCH?
CALL YANK1 ;YES. FILL BUFFER.
JRST SERCHS ;CONTINUE SEARCHING
NOFND2: STKVAR <SFLPTR,SFLLEN> ;O.K., SINCE P IS RESET AT "GO"
LERROR <Search failed for: >
MOVE A,[440700,,SCHBUF] ;POINTER TO STRING WE COULDN'T FIND
MOVEM A,SFLPTR
MOVE A,SSLEN ;GET LENGTH (MIGHT BE NULLS IN STRING!)
MOVEM A,SFLLEN
UCTYPE """" ;PUT STRING IN QUOTES
NOF1: SOSGE SFLLEN ;MAYBE STRING IS EXHAUSTED
JRST [ PSTR <"
> ;FINISH STRING WITH CLOSE QUOTE AND CRLF
JRST GO] ;FINISH ERROR HANDLING
ILDB A,SFLPTR ;GET NEXT CHARACTER FROM SEARCH STRING
CAIL A,.CHTAB ;FORMATTING CHARACTER?
CAILE A,.CHCRT
JRST [ UCTYPE @A ;NO, TYPE THE CHARACTER
JRST NOF1] ;CONTINUE WITH REST OF STRING
UCTYPE "<" ;START SPECIAL STRING
UPSTR @[ [ASCIZ /TAB/]
[ASCIZ /LF/]
[ASCIZ /VT/]
[ASCIZ /FF/]
[ASCIZ /CR/]]-.CHTAB(A)
UCTYPE ">" ;FINISH SPECIAL STRING
JRST NOF1 ;DO REST OF STRING
COLON: TRO FF,COLONF ;SET COLON FLAG
JRST CD5
;MI PERFORM NOW THE TEXT IN Q-REGISTER IN AS A SERIES OF COMMANDS.
MAC: CALL QREGVI ;A:=C(Q-REG)
MAC0: TLZE A,400000 ;MAKE SURE Q-REG CONTAINS TEXT
TLZE A,377770
ERROR <QREG DOES NOT CONTAIN TEXT>
ADD A,QRBUF
MOVE I,A
CALL SAVCMD ;SAVE CURRENT COMMAND STATE
PUSH P,INTDPH ;REMEMBER HOW DEEP ITERATIONS ARE
CALL GETINC ;GET FIRST CHARACTER OF MACRO
CAIE CH,141 ;IT SHOULD BE FLAG
ERROR <QREG DOES NOT CONTAIN TEXT>
CALL GETINC ;GET NUMBER OF CHARACTERS IN MACRO
MOVE A,CH
CALL GETINC
LSH A,7
IOR A,CH
CALL GET
LSH A,7
IOR A,CH
SUBI A,4 ;-FLAG AND COUNT
MOVEM A,COMCNT ;THAT MANY COMMANDS TO COUNT
MOVEM A,COMAX ;AND MAX.
SETZM INTDPH ;SAY NO ITERATIONS YET
MOVE A,I
IDIVI A,5
MOVE B,BTAB(B) ;MAKE A BYTE POINTER
HRR B,A
MOVEM B,CPTR ;PUT IT IN CPTR
SKIPN INIJFN ;DOING TV.INI FILE???
JRST CD5 ;NO, DON'T FLUSH ANY ARGUMENTS
JRST CRET ;GO EXECUTE TV.INI
;MXFILENAME$ PUTS THE CONTENTS OF THE FILE IN Q-REG X
MFILE: TXNE FF,SCANF ;SCANNING
CALLRET SCSTR ;YES, JUST FIND END OF STRING
CALL QREGVI ;GET Q-REG NAME TO USE AND MAKE SURE IT IS LEGAL.
MOVE T,CH ;REMEMBER NAME IN T
CALL FACCES ;OPEN THE FILE
CALL MFILE0 ;LOAD THE FILE
MOVEM A,QTAB-"0"(T) ;STORE POINTER TO TEXT IN QREG "X"
RET
;ROUTINE TO LOAD A FILE INTO A Q-REG. GIVE IT JFN IN A. IT RETURNS
;HANDLE IN A.
MFILE0: CALL QGC ;GET AS MUCH SPACE AS POSSIBLE
MOVE C,EQRBUF ;GET ADDRESS OF BEGINNING OF FREE SPACE
SUB C,BEG ;SUBTRACT END OF F.S. TO YIELD NEG OF FREE AMOUNT
ADDI C,4 ;LEAVE 4 CHARACTERS SPACE FOR FLAG AND LENGTH
JUMPGE C,[ERROR <NOT ENOUGH QREG SPACE>]
MOVE OU,EQRBUF
MOVEI CH,141
CALL PUT ;CREATE BYTE POINTER TO BEGINNING OF FREE SPACE AND PUT IN FLAG
MOVE D,TT ;SAVE BYTE POINTER
REPEAT 3,< IBP TT
> ;LEAVE ROOM FOR LENGTH
MOVE B,TT ;TELL SYSTEM WHERE TO READ FILE INTO
MOVE P1,C ;SAVE AMOUNT WE'LL ATTEMPT TO READ IN
SIN ;READ ENTIRE FILE INTO CORE
GTSTS ;GET EOF BIT INTO b
CLOSF ;CLOSE THE FILE
JRST DNTFL2 ;COULDN'T.
TLNN B,(GS%EOF) ;WAS THERE ENOUGH ROOM FOR WHOLE FILE ??
ERROR <NOT ENOUGH QREG SPACE> ;NO .(WE DIDN'T REACH EOF)
SUB C,P1 ;SEE HOW MANY CHARACTERS WE READ IN
ADDI C,4 ;4 FOR FLAG AND COUNT.
MOVE B,[250700,,C] ;PREPARE TO PICK UP AMOUNT IN THREE INSTALLMENTS
REPEAT 3,<
ILDB P1,B ;PICK UP PART OF LENGTH
IDPB P1,D ;PUT IT AT BEGINNING OF STRING
>
ADD C,EQRBUF ;COMPUTE NEW SPACE BOUNDARY
MOVE A,EQRBUF ;GET OLD FREE SPACE BOUNDARY
MOVEM C,EQRBUF ;UPDATE BOUNDARY
SUB A,QRBUF ;GET RELATIVE ADDRESS
TLO A,(1B0) ;SET "TEXT" FLAG
RET
;ERROR HANDLERS
DONTFL: DPB CH,CPTR ;PUT ALTMODE BACK IN STRING
DNTFL2: CALL JSER ;ANALYZE ERROR
ERROR <COULDN'T ACCESS FILE>
DNTFL1: MOVE A,C ;COULDN'T OPEN FILE, SO RELEASE JFN
RLJFN
JFCL ;CAN'T EVEN DO THAT !!
JRST DNTFL2 ;ANNOUNCE REASON FOR ERROR
;FILE ACCESS ROUTINE
FACCES: CALL FILSPC ;FIND END OF FILE NAME AND DELIMIT WITH NULL
MOVSI A,(GJ%OLD+GJ%SHT) ;SHORT FORM+OLD FILE ONLY
GTJFN ;GET HANDLE ON FILE
JRST DONTFL ;COULDN'T.
DPB CH,CPTR ;PUT ALTMODE BACK
MOVE B,[70000,,OF%RD] ;7 BIT BYTES+OPEN FOR READING
MOVE C,A ;SAVE JFN IN CASE OF ERROR
OPENF ;OPEN THE FILE
JRST DNTFL1 ;COULDN'T.
RET
;WFILENAME INSERTS THE FULL FILENAME OF THE LAST FILESPEC GIVEN
;IN A ;Y ;U ;S ;D ;X ;R OR ;W COMMAND
WFILEN: MOVE A,[440700,,NAMBFR] ;POINTER TO FILESPEC
CALLRET INSRTZ ;INSERT THE FILESPEC
;EFILENAME$ PUSHES TYPIN JFN AND INPUTS FROM NAMED FILE.
DOFILE: TXNE FF,SCANF ;JUST SCANNING?
CALLRET SCSTR ;YES, JUST FIND END OF STRING
CALL FACCES ;OPEN THE FILE
MOVE C,TYIP ;GET TYPIN STACK POINTER
PUSH C,TYIJFN ;SAVE OLD TYPIN JFN
MOVEM C,TYIP ;SAVE NEW STACK POINTER
MOVEM A,TYIJFN ;AND SAVE NEW INPUT JFN
DVCHR ;SEE IF DEVICE IS A TERMINAL
SETOM TERIO ;FIRST ASSUME IT'S NOT
LDB A,[221100,,B] ;GET DEVICE TYPE
CAIE A,.DVTTY ;SKIP IF IT'S A TERMINAL
SETZM TERIO ;IT'S NOT.
RET
;<> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT
; BACK TO THE < WHEN THE > IS ENCOUNTERED.
LSSTH: TXNE FF,SCANF ;SCANNING?
JRST [ MOVEI A,">" ;YES, SEE IF SCANNING FOR CLOSING BRACKET
CAMN A,LCHAR
AOS SCNEST ;YES, SO NEST DEEPER
JRST CRET]
AOS INTDPH
PUSH P,ITERCT ;SAVE ITERATION COUNT
TRZN FF,ARG ;IS THERE AN ARGUMENT?
HRLOI C,377777 ;NO, SET ITERCT= POS INF
MOVEM C,ITERCT ;YES. ITERCT:=ARGUMENT
CALL SAVCMD ;SAVE CURRENT COMMAND STATE
SKIPG C,ITERCT
JRST INCMA ; 0<...> DOES NOTHING FEATURE.
JRST CRET
GRTH: TXNE FF,SCANF ;SCANNING?
JRST [ MOVEI A,">" ;YES, SEE IF FOR CLOSED BRACKET
JRST SCAN1]
SKIPG INTDPH ;IS THERE A LEFT ANGLE BRACKET?
ERROR <UNMATCHED RIGHT ANGLE BRACKET>
SOSG ITERCT ;ITERCT:=ITERCT-1. DONE?
JRST INCMA2 ;YES
CALL RESCMD ;RESTORE COMMAND STATE TO BEGINNING OF LOOP
CALL SAVCMD ;BUT LEAVE ON STACK
TRNE FF,TRACEF ;TRACING?
CALL CRR ;YES. OUTPUT CRLF
JRST CRET
;: IF NOT IN AN ITERATION, GIVES ERROR. IF IN AN ITERATION AND
; IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED
; RBRACKET TO THE RIGHT. OTHERWISE, NO EFFECT.
TCOND: SKIPN INTDPH ;IN < > ?
ERROR <No iteration loop currently in progress>
TRNN FF,ARG ;YES. IF NO ARG,
MOVE C,SFINDF ;LAST SEARCH SWITCH
JUMPL C,CRET ;IF ARG .L. 0, JUST RET + EXECUTE LOOP
INCMA: MOVEI A,">" ;WHAT WE'RE LOOKING FOR
CALL SCAN ;FIND END OF CONDITIONAL
INCMA2: SOS INTDPH ;POP OU A LEVEL
ADJSP P,-CBLEN ;THROW AWAY SAVED COMMAND STATE
POP P,ITERCT
JRST CRET
;HERE WITH CHARACTER IN A TO SCAN FOR
SCAN: MOVEM A,LCHAR ;REMEMBER WHAT WE'RE LOOKING FOR
TXO FF,SCANF ;REMEMBER WE'RE SCANNING
SETZM SCNEST ;RESET NESTING LEVEL
JRST CRET
;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT
; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.
EXCLAM: CALL SKRCH ;EXCLAM JUST INCREMENTS PAST ANOTHER !
CAIE CH,"!"
JRST .-2
JRST CRET
;OTAG$ GO TO THE TAG NAMED TAG. THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OG: TXNE FF,SCANF ;SCANNING?
JRST [ CALL SCSTR ;YES, SCAN FOR ESCAPE
JRST CRET] ;DONE
MOVE A,CPTR ;COMPUTE HASH OF CPTR INTO SYMBOL TABLE
MOVE B,A
IDIVI B,17
CAMN A,SYMS(C) ;DO 3 PROBES MAX THEN GIVE UP
JRST OGFND
SKIPN SYMS(C)
JRST OGNF
CAMN A,SYMS+1(C)
ES1: AOJA C,OGFND
SKIPN SYMS+1(C)
AOJA C,OGNF
CAMN A,SYMS+2(C)
AOJA C,ES1
SKIPN SYMS+2(C)
ADDI C,2
OGNF: PUSH P,CPTR
PUSH P,C
MOVEI P2,OTAB+1
MOVEI A,41
MOVEM A,-1(P2) ;OTAB_"!"
OGNF1: CALL SKRCH
MOVEM CH,(P2) ;OTAB+1 ... _ TAG
CAIL P2,OTAB+OTABL ;FILLED BUFFER?
ERROR <SYMBOL TOO LONG OR TERMINATOR MISSING>
CAIE CH,.CHESC
AOJA P2,OGNF1
MOVEI A,"!" ;DON'T ASSUME SKRCH PRESERVES A
MOVEM A,(P2) ;ALTMODE: OTAB+N_"!"
MOVE C,COMCNT
SUB C,COMAX ;# REMAINING COMMANDS
IDIVI C,5
ADD C,CPTR ;MAKE A COMMAND POINTER
JUMPE D,OG2
SOS C
MOVMS D
JRST .(D)
IBP C
IBP C
IBP C
IBP C
OG2: MOVE B,COMAX ;ALL COMMANDS
OG4: MOVEM C,CPTR
MOVEM B,COMCNT
MOVEI D,OTAB ;INIT SEARCH STRING TO "!"
OG5: CAIN D,1(P2) ;END OF STRING?
JRST OG3 ;YES
CALL SKRCH1 ;NO. GET A CHAR
CAMN CH,(D) ;MATCH ?
AOJA D,OG5 ;YES. MOVE ON.
IBP C ;NO. TRY A NEW STARTING PT
SOJG B,OG4 ;COUNT DOWN COMMANDS
ERROR <TAG NOT FOUND>
OG3: POP P,A
POP P,SYMS(A)
MOVEM B,CNTS(A)
MOVEM C,VALS(A)
JRST CRET
OGFND: MOVE A,VALS(C)
MOVEM A,CPTR
MOVE A,CNTS(C)
MOVEM A,COMCNT
JRST CRET
;APOSTROPHE MARKS END OF CONDITIONAL FOR DUOBLE QUOTE
APOST: TXNN FF,SCANF ;SCANNING?
JRST CRET ;NO, NOTHING TO DO
MOVEI A,"'" ;YES, SEE FOR WHAT
SCAN1: CAME A,LCHAR ;FOR APOSTROPHE?
JRST CRET ;NO
SOSL SCNEST ;YES, HAVE WE JUST FOUND THE ONE WE'RE LOOKING FOR?
JRST CRET ;NOT YET
TXZ FF,SCANF ;YES, SAY NOT SCANNING ANYMORE
RET
;N"G HAS NO EFFECT IF N IS GREATER THAT 0. OTHERWISE,
; SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
; THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L SEND COMMAND TO MATCHING ' UNLESS N .L. 0.
;N"N SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"C SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
; OR PER CENT (%).
DQUOTE: CALL RCH
TXNE FF,SCANF ;SCANNING?
JRST DQS ;YES
TRNN FF,ARG
ERROR <NO ARGUMENT GIVEN>
TRZ CH,40
MOVSI A,0
CAIN CH,"G"
MOVSI A,(<JUMPG C,>)
CAIN CH,"L"
MOVSI A,(<JUMPL C,>)
CAIN CH,"N"
MOVSI A,(<JUMPN C,>)
CAIN CH,"E"
MOVSI A,(<JUMPE C,>)
CAIN CH,"C"
JRST DQT1
JUMPE A,[ERROR (<UNDEFINED COMMAND>)]
HRRI A,CRET
XCT A
NOGO: MOVEI A,"'" ;SAY WE'RE LOOKING FOR AN APOSTROPHE
CALL SCAN ;SCAN COMMAND STRING FOR END OF CONDITIONAL
JRST CRET
;GET HERE WHEN "x ENCOUNTERED DURING A SCAN
DQS: MOVEI A,"'"
CAMN A,LCHAR ;ARE WE SCANNING FOR APOSTROPHE
AOS SCNEST ;YES, SO NEST DEEPER
JRST CRET ;RETURN FOR NEXT COMMAND
DQT1: MOVE CH,C ;CHARACTER INTO CH
CALL SEPER
JRST CRET
JRST NOGO
;SKIP IFF CHARACTER IN CH IS AN OCTAL DIGIT
DIG8Q: CAIL CH,"0"
CAILE CH,"7"
RET ;LESS THAN 0 OR (NOT, AND GREATER THAN 7)
RETSKP
;ROUTINE TO TEST CHARACTER FOR LEGAL SYMBOL CHAR, I.E. $,%,.,0-9,A-Z
;CALL MOVE CH,CHARACTER
; CALL NOTSEP
; RETURN IF $,%,.,0-9,A-Z
; RETURN ON ALL OTHER CHARACTERS
SEPER: CAIE CH,"$" ;$ OR %?
CAIN CH,"%"
RET ;YES
CAIN CH,"." ;NO. POINT?
RET ;YES.
CAIGE CH,"0" ;NO. DIGIT OR LETTER?
JRST POPJ1 ;NO
CAIG CH,"9" ;MAYBE. DIGIT?
RET ;YES.
CAIGE CH,"A" ;NO. LETTER?
JRST POPJ1 ;NO.
CAIG CH,"Z"
RET ;YES.
CAIL CH,141 ;LOWER CSE LETTERS?
CAIL CH,173 ;..
POPJ1: AOS 0(P) ;NO.
RET
;LUUO HANDLER
;S0UUOH - HANDLES LUUO'S FROM SECTION 0, INVOKED BY CALL S0UUOH
; IN LOCATION .JB41; WORKS BY DUMMYING UP NON-ZERO SECTION
; LUUO BLOCK
;S1UUOH - HANDLES LUUO'S FROM NON-ZERO SECTIONS, INVOKED BY HARDWARE
; PASSING CONTROL TO LOCATION WHOSE ADDRESS IS IN UUOB+.ARNPC
S0UUOH: MOVEM 16,UUOACS+16 ;SAVE AC'S 0-16
MOVEI 16,UUOACS
BLT 16,UUOACS+15
HRRZ TT,.JBUUO ;COPY EFFECTIVE ADDR TO UUO BLOCK
MOVEM TT,UUOB+.AREFA
LDB TT,[POINT 4,.JBUUO,12] ;COPY AC SPECIFICATION TO UUO BLOCK
DPB TT,[POINT 4,UUOB+.ARPFL,30]
LDB TT,[POINT 9,.JBUUO,8] ;COPY OPCODE TO UUO BLOCK
DPB TT,[POINT 9,UUOB+.ARPFL,26] ;KEEP OPCODE IN TT FOR DISPATCH
JRST LUUO1 ;MERGE WITH NON-0 SECTION CODE
S1UUOH: MOVEM 16,UUOACS+16 ;SAVE AC'S 0-16
MOVEI 16,UUOACS
BLT 16,UUOACS+15
PUSH P,UUOB+.AROPC ;PUT RETURN PC ON STACK FOR POPJ
LDB TT,[POINT 9,UUOB+.ARPFL,26] ;GET OPCODE OF UUO
LUUO1: CAIL TT,LUUOTB ;IS THIS OPCODE DEFINED FOR TV?
ERROR <UNDEFINED UUO> ;NO
CALL UUOTAB(TT) ;GO TO ROUTINE
MOVSI 16,UUOACS
BLT 16,16 ;RESTORE AC'S
RET ;END OF UUO.
UUOTAB: ERROR <UNDEFINED UUO>
JRST UERR0 ;ERROR
JRST UPSTR0 ;PRINT STRING
JRST %LDB ;GO HANDLE LDB FROM BUFFER
JRST %LDB ;GO HANDLE ILDB FROM BUFFER
JRST LERR0 ;ERROR BUT RETURN TO CALLER
JRST JERR0 ;JSYS ERROR
JRST LJERR0 ;LOCAL JSYS ERROR
JRST IERR0 ;INTERNAL ERROR
JRST UCTYP0 ;PRINT SINGLE CHARACTER
LUUOTB==.-UUOTAB
;JSYS ERROR.
JERR0: CALL LJERR0 ;DO IT LIKE LOCAL ONE
JRST GO ;BUT DON'T RETURN
;LOCAL JSYS ERROR.
LJERR0: CALL ERRMES ;PRINT PROGRAM'S REASON FOR ERROR
PSTR < - >
SETZM ERRBUF ;CLEAR BUFFER IN CASE ERSTR FAILS
HRROI A,ERRBUF ;PREPARE TO BUFFER SYSTEM'S REASON
MOVE B,[.FHSLF,,-1] ;OURSELF, LAST ERROR
SKIPE D,LSTERR ;ANY PARTICULAR ERROR?
HRR B,D ;YES, USE IT
MOVSI C,-ERRBLN*5 ;NUMBER OF CHARACTERS WE HAVE ROOM FOR IN OUR BUFFER
ERSTR ;GET ERROR STRING
PSTR <Unknown error code>
JFCL ;DON'T WORRY IF LENGTH TOO SHORT
UPSTR ERRBUF ;PRINT ERROR MESSAGE
SETZM LSTERR ;DON'T USE SAME PARTICULAR ERROR OVER AGAIN
CALLRET CRR ;END WITH CARRIAGE RETURN
;LOCAL ERROR (LERROR) MEANS PRINT THE MESSAGE AS AN ERROR, BUT
;RETURN TO THE CALLER
LERR0: CALLRET ERRMES ;NO CRLF, SINCE MIGHT BE COMPOSITE MESSAGE
;INTERNAL ERROR
IERR0: CALL ERRMES ;PRINT THE MESSAGE
CALL CRR ;END OF LINE
CALL DOHALT ;STOP
RET ;ATTEMPT TO CONTINUE IF USER REQUESTS SO
;ERROR UUO
;TYPE ERROR MESSAGE FOLLOWED BY LAST 10 CHARS OF COMMAND STRING
UERR0: CALL ERRMES ;PRINT THE ERROR MESSAGE
SKIPGE COMCNT ;DID COMCNT OVERSHOOT (AT RCH) ?
SETZM COMCNT ;YES, ASSUME COMMAND JUST EXHAUSTED
MOVE A,COMAX
SUB A,COMCNT
MOVEM A,ERR1 ;ERR1 := NUMBER OF CHARACTERS EXECUTED
MOVE P1,CPTR ;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
MOVEI P2,12
SUBI P1,2 ;BACK POINTER UP 10 CHARACTERS.
PSTR <: >
ILDB A,P1 ;GET CHARACTER
CAMG P2,ERR1 ;WAS IT IN THE COMMAND BUFFER?
CALL TYO ;YES. TYPE IT.
CAME P1,CPTR ;HAVE WE REACHED THE BAD COMMAND?
SOJA P2,.-4 ;NO. DO IT AGAIN.
CALL CRR ;TYPE CRLF AFTER ERROR MESSAGE IF NOT SCREEN.
JRST GO
;PRINT ERROR MESSAGE
ERRMES: CALL WINCLS ;SO ERROR MESSAGES DON'T GET ERASED
SETZM INIJFN ;IF ERROR DURING TV.INI, DON'T TRY TO REEXECUTE IT AT CLIS
PUSH P,UUOB+.AREFA ;SAVE PTR TO ERROR STRING
CALL LM ;MAKE SURE WE'RE AT LEFT MARGIN
PSTR <?>
;QUESTION MARK MUST ALWAYS BE AT LEFT MARGIN.
CALL CLRINP ;CLEAR TYPING INPUT
POP P,TT ;RECOVER ADR OF ERROR STRING
HRRO TT,TT ;CONSTRUCT BYTE PTR
CALLRET PSTR0 ;PRINT IT
;PRINT STRING UUO
UPSTR0: HRRO TT,UUOB+.AREFA ;GET ADR OF STRING
CALLRET PSTR0 ;PRINT IT
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: MOVE A,[JRST TYO]
TRCE FF,TRACEF
MOVSI A,(<RET>)
MOVEM A,TRACS
TRNE FF,TRACEF ;DID WE TOGGLE INTO TRACE MODE ??
CALL WINCLS ;DON'T ERASE TRACINGS
JRST CRET
COMM: PUSHJ P,SKRCH ;GET A COMMENT CHAR
SKIPE ABORTF ;ABORT?
JRST TYOQT ;YES, QUIT TYPEOUT
CAIN CH,.CHESC ;ALTMODE
JRST CRET
MOVE A,CH
TXNN FF,SCANF ;don't type anything if scanning!!
PUSHJ P,TYO ;TYPE IT
JRST COMM
CALDDT: SKIPN 770000 ;MAKE SURE DDT IS LOADED
ERROR <DDT is not loaded>
JRST 770000 ;ASSUMED LOC OF DDT
;THE FOLLOWING ROUTINE DECIDES WHERE IN BUFFER TO START DISPLAYING
;FROM. IT TRYS TO CAUSE THE POINTER TO BE ABOUT ONE HALF DOWN THE
;WINDOW. AT POPJ TIME, SCRNPT HAS BEEN SET UP AS AN ADDRESS
;OF THE BUFFER CHARACTER TO BE DISPLAYED FIRST.
;THE SCREEN SIZE IS DETERMINED BY THE CONTENTS OF DLENTH.
WINIT: STKVAR <DFT>
MOVEI P1,0 ;FIRST FIND THE END OF THE CURRENT LINE
MOVE I,PT ;START FROM THE POINTER.
WINL: CAML I,ZEE ;END OF BUFFER ??
JRST WINND1 ;YES, SO SURELY END OF LINE !!
CALL GET ;FIND OUT WHAT CHARACTER WE'RE AT.
CAIE CH,12
CAIN CH,15
JRST WINND1 ;LF OR CR, SO WE'RE AT THE END OF THE LIE.
AOJ P1,
CAIG CH,37
CALL SFLAGC
CAIA
AOJ P1, ;FLAGGED LETTER OR CONTROL CHARACTER TAKE UP TWO COLUMNS.
CAIL P1,MAXWTH ;NEVER SCAN MORE COLUMNS THAN LONGEST ALLOWED LINE.
JRST WINND1
CAMGE P1,SWIDTH ;DON'T SCAN LONGER THAN SPECIFIED TERMINAL LINE WIDTH.
AOJA I,WINL ;KEEP SCANNING FOR END OF LINE.
WINND1: MOVE A,DLENTH ;GET NUMBER OF LINES IN SCREEN TO BE USED
IDIVI A,2 ;QUOTIENT IS HOW MANY LINES WANTED ABOVE POINTER
MOVEM A,DFT
WINR5: MOVEI P1,0 ;CHARACTER COUNTER
;WE NOW COUNT LINES IN REVERSE, ACCOUNTING FOR ONE LINE EVERY TIME
;A SCREEN LINE'S WIDTH OF CHARACTERS IS SCANNED, OR AN END OF
;LINE WITHIN THE ACTUAL BUFFER IS ENCOUNTERED
CAMG I,BEG ;ARE WE ALREADY AT BEGINNING OF BUFFER ?
JRST WINR1 ;YES
WINR4: SUBI I,1 ;BACK UP ONE CHARACTER
CAMG I,BEG ;BEGINNING OF BUFFER ???
JRST WINR1 ;YUP
CALL GET ;MAKE BYTE POINTER AND GET CHAR INTO CH
CAIN CH,12 ;LF ??
JRST WINLF ;YES, END OF LINE
ADDI P1,1 ;ACCOUNT FOR CHARACTER SPACE
CAIN CH,.CHTAB ;TAB?
ADDI P1,6 ;YES, ASSUME WORST IS 8, 1 ABOVE, 6 HERE, 1 BELOW
CALL SFLAGC ;AND IF IT SHOULD BE FLAGGED ON OUTPUT
CAIG CH,37 ;OR IS A CONTROL CHARACTER
WINR6: ADDI P1,1 ;IT TAKES UP AT LEAST TWO POSITIONS
CAIL P1,MAXWTH
JRST WINRX ;RIDICULOUSLY LONG LINES DON'T LOUSE US UP.
CAMGE P1,SWIDTH ;REAL LONG LINE ??
JRST WINR4 ;NOT YET, GOBBLE ON
WINRX: SOSLE DFT ;DO MORE LINES?
JRST WINR5 ;YES
WINR1: MOVEM I,SCRNPT ;SET UP POINTER TO BUFFER WHERE TO START DISPLAYING
;...
;NOW WE PRETTY MUCH KNOW WHERE TO START DISPLAYING FROM. THE FOLLOWING
;STEP MAKES AN EFFORT TO NOT CHOP OFF THE FIRST LINE ON THE DISPLAY.
;NOTE THAT THE FOLLOWING CODE IS NEEDED IN ADDITION TO THE LININI
;ROUTINE, SINCE WHEN A SCREEN REFRESH IS ALREADY CALLED FOR, WE
;ARE MORE WILLING TO BACK UP TO THE BEGINNING OF THE LINE, SINCE WE
;DON'T CARE IF THAT CAUSES THE REST OF THE LINE TO SPILL ONTO THE NEXT
;ON THE SCREEN.
;...
MOVE A,I ;GET CURRENT BEGINNING OF DISPLAY
CALL LINBGQ ;TRY TO FIND BEGINNING OF LINE
MOVEM A,SCRNPT ;THIS IS WHERE TO DISPLAY FROM
RET
WINLF: SUBI I,1 ;SAW LINEFEED, BACKUP AND SEE IF CR
CALL GET ;GET CHAR BEFORE LINEFEED
CAIE CH,15 ;CR ??
AOJ I, ;NO
SOSLE DFT ;DONE ENOUGH LINES?
JRST WINR5 ;NOT YET
AOJA I,WINR1 ;ENOUGH LINES BACK, PREPARE TO EXIT
;ROUTINE TO FIND BEGINNING OF BUFFER LINE. PASS IT CHARACTER ADDRESS
;IN A. THE ROUTINE RETURNS WITH ADDRESS OF BEGINNING OF LINE IN A, OR
;BEGINNING OF BUFFER, OR A UNMODIFIED IF NEITHER IS FOUND.
LINBGQ: STKVAR <FSTCNT,GIVENA>
MOVEM A,GIVENA
SETZM FSTCNT ;AMOUNT WE'VE TRIED TO BACKUP
SOS I,A
WINBU: CAMGE I,BEG ;ARE WE BACK TO BEGINNING OF BUFFER?
AOJA I,WINBU1 ;YES, SO WE'RE AT BEGINNING OF LINE
CALL GET ;SEE IF WE'RE BACK TO BEGINNING OF LINE
CAIN CH,12 ;LINEFEED?
AOJA I, WINBU1 ;YES, ASSUME BEGINNING OF LINE
AOS A,FSTCNT ;NOT YET, SEE HOW HARD WE'VE LOOKED
CAIGE A,MAXWTH ;MAXIMUM AMOUNT FOR DISPLAY LINE?
SOJA I,WINBU ;NO, SO KEEP LOOKING
MOVE I,GIVENA ;YES, SO NO MODIFICATION
WINBU1: MOVE A,I ;RETURN LINE BEGINNING IN A
RET
;ROUTINE TO UPDATE THE SCREEN. THIS IS INVOKED EVERY TIME TV IS READY
;TO INPUT A COMMAND. IT IS ALSO INVOKED BY THE "WUPDATE$" COMMAND.
UPDATE: MOVE I,ZEE ;GET POINTER TO END OF BUFFER
SUBI I,1
CALL GETX ;CHANGE TO BYTE POINTER
MOVEM TT,SCRNZ ;TELL DISPLAY TO GO ALL THE WAY
MOVE A,TTYOUT
MOVEI B,.MORLC
MTOPR ;READ LINE COUNTER
MOVEM C,CRRCNT ;IN CASE WE HAVE TO LINE STARVE UP FROM WHERE WE ARE
MOVEI B,.MORLM ;GET MAXIMUM LINES OUTPUT
MTOPR
SUB C,SSIZE ;CALCULATE NUMBER OF SCROLLS
AOJ C, ;NO SCROLL IF EXACTLY AT BOTTOM
CAML C,SSIZE
MOVE C,SSIZE ;DON'T TRY TO SCROLL MORE THAN ENTIRE SCREEN
MOVN B,C
SKIPN SCRNF ;ON A SCREEN?
JRST NOSCRL ;NO, SO NO SCROLLING
JUMPLE C,NOSCRL ;NEG SCROLL AMOUNT MEANS NO SCROLLING HAPPENED
ADDM B,DISBLK ;ADJUST MARK FOR WHERE PRESERVED OUTPUT BEGINS
ADDM B,CRRCNT ;ADJUST CURSOR POSITION UPSCREEN DUE TO SCROLLING
MOVE I,LINNEW(C) ;FIND WHAT PART OF BUFFER NOW BEGINS DISPLAY
MOVEM I,SCRNPT ;SAVE NEW BEGINNING ADDRESS
IMUL C,[<WINDEX>B17] ;C HAS BUFFER WORD OFFSET IN LEFT HALF
ADD C,[WINDOW,,WINDOW] ;MAKE WINDOW+X,,WINDOW
MOVE B,DLENTH ;GET NUMBER OF LINES NEEDED TO SCROLL
IMULI B,WINDEX ;GET NUMBER OF MEMORY WORDS INVOLVED
HLRZ D,C ;GET FIRST WORD BEING MOVED FROM
ADDI D,-1(B) ;CALCULATE LAST MEMORY WORD MOVED FROM
SUBI D,WINDOW+WINTOP ;SEE HOW MANY WOULD BE OUT OF BOUNDS
CAIGE D,0 ;ARE THERE SOME OUT OF BOUNDS?
MOVEI D,0 ;NO, SO SAY EXACTLY NONE
SUB B,D ;TRIM SIZE OF BLT TO NOT MOVE WORDS FROM OUT OF BOUNDS
BLT C,WINDOW-1(B) ;SCROLL THE MEMORY TO AGREE WITH SCREEN
MOVEI D,WINDOW(B) ;GET NEXT ADDRESS TO BE FIXED (FIRST ONE BLT MISSED)
MOVE C,DLENTH ;SEE HOW MANY LINES WE CARE ABOUT
IMULI C,WINDEX ;SEE HOW MANY BUFFER WORDS WE CARE ABOUT
ADDI C,WINDOW-WINDEX ;GET FIRST ADDRESS OF LAST GROUP WE CARE ABOUT
UPD1: CAMLE D,C ;DO WE CARE ABOUT THIS WORD?
JRST NOSCRL ;NO, WE'RE DONE FIXING MEMORY
SETOM (D) ;YES, OBLITERATE IT TO FORCE IT TO BE REDISPLAYED
ADDI D,WINDEX ;STEP TO FIRST WORD OF NEXT GROUP
JRST UPD1
NOSCRL: MOVE A,DISBLK ;FIND OUT WHERE PRESERVED OUTPUT BEGINS
SOJ A, ;GET LINES ALLOWABLE FOR WINDOW LEAVING ROOM FOR PROMPT AND PRESERVED OUTPUT
CAMG A,SLENTH ;don't let this window exceed size of standard window.
SKIPGE WINFLG ;DON'T RESET SCREEN LENGTH IF THERE IS PRESERVED OUTPUT
MOVE A,SLENTH ;IT WAS.
MOVEM A,DLENTH ;WE JUST MADE SURE OUTPUT OF T,=, ETC. DON'T GET ERASED
SKIPG DLENTH ;MAYBE DON'T DISPLAY BECAUSE WE MUST PRESERVE THE WHOLE SCREEN
JRST GO2 ;DON'T DISPLAY IF ZERO LENGTH WINDOW
SKIPE MESFLG ;SCREEN MESSED UP?
CALL CLRSCN ;YES, SO CLEAR GARBAGE OFF IT
MOVE I,SCRNPT ;GET CHARACTER ADDRESS OF FIRST CHARACTER
SKIPN MESFLG ;IF REDOING ENTIRE SCREEN ANYWAY, RECENTER IT
CAML I,ZEE ;ARE WE IN BUFFER ??
CALL WINIT ;NO, RELOCATE DISPLAY BEGINNING POINTER
CALL DISINI ;INITIALIZE DISPLAY ROUTINE
CALL LININI ;INITIALIZE FIRST LINE OF DISPLAY
CALL WINFIL ;FILL UP NEW SCREENFUL
SKIPN PUTPTF ;SEE IF POINTER IS ON SCREEN
CALL WINIT ;WASN'T, SO GET NEW STARTING CHARACTER
SETZM MESFLG ;CLEAR FLAG SAYING SCREEN WAS MESSED UP
CALL DISINI ;INITIALIZE DISPLAY ROUTINE
CALL VIEW1 ;DISPLAY TO END OF BUFFER
GO2: RET
;THE WUPDATE$ COMMAND UPDATES THE SCREEN.
WUPDAT: SETOM UPDATF ;SAY DOING WUPDATE
CALL UPDATE
SETZM UPDATF
RET
;THE NV OR N,MV COMMAND IS JUST LIKE T, EXCEPT THE DISPLAY IS JUST
;UPDATED TO REPRESENT THE TEXT DESIRED TO BE VIEWED.
VIEW: SKIPN SLENTH ;MAKE SURE A WINDOW SIZE EXISTS
JRST TYPE ;NO, SO DO REGULAR "T" COMMAND
CALL TVINIT ;MAKE SURE WE HAVE REASONABLE ARGUMENTS
MOVEM I,SCRNPT ;CHARACTER ADDRESS OF CHAR IN BUFFER TO BE DISPLAYED FIRST
MOVE I,C
SUBI I,1
SETZM DISBLK ;DON'T LET ANY OUTPUT HAPPEN AFTER V COMMAND.
AOS WINFLG ;NOTE THAT PRESERVED OUTPUT HAS STARTED.
MOVE A,SLENTH
MOVEM A,DLENTH ;SET WINDOW SIZE TO DEFAULT
CALL GETX ;MAKE BYTE POINTER
MOVEM TT,SCRNZ ;LDB POINTER TO LAST CHARACTER TO BE DISPLAYED
CALL DISINI
CALL VIEW1 ;DISPLAY SOME OF BUFFER
VIEW3: SKIPE EOBFLG ;SEEN END OF BUFFER?
RET ;YES, CAN'T POSSIBLY BE MORE
CALL TYIX ;SEE IF HE WANTS TO SEE MORE
CAIE A,C.MORE ;USER WANT TO SEE MORE?
CALLRET RECHAR ;NO, MAKE NON-SPACE GET RESEEN AND RETURN
CALL MORE1 ;YES, SHOW HIM SOME
JRST VIEW3 ;LOOP UNTIL DONE
;HERE WHEN FIRST CHARACTER TYPED OF COMMAND IS SPACE. WE SHOULD
;DISPLAY NEXT BUFFER SECTION.
DMORE: CALL MORE1 ;DO THE WORK
JRST CLIS ;GO BACK FOR NEXT COMMAND
MORE1: CALL MORE ;DO THE DISPLAYING
MOVEI A,C.MORE
CALLRET BCHAR ;REMEMBER IN BACKUP FILE THAT USER TYPED SPACE
;COME HERE TO DO MORE IF USER TYPES SPACE
MORE: AOS A,SCNEND ;YES, FIND OUT WHERE WE LEFT OFF
MOVEM A,SCRNPT ;AND RESUME THERE
SKIPN SCRNF ;IF NOT ON A SCREEN,
CALL CRR ;TYPE A CRLF HERE.
CALLRET VIEW2 ;GO BACK AND DISPLAY MORE
;ENTER HERE IF SCRNPT AND SCRNZ ARE ALREADY SET UP
VIEW1: MOVE TT,SCRNZ
CALL PTR2AD ;MAKE CHARACTER ADDRESS FROM POINTER
CAMGE I,SCRNPT
SETOM EOBFLG ;IF NOTHING TO DISPLAY, PRETEND END OF BUFFER
VIEW2: SETZM COLUMN
MOVE A,DLENTH ;START WITH FULL WINDOW'S WORTH
SKIPN EOBFLG ;SAYING "MORE"???
SOJ A, ;YES, USE ONE LESS LINE FOR DISPLAY
CALL DISPLA ;OUTPUT FULL WINDOW'S WORTH
SKIPN SCRNF ;HARDCOPY?
JRST [ CALL CRR ;YES, FINISH LAST LINE
JRST NOLNPS] ;SKIP CURSOR POSITIONING STUFF
MOVE CH,DLENTH ;NO, SO PROMPT USER FOR PERMISSION
SOJ CH,
CALL LINPOS ;BY REQUESTING PERMISSION AT BOTTOM
CALL EOL ;OF WINDOW AREA
NOLNPS: SKIPN UPDATF ;NO "--MORE--" IF WUPDATE
SKIPE EOBFLG ;quit if end of buffer
JRST LASTV ;YES
SKIPE TYPEF ;SKIP IF NOT END OF BUFFER AND USER HASN'T TYPED ANYTHING
JRST LASTV ;USER TYPED SOMETHING
MOVE A,TTYOUT ;GET OUTPUT CHANNEL
HRROI B,[ASCIZ /--MORE--/]
MOVEI C,0
SOUT ;ASK FOR PERMISSION TO CONTINUE DISPLAYING
LASTV: SKIPN SCRNF ;HARDCOPY?
CALLRET CRR ;YES, PUT END OF LINE AFTER "MORE" AND RETURN
MOVE CH,DLENTH
CALL LINPOS ;POSITION CURSOR AFTER WINDOW
HRRZ A,CRRCNT ;TELL SYSTEM CURSOR POSITION
CALL SETLIN
RET
;ROUTINE TAKING ARG IN A AND SETTING LINE COUNTER TO THAT VALUE
SETLIN: MOVE C,A ;ARG INTO B FOR JSYS
MOVE A,TTYOUT ;STANDARD OUTPUT
MOVEI B,.MOSLC ;SET LINE COUNTER
MTOPR
MOVEI B,.MOSLM ;SET MAXIMUM TOO
MTOPR
MOVEI B,0
SFPOS ;SAY WE'RE AT LEFT MARGIN (PAGE POSITION SHOULDN'T MATTER)
RET
;^L CLEARS THE SCREEN AND CAUSES THE POINTER TO BE MOVED
;INTO THE CENTER OF THE SCREEN THE NEXT TIME AN UPDATE HAPPENS
CTRLL: CALLRET CLRSCN
CLRSCN: HRLOI A,377777 ;USE OUT-OF-BOUNDS VALUE TO FORCE RECALCULATION
MOVEM A,SCRNPT
SETZM WINDOW ;CLEAR WINDOW MEMORY TO SHOW THERE'S NOTHING ON SCREEN
MOVE A,[WINDOW,,WINDOW+1]
BLT A,WINDOW+WINTOP
CALL HOME ;YES, HOME UP FIRST
SKIPN SCRNF ;ARE WE ON A SCREEN?
RET ;NO, SO DON'T TRY TO CLEAR IT
JRST EOS ;THEN CLEAR TO END OF SCREEN
CLREOS: MOVEI CH,37 ;MAGIC CLEAR TO END OF SCREEN CHARACTER
CALLRET CNFILL ;REQUIRES FILLERS
CUP: MOVEI CH,C.UP ;LINE STARVE
CALLRET CNFILL
;SCREEN MANAGEMENT ROUTINES
;ROUTINE TO ERASE "REST" OF LINE.
EOL: CALL DISCOC ;MAKE CONTROL CHARACTERS TYPE LITERALLY
MOVE A,TRMTYP ;FIND OUT WHAT SPECIES OF TERMINAL WE ARE
CALL @EOLTAB(A) ;CALL APPROPRIATE ROUTINE
CALLRET REGCOC ;RESTORE CONTROL CHARACTER STUFF
TERINI EOLTAB
TER (.TTV05,IFIW!CLREOL)
TER (.TTV50,IFIW!V50EOL)
TER (.TT100,IFIW!V100CL)
TER (.TTV52,IFIW!V50EOL) ;VT52 GETS CLEARED JUST LIKE VT50
;ROUTINE FOR ERASING "REST OF SCREEN"
EOS: CALL DISCOC ;MAKE SO ALL CONTROLS ARE LITERAL
MOVE A,TRMTYP
CALL @EOSTAB(A) ;CALL APPROPRIATE ROUTINE
CALLRET REGCOC ;RESTORE REGULAR CONTROL STUFF AND RETURN
TERINI EOSTAB
TER (.TTV05,IFIW!CLREOS)
TER (.TTV50,IFIW!V50EOS)
TER (.TT100,IFIW!V100ES)
TER (.TTV52,IFIW!V50EOS) ;SCREEN CLEARING THE SAME ON VT52 AS VT50
;ROUTINE TO PUT CURSOR AT TOP LEFT (HOME) POSITION ON SCREEN.
HOME: SETZB A,CRRCNT ;RESET LINE COUNTER.
CALL SETLIN ;TELL SYSTEM WE'RE AT TOP OF SCREEN
SKIPN SCRNF ;ON A SCREEN?
CALLRET CRR ;NO, JUST TYPE CRLF AND RETURN
CALL DISCOC ;MAKE CONTROL CHARACTERS SOME OUT LITERALLY
MOVE A,TRMTYP
CALL @HOMTAB(A) ;DO SPECIES DEPENDENT HOMEUP
CALLRET REGCOC ;RESTORE CONTROL CHARACTERS AND RETURN
TERINI HOMTAB
TER (.TTV05,IFIW!HOMEUP)
TER (.TTV50,IFIW!V50HOM)
TER (.TT100,IFIW!V100HM)
TER (.TTV52,IFIW!V50HOM) ;VT50 AND VT52 HOME THE SAME WAY
;LINE STARVE...
LINSTV: CALL DISCOC ;TYPE CONTROLS LITERALLY
MOVE A,TRMTYP
CALL @STVTAB(A)
CALLRET REGCOC ;RESTORE CONTROL CHARACTER STUFF
TERINI STVTAB
TER (.TTV05,IFIW!CUP)
TER (.TTV50,IFIW!V50CUP)
TER (.TT100,IFIW!V100UP)
TER (.TTV52,IFIW!V50CUP)
;VT100 ROUTINES
;MACRO TO CAUSE DISPLAY OF ANSI SEQUENCE ESCAPE - OPEN BRACKET - CHARACTER
;FOLLOWED BY RET
DEFINE DSPANS(CHR)
< MOVEI A,.CHESC ;;FIRST SEND ESCAPE
CALL TYO
MOVEI A,"[" ;;THEN BRACKET
CALL TYO
MOVEI A,CHR ;;THEN SPECIFIC CHARACTER
CALLRET TYO ;;DONE
>
V100ES: DSPANS "J"
V100CL: DSPANS "K"
V100UP: DSPANS "A"
V100HM: DSPANS "H"
;VT50 ROUTINES
;CLEAR TO END OF SCREEN
V50EOS: MOVEI A,33
CALL TYO ;ESCAPE CHARACTER
MOVEI A,112
CALLRET TYO
;CLEAR TO END OF LINE
V50EOL: MOVEI A,33
CALL TYO
MOVEI A,113
CALLRET TYO
;HOMEUP
V50HOM: MOVEI A,33
CALL TYO
MOVEI A,110
CALLRET TYO
;LINE STARVE
V50CUP: MOVEI A,33
CALL TYO
MOVEI A,101
CALLRET TYO
;VT05 CURSOR CONTROL
CLREOL: SKIPA CH,["^"-100] ;MAGIC VT05 CLEAR TO END OF LINE CHARACTER
HOMEUP: MOVEI CH,"]"-100 ;MAGIC VT05 CHARACTER TO HOME UP
CNFILL: MOVE A,CH
CALL TYO ;TYPE MAGIC CHARACTER
MOVEI A,0
CALL TYO
MOVEI A,0
CALL TYO
MOVEI A,0
CALL TYO
MOVEI A,0
CALL TYO ;FILLERS
RET
;ROUTINE TO REMEMBER WHERE PRESERVED OUTPUT STARTS.
;PRESERVED OUTPUT IS LIKE T OR = COMMAND. BUFFER SHOWING SHOULDN'T
;OVERPRINT SUCH OUTPUT.
WINCLS: AOSE WINFLG ;IS THIS FIRST PRESERVED OUTPUT FOR THIS COMMAND STRING ??
RET ;NO, SO WE'VE ALREADY MARKED POSITION
CALL LM ;START "T" "=" ETC. AT LEFT MARGIN
CALL SYSLIN ;FIND OUT LINE WE'RE ON
MOVEM A,DISBLK ;REMEMBER WHERE PRESERVATION STARTS
RET
;ROUTINE TO FIND OUT WHAT LINE WE'RE ON
SYSLIN: MOVE A,TTYOUT
MOVEI B,.MORLC ;READ LINE COUNTER
MTOPR
MOVE A,C ;GIVE ANSWER IN A
RET
;ROUTINE TO DISPLAY NEW WINDOW
;PASS IT NUMBER OF LINES TO USE IN A.
DISPLA: TRVAR <OLDPTR,NEWPTR,NEWCOL,OLDCOL,LINCTR,LINPTR,OLDBEG,NEWBEG,SPCNT,LEN2,LEN1,DLEN1>
MOVEM A,DLEN1 ;REMEMBER NUMBER OF LINES AVAILABLE FOR DATA
CALL DISCOC ;MAKE CONTROL CHARACTERS ECHO LITERALLY
SKIPE SCRNF ;HARDCOPY?
JRST DISPLB ;NO
CALL LM ;YES, MAKE SURE AT LEFT MARGIN
SETZM CRRCNT ;ASSUME STARTING AT TOP OF WINDOW
DISPLB: SETZM TYPEF ;FIRST ASSUME THERE'S NO TYPEAHEAD
MOVE A,TYIJFN
SIBE ;SKIP IF THERE ISN'T.
SETOM TYPEF ;THERE IS, SET FLAG SAYING SO.
CALL WINFIL ;FILL WINEW WITH NEW DISPLAYFUL
SETZB A,LINCTR ;CLEAR LINE COUNTER AND LOAD INTO A
CM1: MOVEI B,WINDEX ;GET WORDS PER DISPLAY MEMORY
IMUL B,A ;CALCULATE OFFSET INTO MEMORY FOR LINE BEING WORKED ON
MOVE C,B ;COPY FOR POINTER TO NEW DISPLAY MEMORY
ADD B,[440700,,WINDOW] ;COMPLETE POINTER TO CURRENT WINDOW
MOVEM B,OLDPTR
MOVEM B,OLDBEG ;REMEMBER POINTER TO BEGINNING OF OLD LINE
ADD C,[440700,,WINEW] ;COMPLETE POINTER TO NEW DATA BEING DISPLAYED
MOVEM C,NEWBEG ;REMEMBER POINTER TO NEW LINE
SETZM LEN1 ;NUMBER OF CHARACTERS NEEDED TO "FIX" LINE
CALL LREPLA ;CALCULATE CHARACTERS NECESSARY TO REWRITE WHOLE LINE
MOVE C,NEWBEG ;RESET LINE POINTER TO BEGINNING
MOVEM C,NEWPTR
SETZM OLDCOL ;START AT LEFT MARGIN
SETZM NEWCOL ;NEW COLUMN WE'RE GOING TO
MOVE C,[440700,,LINBFR] ;POINTER TO LINE BUFFER FOR OUTPUTTING DISPLAY LINE
MOVEM C,LINPTR ;INITIALIZE DISPLAY LINE POINTER
CMLUP: ILDB B,OLDPTR ;PICK UP CHARACTER FROM CURRENT SCREEN
ILDB A,NEWPTR ;AND ONE FOR NEW SCREEN
JUMPE A,CMEND ;JUMP IF DONE SCANNING LINE
JUMPE B,CMEND1 ;OLD LINE ENDED BEFORE NEW
SKIPE SCRNF ;IF HARDCOPY
CAME A,B ;OR IF CHARACTERS ARE DIFFERENT,
CALL PILB ;THEN DISPLAY NEW CHARACTER
AOS NEWCOL ;STEP TO NEXT COLUMN ON SCREEN
JRST CMLUP ;COMPARE REST OF CHARACTERS ON LINE
CMEND1: CALL PILB ;OLD ENDED FIRST, STASH NEW CHARACTERS
AOS NEWCOL
ILDB A,NEWPTR
JUMPN A,CMEND1 ;JUMP IF MORE NEW CHARACTERS
JRST CMEND2
CMEND: JUMPE B,CMEND2 ;JUMP IF BOTH LINES ENDED AT SAME TIME
SKIPN SCRNF ;DON'T ATTEMPT TO CLEAR TO END OF LINE ON HARDCOPY
JRST CMEND2
CALL MOVCOL ;GET TO END OF LINE BEFORE CLEARING TO END OF LINE!
CALL GETEOL ;NEW ONE ENDED FIRST, PUT IN AN EOL
CMEND2: SKIPE TYPEF ;HAS USER STARTED TYPING NEXT COMMAND?
JRST DISDON ;YES, SO STOP UPDATING DISPLAY
MOVE A,LINPTR ;GET LINE POINTER
CAMN A,[440700,,LINBFR] ;WAS ANYTHING PUT IN BUFFER FOR THIS LINE?
JRST CMNEXT ;NO, SO THIS LINE STAYS AS IS
MOVEI A,0 ;MARK END OF DISPLAY BUFFER WITH NULL
IDPB A,LINPTR
MOVEI C,WINDEX ;GET WORDS PER DISPLAY BUFFER
IMUL C,LINCTR ;CALCULATE OFFSET FOR LINE BEING DISPLAYED NOW
MOVE A,LINCTR ;GET LINE BEING DONE NOW
MOVE T,C ;GET COPY OF POINTER TO DISPLAY AREA
HRL T,T ;COPY IT TO LEFT HALF
ADD T,[WINEW,,WINDOW] ;MAKE BLT POINTER
BLT T,WINDOW+WINDEX-1(C);AND MOVE LINE FROM WINEW AREA TO WINDOW AREA
MOVE CH,LINNEW(A)
MOVEM CH,LINBEG(A) ;COPY BUFFER POINTER OF BEGINNING OF LINE
MOVEI CH,(A) ;FIND WHAT DISPLAY LINE POSITION TO
CALL LINPOS ;GO TO AND GO THERE
DISPL9: MOVE A,TTYOUT ;USE STANDARD OUTPUT CHANNEL
HRROI B,LINBFR ;POINTER TO NEW LINE
MOVEI C,0
MOVE D,LEN1 ;GET NUMBER OF CHARACTERS TO FIX LINE
SKIPE SCRNF ;ALWAYS REPLACE ENTIRE LINE ON HARDCOPY
CAML D,LEN2 ;BETTER TO FIX THAN REPLACE?
HRROI B,LINBF2 ;BETTER TO REPLACE
SOUT ;OUTPUT NEW LINE
CMNEXT: AOS A,LINCTR ;STEP TO NEXT LINE ON SCREEN
CAMGE A,DLEN1 ;HAVE ALL LINES BEEN PROCESSED?
JRST CM1 ;NO, GO DO NEXT
DISDON: CALLRET REGCOC ;RESTORE CONTROL CHARACTER BEHAVIOR
;THE FOLLOWING ROUTINE FILLS LINBF2 WITH THE CHARACTERS NECESSARY TO
;COMPLETELY REWRITE THE CURRENT DISPLAY LINE. LEN2 SHOWS APPROXIMATE NUMBER OF CHARACTERS
;NECESSARY
LREPLA: SETZM SPCNT ;NO TAB IN PROGRESS YET
SETZM LEN2 ;COUNTS CHARACTERS PUT INTO BUFFER
MOVE A,NEWBEG ;GET POINTER TO BEGINNING OF NEW LINE
MOVEM A,NEWPTR ;STORE POINTER FOR SCANNING NEW LINE
MOVE A,[440700,,LINBF2] ;POINTER TO OUTPUT LINE BEING CREATED
MOVEM A,LINPTR
SETZM NEWCOL ;COLUMN OF SCREEN WE'RE AT
SKIPE SCRNF ;DON'T ATTEMPT CLEAR LINE ON HARDCOPY
CALL GETEOL ;START WITH EOL TO CLEAR OLD LINE
LRLUP: AOS A,NEWCOL ;SEE WHICH COLUMN TYPING NEXT CHARACTER WILL BRING US TO
SOJ A, ;SEE WHERE WE'RE AT BEFORE TYPING THE CHARACTER
TRNN A,7 ;A TAB STOP?
CALL LRTAB ;YES, PUT IN A TAB IF ANY SPACES WERE STORED UP
ILDB A,NEWPTR ;GET NEXT CHARACTER FROM NEW LINE
JUMPE A,LR2 ;LEAVE LOOP IF END OF STRING
CAIN A,40 ;A SPACE?
JRST LR1 ;YES
SKIPG B,SPCNT ;DID SOME SPACES PRECEDE THIS CHARACTER?
JRST LR5 ;NO
MOVEI A,40 ;YES, SO PUT THE SPACES IN BEFORE THE CHARACTER
ADDM B,LEN2 ;KEEP TRACK OF NUMBER OF CHARACTERS
LR6: IDPB A,LINPTR ;PUT IN A SPACE
SOSLE SPCNT ;MORE NEEDED?
JRST LR6 ;YES, PUT THEM IN
LDB A,NEWPTR ;GET ORIGINAL CHARACTER BACK
LR5: IDPB A,LINPTR ;PUT ORIGINAL CHARACTER IN LINE BUFFER
AOS LEN2 ;KEEP TRACK OF BUFFER LENGTH
JRST LRLUP ;LOOP FOR REST OF CHARACTERS OF LINE
LR1: AOS SPCNT ;FOR A SPACE, JUST REMEMBER HOW MANY WE'VE SEEN
JRST LRLUP ;GO GET REST OF CHARACTERS
LR2: MOVEI A,0
IDPB A,LINPTR ;FINISH WITH NULL (NOTE THAT WE'VE STRIPPED TRAILING SPACES, OR AT LEAST UP TO 7 OF THEM)
RET
;EVERY TIME A TAB STOP IS REACHED, COME HERE TO PUT A TAB IN BUFFER IF ANY
;SPACES WERE RIGHT-JUSTIFIED DURING LAST "TAB COLUMN" (8-SPACES)
LRTAB: SKIPN A,SPCNT ;ANY SPACES STORED UP?
RET ;NO, SO NOTHING TO DO
AOS LEN2
MOVEI A,11 ;YES, SO PUT TAB IN BUFFER
IDPB A,LINPTR
SETZM SPCNT ;SHOW THAT NO BUFFERED SPACES ANYMORE
RET
;INTERRUPT TO HERE IF USER TYPES WHILE BUFFER IS EMPTY.
TYPO: PUSH P,A ;DON'T CLOBBER NUTTIN
PUSH P,B
MOVE A,TYIJFN
SIBE ;CAREFUL NOT TO SET FLAG IF CHARACTER THAT CAUSED INTERRUPT HAS ALREADY BEEN READ!
SETOM TYPEF ;SET FLAG TO SHOW HE TYPED
POP P,B
POP P,A
DEBRK
;ROUTINE WHICH TAKES CHARACTER IN A AND PUTS IN IN DISPLAY LINE
;BUFFER. IT ALSO PUTS IN THE APPROPRIATE CONTROL CHARACTERS FOR
;GETTING THE CURSOR TO THE CORRECT LINE POSITION WHERE THE CHARACTER
;IS SUPPOSED TO GO
PILB: STKVAR <CHAR>
MOVEM A,CHAR ;REMEMBER WHICH CHARACTER WE'RE DOING
MOVE A,NEWCOL ;GET COLUMN AT WHICH THIS CHARACTER GOES
CAMN A,OLDCOL ;ARE WE ALREADY AT RIGHT PLACE?
JRST COLOK ;YES
CALL MOVCOL ;PUT CONTROL SEQUENCE IN TO GET TO CORRECT COLUMN
COLOK: MOVE A,CHAR ;GET CHARACTER BEING PUT IN
IDPB A,LINPTR ;PUT IT IN
AOS LEN1 ;KEEP TRACK OF NUMBER OF CHARACTERS IN OUTPUT BUFFER FOR FIXING LINE
MOVE A,NEWCOL ;GET COLUMN THIS CHARACTER WAS PUT
AOJ A, ;SHOW COLUMN WE'RE AT NOW
MOVEM A,OLDCOL ;REMEMBER WHERE WE ARE NOW
RET
;CODE TO MOVE FROM OLDCOL TO NEWCOL
MOVCOL: STKVAR <DRIGHT,OLDC,NEWC,SAVB>
MOVE A,NEWCOL ;GET COLUMN AT WHICH THIS CHARACTER GOES
SUB A,OLDCOL ;SEE HOW FAR WE MUST MOVE
MOVE B,OLDCOL ;GET WHERE WE'RE MOVING FROM
MOVEM A,DRIGHT ;REMEMBER HOW FAR WE'RE MOVING
MOVEM B,OLDC ;REMEMBER WHERE WE'RE STARTING FROM
ADD A,OLDC ;CALCULATE WHERE WE'RE GOING
MOVEM A,NEWC ;REMEMBER
TRZ B,7 ;GO BACK TO LAST TAB STOP
MOVEI C,11 ;GET A TAB
MOVTAB: ADDI B,8 ;SEE WHERE TAB WOULD BRING US
CAMLE B,NEWC ;TOO FAR?
JRST MOVNMT ;YES
IDPB C,LINPTR ;NO, PUT IN A TAB
AOS LEN1
JRST MOVTAB ;TRY TO PUT IN ANOTHER TAB
MOVNMT: SUBI B,8 ;UNDO LAST NONTAB!
CAMGE B,OLDC ;MAKE SURE WE'RE NOT TO LEFT OF WHERE WE STARTED!
MOVE B,OLDC ;WE ARE (WE DIDN'T TYPE ANY TABS)
MOVEM B,SAVB ;REMEMBER WHERE WE ARE
MOVE C,B ;NUMBER OF CHARACTERS ALONG LINE WE ARE
ADJBP C,OLDBEG ;GET POINTER TO CHARACTER BEING PASSED OVER
MOVSPC: CAML B,NEWC ;ARE WE THERE YET?
JRST MOVNMC ;YES
ILDB A,C ;GET CHARACTER BEING PASSED OVER
IDPB A,LINPTR ;PASS OVER IT BY TYPING IT. QUICKER THAN $C ON VT52
AOS LEN1
AOS B,SAVB ;SHOW THAT WE'VE MOVED A SPACE
JRST MOVSPC ;GO SEE IF MORE SPACES NEEDED
MOVNMC: RET ;ALL DONE, WE'RE AT NEW POSITION
;CLEAR TO END OF LINE (IN BUFFER)
GETEOL: MOVE A,TRMTYP ;GET FLAVOR
JRST @EOLTB1(A) ;DO TERMINAL DEPENDENT CLEARING
TERINI EOLTB1
TER (.TTV05,IFIW!V05POL)
TER (.TTV50,IFIW!V50POL)
TER (.TT100,IFIW!V100PL)
TER (.TTV52,IFIW!V50POL)
V100PL: MOVEI A,.CHESC
IDPB A,LINPTR
MOVEI A,"["
IDPB A,LINPTR
MOVEI A,"K"
IDPB A,LINPTR
RET
V05POL: MOVEI A,C.EOL ;PUT IN CLEARING CHARACTER
IDPB A,LINPTR
MOVEI A,177 ;NEEDS FILLERS
REPEAT 4,<IDPB A,LINPTR> ;(CAN'T USE NULLS BECAUSE SOUT WOULD TERMINATE)
RET
V50POL: MOVEI A,V52.ES ;ESCAPE CODE FOR VT50
IDPB A,LINPTR
MOVEI A,V52.EL ;END OF LINE CHARACTER
IDPB A,LINPTR
RET
;MOVE RIGHT A COLUMN (CAN'T USE SPACE, WHICH ERASES AS IT GOES!)
MOVRIT: CALL DISCOC ;MAKE CONTROL CHARACTERS ECHO LITERALLY
MOVE A,TRMTYP ;GET FLAVOR OF TERMINAL
CALL @RITTAB(A) ;DO TERMINAL DEPENDENT MOVING
CALLRET REGCOC ;RESTORE CONTROL CHARACTERS AND RETURN
TERINI RITTAB
TER (.TTV05,IFIW!V05RIT)
TER (.TTV50,IFIW!V50RIT)
TER (.TT100,IFIW!V100RT)
TER (.TTV52,IFIW!V50RIT)
V100RT: MOVEI A,.CHESC
IDPB A,LINPTR
MOVEI A,"["
IDPB A,LINPTR
MOVEI A,"C"
IDPB A,LINPTR
RET
V05RIT: MOVEI A,C.RITE ;VT05 CHARACTER FOR MOVING RIGHT
IDPB A,LINPTR ;PUT IT IN BUFFER
RET
V50RIT: MOVEI A,V52.ES ;ESCAPE CODE NEEDED FOR VT5X
IDPB A,LINPTR
MOVEI A,V52.RT ;CHARACTER FOR MOVING RIGHT
IDPB A,LINPTR
RET
;ROUTINE TO PUT CURSOR ON LINE SPECIFIED BY CONTENTS OF CH
LINPOS: STKVAR <NEWCRR>
MOVEM CH,NEWCRR
CAMN CH,CRRCNT ;ALREADY AT CORRECT PLACE?
JRST [ CALL CHKLM ;YES, MAKE SURE AT LEFT MARGIN
JRST [ MOVEI A,.CHCRT
CALL TYO
JRST LINDON]
JRST LINDON]
MOVEI A,-1(CH) ;IF GOING DOWN EXACTLY ONE LINE, JUST
CAME A,CRRCNT ;TYPE CRLF, SO AS NOT TO OVERPRINT SYSTEM MESSAGES
SKIPN SCRNF ;ON A SCREEN?
JRST LINHRD ;NO, HARD COPY
CALL DISCOC ;MAKE CONTROL CHARACTERS ECHO LITERALLY
MOVE A,TRMTYP
CALL @POSTAB(A) ;CALL APPROPRIATE ROUTINE
CALL REGCOC ;RESTORE CONTROL CHARACTERS
LINDON: MOVE A,NEWCRR
MOVEM A,CRRCNT ;REMEMBER WHERE WE NOW ARE.
RET
;POSITIONING ON A HARDCOPY
LINHRD: CAMGE CH,CRRCNT ;MAKE SURE GOING DOWN
IERROR <Attempt to linestarve on hardcopy terminal>
LINH1: MOVE A,CRRCNT ;SEE WHERE ANOTHER CRLF WILL BRING US
CAML A,NEWCRR ;FAR ENOUGH?
RET ;YES, DONE
CALL CRR ;NO, GET TO NEXT LINE
AOS CRRCNT
JRST LINH1 ;LOOP FOR REST
TERINI POSTAB ;CURSOR ADDRESSING ROUTINES
TER (.TTV05,IFIW!LINECH)
TER (.TTV50,IFIW!V50LIN)
TER (.TT100,IFIW!V100LN)
TER (.TTV52,IFIW!V50LIN)
;ROUTINE FOR VT50 RANDOM LINE ADDRESSING
V50LIN: PUSH P,CH ;REMEMBER WHERE WE WANT TO GO
SUB CH,CRRCNT ;CALCULATE HOW FAR AWAY WE ARE.
JUMPG CH,V50DWN ;WE HAVE TO GO DOWN TO SOMEWHERE
MOVNI CH,2(CH) ;2 CHARACTERS OVERHEAD FOR HOMEUP
HRRZ CH,CH ;FLUSH BAD BITS
CAMG CH,(P)
JRST V50GUP ;IT'S BETTER TO GO UP THAN HOME AND COME DOWN
CALL HOME ;CHECK ON THE FOLKS (GO TO TOP OF SCREEN)
MOVE CH,(P) ;WE'RE GOING TO START AT THE TOP AND COME DOWN.
JUMPE CH,V50DN1 ;MAYBE HOMING UP IS ALL THAT'S NECESSARY
V50LN1: MOVEI A,12 ;CHARACTER FOR MOVING DOWN
CALL TYO
SOJG CH,V50LN1 ;FAR ENOUGH YET ??
JRST V50DON ;YES.
V50GUP: ADDI CH,2
CALL LINSTV ;LINE STARVE
SOJG CH,.-1
JRST V50DON
V50DWN: MOVEI A,12 ;CHARACTER TO MOVE DOWN A LINE
CALL TYO
SOJG CH,V50DWN ;GO UP UNTIL WE GET TO CORRECT PLACE
V50DON: MOVEI A,15
CALL TYO ;GET TO LEFT MARGIN
V50DN1: POP P,CH
RET
;VT100 LINE ADDRESSING
V100LN: MOVEI A,.CHESC
CALL TYO ;ANNOUNCE ESCAPE SEQUENCE
MOVEI A,"["
CALL TYO ;NO COMMENT
MOVEI B,1(CH) ;LINE 0 IS HARDWARE LINE 1
MOVEI C,5+5 ;SEND LINE NUMBER IN DECIMAL
MOVE A,TTYOUT ;USE STANDARD OUTPUT CHANNEL
NOUT ;SEND THE LINE NUMBER
JSERR ;SHOULDN'T FAIL
MOVEI A,"H" ;SAY WE'RE DOING POSITIONING
CALLRET TYO
;ROUTINE FOR VT05 RANDOM LINE ADDRESSING
LINECH: MOVEI A,C.CAD ;MAGIC CURSOR ADDRESSING CHARACTER
CALL TYO ;TYPE IT
ADDI CH,40 ;MAKE VT05 ADDRESS
CALL CNFILL ;IT REQUIRES FILLERS
MOVEI A,C.LM+1 ;GO TO COLUMN 1
CALL TYO
RET
;THE FOLLOWING ROUTINE ASSUMES SCRNPT CONTAINS A CHARACTER ADDRESS
;OF THE FIRST ONE TO BE DISPLAYED. THIS
;ROUTINE TRIES TO BACKUP SCRNPT TO THE BEGINNING OF THE LINE, BEING
;CAREFUL NOT TO DO SO IF THAT WOULD CAUSE THE LINE TO OVERFLOW, THUS
;CAUSING A LARGE AMOUNT OF SCREEN REFRESH (SHIFTING EVERYTHING DOWN)
LININI: STKVAR <LINQCL,CHARAD,BACKTO>
MOVE A,SCRNPT ;GET CURRENT BEGINNING OF LINE
CALL LINBGQ ;TRY TO FIND REAL BEGINNING
MOVEM A,BACKTO ;REMEMBER WHERE BEGINNING IS
MOVEM A,CHARAD ;INITIAL CHARACTER ADDRESS IS BEGINNING OF LINE
SETZM LINQCL ;KEEP TRACK OF COLUMNS
LINI1: MOVE A,LINQCL ;SEE WHAT COLUMN WE'RE UP TO
CAML A,SWIDTH ;HAS LINE GOTTEN REAL LONG?
RET ;YES, SO WE WON'T TRY TO REPOSITION BEGINNING POINTER
MOVE A,CHARAD ;GET CURRENT CHARACTER ADDRESS
CAML A,ZEE ;MAKE SURE WE HAVEN'T HIT END OF BUFFER
JRST LINI2 ;WE HAVE, SO LINE ISN'T TOO LONG
MOVE I,A
CALL GET ;GET CURRENT CHARACTER
CAIN CH,15 ;DID WE FIND END OF LINE?
JRST LINI2 ;YES, SO WE CAN FIT THIS WHOLE LINE ON
MOVE A,CH
MOVE B,LINQCL ;FOR TAB, WIDTH DEPENDS ON CURRENT COLUMN
CALL CHRCOL ;GET WIDTH OF CHARACTER
MOVEM A,LINQCL ;KEEP TRACK OF WHAT COLUMN WE'RE UP TO
AOS CHARAD ;STEP TO NEXT CHARACTER IN BUFFER
JRST LINI1 ;LOOP BACK TO SEE IF WE'VE FOUND END OF LINE
LINI2: MOVE A,BACKTO ;THE LINE IS REASONABLE LENGTH, SO
MOVEM A,SCRNPT ;WE CAN START DISPLAYING FROM ITS BEGINNING
RET
;ROUTINE TO TELL EFFECT OF DISPLAYING A CHARACTER, COLUMNWISE.
;THE CALL:
; 1/ CHARACTER TO BE DISPLAYED
; 2/ COLUMN ON LINE SO FAR
; CALL CHRCOL
;RETURNS +1 ALWAYS WITH:
; 1/ COLUMN CHARACTER BRINGS US TO
;
;THIS ROUTINE KNOWS HOW TO ACCOUNT FOR TABS AND FLAGGED CHARACTERS
CHRCOL: STKVAR <COL1,CHAR1>
MOVEM A,CHAR1
MOVEM B,COL1
CAIN A,11 ;A TAB?
JRST CHRCTB ;YES
AOS COL1 ;ALL CHARACTERS INCREASE COLUMN BY AT LEAST 1
MOVE CH,A
CALL SFLAGC ;A FLAGGED CHARACTER?
CAIA ;NO
AOS COL1 ;YES, SO INCREASE COLUMN BY 2
MOVE A,COL1 ;RETURN NEW COLUMN IN A
RET
CHRCTB: MOVEI A,8
ADD A,COL1 ;TAB MIGHT GO 8 COLUMNS
TRZ A,7 ;BUT USUALLY NOT QUITE THAT MUCH
RET
;ROUTINE TO FILL WINEW WITH NEW PICTURE TO BE DISPLAYED
;SCRNPT MUST BE THE ADDRESS OF THE FIRST CHARACTER WITHIN BUFFER
;DESIRED IN DISPLAY. ROUTINE ASSUMES SCRNPT POINTS TO SOME CHARACTER
;WITHIN THE BUFFER.
WINFIL: TRVAR <OURWT0,OURWTH,WLNO>
SKIPE T,SWIDTH
CAILE T,MAXWTH
MOVEI T,MAXWTH ;IN SCREEN BUFFER, NOT ANY WIDTH IS ALLOWED !!
MOVEM T,OURWTH ;REMEMBER WIDTH OF OUR SCREEN MEMORY
SOJ T, ;LEAVE ROOM FOR ONE CONTINUATION CHARACTER
MOVEM T,OURWT0
SETZM WLNO ;DISPLAY LINE NUMBER
MOVEI P2,1 ;POINTER TO LINNEW ARRAY
MOVE I,SCRNPT ;POINTER TO FIRST CHARACTER TO BE DISPLAYED
SOJ I, ;WE WANT ILDB POINTER
CALL GETX ;MAKE BYTE POINTER
MOVE C,TT ;PUT POINTER IN C
WINFL3: MOVE TT,C ;PUT POINTER IN TT
CALL PTR2AD ;CHANGE TO CHARACTER ADDRESS
AOJ I, ;GET FIRST CHARACTER ADDRESS OF DISPLAY LINE
MOVEM I,LINNEW-1(P2) ;REMEMBER WHAT PART OF BUFFER BEGINS ON EACH LINE
MOVE P2,[440700,,WINEW]
ADD P2,WLNO ;CREATE POINTER TO NEW DISPLAY IMAGE
MOVEI P1,0 ;# OF CHARS ON THIS SCREEN LINE SO FAR
WINFL2: CALL PUTCHR ;GET CHARACTER FROM BUFFER
CAIE T,11 ;IS THIS A TAB?
JRST WINNT ;NO
MOVEI T,40 ;YES, MARK IT WITH APPROPRIATE NUMBER OF SPACES
WINTAB: AOJ P1, ;COUNT THE COLUMN FOR TAB
IDPB T,P2 ;ALWAYS PUT AT LEAST ONE SPACE IN FOR TAB
TRNE P1,7 ;ARE WE AT NEXT TAB STOP YET?
JRST WINTAB ;NO, SPACE OVER SOME MORE
JRST WINFL2 ;GO GET NEXT CHARACTER FROM BUFFER
WINNT: IDPB T,P2 ;SAVE IT IN SCREEN MEMORY
CAIN T,15
HRROI P1,-1 ;SO AOJA CORRECTLY ZEROES p1 FOR END OF LINE
CAIE T,12 ;LF MEANS END OF SCREEN LINE
AOJA P1,WINFL2 ;COUNT CHARACTER AND GO GET ANOTHER
MOVEI T,0 ;CLOBBER END OF LINE WITH 0
DPB T,P2 ;REPLACE LINEFEED WITH NULL
MOVNI A,1
ADJBP A,P2 ;POINT TO WHAT MAY BE A CARRIAGE RETURN
CAIN P1,0 ;IS IT?
DPB T,A ;YES, SO NULL IT TOO (DISPLA ROUTINE EXPECTS NULL AFTER TEXT OF LINE)
MOVEI P2,WINDEX
ADDB P2,WLNO ;STEP TO NEXT DISPLAY LINE
IDIVI P2,WINDEX
ADDI P2,1
CAMGE P2,DLENTH ;ARE WE THROUGH ??
JRST WINFL3 ;NO DO ANOTHER
MOVE TT,C
CALL PTR2AD ;MAKE CHARACTER ADDRESS
MOVEM I,SCNEND ;REMEMBER LAST CHARACTER POSITION DISPLAYED
MOVE A,WLNO
WINFL5: CAILE A,WINTOP ;HAS WHOLE DISPLAY AREA BEEN UPDATED??
RET ;YES
SETOM WINDOW(A) ;NO, OBSCURE THE UNUSED PORTION
ADDI A,WINDEX
JRST WINFL5
;ROUTINE TO RETURN NEXT DISPLAY LINE CHARACTER IN T, TAKES
;TWO CALLS TO GET ^* FOR CONTROL-CHARACTER.
;LINEFEEDS NOT AT THE LEFT MARGIN ARE RETURNED AS ^J.
;CARRIAGE RETURNS NOT FOLLOWED BY LINEFEEDS ARE RETURNED AS ^M.
;THE CONTENTS OF LASTCH IS GIVEN IF LINE IS ABOUT TO GO OVER RIGHT MARGIN.
;POINTER IS DISPLAYED AS CHARACTER STRING THAT IS THE CONTENTS OF
;PTRCHR.
PUTCHR: SKIPE SEOL ;NON-ZERO SEOL MEANS END OF DISPLAY LINE
JRST PUTEOL ;END OF LINE
CAML P1,OURWT0 ;BEGINNING OF END OF LINE ???
JRST SCON ;HANDLE END OF LINE
SKIPE CTLFLG ;OUTPUTTING CONTROL CHARACTER ??
JRST CTLCHR ;YES, GO SEND CHARACTER
SKIPLE PUTPTF ;if outputting pointer
JRST PUTPT1 ;continue doing so...
SKIPE EOBFLG ;END OF BUFFER ??
JRST EOBCHR ;YES, JUST SEND CRLFS
MOVE T,BEG
CAMN T,ZEE ;NO BUFFER ??
JRST EOBCR2 ;THEN SURELY WE ARE AT THE END !!
CAME C,ILDBPT ;ARE WE AT POINTER IN BUFFER ??
JRST PUTCR1 ;NOT YET, OR PAST IT
SKIPE PUTPTF ;AT IT, BUT DID WE ALREADY KNOW THAT ??
JRST PUTPT1 ;YES, SO CONTINUE GIVING PICTURE OF POINTER
POINTP: MOVE T,[010700,,PTRCHR-1] ;get pointer to picture of pointer
MOVEM T,PUTPTF
JRST PUTPT1 ;OUTPUT PICTURE OF POINTER
PUTCR1: UILDB T,C ;GET NEXT CHARACTER IN BUFFER
CAMN C,SCRNZ ;IS THIS LAST CHARACTER IN BUFFER ??
SETOM EOBFLG ;YES, SET FLAG FOR NEXT CALL TO PUTCHR
CAIN T,33 ;ALTMODE ??
MOVEI T,"$" ;ALTMODE REGULAR NON-CONTROL CHARACTER
CAIN T,15 ;CR ??
JRST SCR ;YES, MAYBE END OF LINE (IF LINEFEED NEXT)
CAIN T,12 ;LF ??
JRST SLF ;YES, PART OF END OF LINE ??
CAIN T,11 ;HANDLE TAB SPECIALLY
RET ;NOTHING SPECIAL HERE ABOUT TAB
CAILE T,37 ;OTHER CONTROL CHARACTER ??
JRST PUTCR3
PUTCR2: ADDI T,100 ;MAKE * PART OF ^*
MOVEM T,CTLFLG
MOVEI T,"^" ;PRINT UPARROW FIRST
RET
PUTCR3: MOVE CH,T
CALL SFLAGC ;FLAG THIS CHARACTER ??
RET ;NO
MOVEM T,CTLFLG ;REMEMBER WHAT CH WAS FLAGGED
MOVEI T,CFLAG ;GET FLAG CHARACTER
RET
PUTPT1: ILDB T,PUTPTF ;GET CHARACTER OF PICTURE OF POINTER
JUMPN T,R ;ZERO MEANS POINTER HAS COMPLETED BEING
SETOM PUTPTF ;neg means pointer fully displayed
SKIPE EOBFLG ;end of buffer ??
JRST EOBCR4 ;yes
JRST PUTCR1 ;go back to get next character from buffer
EOBCR2: SETOM EOBFLG
JRST POINTP
CTLCHR: MOVE T,CTLFLG ;GET CHARACTER THAT WAS "CONTROL"ED
SETZM CTLFLG ;SAY DONE PROCESSING CONTROL CHARACTER
RET
EOBCHR: SKIPL EOBFLG ;EOBFLG NEGATIVE IF JUST REACHED END OF LINE
JRST EOPCR1 ;DIDN'T JUST, SO OSCILLATE BETWEEN CR AND LF
CAME C,ILDBPT ;if pointer is at end of buffer,
JRST EOBCR4 ;put it in picture
SKIPN PUTPTF ;skip if pointer in picture
JRST POINTP ;it's not, so put it in
EOBCR4: MOVEI T,12 ;SO CR BEFORE LF IN OSCILLATION
MOVEM T,EOBFLG
EOPCR1: MOVEI T,27 ;CR+LF
SUBB T,EOBFLG ;CHANGE CR TO LF AND LF TO CR
RET ;T HAS CR OR LF BECAUSE NO MORE BUFFER
SCR: CAME C,ILDBPT
SKIPGE EOBFLG ;ARE WE AT END OF BUFFER ??
JRST PUTCR2 ;CR LAST CHAR IN BUFFER = ^M
MOVE T,C ;SEE IF CHAR AFTER CR IS LF
UILDB T,T ;GET NEXT CHARACTER
CAIN T,12 ;LF ??
JRST SCR1 ;YES
MOVEI T,15 ;NO, ^M
JRST PUTCR2
SCR1: MOVEI T,15 ;CRLF, SO CARRIAGE RETURN NOT HACKED
RET
SLF: MOVE TT,C ;DECREMENT BYTE POINTER
CALL DBP
CAME TT,ILDBPT ;IF JUST AFTER CARAT, LINEFEED IS ^J
JUMPE P1,SLF1 ;LINEFEED AT LEFT MARGIN IS JUST LINEFEED
SLF2: MOVEI T,12 ;NO, SO ^J
JRST PUTCR2
SLF1: MOVEI T,12 ;CR BEFORE LF, SO DON'T HACK LF
RET
SCON: CAME C,ILDBPT ;ARE WE AT POINTER NOW ??
JRST SCON4 ;NO
SKIPL PUTPTF ;skip if pointer fully displayed
JRST SCON2 ;it's not
SCON4: SKIPE CTLFLG ;OR IN THE MIDDLE OF A CONTROL CHARACTER
JRST SCON2 ;THEN TYPE CONTINUATION CHARACTER
SKIPE EOBFLG ;END OF BUFFER ??
JRST EOBCHR
MOVE TT,C
UILDB T,TT ;PEEK AT NEXT TWO CHARACTERS AND IF THEY
;ARE CRLF, THEN NO CONTINUATION
CAMN TT,ILDBPT ;AT POINTER NOW
JRST SCON2 ;THEN CONTINUATION REQUIRED
CAIN T,15 ;CR ??
JRST SCON1 ;YES, SEE IF LF NEXT
CAME TT,SCRNZ ;END OF BUFFER ??
JRST SCON69 ;NO, MAYBE LINE IS JUST ONE MORE CHARACTER
SETOM EOBFLG ;REMEMBER THAT END OF BUFFER HAS BEEN REACHED
CAIE T,11 ;TAB AT END OF LINE ?
CAIN T,33 ;OR ALTMODE
JRST SCON5 ;TAB OR ALTMODE IS LAST CHAR IN BUFFER
CAILE T,37
JRST SCONGD ;NON-CONTROL CHARACTER IS LAST IN BUFFER
SCON2: CAML P1,OURWTH ;DID WE JUST TAB TO RIGHT MARGIN?
JRST [ MOVE T,OURWT0 ;YES, SO CAN'T PUT ANOTHER CHARACTER IN LIEU
;OF CONTINUATION SIGNAL EVEN IF THAT CHARACTER
;IS THE LAST ON THE LINE
SUB T,P1 ;CALCULATE AMOUNT OF OVERSHOOT
MOVE P1,OURWT0 ;POSITION AT EXACT PLACE WHERE CONTINUATION GOES
ADJBP T,P2 ;BACK UP POINTER SO LAST SPACES OF TAB GET REPLACED
;WITH CONTINUATION SIGNAL
MOVE P2,T
JRST .+1] ;DO CONTINUATION BEFORE CHARACTERS AFTER TAB
MOVEI T,12 ;START EOL SEQUENCE WITH LF SO CR FIRST
MOVEM T,SEOL
MOVE T,LASTCH ;GET CONTINUATION CHARACTER
RET
;AT THIS POINT WE KNOW CHARACTER FOR COLUMN 72 IS NOT THE LAST
;IN THE BUFFER, AND IT IS NOT IMMEDIATELY FOLLOWED BY THE POINTER
SCON69: CAMGE P1,OURWTH ;IF JUST TABBED TO RIGHT MARGIN, NO ROOM FOR
;LAST REMAINING CHARACTER ON LINE
CAIG T,37 ;IS THIS CHAR A CONTROL CHARACTER
JRST SCON2 ;YES, SO NO ROOM FOR IT HERE
MOVE CH,T
CALL SFLAGC ;WOULD THIS CHAR BE FLAGGED ??
CAIA ;NO
JRST SCON2 ;CHARACTER FLAGGED, SO NO ROOM
UILDB T,TT ;NOT CONTROL, SO IF CRLF NEXT, NO CONTINUATION
CAME TT,ILDBPT ;NOW AT END OF BUFFER ??
CAMN TT,SCRNZ ;OR RIGHT BEFORE POINTER ??
JRST SCON2 ;YES, SO EVEN CR WOULD BE ^M
CAIE T,15 ;CR ??
JRST SCON2 ;NO
UILDB T,TT ;YES, LOOK AT NEXT ONE
CAIE T,12 ;IS IT A LINEFEED ??
JRST SCON2 ;NO
JRST SCONGD ;YES
SCON1: UILDB T,TT
CAIE T,12 ;LF AFTER CR AT EOL ??
JRST SCON2 ;NO
SCONGD: UILDB T,C ;CRLF , SO JUST GOBBLE IT UNHACKED
RET
SCON5: MOVE CH,T
CALL SFLAGC
JRST SCONGD
JRST SCON2
PUTEOL: MOVEI T,27 ;CR + LF
SUBB T,SEOL ;CHANGE ONE TO THE OTHER
CAIN T,12 ;SEE IF WE'VE PRINTED ONE SET YET
SETZM SEOL ;YES, ANNOUNCE END OF END OF LINE
RET
;DISPLAY INITIALIZATION ROUTINE
DISINI: SETZM EOBFLG ;END OF BUFFER FLAG
SETZM PUTPTF ;POINTER IN DISPLAY FLAG
SETZM CTLFLG ;NON-ZERO MEANS CONTROL CHARACTER
SETZM SEOL ;END OF LINE SEEN FLAG
MOVE I,PT
SUBI I,1 ;TO POINT TO LAST CHARACTER
CALL GETX ;LDB POINTER TO CHARACTER AFTER POINTER IN BUFFER
MOVEM TT,ILDBPT
RET
;@J TRIES TO PUT THE POINTER IN THE MIDDLE OF THE SCREEN.
ATSGNJ: SKIPN SLENTH ;IS THERE A POSITIVE WINDOW DEFINED??
JRST CRET ;NO, SO @J DOES NOTHING.
MOVE A,SLENTH ;YES, GET WINDOW SIZE.
LSH A,-1 ;DIVIDE BY 2 TO GET IN MIDDLE OF WINDOW.
MOVE I,LINNEW(A) ;GET POINTER TO FIRST CHARACTER OF A LINE.
CAMG I,ZEE ;MAKE SURE WE'RE STILL IN THE BUFFER.
CAMGE I,BEG ;AND NOT BEFORE IT.
JRST CRET ;WE WEREN'T, SO GIVE UP.
MOVEM I,PT ;WE'RE O.K., SO CHANGE "POINT".
JRST CRET
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL CALL GETARG
; RETURN WITH FIRST ARGUMENT ADDRESS IN p1, SECOND IN B.
;THE ROUTINE ALSO MAKES SURE THE ARGUMENTS SUPPLIED ARE REALLY
;WITHIN THE BUFFER !!
GETARG: MOVE C,NUM ;GET FIRST ARG (IF ANY)
TRNE FF,ARG2 ;IS THERE A SECOND ARGUMENT?
JRST GETAG6 ;YES
;N SIGN INDICATES DIRECTION RELATIVE TO PT.
TRON FF,ARG ;NO. IS THERE AN ARGUMENT?
CALL CHK22 ;c:=1 IF LAST ARG FUNCTION WAS +,*,OR /
;c:=-1, IF &,#, OR -
;IE, ASSUME AN ARG OF 1 AND RETAIN SIGN
MOVE I,PT ;I:=PT
JUMPLE C,GETAG2 ;WAS LAST ARGUMENT FUNCTION -?
GETAG4: CAMN I,ZEE ;NO. ARGUMENT IS LOCATION OF NTH LINE
;FEED FORWARD FROM PT.
;IS PT AT END OF BUFFER?
JRST GETAG1 ;YES.
CALL GET ;NO.
CAIE CH,.CHLFD ;LF?
AOJA I,GETAG4 ;NO. TRY AGAIN.
SOSLE C ;HAVE WE FOUND ENOUGH ??
AOJA I,GETAG4 ;NO, FIND ANOTHER.
CAME I,BEG
TRNN FF,COLONF
AOJA I,GETAG1 ;AT BEGINNING OF BUFFER OR NOT : COMMAND
SOJ I, ;FOR :L,:K ETC. PUT POINTER BEFORE END OF LINE
CALL GETINC ;GET CHARACTER BEFORE LINEFEED
CAIE CH,.CHCRT ;CR ??
AOJA I,GETAG1 ;NO, SO COLON HAS NO EFFECT.
SOJ I, ;YES, SO PUT POINTER AT END OF LAST LINE
GETAG1: MOVE C,I ;YES. RETURN FIRST ARGUMENT IN p1
MOVE P1,PT ;SECOND IN B.
CALLRET CHK1 ;CHECK ARGS AND RETURN.
;M,N
GETAG6: ADD C,BEG ;p1:=M+BEG
ADD P1,BEG ;c:=N+BEG
CALLRET CHK1 ;MAKE SURE ARGUMENTS ARE WITHIN BUFFER AND RETURN.
GETAG2: SOS I ;ARG IS POS OF NTH LINE FEED LEFT OF PT.
;N:=N-1
GETAG9: CAMGE I,BEG ;PASSED BEGINNING OF BUFFER?
JRST GETAG3 ;YES. I:=BEG
CALL GET ;NO.
CAIE CH,.CHLFD ;LF?
SOJA I,GETAG9 ;NO. BACK UP ONE POSITION AND TRY AGAIN.
AOSG C ;HAVE WE FOUND ENOUGH LINEFEEDS ??
SOJA I,GETAG9 ;NOT YET.
CAME I,BEG
TRNN FF,COLONF
AOJA I,GETAG3 ;AT BEGINNING OF BUFFER OR NOT : COMMAND
SOJ I, ;FOR :L,:K ETC. PUT POINTER BEFORE END OF LINE
CALL GETINC ;GET CHARACTER BEFORE LINEFEED
CAIE CH,.CHCRT ;CR ??
AOJA I,GETAG3 ;NO, SO COLON HAS NO EFFECT.
SOJ I, ;YES, SO PUT POINTER AT END OF LAST LINE
GETAG3: CAMGE I,BEG ;YES. PASSED BEGINNING OF BUFFER?
MOVE I,BEG ;YES. RESET TO BEGINNING.
MOVE P1,I ;NO. RETURN FIRST ARGUMENT IN C.
MOVE C,PT ;SECOND IN c
CALLRET CHK1 ;CHECK ARGS AND RETURN.
;MOVE STRING GIVEN CHARACTER POINTERS
; I/ SOURCE CHAR PTR
; OU/ DEST CHAR PTR
; p1/ COUNT
MVCST: MOVE A,I ;GET CHARACTER ADDRESS OF LEFTMOST CHARACTER IN SOURCE
CALL ADDPTR ;MAKE LDB POINTER TO FIRST CHARACTER
MOVNI I,1
ADJBP I,A ;MAKE ILDB POINTER TO FIRST CHAR IN I
MOVE A,OU ;LIKEWISE GET IDPB POINTER TO LEFTMOST DESTINATION CHARACTER
CALL ADDPTR
MOVNI OU,1
ADJBP OU,A ;NOW OU HAS IDPB POINTER TO DESTINATION
CALLRET MVSTR ;MOVE REST OF STRING
;MOVE STRING
; I/ SOURCE BYTE PTR
; OU/ DEST BYTE PTR
; p1/ COUNT
;RETURNS WITH I AND OU UPDATED SUCH THAT SUBSEQUENT CALL WITH NEW COUNT
;IN P1 WOULD JUST "CONTINUE" COPYING.
;THIS SIMULATES AN ILDB/IDPB/SOJG LOOP IF DESTINATION IS TO LEFT OF SOURCE
;IF DESTINATION IS TO RIGHT OF SOURCE, THE SOURCE IS MOVED STARTING
;WITH ITS RIGHTMOST END, HENCE DOING THINGS LIKE SLIDING A LONG STRING
;A FEW CHARACTERS TO THE RIGHT WORKS. NOTE THAT THE I, OU, AND P1 YOU
;SHOULD CALL MVSTR WITH ARE ALWAYS FOR ILDB/IDPB/SOJG REGARDLESS OF
;CURRENT FLOW. JUST LEAVE THE DRIVING TO US...
MVSTR: STKVAR <RETOU,RETI>
TLC I,-1 ;IF -1 IN LEFT HALF, THEN 0 THERE NOW
TLCN I,-1 ;RESTORE LEFT HALF TO ORIGINAL AND SKIP IF WASN'T -1 ORIGINALLY
HRLI I,440700 ;WAS -1 SO MAKE IT 440700
TLC OU,-1
TLCN OU,-1
HRLI OU,440700
MOVE A,P1 ;GET COUNT
ADJBP A,OU ;CALCULATE UPDATED POINTER
MOVEM A,RETOU
MOVE A,P1
ADJBP A,I ;DO BOTH POINTERS
MOVEM A,RETI
CALL MVSTWK ;DO THE WORK
MOVE OU,RETOU
MOVE I,RETI
RET
MVSTWK: JUMPLE P1,R ;RETURN NOW IF NO CHARACTERS TO MOVE
STKVAR <ARGI,ARGOU>
MOVEM I,ARGI ;SAVE ARGS
MOVEM OU,ARGOU
MOVEM P1,STRLEN
MOVE TT,I ;GET CHARACTER ADDRESSES OF ARGS
IBP TT ;WE WANT ADDRESS OF BEGINNING OF SOURCE
MOVEM TT,SRCBPT ;REMEMBER WHERE SOURCE STARTS
CALL PTRXAD ;MAKE CHARACTER ADDRESS
MOVEM I,SRCBEG
MOVE TT,ARGOU
IBP TT
MOVEM TT,DESBPT ;REMEMBER WHERE DESTINATION STARTS
CALL PTRXAD
MOVEM I,DESBEG
MOVE I,SRCBEG
CAMN I,DESBEG ;DOING MUCH MOVING AT ALL?
RET ;NO, NONE AT ALL
ADD I,STRLEN ;GET RIGHTMOST CHAR ADDRESS OF SOURCE
MOVEM I,SRCEND ;REMEMBER CHARACTER ADDRESS JUST TO RIGHT OF SOURCE
CALL GET1 ;GET BYTE POINTER TO JUST TO RIGHT OF SOURCE
MOVEM TT,SRCEPT
MOVE I,DESBEG
ADD I,STRLEN
MOVEM I,DESEND ;REMEMBER END OF DESTINATION
CALL GET1 ;GET BYTE POINTER TO JUST TO RIGHT OF DESTINATION
MOVEM TT,DESEPT
MOVE A,DESBEG
CAML A,SRCBEG
CAML A,SRCEND
CAIA ;IT'S SAFE TO ILDB/IDPB/SOJG
JRST MVSTX ;ILDB/IDPB/SOJG WOULD CLOBBER CERTAIN BYTES WITH IDPB BEFORE THEY GOT ILDB'D !
MOVE I,ARGI
MOVE OU,ARGOU ;LEAVE ARGS AS GIVEN TO US
MVST1: ILDB CH,I ;MOVE ONE CHAR
IDPB CH,OU
SOJLE P1,R ;RETURN IF COUNT DONE
TLNE OU,(74B5) ;DEST NOW AT WORD BOUNDARY?
JRST MVST1 ;NO, DO ANOTHER CHAR
CAIGE P1,^D20 ;AT LEAST 20 CHARS TO DO?
JRST MVST1 ;NO, NOT WORTH SETTING UP WORD MOVE
MOVE TT,P1 ;YES, SETUP FOR FULL WORD MOVE
IDIVI TT,5 ;COMPUTE NUMBER FULL WORDS TO MOVE
MOVEM TT1,P1 ;SAVE REMAINDER OF CHARACTERS
LDB T,[POINT 6,I,5] ;GET SOURCE "P" FIELD
CAIN T,1 ;SOURCE ALSO ON WORD BOUNDARY?
JRST MVST4 ;YES, GO DO BLT
MOVN P2,T
SUBI T,1 ;T = P-1
ADDI P2,^D36 ;p2 = 36-P
ADDM TT,I ;UPDATE PTRS FOR FULL WORDS MOVED
ADDM TT,OU
MOVNM TT,C ;SETUP NEG COUNT FOR LOOP
MOVEI B,1(P) ;GET ADDRESS OF NEXT FREE STACK WORD
ADD P,[NMVLP,,NMVLP] ;ALLOCATE STACK SPACE FOR LOOP
MOVSI A,MVLP ;COPY MOVE LOOP ONTO STACK
HRR A,B
BLT A,0(P)
HRRZ A,I ;FILL IN SOURCE ADR
HRRM A,MVLP0(B)
HRRZ A,OU ;FILL IN DESR ADR
HRRM A,MVLPA(B)
HRRM B,MVLPC(B) ;FILL IN LOOP ADR TO AOJL
MOVE A,MVLP0(B) ;GET MOVE INSTRUCTION
TLZ A,(17777B12) ;CLEAR BITS 0-12
TLO A,(IFIW) ;COMPOSE LOCAL INDIRECT WORD
MOVE A,@A ;GET FIRST (PARTIAL) SOURCE WORD
LSH A,-1 ;RIGHT JUSTIFY IT
JRST MVLPC(B) ;JUMP INTO LOOP
;FULL-WORD CHARACTER MOVE LOOP - MOVED ONTO STACK AND ADDRESSES FILLED IN
MVLP: PHASE 0
MVLP0: MOVE B,.-.(C) ;GET FIRST PART OF SOURCE WORD
ROTC A,0(P2) ;SHIFT LEFT TO COMPLETE DEST WORD
LSH A,1 ;LEFT JUSTIFY DEST CHARS
MVLPA: MOVEM A,.-.(C) ;STORE DEST WORD
ROTC A,0(T) ;SHIFT IN REMAINDER OF SOURCE WORD
MVLPC: AOJLE C,.-. ;COUNT WORDS AND LOOP
JRST MVST2 ;LOOP DONE, JUMP OFF STACK
DEPHASE
NMVLP==.-MVLP ;NUMBER OF WORDS IN LOOP
;LOOP RETURNS HERE FROM STACK WHEN DONE
MVST2: SUB P,[NMVLP,,NMVLP] ;CLEAR STACK
JUMPG P1,MVST1 ;IF ANY CHARS REMAINING, GO DO THEM
RET
;BLT CASE - SOURCE AND DEST ARE ALIGNED
MVST4: HRLZ A,I ;GET SOURCE ADR
HRR A,OU ;GET DESR ADR
ADD A,[1,,1] ;MAKE BOTH POINT TO FIRST WORD
ADDM TT,I ;UPDATE SOURCE PTR FOR FULL WORDS MOVED
ADDM TT,OU ;UPDATE DEST PTR FOR FULL WORDS MOVED
HRRZ TT,OU ;GET LOCAL ADDRESS OF LAST WORD
BLT A,0(TT) ;MOVE WORDS UNTIL LAST WORD OF DEST
JUMPG P1,MVST1 ;IF ANY CHARS REMAINING, GO DO THEM
RET
;GET HERE WHEN SLIDING A STRING TO THE RIGHT.
MVSTX: MOVE P1,DESEND ;GET ADDRESS TO RIGHT OF DESTINATION
IDIVI P1,5 ;SEE HOW CLOSE TO WORD BOUNDARY WE ARE
MVSTX1: JUMPE P2,MVSTX2 ;WE'RE ON WORD BOUNDARY
CALL DOBBYT ;TRANSFER ONE BYTE
SKIPN STRLEN ;SHOW REFLECTION OF ENTIRE LENGTH
RET ;LENGTH EXHAUSTED, WE'RE ALL DONE
SOJA P2,MVSTX1 ;LOOP UNTIL DESTINATION ENDS ON WORD BOUNDARY
MVSTX2: MOVE A,STRLEN ;SEE HOW MANY CHARACTERS TO DO
CAIGE A,5 ;AT LEAST ON WORD'S WORTH IN DESTINATION?
JRST MVSTX3 ;NO
MOVE A,SRCEND ;SEE WHERE SOURCE ENDS
IDIVI A,5
JUMPE B,BAKBLT ;JUMP IF DESTINATION AND SOURCE ARE ON WORD BOUNDARIES
MOVE A,SRCEND
IDIVI A,5 ;SEE WHERE IN WORD IT IS
SUBI B,5
IMULI B,7 ;GET MINUS BITS RIGHT TO SHIFT TO WORD ALIGN WITH DESTINATION
HRRM B,MAKE5 ;REMEMBER FOR FAST LOOP
ADDI B,^D35
MOVN B,B ;GET MINUS BITS RIGHT TO SHIFT TO REALIGN WITH SOURCE
HRRM B,RESIDU
MOVE A,STRLEN
IDIVI A,5 ;GET NUMBER OF FULL DESTINATION WORDS TO BE WRITTEN
MOVEM A,WCNTB
MOVE A,DESEND
SOJ A, ;GET RIGHTMOST ADDRESS OF DESTINATION
IDIVI A,5 ;RIGHTMOST WORD ADDRESS
SUB A,WCNTB ;TIGHT LOOP ADDS WCNTB
HRRM A,SETDES ;SAVE FOR STORING DESTINATION
MOVE A,SRCEND
SOJ A, ;SRCEND IS ONE CHARACTER TO RIGHT
IDIVI A,5 ;GET SOURCE WORD ADDRESS
MOVE B,(A) ;PRIME LOOP WITH FIRST SOURCE WORD
SOJ A, ;RIGHTMOST SOURCE ADDRESS
SUB A,WCNTB ;OFFSET SOURCE WORD ADDRESS BECAUSE LOOP INDEXES BY C
HRRM A,GETSRC ;FIX TIGHT LOOP FETCH ADDRESS
MOVE C,WCNTB ;C TELLS HOW MANY WORDS TO DO
CALL MBLUP ;DO THE TIGHT LOOP
MVSTX4: MOVE A,WCNTB
IMULI A,5 ;NUMBER OF CHARACTERS WE DID IN A
MOVN B,A ;NEGATIVE NUMBER IN B
ADJBP B,SRCEPT ;UPDATE NEW END OF SOURCE
MOVEM B,SRCEPT
MOVN B,A
ADJBP B,DESEPT ;UPDATE NEW END OF DESTINATION
MOVEM B,DESEPT
MOVN B,A ;GET NEGATIVE NUMBER OF CHARACTERS DONE
ADDM B,STRLEN ;UPDATE NUMBER LEFT TO DO
MVSTX3: SKIPN STRLEN ;ANY MORE CHARACTERS TO DO?
RET ;NO, ALL DONE
CALL DOBBYT ;YES, DO ONE
JRST MVSTX3 ;LOOP FOR REST
;IF SOURCE AND DESTINATION BOTH ARE ON WORD BOUNDARIES, AND THERE'S
;AT LEAST ONE WORD TO DO, COME HERE TO DO IT. THIS WOULD BE A BLT
;CASE IF A BACKWARDS BLT WERE AVAILABLE.
BAKBLT: MOVE A,STRLEN ;SEE HOW MANY CHARACTERS LEFT TO DO
IDIVI A,5 ;SEE HOW MANY WORDS
MOVEM A,WCNTB ;REMEMBER
MOVE A,SRCEND
SOJ A,
IDIVI A,5 ;GET RIGHTMOST WORD ADDRESS OF SOURCE
SUB A,WCNTB ;LOOP ADDS COUNT TO ADDRESS
HRRM A,BBS ;SET UP FETCH IN LOOP
MOVE A,DESEND
SOJ A,
IDIVI A,5 ;GET RIGHTMOST WORD ADDRESS OF DESTINATION
SUB A,WCNTB
HRRM A,BBD
MOVE C,WCNTB ;LOAD COUNTER WITH NUMBER OF WORDS TO DO
CALL BBL ;DO THE BACKWARDS BLT LOOP
JRST MVSTX4 ;GO UPDATE COUNTS AND FINISH NIBBLINGS
;ROUTINE TO DO ONE BYTE
DOBBYT: SOS SRCEND ;WE'RE DOING A BYTE, SO SHRINK SOURCE END ADDRESS
HRROI TT,-2
ADJBP TT,SRCEPT ;GET MODIFIED POINTER TO JUST BEFORE END OF SOURCE
ILDB CH,TT ;GET THE BYTE
MOVEM TT,SRCEPT ;REMEMBER NEW END OF SOURCE POINTER
HRROI TT,-2
ADJBP TT,DESEPT ;GET POINTER TO DESTINATION
IDPB CH,TT ;STORE THE BYTE
MOVEM TT,DESEPT ;UPDATE DESTINATION END POINTER
SOS DESEND ;UPDATE DESTINATION END ADDRESS
SOS STRLEN ;SHOW DECREASE IN NUMBER LEFT TO DO
RET
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS)
; CALL GETINC
; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.
GETINC: CALL GET
AOJA I,R
;CHANGE CHARACTER ADDRESS INTO BYTE POINTER
ADDPTR: IDIVI A,5 ;DIVIDE BY BYTES PER WORD
HLL A,BTAB(B) ;CHOOSE CORRECT LEFT HALF
RET
;"GET" TAKES CHARACTER ADDRESS IN I, RETURNS BYTE POINTER TO CHARACTER
;IN TT, CHARACTER IN CH. KNOWS ABOUT THE HOLE AND HOW TO AVOID IT.
GET: CALL GETX ;GET BYTE POINTER
LDB CH,TT
RET
;GETX IS LIKE "GET", BUT DOESN'T REFERENCE THE MEMORY POINTED TO
;BY THE CONSTRUCTED BYTE POINTER
GETX: PUSH P,I ;SAVE CHARACTER ADDRESS ARG
CAML I,HOLBEG ;ARE WE TO LEFT OF HOLE?
ADD I,HOLSIZ ;NO, SO MODIFICATION NECESSARY TO GET OUT OF HOLE
CALL GET2
POP P,I ;DON'T CLOBBER USER'S I
RET
;GET1 IS LIKE GETX, BUT DOESN'T CHECK FOR WHETHER WE'RE IN HOLE OR
;NOT
GET1: CALL GET2
RET
GET2: MOVE TT,I
IDIVI TT,5
HLL TT,BTAB(TT1)
RET
PUT: CALL PUT2
DPB CH,TT
RET
PUT2: MOVE TT,OU
IDIVI TT,5
HLL TT,BTAB(TT1)
RET
;ROUTINE TO SUPPORT ULDB AND UILDB UUO'S, WHICH ARE EXACTLY LIKE
;LDB AND ILDB INSTRUCTIONS, EXCEPT THAT IF THE HOLE IN THE BUFFER IS
;REFERENCED, IT IS PASSED OVER.
%LDB: HRRZ A,UUOB+.AREFA ;GET ADDRESS OF BYTE POINTER
CAIGE A,20 ;IS IT IN AN AC?
ADDI A,UUOACS ;YES, SO POINT TO SAVED AC BLOCK
CAIN TT,<UILDB>_-^D27 ;ARE WE SUPPOSED TO INCREMENT POINTER?
IBP (A) ;YES
MOVE TT,(A) ;GET BYTE POINTER
CAMN TT,HOLBPT ;MAKE SURE WE'RE NOT IN HOLE
MOVE TT,HOLEPT ;WE ARE, GET OUT
LDB CH,TT ;GET THE DATA
MOVEM TT,(A) ;STORE RESULTANT POINTER
LDB A,[POINT 4,UUOB+.ARPFL,30] ;GET AC FIELD OF LUUO
MOVEM CH,UUOACS(A) ;STORE DATA (SECOND, SO UILDB T,T WINS)
RET ;ALL DONE
;ROUTINE TO CHANGE BYTE POINTER TO CHARACTER ADDRESS. GIVE IT THE
;BYTE POINTER IN TT, IT RETURNS THE ADDRESS IN I. THE ADDRESS GIVEN
;IS AS IF THERE WERE NO HOLE IN THE BUFFER. THAT IS, IF CHARACTER
;ADDRESS BEFORE DOING THE "AS IF" IS REAL LARGE, I.E. TO RIGHT OF
;HOLE, IT IS ADJUSTED LEFT.
PTR2AD: CALL PTRXAD ;FIRST DO RAW WORK, THEN WE'LL WORRY ABOUT HOLE
CAML I,HOLBEG ;ARE WE TO LEFT OF HOLE?
SUB I,HOLSIZ ;NO, SO ADJUSTMENT NECESSARY
RET
;ROUTINE TO TAKE BYTE POINTER IN TT AND TRANSFORM IT INTO A CHARACTER
;ADDRESS, WHICH IS RETURNED IN I. NO AC'S ARE CHANGED EXCEPT, OF COURSE, I.
PTRXAD: PUSH P,A
PUSH P,B
HRRZ I,TT ;CHANGE BYTE POINTER TO CHARACTER ADDRESS
IMULI I,5 ;5 CHARACTERS PER WORD.
LDB A,[360600,,TT]
IDIV A,[-7] ;DIVIDE P FIELD FOR NUMBER OF CHARS OVER IN WORD
ADDI I,4(A) ;ADD CHARACTER REMAINDER TO CHARACTER ADDRESS
POP P,B
POP P,A
RET
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT
;OF A CHARACTER ADDRESS POINTER
XWD 440700,0
BTAB: XWD 350700,0
XWD 260700,0
XWD 170700,0
XWD 100700,0
XWD 10700,0
;ROUTINE TO CREATE THE HOLE. IT GETS CALLED WHEN BUFFER IS BEING
;COMPLETELY CLEARED.
MAKHOL: MOVE A,BEG ;hole is initially located at beginning
MOVEM A,HOLBEG ;remember where hole begins
MOVX A,EMTBUF*5 ;GET ADDRESS JUST BEYOND END OF HOLE
MOVEM A,HOLEND
CALL SETHPT
RET
;ROUTINE TO MOVE THE HOLE. CALL IT WITH DESIRED CHARACTER ADDRESS
;IN A. THE HOLE WILL BE MOVED SUCH THAT ARG IN A IS FIRST CHARACTER
;OF HOLE. HENCE CALLING IT WITH 0 PUTS HOLE AT BEGINNING OF BUFFER.
MOVHOL: STKVAR <DISTAN,NEWBEG,NEWEND>
MOVEM A,NEWBEG ;REMEMBER WHERE HOLE'S GOING TO
SUB A,HOLBEG ;CALCULATE DISTANCE
MOVEM A,DISTAN ;REMEMBER DISTANCE
MOVE A,HOLEND
SUB A,HOLBEG ;GET SIZE OF HOLE
ADD A,NEWBEG ;ADD BEGINNING TO GET NEW END
MOVEM A,NEWEND ;STORE NEW END
MOVE A,DISTAN ;GET DISTANCE
JUMPL A,MOVLFT ;JUMP OFF IF MOVING HOLE LEFT
MOVE I,HOLEND ;GET OLD END OF HOLE
MOVE OU,HOLBEG
MOVE P1,DISTAN ;GET NUMBER OF CHARACTERS NECESSARY TO MOVE
CALL MVCST ;MOVE DATA IN BUFFER TO RELOCATE THE HOLE
MOVDON: MOVE A,NEWBEG
SUB A,HOLBEG ;SEE HOW FAR RIGHT WE MOVED IT
ADDM A,HOLEND ;MARK NEW END OF HOLE
MOVE A,NEWBEG
MOVEM A,HOLBEG ;REMEMBER NEW LOCATION OF HOLE
CALL SETHPT
RET
;FOLLOWING CODE FOR CASE WHERE HOLE IS BEING MOVED "LEFT".
MOVLFT: MOVE I,NEWBEG ;MOVE DATA FROM NEW LOCATION OF BEGINNING OF HOLE
MOVE OU,NEWEND ;TO NEW END OF HOLE
MOVM P1,DISTAN ;GET POSITIVE NUMBER OF CHARACTERS TO MOVE
CALL MVCST ;MOVE DATA AROUND TO REPOSITION HOLE
JRST MOVDON ;RESET HOLE LOCATION AND RETURN
;ROUTINE TO UPDATE HOLBPT AND HOLEPT TO CONTAIN BYTE POINTER VERSIONS
;OF HOLBEG AND HOLEND. THIS ALLOWS MORE EFFICIENT HOLE BOUNDARY
;AVOIDANCE, AS POINTERS NEEDN'T BE CHANGED TO CHARACTERS ADDRESSES TO
;BE CHECKED.
SETHPT: STKVAR <SAVI,SAVTT>
MOVEM I,SAVI
MOVEM TT,SAVTT
MOVE I,HOLBEG ;GET BEGINNING ADDRESS
CALL GET1 ;CONVERT TO POINTER
MOVEM TT,HOLBPT ;STORE POINTER
MOVE I,HOLEND ;GET END OF HOLE ADDRESS
CALL GET1 ;CONVERT TO POINTER
MOVEM TT,HOLEPT ;STORE ENDING POINTER
MOVE A,HOLEND
SUB A,HOLBEG
MOVEM A,HOLSIZ ;STORE HOLE'S SIZE
MOVE I,SAVI
MOVE TT,SAVTT
RET
;ROUTINE TO SAY HOW MANY CHARACTERS MORE THE BUFFER CAN HOLD
;RETURNS THE RESULT IN A.
NFREE: MOVE A,HOLSIZ ;SOMEWHERES AROUND THE SIZE OF THE HOLE
SUBI A,^D35 ;NEED ROOM FOR STRINGS BEING SEARCHED FOR
SUBI A,5 ;NEED ROOM FOR MATCH IN SEARCHES
RET
;WHEN READING IN A FILE, CALL FILFRE INSTEAD OF NFREE SO THAT SOME
;INSERTS MAY BE DONE AFTER THE FILE IS READ IN
FILFRE: CALL NFREE ;GET ACTUAL SPACE AVAILABLE
SUBI A,1000 ;LEAVE SOME ROOM FOR INSERTS
RET
;GARBAGE COLLECTION. REMOVE FROM QREG BUFFER AREA ANY
;STRINGS NO LONGER IN USE, I.E. FOR WHICH NO POINTERS
;CAN BE FOUND.
QGC: MOVEM 16,ACNR+16
MOVEI 16,ACNR
BLT 16,ACNR+15 ;SAVE AC'S
CALL GC ;DO THE WORK
MOVSI 16,ACNR ;RESTORE ACS
BLT 16,16
RET
GC: MOVEI T,100
MOVEM T,GCCNT ;NUMBER OF X'S TO DO BEFORE NEXT GC
SETOM GCPTR ;YES. GCPTR:=-1
CLEARM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVEI T,CPTR ;COMMAND BUFFER
CALL GCMA
HRRZ T,P
CAIL T,PDL ;PUSHDOW LIST EMPTY?
CALL GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS
CAILE T,PDL
SOJA T,.-2
HRRZ T,PF ;COLLECT QREG PDL
CAIL T,PFL
CALL GCM
CAILE T,PFL
SOJA T,.-2
MOVE T,[XWD -44,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
CALL GCM
AOBJN T,.-1
;COMPACT QREG STRING STORAGE AREA
MOVE I,QRBUF ;I WILL CONTAIN NEXT FREE ADDRESS TO USE
;FIND STRING WITH LOWEST ADDRESS IN AREA
GCS1A: MOVE TT,EQRBUF ;END OF PRESENT QREG AREA
SKIPGE OU,GCPTR ;SETUP TO SCAN GCTAB - EMPTY?
JRST GCS21 ;YES
GCS1: MOVE A,GCTAB(OU) ;GET ADR OF STRING FOUND ABOVE
ADD A,QRBUF
CAMGE A,I ;PTR ABOVE AREA ALREADY DONE?
JRST GCS2 ;NO, NOT INTERESTED
CAMGE A,TT ;THIS LOWEST PTR IN GC AREA?
MOVE TT,A ;YES, REMEMBER IT
GCS2: SOJGE OU,GCS1
GCS21: CAML TT,EQRBUF ;IS LOWEST PTR WITHIN QREG AREA?
JRST [ MOVEM I,EQRBUF ;NO, UPDATE FINAL END OF ACTIVE STUFF
RET]
;HAVE FOUND A STRING, MOVE IT AND EVERYTHING AFTER IT DOWN TO
;LOWEST FREE ADDRESS.
MOVE A,TT ;ADDRESS OF STRING
IDIVI A,5 ;COMPUTE WORD ADR OF BEG OF STRING
MOVE B,I
IDIVI B,5 ;COMPUTE WORD ADDRESS OF BEG OF FREE SPACE
SKIPE C ;DOES FREE AREA START ON WORD BOUNDARY?
AOS B ;NO, SKIP PARTIAL WORD
HRLZ OU,A ;SETUP SOURCE FOR BLT
MOVE T,A
SUB T,B ;COMPUTE DISTANCE OF MOVE
JUMPLE T,GCS4A ;JUMP IF ALREADY IN RIGHT PLACE
HRR OU,B ;SETUP DEST FOR BLT
MOVE C,EQRBUF ;EQRBUF IS END OF SOURCE
IDIVI C,5 ;SETUP FINAL DEST FOR BLT
SUB C,T ;I.E. FINAL SOURCE MINUS DISTANCE
BLT OU,0(C) ;MOVE STUFF DOWN
MOVNS OU,T ;GET NEG DISTANCE
IMULI OU,5 ;IN TERMS OF CHARACTERS
ADDM OU,EQRBUF ;UPDATE AREA END ADDRESS
ADDM OU,RREL ;RREL:=p1(RREL)-5*NREG
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: MOVE A,GCTAB(CH) ;GET STRING ADR
ADD A,QRBUF
CAMGE A,TT
JRST GCS4
ADDM OU,GCTAB(CH) ;RELOCATE PTR
MOVE A,GCTAB2(CH) ;GET ADR WHERE PTR WAS LIVING
SKIPL TT1,0(A)
TLNN TT1,777700
JRST [ ADDM OU,0(A) ;RELOCATE CHAR PTR
JRST GCS4]
ADDM T,0(A) ;RELOCATE BYTE POINTER
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. I:=p1(TT)-5*NREG
GCS4A: MOVE I,TT ;SHOULD POINT TO BEG OF STRING FLAG (141)
CALL GETINC
CAIE CH,141
GCERR: PSTR <
?GC INTERNAL ERROR.
>
CALL GETINC
MOVE A,CH
CALL GETINC
LSH A,7 ;GET COUNT OF STRING
IOR A,CH
CALL GETINC
LSH A,7
IOR A,CH
ADD I,A
SUBI I,4 ;CORRECT FOR 4 OVERHEAD CHARS
JRST GCS1A
;MARK ACTIVE QREG STRING
; T/ ADDRESS OF QREG STRING PTR
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377770
RET ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCM2: CAML I,EQRBUF ;IN QREG BUFFER?
RET ;NO. FORGET IT.
CALL GET ;YES. CHECK FOR MARK.
CAIE CH,141 ;END OF STRING?
RET ;NO.
GCM3: SUB I,QRBUF ;YES. I:=# CHARACTERS TO RETREIVE.
AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBL ;AM IN WINNING?
JRST GCERR ;NO. VERY BAD.
MOVEM I,GCTAB(TT) ;SAVE CHAR ADR
MOVEM T,GCTAB2(TT) ;SAVE WHERE IT LIVES
RET
;MARK ACTIVE BYTE PTR, I.E. CPTR AND SAVED CPTR'S WHILE IN MACROS.
; T/ ADDRESS OF BYTE PTR
;ASSUMED: ADDRESS-1 CONTAINS TOTAL COUNT (COMAX), ADDRESS+1
;CONTAINS REMAINING COUNT (COMCNT).
GCMA: MOVE I,0(T)
LDB TT,[POINT 12,I,17] ;BYTE SIZE + XR
CAIE TT,700 ;DOES T PT TO A TEXT BYTE PTR?
RET ;NO
LDB TT,[POINT 6,I,5] ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
HRRZI I,1(I) ;BYTE PTR ADDR +1
IMULI I,5
SUBI I,4(TT) ;A MAGIC NUMBER
ADD I,1(T) ;CT (WE HOPE)
SUB I,-1(T) ;MAX
JRST GCM2
WRDCOM: STKVAR <BEGWRD>
MOVE A,CPTR ;GET POINTER TO BEGINNING OF WORD
MOVEM A,BEGWRD ;REMEMBER
WRD1: CALL SKRCH ;PICK UP LETTER OF WORD FROM COMMAND STRING
CAIE CH,.CHESC ;END OF WORD FROM COMMAND STRING ??
JRST WRD1 ;NO, KEEP LOOKING
TXNE FF,SCANF ;SCANNING?
RET ;YES, DON'T REALLY DO ANYTHING
MOVEI A,0
DPB A,CPTR ;ISOLATE WORD BY PUTTING BULL AT END
MOVEI A,WORDS ;TELL SYSTEM WHERE TABLE IS
MOVE B,BEGWRD ;GET POINTER TO WORD
TBLUK ;LOOK UP THE WORD
MOVEI D,.CHESC
DPB D,CPTR ;FIX THE COMMAND STRING
TXNE B,TL%AMB ;GIVE APPROPRIATE ERROR IF FAILURE
ERROR <AMBIGIOUS PARTIAL COMMAND>
TXNE B,TL%NOM
ERROR <UNDEFINED COMMAND WORD>
HRRZ B,(A) ;GET ADDRESS OF DATA BLOCK
MOVE A,(B) ;GET FLAGS
TXNE FF,SCANF ;SCANNING?
JRST [ MOVE A,(B) ;YES, GET FLAGS
JRST CDS1] ;LET SCANNER DECIDE
MOVE C,NUM ;GET ARGUMENT FOR COMMAND
JRST @1(B) ;GO EXECUTE THE COMMAND
;WLIST$ - LIST ALL THE DEFINED WORDS
WRDLST: CALL WINCLS ;THIS IS PRESERVED OUTPUT.
MOVNI CH,WLEN
HRLZ CH,CH ;MAKE AOBJN POINTER TO WORD LIST.
WRDLS1: HLRZ C,WORDS(CH) ;GET ADDRESS OF WORD NAME
UPSTR @c ;TYPE OUT WORD
CALL CRR ;END WORD WITH CRLF
AOBJN CH,WRDLS1 ;LOOP FOR REST OF WORDS
RET
;W COMMAND DISPATCH TABLE. W STANDS FOR WORD AND MAY APPEAR IN THE
;COMMAND STRING FOLLOWED BY A UNIQUE WORD OR PARTIAL WORD.
DEFINE WORD (A,C,FLAGS<0>)<[ASCIZ /A/],,[EXP FLAGS,IFIW!C]>
;CURRENTLY DEFINED WORD COMMANDS:
WORDS: WLEN,,WLEN
WORD AUTO-EXPUNGE,AUTO ;AUTO-EXPUNGE WHEN OVER QUOTA
WORD BACKUP,BACKUP ;TURN ON COMMAND SAVING
WORD DATE-AND-TIME,WDATIM ;INSERT CURRENT DATE AND TIME
WORD EDITBASIC,EBASIC ;WE ARE EDITING A BASIC PROGRAM SO DON'T FILTER OUT LINE #'S.
WORD EDITREGULAR,ERGLR ;FILTER LINE NUMBERS AS USUAL.
WORD FILENAME,WFILEN ;LAST FILENAME IN COMMAND
WORD FLAGUPPERS,FLAGU ;FLAG CAPITALS
WORD LIST,WRDLST ;LIST ALL THE DEFINED WORDS
WORD NOAUTO-EXPUNGE,NOAUTO ;DON'T AUTO-EXPUNGE WHEN OVER QUOTA
WORD NOBACKUP,NOBACK ;TURN OFF COMMAND SAVING
WORD NOFLAG,NOFLAG ;DON'T FLAG ANY LETTERS
WORD NOSHIFT,NSHIFT ;DON'T SHIFT INPUT
WORD RAISE,TERRAS ;RAISE INPUT LETTERS
WORD SAVLEN,BETSAV,CH%TOR ;GET OR SET NUMBER OF CHARACTERS TO INPUT BEFORE CALLING SAVER.
WORD SCREENSIZE,SCNSET,CH%TOR ;SET OR GET SCREEN SIZE
WORD UPDATE,WUPDATE ;UPDATE THE SCREEN
WORD VT05,VT05 ;ANNOUNCE THAT YOU ARE RUNNING ON A VT05
WORD VT100,VT100 ;SAY VT100
WORD VT50,VT50 ;SAY YOU ARE ON A VT50.
WORD VT52,VT52 ;SAY WE'RE A VT52
WORD WIDTH,WTHSET,CH%TOR ;SET OR GET CURRENT LINE WIDTH
WORD WINSIZ,WINSET,CH%TOR ;GET OR SET WINDOW SIZE
WLEN==.-WORDS-1
;COMMAND DISPATCH TABLE
;DISPATCH IS BY XCT DTB(CH)
;FORMAT:
; MOVEI A,X ;IF X RETURNS A VALUE
; HRROI A,X ;IF X DOES NOT RETURN A VALUE AND EXITS WITH POPJ
; JRST X ;IF X DOES NOT RETURN A VALUE AND EXITS TO A
; ;FIXED LOCATION.
DTB: HRROI A,ERRA ;^@
MOVEI A,COMM ;^A
HRROI A,ERRA ;^B
HRROI A,ERRA ;^C
MOVEI A,CALDDT ;^D
MOVEI A,FFEED ;^E
HRROI A,ERRA ;^F
HRROI A,DECDMP ;^G
MOVEI A,GTIME ;^H
HRROI A,TAB ;^I (TAB) INSERT IT AND FOLLOWING TEXT
MOVEI A,CRET ;LINEFEED IS NOOP
HRROI A,ERRA ;^K
HRROI A,CTRLL ;^L
MOVEI A,CRET ;CR IS NOOP
HRROI A,ERRA ;^N
HRROI A,ERRA ;^O
HRROI A,ERRA ;^P
HRROI A,ERRA ;^Q
HRROI A,ERRA ;^R
HRROI A,ERRA ;^S
MOVEI A,SPTYI ;^T
HRROI A,ERRA ;^U
HRROI A,ERRA ;^V
HRROI A,ERRA ;^W
MOVEI A,SSERCH ;^x set or read search mode switch
HRROI A,ERRA ;^Y
HRROI A,ERRA ;^Z
HRROI A,ERRA ;^[
HRROI A,ERRA ;^BACKSLASH
HRROI A,ERRA ;^]
MOVEI A,CNTRUP ;^^
HRROI A,ERRA ;^LEFT ARROW
MOVEI A,CD2 ;SPACE
MOVEI A,EXCLAM ;!
MOVEI A,DQUOTE ;"
MOVEI A,COR ;#
MOVEI A,CRET ;$
MOVEI A,PCNT ;%
MOVEI A,CAND ;&
MOVEI A,APOST ;'
MOVEI A,OPEN ;(
MOVEI A,CLOSE ;)
MOVEI A,TIMES ;*
MOVEI A,CD2 ;+
MOVEI A,COMMA ;,
MOVEI A,MINUS ;-
MOVEI A,PNT ;.
MOVEI A,SLASH ;/
JRST CDNUM ;0
JRST CDNUM ;1
JRST CDNUM ;2
JRST CDNUM ;3
JRST CDNUM ;4
JRST CDNUM ;5
JRST CDNUM ;6
JRST CDNUM ;7
JRST CDNUM ;8
JRST CDNUM ;9
MOVEI A,COLON ;:
JRST SEMICL ;;
MOVEI A,LSSTH ;LEFT ANGLE BRACKET
HRROI A,PRNT ;=
MOVEI A,GRTH ;RBRACKET
MOVEI A,QUESTN ;?
MOVEI A,ATSIGN ;@
JRST ACMD ;A
MOVEI A,BEGIN ;b
MOVEI A,CHARAC ;c
HRROI A,DELETE ;d
MOVEI A,ELINE ;e
HRROI A,ERRA ;F
MOVEI A,QGET ;G
MOVEI A,HOLE ;H
HRROI A,INSERT ;I
MOVEI A,JMP ;J
HRROI A,KILL ;K
MOVEI A,LINE ;L
JRST MAC ;M
MOVEI A,SERCHP ;N
MOVEI A,OG ;O
HRROI A,PUNCH ;P
MOVEI A,QREG ;Q
MOVEI A,REPLAC ;R
MOVEI A,SERCH ;S
HRROI A,TYPE ;T
HRROI A,USE ;U
HRROI A,VIEW ;V
HRROI A,WRDCOM ;W
HRROI A,X ;X
HRROI A,YANK ;Y
MOVEI A,END1 ;Z
MOVEI A,OPENB ;[
MOVEI A,BAKSL ;BACKSLASH
MOVEI A,CLOSEB ;]
MOVEI A,UAR ;^
MOVEI A,LARR ;LEFT ARROW
;SEMICOLON COMMAND TABLE
SEMTAB: MOVEI A,TCOND
REPEAT 37,<JRST ERRA
>
JRST ERRA ;@
JRST ERRA ;A
JRST ERRA ;b
HRROI A,CLOSEF ;c
HRROI A,DNLOAD ;d
HRROI A,DOFILE ;e
JRST ERRA ;F
MOVEI A,GETOB ;G
HRROI A,DECDMP ;H
JRST ERRA ;I
JRST ERRA ;J
JRST ERRA ;K
JRST ERRA ;L
HRROI A,MFILE ;M
MOVEI A,PIKNUM ;N
JRST ERRA ;O
MOVEI A,PICKUP ;P
JRST ERRA ;Q
HRROI A,OPNRD ;R
HRROI A,BSAVE ;;S - SAVE THE ENTIRE BUFFER.
MOVEI A,TPREG ;T
HRROI A,UNLOAD ;U
JRST ERRA ;V
HRROI A,OPNWR ;W
HRROI A,EXCOM ;X
HRROI A,YLOAD ;Y
JRST ERRA ;Z
JRST ERRA ;[
JRST ERRA ;\
JRST ERRA ;]
JRST ERRA ;^
JRST ERRA ;_
;COMMON ERROR FOR UNDEFINED COMMANDS
ERRA: ERROR <UNDEFINED COMMAND>
;PUT LITERALS HERE THAT SAVER NEEDN'T HAVE IN ITS MAP
XLIST ;DON'T CLUTTER LINEPRINTER PAPER WITH THEM
LIT
LIST
;PAGES USED FOR WINDOWS TO INPUT AND OUTPUT DISK FILE AND OTHER FORK
IBFPG==<.+1000>_-9
IBFPGA=IBFPG_9
OBFPG==IBFPG+1
OBFPGA=OBFPG_9
FRKWPN==OBFPG+1
FRKWIN==FRKWPN_9
FRKWP2==FRKWPN+1
FRKWI2==FRKWP2_9
LOC FRKWI2+1000 ;LEAVE ROOM FOR WINDOWS
;PATCH SPACE
PATS:
PAT: BLOCK 100
;DATA AREA FOR TV
VIRGIN: -1 ;IF 0, THIS IS THE VIRGIN RUN(FIRST TIME SINCE LOADING)
;ROUTINE TO MOVE STRING STARTING WITH RIGHTMOST END. IT'S HERE
;BECAUSE THE "000"S GET FILLED IN AT RUN TIME
MBLUP:
GETSRC: MOVE A,000(C) ;GET SOURCE WORD
LSH A,-1 ;GET RID OF DATA GAP AT B35
MAKE5: LSHC A,000 ;GET 5 CONTIGUOUS BYTES IN B
TRZ B,1 ;GET RID OF B35
SETDES: MOVEM B,000(C) ;STORE DESTINATION WORD
RESIDU: LSHC A,000 ;PUT REST OF WHAT WAS IN A LEFT-JUSTIFIED IN B
SOJG C,MBLUP ;REPEAT FOR ALL FULL WORDS
RET ;DONE
;ROUTINE TO MOVE STRING FROM RIGHTMOST END WHEN WE KNOW THERE'S NO
;SHIFTING TO DO BECAUSE SOURCE AND DESTINATION ARE WORD ALIGNED
BBL:
BBS: MOVE A,000(C) ;GET SOURCE WORD
BBD: MOVEM A,000(C) ;STORE IN DESTINATION
SOJG C,BBL ;REPEAT FOR ALL WORDS
RET
;FUNCTION DESCRIPTOR BLOCK FOR COMND TO READ FILESPECS
FILCBK: <.CMFIL>B8 ;SPECIFY FILE FUNCTION
0 ;DATA
0 ;HELP TEXT
-1,,DEFSPC ;DEFAULT POINTER
FIRSTV: ;FIRST LOCATION CLEARED AT STARTUP
COCNST: 0 ;NUMBER OF TIMES WE'VE SET DISPLAY MODE
COCPOS: 0 ;SAVED LINE POSITION BEFORE ESCAPE SEQUENCE
REGCWD: BLOCK 2 ;STANDARD CONTROL ECHO BITS
TRMTYP: 0 ;HOLDS TERMINAL TYPE
UUOACS: BLOCK 20 ;SAVED AC'S DURING UUOS
IAC: BLOCK 20 ;INTERRUPT AC'S
ABORTF: 0 ;ABORT REQUESTED IF NOT 0
LISNF: 0 ;DOING COMMAND INPUT IF NOT 0
COFLG: 0 ;SUPRESS OUTPUT IF NON-0
BASICF: 0 ;SET TO -1 IF WE INSIST ON NOT FILTERING OUT LINE NUMBERS.
FLAGF: 0 ;-1 = FLAGGING UPPERS
LINCNT: 0 ;COUNTS LINEFEEDS ON OUTPUT, BUT GETS ZEROED WHEN A CHARACTER IS INPUT
CRRCNT: 0 ;NUMBER OF CRLFS TYPED
COLUMN: 0 ;CURSOR COLUMN DURING COMMAND TYPIN
ERRBLN==20 ;room for system ERROR messages
LSTERR: 0 ;HOLDS 0 OR SPECIFIC ERROR NUMBER
ERRBUF: BLOCK ERRBLN
FLDSIZ==^D78 ;SIZE OF FILESPEC FIELD MAX, 39 CHARS MAYBE ALL QUOTED
FWDS==FLDSIZ/5+1 ;WORDS NEEDED FOR FIELD OF FILESPEC
FNAMSZ==FLDSIZ+1+1+FLDSIZ+1+FLDSIZ+1+FLDSIZ+1+6+1+FLDSIZ ;STRUCTURE, COLON, BRACKET, DIR, BRACKET, NAME, DOT, EXT, DOT, GENERATION, SEMICOLON, ATTRIBUTE
NAMBFR: BLOCK FNAMSZ/5+1 ;ROOM FOR NAME PLUS NULL
DEFSPC: BLOCK FNAMSZ+1 ;DEFAULT FILESPEC
CMDBLN==<FLDSIZ+1+FNAMSZ+2>/5+1 ;PROGRAM, SPACE, FILESPEC, CRLF (RESCAN BUFFER)
CMDBFR: BLOCK CMDBLN
CMDACS: BLOCK 20 ;SAVED AC'S FROM BEGINNING OF COMMAND LINE
ATMBLN==CMDBLN
ATMBFR: BLOCK ATMBLN ;HOLDS LAST PARSED FIELD
SBK: BLOCK 20 ;COMND JSYS STATE BLOCK
CJFNBK: BLOCK 20 ;GTJFN BLOCK FOR COMND JSYS
REPARA: 0 ;REPARSE ADDRESS FOR COMND
DATBUF: BLOCK 200 ;FOR RANDOM DATA INSERTIONS
TRACS: 0
XCOLPT: 0
XCOLST: BLOCK 20
BAKLEN: 0 ;NUMBER OF CHARACTERS TO BUFFER BEFORE SAVING
BAKFLG: 0 ;-1 IF COMMANDS ARE BEING SAVED
SAVFRK: 0 ;HOLDS FORK HANDLE OF SAVER
LPM: 0 ;LAST PAGE MAPPED FROM OTHER FORK
LPM2: 0 ;LAST OTHER PAGE MAPPED FROM OTHER FORK
RESPTR: 0 ;POINTER TO COMMAND STRING INVOKED BY "TV FILENAME"
LSTCB: 0 ;BEG OF LAST COMMAND STRING
LSTCE: 0 ;END OF LAST COMMAND STRING
DLIM: 0
NUM: 0
SYL: 0
SARG: 0
LEV: 0
DUNFLG: 0 ; ;D/;U FLAG
DEFNAM: BLOCK FWDS ;DEFAULT FILE NAME
DEFEXT: BLOCK FWDS ;DEFAULT EXTENSION
TTYOUT: 0 ;TTY OUTPUT JFN
TYIJFN: 0 ;TYPIN JFN
TYIP: 0 ;TYPIN STACK POINTER
TYILEN==50 ;MAXIMUM DEPTH OF INPUT FILES ALLOWED FOR TYPIN
TYIPDL: BLOCK TYILEN ;TYPIN STACK
TERIO: 0 ;SET IF CURRENT INPUT IS FROM A TERMINAL
OTERIO: 0 ;PREVIOUS (OLD) VALUE OF TERIO
INJFN: 0
OUTJFN: 0
IBFRC: 0 ;NO. CHARS IN BUFFER
IBFRP: 0 ;BYTE PTR TO BUFFER
INBYC: 0 ;REMAINING BYTES IN FILE
INFPG: 0 ;PAGE NUMBER IN FILE
FBIN: 0 ;DISPATCH ADDRESS
OBFRC: 0
WRITEF: 0 ;NON-0 IF OUTPUT FILE HAS SOME OUTPUT IN IT
OBFRP: 0
OUBYC: 0
OUFPG: 0
FBOUT: 0
SCNEST: 0 ;NEST LEVEL WHILE SCANNING
LCHAR: 0 ;CHARACTER BEING SCANNED FOR
ITERCT: 0
INTDPH: 0 ;NUMBER OF ITERATIONS DEEP IN CURRENT MACRO
SRPF: 0 ;-1 IF REPARSE NEEDED OF SEARCH STRING
EXACTF: 0 ;0=> SEARCHES MATCH EITHER CASE, 1=> EXACT MODE ONLY
SFINDF: 0
ERR1: 0
RADIX: 0 ;holds radix for number printout
LISTF5: 0 ;OUTPUT DISPATCH
HOLBEG: 0 ;CHARACTER ADDRESS OF BEGINNING OF HOLE
HOLEND: 0 ;CHARACTER ADDRESS OF FIRST CHARACTER NOT IN HOLE
HOLBPT: 0 ;BYTE POINTER (LDB) TO BEGINNING OF HOLE
HOLEPT: 0 ;BYTE POINTER (LDB) TO FIRST CHAR TO RIGHT OF HOLE
HOLSIZ: 0 ;NUMBER OF CHARACTERS IN HOLE
BEGX: 0 ;WORD ADDRESS OF LEFTHAND PAGE FAULT BOUNDARY OF BUFFER
ENDX: 0 ;SAME FOR RIGHTHAND BOUNDARY
BEG: 0
PT: 0
ZEE: 0 ;CHAR PTR TO END OF BFR
QRBUF: 0
EQRBUF: 0 ;END OF QREG BUFFER AREA
UUOB: BLOCK 4 ;HARDWARE LUUO BLOCK
;*** TEXTI STATE BLOCK
RDCWB: 0 ;NUMBER OF WORDS FOLLOWING
RDFLG: 0 ;FLAGS
RDIOJ: 0 ;SOURCE DESIGNATOR,,DESTINATION DESIGNATOR
RDDBP: 0 ;DESTINATION POINTER
RDDBC: 0 ;NUMBER OF BYTES MORE WE CAN READ
RDBFP: 0 ;BEGINNING OF DESTINATION BUFFER
RDRTY: 0 ;POINTER TO PROMPT
RDBRK: 0 ;POINTER TO BREAK SET
RDBKL: 0 ;PLACE IN INPUT WHERE WE MUST REPARSE
RDEND==. ;USED TO MEASURE SIZE OF BLOCK
FCHAR: 0 ;FIRST CHARACTER OF COMMAND
;*** DO NOT SEPARATE ***
CBBLK==. ;BEGINNING OF AREA TO STACK WHEN CHANGING COMMAND STATE
COMAX: 0
CPTR: 0
COMCNT: 0
CBLEN==.-CBBLK ;NUMBER OF WORDS TO SAVE FOR COMMAND STATE
;*** DO NOT SEPARATE ***
CBUFH: 0
GCPTR: 0
GCCNT: 0 ;COUNT OF X'S TO DO BETWEEN GC'S
RREL: 0
;*** SEARCH DATA
SMAXLN==200 ;MAXIMUM SEARCH STRING LENGTH (NUMBER OF TYPED CHARACTERS)
SMAXWD==SMAXLN/5+1 ;WORDS TO HOLD MAXIMUM LENGTH
SCHPTR: 0 ;POINTER TO SEARCH STRING
SSLEN: 0 ;NUMBER OF TYPED CHARACTERS IN LAST SEARCH
SCHBUF: BLOCK SMAXWD ;ACTUAL CHARACTERS TYPED IN LAST SEARCH STRING
SRCHLN: 0 ;BIT N ON MEANS SEARCH STRING IS N CHARS LONG
SCHLNN: 0 ;N
SENDPT: 0 ;CHARACTER ADDRESS OF CHARACTER THAT MATCHED IN SEARCH
S0PT: 0 ;WHAT TO SET PT TO IF SEARCH HAS SUCCEEDED n TIMES
SDELIM: 0 ;SEARCH DELIMITING CHARACTER ($ UNLESS @S)
CARTAB: BLOCK 5 ;CARBTS WITH GAP IN DIFFERENT PLACES
SMTAB: BLOCK 5 ;SAME AS CARTAB BUT WITH SMASK
SCHARG: 0 ;ARGUMENT TO SEARCH COMMAND
SLAST: 0 ;B.P. TO NTH CHARACTER POSITION IN SEARCH WORKING REGISTER
NXTFRM: 0 ;WHERE TO GO DURING SEARCH TO SKIP FRAME
SLIDE: 0 ;NUMBER OF BITS TO SHIFT DATA IN ORDER TO SKIP FRAME
SDAT: BLOCK 2 ;HOLDS SEARCH DATA FROM BUFFER
MATCH: 0 ;HOLDS A MATCH ON FIRST FIVE CHARACTERS OF SEARCH
SMASK: 0 ;SHOWS WHAT FIRST FIVE CHARACTERS SHOULD BE
CARBTS: 0 ;BIT POSITIONS WE CARE ABOUT DURING SEARCH
SADD: 0 ;ADDRESS AT WHICH TO RESUME SEARCH AFTER FALSE ALARM
SPTR: 0 ;POINTER TO BUFFER DURING SEARCH
REPARG: 0 ;ARG TO REPLACE COMMAND
SOARG: 0 ;OLD SEARCH ARG
SMATLN==200 ;LENGTH OF SEARCH MATRIX
SMAT: BLOCK SMATLN ;SEARCH MATRIX. BIT N ON IN WORD K
;MEANS CHARACTER K IS BEING SEARCHED FOR
;AS AN N-1TH CHARACTER IN THE SEARCH STRING
;*** END OF SEARCH DATA SECTION
OTAB: BLOCK OTABL ;"O" COMMAND SEARCH TABLE
;THIS CAN'T BE SAME AS SMAT
;SMAT IS SUPPOSED TO REMAIN
;VALID FOR S$
ACNR: BLOCK 20 ;SAVED ACS IN GC
BAKTAB: BLOCK 20 ;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
SYMS: BLOCK 22 ;LIS+4(0),OG3+1,GC+3(0)
VALS: BLOCK 22 ;LIS+4(0),OG3+3,GC+3(0)
CNTS: BLOCK 22 ;LIS+4(0),OG3+2,GC+3(0)
SYMEND:
PF: 0 ;Q-REG STACK POINTER
PFL: BLOCK LPF
GTJERR: 0 ;ERROR CODE FROM GTJFN
GTJJFN: 0 ;JFN
CREJFN: 0 ;JFN FOR CREATE COMMAND
BBUFX: 0 ;SHOWS WHICH BACKUP BUFFER BEING USED
WTOGGL: 0 ;WINDOW BUFFER TOGGLE FOR SAVER FORK
;HOLDS 0 FOR ONE BUFFER, -1 FOR OTHER
;USING TWO BUFFERS REDUCES NUMBER OF PMAPS
;NEEDED
BBPTR: 0 ;POINTER TO BACKUP BUFFER
BBLEN: 0 ;NUMBER OF CHARACTERS IN BACKUP BUFFER
OBBLEN: 0 ;BBLEN AT TIME OF LAST UPDATE
OCP: 0 ;OLD COMMAND POINTER (WHERE LAST BACKUP OCCURED)
INIJFN: 0 ;HOLDS INI FILE JFN
QUOJFN: 0 ;HOLDS JFN BEING WRITTEN TO
UPDATF: 0 ;-1 IF DOING WUPDATE
GCTAB: BLOCK GCTBL ;GCS3+4,GCM2+13
GCTAB2: BLOCK GCTBL
QTAB: BLOCK 45 ;Q-REGISTER TABLE
;USEA1,PCNT+1
;**** VARIABLE AREA FOR STRING MOVE ROUTINE
SRCBEG: 0 ;LEFTMOST CHARACTER ADDRESS OF STRING BEING MOVED
SRCBPT: 0 ;BYTE POINTER FORM OF SRCBEG
DESBEG: 0 ;LEFTMOST CHAR ADDRESS OF DESTINATION
DESBPT: 0 ;BYTE POINTER FORM OF DESBEG
SRCEND: 0 ;CHAR ADDRESS JUST TO RIGHT OF SOURCE
SRCEPT: 0 ;BYTE POINTER FORM OF SRCEND
DESEND: 0 ;CHAR ADDRESS JUST TO RIGHT OF DESTINATION
DESEPT: 0 ;BYTE POINTER FORM OF DESEND
STRLEN: 0 ;NUMBER OF CHARACTERS LEFT TO MOVE
WCNTB: 0 ;NUMBER OF WHOLE WORDS BEING MOVED
;**** END OF STRING MOVE STORAGE AREA
PDL: BLOCK LPDL
CMDPDL: BLOCK LPDL ;SAVED PDL DURING COMMAND
;***** DISPLAY ROUTINE VARIABLE AREA
SCRNF: 0 ;SET TO -1 IF WE'RE RUNNING ON A SCREEN.
SCRNZ: 0 ;BYTE POINTER TO LAST CHARACTER TO BE DISLAYED
SCRNPT: 0 ;CHARACTER ADDRESS OF FIRST CHARACTER TO BE DISPLAYED
ILDBPT: 0 ;LDB POINTER TO CHARACTER BEFORE POINTER
SCNEND: 0 ;CHARACTER ADDRESS OF LAST CHAR IN BUFFER DISPLAYED
MESFLG: 0 ;SET TO -1 TO MEAN DISPLAY IS MESSED UP
SWIDTH: 0 ;SCREEN WIDTH
LASTCH: 0 ;CONTINUATION CHARACTER FOR LAST COLUMN
DLENTH: 0 ;NUMBER OF LINES TO USE FOR NEXT DISPLAY WINDOW
DISBLK: 0 ;NUMBER OF LINES TYPED BEFORE SOME THAT WANT TO NOT BE OVERWRITTEN BY DISPLAY
SLENTH: 0 ;HOLDS NUMBER OF SCREEN LINES TO DISPLAY
SSIZE: 0 ;HOLDS NUMBER OF LINES THAT FIT ON SCREEN
MAXLEN==^D40 ;MAXIMUM VALUE ALLOWABLE FOR SLENTH
PTRCHR: BLOCK 2 ;ASCII STRING TO REPRESENT POINTER WITH
LBSIZ==<MAXWTH*2>/5+1 ;WORDS NEEDED FOR DISPLAY LINE BUFFER
LINBFR: BLOCK LBSIZ
WINDEX=1+<MAXWTH+2>/5 ;PDP-10 WORDS PER SCREEN LINE
LINBF2: BLOCK WINDEX ;OUTPUT BUFFER WHEN REPLACING ENTIRE LINE
;STORAGE
WINTOP=MAXLEN*WINDEX-1 ;HIGHEST WORD USED FOR SCREEN MEMORY RELATIVE
;TO FIRST WORD (WINDOW OR WINEW)
WINDOW: BLOCK WINTOP+1 ;STORAGE OF WHAT IS SHOWING ON SCREEN NOW
WINEW: BLOCK WINTOP+1 ;NEW SCREENFUL ABOUT TO BE DISPLAYED
LINBEG: BLOCK MAXLEN ;CHARACTER POINTERS TO BEGINNING OF DISPLAY LINES IN BUFFER
LINNEW: BLOCK MAXLEN ;SAME POINTERS AS LINBEG . MOVED TO LINBEG AS LINES ARE ACTUALLY PUT ON SCREEN.
WINFLG: 0 ;-1 IF NO LINES WORTH PRESERVING HAVE BEEN PRINTED
EOBFLG: 0 ;END OF BUFFER FLAG
SEOL: 0 ;END OF DISPLAY LINE FLAG
CTLFLG: 0 ;CONTROL CHARACTER FLAG
PUTPTF: 0 ;POINTER ON SCREEN FLAG
TYPEF: 0 ;-1 WHEN USER STARTS TYPING
;THIS IS THE ROUTINE THAT RUNS AS A LOWER FORK TO SAVE TYPED IN
;STRINGS ON THE DISK.
;THIS ROUTINE MUST BE LOADED IN MEMORY CONTIGUOUS TO EVERYTHING
;IT NEEDS TO RUN, SUCH AS ITS LITERALS, DATA, CODE, AND ANY ROUTINES
;IN .REQUIRED FILES. THIS IS BECAUSE FOR THE PURPOSE OF STARTUP
;EFFICIENCY, WE WANT TO DO A SINGLE PMAP TO SET UP THE MINIMUM NUMBER
;OF PAGES IN THE LOWER FORK.
SAVBEG==. ;REMEMBER WHERE SAVER FORK BEGINS
;DATA FOR SAVER FORK. IT MUST BE CONTIGUOUS WITH THE SAVER FORK
;ITSELF
SDONEF: 0 ;-1 WHEN SAVER DONE SAVING A STRING
SAVJFN: 0 ;holds command file jfn
SAVPDL: BLOCK 50 ;STACK FOR SAVER
MAXBAK==^D1000 ;MAXIMUM NUMBER OF TYPED IN CHARACTERS ALLOWED BETWEEN SAVES
SAVX: 0 ;BYTE POINTER TO WHICH AREA TO SAVE
SAVTOT: 0 ;TOTAL CHARACTERS BEING BACKED UP
SAVPER: 0 ;NUMBER OF PERMANENT CHARACTERS BEING BACKED UP
SAVPOS: 0 ;FILE POSITION AT WHICH SAVED CHARACTERS SHOULD GO
EXPFLG: 0 ;-1 FOR AUTO-EXPUNGE
DIRECT: BLOCK 1+3+^D78/5 ;SPACE FOR DIRECTORY NAME
TOP==.-1
;INTERRUPT TABLES
LEVTAB: LEV1PC
LEV2PC
LEV3PC ;LOCATIONS OF SAVED PC DURING INTERRUPTS
LEV1PC: BLOCK 2
LEV2PC: BLOCK 2
LEV3PC: BLOCK 2 ;INTERRUPT PC'S STORED HERE
CHNTAB: XWD 3,TTYINT ;CONTROL-G
XWD 3,CTRL.O ;CONTROL-O
XWD 3,CTRL.C ;CONTROL-C
XWD 3,TYPO ;USER HAS TYPED SOMETHING
TICHN==3 ;TYPEIN INTERRUPT CHANNEL
REPEAT ^D11-^D4,<0>
XWD 3,IOERR ;CHANNEL 11, IO ERROR
XWD 3,OVRQUO ;CHANNEL 12, OVER QUOTA
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
;GTJFN BLOCK FOR COMMAND FILE...
SAVFIL: GJ%FOU ;FILE FOR OUTPUT USE
377777,,377777 ;NO JFNS FOR FILE NAME INPUT
0
0
440700,,[ASCIZ /COMMANDS/]
440700,,[ASCIZ /TV/]
0 ;STANDARD PROTECTION,
0 ;ACCOUNT
0
0
0
;GTJFN INFO FOR ACCESSING TV.INI FILE.
INIFIL: GJ%OLD ;OLD FILE ONLY
377777,,377777
0
0
440700,,[ASCIZ /TV/]
440700,,[ASCIZ /INI/]
0
0
0
0
0
;GET TO HERE WHEN A TYPED IN STRING IS READY TO BE SAVED...
SAVST: SKIPN A,SAVJFN ;get jfn of BACKUP file
JRST CNOGT9 ;NO JFN EVER DONE, GO DO IT
SAVST1: MOVE B,[7B5+OF%WR+OF%RD] ;open file in UPDATE mode
OPENF
JRST CNOGET ;couldn't open it, say why
MOVE B,SAVPOS ;GET TO CORRECT FILE POSITION
SFPTR
JSHLT
MOVE A,SAVJFN ;GET JFN TO SAVE STRING ON
MOVE B,SAVX ;POINT AT TEXT BEING SAVED
MOVN C,SAVTOT ;GET NEGATIVE NUMBER OF CHARACTERS TO SAVE
SOUT ;SAVE THE STRING ON THE DISK
ERJMP CNOGTE ;COULDN'T, PROBABLY OVER QUOTA
TLO A,400000 ;close file but don't release jfn
CLOSF
JSHLT
HRROI B,-1 ;WE WANT TO CHANGE AN ENTIRE FDB WORD
MOVE C,SAVPOS ;GET PLACE IN FILE WE STARTED WRITING
ADD C,SAVTOT ;ADD NUMBER OF CHARACTERS WRITTEN TO GET TOTAL FILE SIZE
HRLI A,.FBSIZ ;SPECIFY WHICH WORD WE'RE CHANGING
CHFDB ;UPDATE THE FILE'S END
MOVE A,SAVPOS ;GET FILE POSITION
ADD A,SAVPER ;INCREASE BY AMOUNT EQUAL TO NUMBER OF PERMANENT CHARACTERS
MOVEM A,SAVPOS
SETOM SDONEF ;SET DONE FLAG TO SHOW WE'RE DONE
HALTF ;JUST HALT
;HERE WHEN ERROR, PROBABLY OVER QUOTA
CNOGTE: MOVE A,SAVJFN ;CLOSE JFN
TXO A,CO%NRJ ;BUT DON'T RELEASE IT
CLOSF
JSHLT
CNOGT3: MOVEI A,.FHSLF
GETER ;GET LAST ERROR
HRRZM B,SDONEF ;SIGNAL WE'RE DONE WITH ERROR CODE
HALTF
CNOGET: CAIE A,OPNX2 ;FILE DELETED OUT FROM UNDER US?
JRST CNOGT8 ;NO, SOMETHING ELSE
MOVE A,SAVJFN ;YES, THROW AWAY OLD JFN
RLJFN
JFCL ;DON'T WORRY IF CAN'T
JRST CNOGT9 ;GO GET NEW JFN
CNOGT8: CAIE A,DESX3 ;SKIP IF JFN WAS RELEASED OUT FROM UNDER US
JRST CNOGT3 ;NO, OPENF FAILED FOR OBSCURE REASON (MAYBE ENTIRE DISK FULL!!)
CNOGT9: DMOVE A,[EXP SAVFIL,<-1,,[ASCIZ /TVBACK:/]>]
GTJFN ;PERHAPS USER WANTS BACKUP FILE ON LOGICAL NAME TVBACK:
ERJMP CNOGT1 ;NO
JRST CNOGT2 ;YES
CNOGT1: DMOVE A,[EXP SAVFIL,<-1,,DIRECT>]
GTJFN ;GET HANDLE ON BACKUP FILE.
JSHLT ;COULDN'T EVEN DO THAT !!
CNOGT2: MOVEM A,SAVJFN ;SAVE THE BACKUP FILE JFN.
JRST SAVST1 ;GO BACK AND TRY THE OPENF AGAIN.
XLIST ;DON'T LIST LITERALS IN LISTING
LIT ;MAKE SURE LITERALS SAVER NEEDS ARE IN ITS MAP
LIST ;TURN LISTING BACK ON
RELOC .-140 ;WE'RE NOT RELOCATABLE BUT OTHER MODULES MAY BE
.REQUIRE SYS:MACREL
;NOTE THAT ANY .REQUIRES THAT SAVER REFERENCES MUST BE CONTIGUOUS TO
;SAVER
SAVEND==.RLEND ;MARK END OF SAVER FORK
END <ENLEN,,GOGO>