Trailing-Edge
-
PDP-10 Archives
-
bb-d868e-bm_tops20_v41_2020_dist_1of2
-
4-1-sources/tv.mac
There are 20 other files named tv.mac in the archive. Click here to see a list.
;**Modify PERUSE so there is no default filename on a ;X -SMAYO
; UPD ID= 156, SNARK:<6.UTILITIES>TV.MAC.9, 12-Oct-82 22:47:51 by CHALL
;TCO 6.1308- ALLOW THE "PERUSE" COMMAND
; UPD ID= 34, AU51:TV.MAC.20, 1-Sep-82 11:06:17 by MAYO
;**Edit 513 by SM - Stop <;Efile$> from giving stack overflow. 18173.
; UPD ID= 31, AU5:TV.MAC.18, 9-Jul-82 09:56:31 by MAYO
;**Edit 512 by SM - Add SETSN code at startup. Add WLIBRARY$. No SPR.
; UPD ID= 26, AU5:TV.MAC.15, 9-Jun-82 13:00:16 by MAYO
;**Edit 511 by SM - 502 broke n,mP; fix. No SPR.
; UPD ID= 23, AU5:TV.MAC.13, 26-May-82 17:50:30 by MAYO
;**Edit 510 by SM - :N,:R weren't returning values properly.
; UPD ID= 19, AU5:TV.MAC.9, 5-May-82 13:48:01 by MAYO
;**Edit 509 by SM - WFILE$ returns nothing after CREATE foo. Fix. No SPR.
; Also S...^Ex...$ doing things at runtime that could be done at compile
; time. Fix. No SPR.
; UPD ID= 8, AU5:TV.MAC.4, 22-Apr-82 13:37:54 by MAYO
;**Edit 508 by SM - Stack imbalance at OPNOUT. Fix. No SPR.
;**Edit 507 by SM - n,nK returns n. Fix. No SPR.
;**Edit 506 by SM - ARG2 not being cleared properly. Fix. No SPR.
;**Edit 505 by SM - Fix octal input; large values can get trashed. No SPR.
; UPD ID= 26, AU41:TV.MAC.5, 26-Mar-82 15:16:27 by MAYO
;**Edit 504 by SM - clean up code. V5. Fix comments. No SPR.
; UPD ID= 17, AU41:TV.MAC.4, 25-Mar-82 11:22:42 by MAYO
;**Edit 503 by SM - Fix edit 474 (make N and _ work)
; UPD ID= 4, AU41:TV.MAC.2, 23-Mar-82 20:59:14 by MAYO
;**Edit 502 by SM - Large fix for arg passing and scanning.
; UPD ID= 985, AU4:TV.MAC.3, 18-Feb-82 12:39:58 by MAYO
;**Edit 501 by SM - Stop Y and A from stripping nulls
; UPD ID= 984, AU4:TV.MAC.2, 18-Feb-82 12:07:29 by MAYO
;**Edit 500 by SM - Have 0"N^I$' not insert tab. Also force version decimal.
;
; UPD ID= 889, AU4:TV.MAC.6, 11-Nov-81 10:36:35 by MULLAHOO
;EDIT 477 - Make TV reset Cursor Key Mode for VT100
; UPD ID= 882, AU4:TV.MAC.5, 26-Oct-81 14:41:53 by MULLAHOO
;EDIT 476 - Delete erroneous code in MOVRIT routine
; UPD ID= 829, AU4:TV.MAC.4, 22-Sep-81 13:54:52 by MULLAHOO
;Edit 475 - Make -1:SFOO$ return 0 on failure
;
; UPD ID= 204, AU4:TV.MAC.3, 12-Sep-80 13:08:20 by SIMMONS
;TCO 5.1144 - TV.MAC.474 FIX INFINITE LOOP ON N COMMAND ON INPUT FILE (see 503)
; UPD ID= 133, AU4:TV.MAC.2, 28-Jul-80 11:37:39 by SIMMONS
;TCO 5.1107 - MAKE 0"N%X' NOT RETURN AN ERROR 473
;TCO 5.1037 - FIX WLIST$$ COMMAND 472
;
;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,1981,1982,
; By DIGITAL EQUIPMENT CORPORATION, Maynard, Mass.
TITLE TV - screen editor for TOPS-20 systems
SEARCH MONSYM,MACSYM
SALL ;MACROS TEND TO BE MESSY
EXTERNAL .RLEND ;SYMBOL SHOWING END OF MACREL
WHTV==0 ;LAST EDITED BY DEC
VRTV==5 ;MAJOR VERSION #
RVTV==1 ;REVISION #
RADIX 10
.EDIT==513 ;EDIT NUMBER, decimal
RADIX 8 ;RESTORE OLD RADIX
%%RVER==: .EDIT ;RHS FOR LINK
%%LVER==: <WHTV>B20+<VRTV>B29+RVTV ;LHS
;IF DEFINED, LEAVE ALONE, IF UNDEFINED, DEFINE IT
DEFINE ND(SYM,VAL), <IFDEF SYM,<SYM=SYM>
IFNDEF SYM,<SYM=VAL> >
;COMPILATION "FALL-OVER-AND-DIE" MACRO
DEFINE FOAD ($MSG)<
PRINTX ?'$MSG
PASS2
END>
;COMPILATION "PLEASE TAKE NOTE" MACRO
DEFINE UH.OH ($MSG)<
IF1, <PRINTX $MSG> >
;CONSTANTS OF MERIT
ND MAXWTH,^D255 ;MAXIMUM VALUE ALLOWABLE FOR SWIDTH
ND USARYL,^D200 ;NUMBER OF CELLS IN USER ARRAY
ND MAXSEC,7 ;MAX # OF SECTS WE GIVE TO THE USER
;SET TO 0 TO REMOVE EXTENDED COMMANDS
;SET TO 0 ON 2020's
ND FTRSC,0 ;IF 0, ALWAYS RESCAN ON RESTART
ND FTDEB,0 ;ADDS RANDOM NNU'D ROUTINES
ND FTUNS,0 ;IF NONZERO, *** THIS BECOMES UNSUPPORTED ***
;to get various interesting flavors of TV
;you could override the 0 in ND FTUNS,0 with
;below values. ANY NONZERO VALUE
;of FTUNS is UNSUPPORTED.
UN.ENC==1B0 ;1B0 Coding algorithm included (WENCRYPT$)
UN.CST==1B35 ;if customized, light this bit
;bits 25-34 for customer use
UN.ANY==-1 ;if ANY bit lit, UN.ANY hits it
DEFINE OPTION(OPT,CDE),<
IFN FTUNS&UN.'OPT,<CDE> >
;Paranoia checks
OPTION ANY,<UH.OH <%This version of TV is *NOT* supported> >
OPTION ENC,<UH.OH < ENCRYPTION included> >
OPTION CST,<UH.OH < (This is a USER CUSTOMISED version of TV)> >
IFLE MAXSEC, UH.OH <%Extended buffer commands will not be available.>
IFL USARYL-^D10, FOAD <Array size set too small>
;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 IS FOR GENERAL USAGE
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
;OPDEFS AND DEFINES
OPDEF UERR [01B8]
OPDEF UPSTR [02B8] ;PRINT STRING UUO
OPDEF ULDB [03B8] ;LDB BUT ADJUST BYTE POINTER 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
;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 COPYS 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
ARG2== 1B34 ;THERE IS A SECOND ARGUMENT
ARG== 1B33 ;THERE IS AN ARGUMENT
PERUS== 1B32 ;PERUSE MODE
SLSL== 1B31 ;@ SEEN
PCHFLG==1B30 ;N SEARCH
COLONF==1B29 ;COLON SEEN
SYLF== 1B28 ;SYLLABLE FLAG
RUBCF== 1B27 ;RUBOUT IN OUTPUT TO FILE
;**;[503] At GOGO: -52L, Deleted 1 line SM 24-Mar-82
FINDR== 1B26 ;LEFT ARROW SEARCH
RPLFG== 1B25 ;I REPLACE COMMAND
NOTF== 1B24 ;^N SEARCH MODIFIER
TRACEF==1B23 ;? SEEN
DDTMF== 1B22 ;NEED TO TYI IN DDT MODE
FORM== 1B18 ;FORM FEED TERMINATED LAST Y OR A
RSCNF2==1B17 ;SAYS RESCANNED DATA AVAILABLE
RSCANF==1B16 ;SAYS WE'RE USING RESCANNED DATA
FINF== 1B15 ;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
;VARIOUS CHARACTER DEFINITIONS
PCHAR=="*" ;PROMPT CHARACTER
CFLAG=="'" ;CHAR FOR FLAGGING "WRONG CASE" CHARACTERS
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.CAD=="N"-100 ;vt05 cursor addressing character
C.LM==37 ;add column or row to get there on vt05
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=150
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
VRSNI: %%LVER,,%%RVER ;VERSION NUMBER
ENLEN==.-GOGO ;LENGTH OF ENTRY VECTOR
;CHARACTER TABLE. ALLOWS RAISING, LOWERING, ETC. IN ONE INSTRUCTION.
;ALSO HAS INFORMATION CONCERNING "WHAT KIND OF CHARACTER IS THIS?"
CH%UPR==1B35 ;BIT TO MEAN CHARACTER IS CAPITAL LETTER
CH%DWN==1B34 ;LOWER CASE
CH%EOL==1B33 ;<CR><LF><FF>
CH%BL0==1B32 ;<SP><TAB>
CH%DIG==1B28 ;DIGITS, 0-9
CH%PN1==1B27 ;PUNCTUATION .,;:!?"
CH%SYM==1B24 ;.$%
CH%USR==1B23 ;USER DEFINABLE
CH%ALP=CH%DWN!CH%UPR ;ALPHABETIC IS UPPER+LOWER
CH%SBL==CH%ALP!CH%DIG!CH%SYM ;SYMBOL CONSTUTIENT IS ALPHA+DIGITS+.%$
CH%BL1==CH%EOL!CH%BL0 ;BLANK TYPE 1 - <CR><FF><LF><SP><TAB>
LWRFLD==177B8
UPRFLD==177B15
MSKSTR LWRCOD,CHRTAB,LWRFLD ;LOWERCASE VERSION OF CHARACTER
MSKSTR UPRCOD,CHRTAB,UPRFLD ;UPPERCASE VERSION
CHRTAB: FLD(0,LWRFLD)!FLD(0,UPRFLD)
FLD(1,LWRFLD)!FLD(1,UPRFLD)
FLD(2,LWRFLD)!FLD(2,UPRFLD)
FLD(3,LWRFLD)!FLD(3,UPRFLD)
FLD(4,LWRFLD)!FLD(4,UPRFLD)
FLD(5,LWRFLD)!FLD(5,UPRFLD)
FLD(6,LWRFLD)!FLD(6,UPRFLD)
FLD(7,LWRFLD)!FLD(7,UPRFLD)
FLD(10,LWRFLD)!FLD(10,UPRFLD)
CH%BL0! FLD(11,LWRFLD)!FLD(11,UPRFLD) ;^I
CH%EOL! FLD(12,LWRFLD)!FLD(12,UPRFLD) ;^J
FLD(13,LWRFLD)!FLD(13,UPRFLD)
CH%EOL! FLD(14,LWRFLD)!FLD(14,UPRFLD) ;^L
CH%EOL! FLD(15,LWRFLD)!FLD(15,UPRFLD) ;^M
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)
FLD(31,LWRFLD)!FLD(31,UPRFLD)
FLD(32,LWRFLD)!FLD(32,UPRFLD)
FLD(33,LWRFLD)!FLD(33,UPRFLD) ;^Z
FLD(34,LWRFLD)!FLD(34,UPRFLD)
FLD(35,LWRFLD)!FLD(35,UPRFLD)
FLD(36,LWRFLD)!FLD(36,UPRFLD)
FLD(37,LWRFLD)!FLD(37,UPRFLD)
CH%BL0! FLD(40,LWRFLD)!FLD(40,UPRFLD) ;SPACE
CH%PN1! FLD(41,LWRFLD)!FLD(41,UPRFLD) ;!
CH%PN1! FLD(42,LWRFLD)!FLD(42,UPRFLD) ;"
FLD(43,LWRFLD)!FLD(43,UPRFLD)
CH%SYM! FLD(44,LWRFLD)!FLD(44,UPRFLD) ;$
CH%SYM! FLD(45,LWRFLD)!FLD(45,UPRFLD) ;%
FLD(46,LWRFLD)!FLD(46,UPRFLD)
FLD(47,LWRFLD)!FLD(47,UPRFLD)
FLD(50,LWRFLD)!FLD(50,UPRFLD)
FLD(51,LWRFLD)!FLD(51,UPRFLD)
FLD(52,LWRFLD)!FLD(52,UPRFLD)
FLD(53,LWRFLD)!FLD(53,UPRFLD)
CH%PN1! FLD(54,LWRFLD)!FLD(54,UPRFLD) ;,
FLD(55,LWRFLD)!FLD(55,UPRFLD) ;-
CH%PN1!CH%SYM! FLD(56,LWRFLD)!FLD(56,UPRFLD) ;.
FLD(57,LWRFLD)!FLD(57,UPRFLD)
CH%DIG! FLD(60,LWRFLD)!FLD(60,UPRFLD) ;0
CH%DIG! FLD(61,LWRFLD)!FLD(61,UPRFLD) ;1
CH%DIG! FLD(62,LWRFLD)!FLD(62,UPRFLD) ;2
CH%DIG! FLD(63,LWRFLD)!FLD(63,UPRFLD) ;3
CH%DIG! FLD(64,LWRFLD)!FLD(64,UPRFLD) ;4
CH%DIG! FLD(65,LWRFLD)!FLD(65,UPRFLD) ;5
CH%DIG! FLD(66,LWRFLD)!FLD(66,UPRFLD) ;6
CH%DIG! FLD(67,LWRFLD)!FLD(67,UPRFLD) ;7
CH%DIG! FLD(70,LWRFLD)!FLD(70,UPRFLD) ;8
CH%DIG! FLD(71,LWRFLD)!FLD(71,UPRFLD) ;9
CH%PN1! FLD(72,LWRFLD)!FLD(72,UPRFLD) ;:
CH%PN1! FLD(73,LWRFLD)!FLD(73,UPRFLD) ;;
FLD(74,LWRFLD)!FLD(74,UPRFLD)
FLD(75,LWRFLD)!FLD(75,UPRFLD)
FLD(76,LWRFLD)!FLD(76,UPRFLD)
CH%PN1! FLD(77,LWRFLD)!FLD(77,UPRFLD) ;?
FLD(100,LWRFLD)!FLD(100,UPRFLD)
CH%UPR! FLD(141,LWRFLD)!FLD(101,UPRFLD)
CH%UPR! FLD(142,LWRFLD)!FLD(102,UPRFLD)
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%UPR! FLD(146,LWRFLD)!FLD(106,UPRFLD)
CH%UPR! FLD(147,LWRFLD)!FLD(107,UPRFLD)
CH%UPR! FLD(150,LWRFLD)!FLD(110,UPRFLD)
CH%UPR! FLD(151,LWRFLD)!FLD(111,UPRFLD)
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%UPR! FLD(155,LWRFLD)!FLD(115,UPRFLD)
CH%UPR! FLD(156,LWRFLD)!FLD(116,UPRFLD)
CH%UPR! FLD(157,LWRFLD)!FLD(117,UPRFLD)
CH%UPR! FLD(160,LWRFLD)!FLD(120,UPRFLD)
CH%UPR! FLD(161,LWRFLD)!FLD(121,UPRFLD)
CH%UPR! FLD(162,LWRFLD)!FLD(122,UPRFLD)
CH%UPR! FLD(163,LWRFLD)!FLD(123,UPRFLD)
CH%UPR! FLD(164,LWRFLD)!FLD(124,UPRFLD)
CH%UPR! FLD(165,LWRFLD)!FLD(125,UPRFLD)
CH%UPR! FLD(166,LWRFLD)!FLD(126,UPRFLD)
CH%UPR! FLD(167,LWRFLD)!FLD(127,UPRFLD)
CH%UPR! FLD(170,LWRFLD)!FLD(130,UPRFLD)
CH%UPR! FLD(171,LWRFLD)!FLD(131,UPRFLD)
CH%UPR! FLD(172,LWRFLD)!FLD(132,UPRFLD)
FLD(133,LWRFLD)!FLD(133,UPRFLD)
FLD(134,LWRFLD)!FLD(134,UPRFLD)
FLD(135,LWRFLD)!FLD(135,UPRFLD)
FLD(136,LWRFLD)!FLD(136,UPRFLD)
FLD(137,LWRFLD)!FLD(137,UPRFLD)
FLD(140,LWRFLD)!FLD(140,UPRFLD)
CH%DWN! FLD(141,LWRFLD)!FLD(101,UPRFLD) ;a
CH%DWN! FLD(142,LWRFLD)!FLD(102,UPRFLD)
CH%DWN! FLD(143,LWRFLD)!FLD(103,UPRFLD)
CH%DWN! FLD(144,LWRFLD)!FLD(104,UPRFLD)
CH%DWN! FLD(145,LWRFLD)!FLD(105,UPRFLD)
CH%DWN! FLD(146,LWRFLD)!FLD(106,UPRFLD)
CH%DWN! FLD(147,LWRFLD)!FLD(107,UPRFLD)
CH%DWN! FLD(150,LWRFLD)!FLD(110,UPRFLD)
CH%DWN! FLD(151,LWRFLD)!FLD(111,UPRFLD)
CH%DWN! FLD(152,LWRFLD)!FLD(112,UPRFLD)
CH%DWN! FLD(153,LWRFLD)!FLD(113,UPRFLD)
CH%DWN! FLD(154,LWRFLD)!FLD(114,UPRFLD)
CH%DWN! FLD(155,LWRFLD)!FLD(115,UPRFLD)
CH%DWN! FLD(156,LWRFLD)!FLD(116,UPRFLD)
CH%DWN! FLD(157,LWRFLD)!FLD(117,UPRFLD)
CH%DWN! FLD(160,LWRFLD)!FLD(120,UPRFLD)
CH%DWN! FLD(161,LWRFLD)!FLD(121,UPRFLD)
CH%DWN! FLD(162,LWRFLD)!FLD(122,UPRFLD)
CH%DWN! FLD(163,LWRFLD)!FLD(123,UPRFLD)
CH%DWN! FLD(164,LWRFLD)!FLD(124,UPRFLD)
CH%DWN! FLD(165,LWRFLD)!FLD(125,UPRFLD)
CH%DWN! FLD(166,LWRFLD)!FLD(126,UPRFLD)
CH%DWN! FLD(167,LWRFLD)!FLD(127,UPRFLD)
CH%DWN! FLD(170,LWRFLD)!FLD(130,UPRFLD)
CH%DWN! FLD(171,LWRFLD)!FLD(131,UPRFLD)
CH%DWN! FLD(172,LWRFLD)!FLD(132,UPRFLD) ;z
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)
;Flags for commands
CM.ATS==1B0 ;Atsign is meaningful for this command
CM.0AI==1B1 ;it is illegal to have 0 args before the command
CM.1AI==1B2 ;it is illegal to have only 1 arg 'fore the cmd
CM.2AI==1B3 ;it is illegal to have 2 args before this command
CM.NAI==CM.2AI!CM.1AI ;no args allowed before this command
CM.MOD==1B4 ;this command modifies the buffer
CM.OPR==1B5 ;this is a binary operator (could be unary also)
CM.EXE==1B6 ;this command is to be executed while scanning
CM.PRE==1B7 ;this is a command prefix char (^ ;)
;Reserved 1B9 and 1B8
CM.OFS==777B17 ;this field contains 0 or the offset to ARGTAB
CM.ADR==777777 ;this field is the address to PUSHJ to,
; or Prefix value to if CM.PRE is set.
;Prefix character types (index into PREPTR)
PRE.NO==0 ;No prefix character seen
PRE.SM==1 ;Semicolon character seen
PRE.UP==2 ;Uparrow prefix seen
PRE.CL==3 ;Colon seen
PRE.AT==4 ;Atsign seen
;Argtypes, used in scanning over commands. These end up in strings at ARGTAB.
CS.STP==0 ;End of argtype string
CS.SY1==1 ;Followed by one symbol
CS.QRG==2 ;followed by Qreg name
CS.DIG==3 ;followed by a digit string, len .GE. 0
CS.STR==4 ;followed by a simple string (no special ^x chars)
CS.INS==5 ;followed by insert string or filename
CS.SRS==6 ;followed by a search string
NBACS==3 ;Number of bits to hold largest of Argtype values
ILLEG==0 ;illegal command
NOFLG==0 ;no flags for this command
;This macro sets up the command table for TV. It contains the flags needed to
;to parse the commands or scan over them while scanning (SCANF flag) is being
;done.
DEFINE CTR%(CHAR,FLAGS,ADDR,TYPES),<
ifn FLAGS&<0,,-1>,< ;;if any flags are in the RH...
FOAD <Command table error, flags in RH> >
%%'CHAR==0 ;;assume no argtype string will be needed
irp TYPES,< ;;get the first arg in TYPES (or -1)
%TMP==TYPES ;;..
stopi> ;;stop after first
ifg %TMP,< %%'CHAR==1-ARGTA1+<[BYTE(NBACS)TYPES ,CS.STP]>>
;;if there is a real string, point to it.
EXP FLAGS!<%%'CHAR,,ADDR> ;;punch out the word
PURGE %%'CHAR> ;;and toss out the unneeded symbol
;This macro is used to call the above. It passes the decimal expansion of the
;character's ascii value (so CTR% can produce a unique symbol, %%nnn) and
;fills in reasonable defaults. It creates the symbols in order. The args are:
; A Address to jump to
; F flags approprate to this command (see CM.xxx)
; T Trailing argtypes (see CS.xxx)
DEFINE CT%(A<ILLEG>,F<0>,T<-1>),<
IFNDEF %%TMP,<%%TMP==0>
CTR% \<%%TMP>,F,A,<T>
%%TMP==%%TMP+1>
;Off the listing to punch out any literals made so far - must be done right
; before CMDTAB.
XLIST
LIT
LIST
;Punched!
;Main Command table here
CMDTAB:
CT% ;^@
CT% COMM ,CM.NAI!CM.ATS ,<CS.STR> ;^A
CT% CCOND ,CM.0AI!CM.2AI ,<CS.SY1> ;^B
CT% ;^C
CT% CALDDT ;^D
CT% FFEED ,CM.2AI ;^E
CT% FITER ,CM.2AI ;^F
CT% DECDMP ;^G
CT% GTIME ;^H
CT% TAB ,CM.NAI!CM.MOD ,<CS.INS> ;^I
CT% CFLUSH ;^J
CT% ;^K
CT% CTRLL ;^L
CT% CFLUSH ;^M
CT% ALTFLW ,CM.2AI ;^N
CT% ;^O
CT% ;^P
CT% QCVAL ,CM.ATS ,<CS.QRG> ;^Q
CT% RNGE ,CM.0AI ;^R
CT% ;^S
CT% SPTYI ;^T
CT% ;^U
CT% VRSN ;^V
CT% ;^W
CT% SSERCH ,CM.2AI ;^X
CT% ARRY ,CM.ATS ;^Y
CT% ;^Z
CT% CFLUSH ;ESC
CT% ;^\
CT% HLFWRD ,CM.0AI!CM.ATS ;^]
CT% CNTRUP ,CM.NAI ,<CS.SY1> ;^^
CT% DUJSI ,CM.0AI ;^_
UPALEN=.-CMDTAB ;END OF ^ COMMAND RANGE
CT% SPACC ,CM.OPR ;SPACE
CT% EXCLAM ,CM.EXE ;!
CT% DQUOTE ,CM.2AI!CM.EXE ,<CS.SY1> ;"
CT% COR ,CM.OPR!CM.0AI ;#
CT% CFLUSH ;$ DOLLARSIGN
CT% PCNT ,NOFLG ,<CS.QRG> ;%
CT% CAND ,CM.OPR!CM.0AI ;&
CT% APOST ,CM.EXE ;'
CT% OPEN ;(
CT% CLOSE ;)
CT% TIMES ,CM.OPR!CM.0AI ;*
CT% PLUS ,CM.OPR ;+
CT% COMMA ,CM.2AI!CM.0AI ;,
CT% MINUS ,CM.OPR ;-
CT% PNT ;.
CT% SLASH ,CM.OPR!CM.0AI ;/
CT% CDNUM ,CM.ATS ,<CS.DIG> ;0
CT% CDNUM ,CM.ATS ,<CS.DIG> ;1
CT% CDNUM ,CM.ATS ,<CS.DIG> ;2
CT% CDNUM ,CM.ATS ,<CS.DIG> ;3
CT% CDNUM ,CM.ATS ,<CS.DIG> ;4
CT% CDNUM ,CM.ATS ,<CS.DIG> ;5
CT% CDNUM ,CM.ATS ,<CS.DIG> ;6
CT% CDNUM ,CM.ATS ,<CS.DIG> ;7
CT% CDNUM ,CM.ATS ,<CS.DIG> ;8
CT% CDNUM ,CM.ATS ,<CS.DIG> ;9
CT% PRE.CL ,CM.PRE ;:
CT% PRE.SM ,CM.PRE ;;
CT% LSSTH ,CM.EXE ;LEFT ANGLE
CT% PRNT ,CM.0AI ;=
CT% GRTH ,CM.EXE ;RIGHT ANGLE
CT% QUESTN ;?
CT% PRE.AT ,CM.PRE ;@
CT% ACMD ;A
CT% ZERINA ;B
CT% CHARAC ,CM.2AI ;C
CT% DELETE ,CM.2AI!CM.MOD ;D
CT% ELINE ,CM.2AI ;E
CT% ;F
CT% QGET ,CM.MOD ,<CS.QRG> ;G
CT% HOLE ,CM.2AI ;H
CT% INSERT ,CM.2AI!CM.ATS!CM.MOD ,<CS.INS> ;I
CT% JMP ,CM.2AI!CM.ATS ;J
CT% KILL ,CM.MOD ;K
CT% LINE ,CM.2AI ;L
CT% MAC ,NOFLG ,<CS.QRG> ;M
CT% SERCHP ,CM.2AI!CM.ATS!CM.MOD ,<CS.SRS> ;N
CT% OG ,NOFLG ,<CS.STR> ;O
CT% PUNCH ,CM.MOD ;P
CT% QREG ,NOFLG ,<CS.QRG> ;Q
CT% REPLAC ,CM.2AI!CM.ATS!CM.MOD ,<CS.SRS,CS.INS> ;R
CT% SERCH ,CM.2AI!CM.ATS ,<CS.SRS> ;S
CT% TYPE ;T
CT% USE ,CM.2AI!CM.0AI ,<CS.QRG> ;U
CT% VIEW ;V
CT% WRDCOM ,NOFLG ,<CS.STR> ;W
CT% X ,CM.MOD!CM.ATS ,<CS.QRG> ;X
CT% DYANK ,CM.2AI!CM.MOD ;Y
CT% END1 ;Z
CT% OPENB ,NOFLG ,<CS.QRG> ;[
CT% BAKSL ;\
CT% CLOSEB ,NOFLG ,<CS.QRG> ;]
CT% PRE.UP ,CM.PRE ;^
CT% LARR ,CM.ATS!CM.2AI!CM.MOD ,<CS.SRS> ;_
CMDLEN=.-CMDTAB ;LENGTH OF COMMAND TABLE
;SEMTAB is just like CMDTAB, for SEMICOLON commands
SEMTAB:
CT% TCOND ; ;SPACE
CT% ; ;!
CT% ; ;"
CT% ; ;#
CT% ; ;$
CT% ; ;%
CT% TXZNC ,CM.0AI!CM.2AI ,<CS.QRG> ; ;&
CT% ; ;'
CT% ; ;(
CT% ; ;)
CT% ; ;*
CT% ; ;+
CT% ; ;,
CT% ; ;-
CT% ; ;.
CT% REMDIV ,CM.NAI ; ;/
CT% ; ;0
CT% ; ;1
CT% ; ;2
CT% ; ;3
CT% ; ;4
CT% ; ;5
CT% ; ;6
CT% ; ;7
CT% ; ;8
CT% ; ;9
CT% ; ;:
CT% ; ;;
CT% ; ;LEFT ANG
CT% UDFFLS ,CM.2AI ,<CS.STR> ; ;=
CT% ; ;RIGHT ANG
CT% ; ;?
CT% UDFFL ,CM.2AI ,<CS.QRG> ; ;@
CT% ; ;A
CT% ; ;B
CT% SEMIC ; ;C
CT% DNLD ; ;D
CT% DOFILE ,NOFLG ,<CS.INS> ; ;E
CT% ; ;F
CT% GETOB ,CM.MOD ; ;G
CT% DECDMP ; ;H
CT% OVWR ,CM.0AI!CM.2AI!CM.MOD ; ;I
CT% ; ;J
CT% ; ;K
CT% CNLINE ,CM.0AI!CM.1AI ; ;L
CT% MFILE ,CM.2AI ,<CS.QRG,CS.INS> ; ;M
CT% PIKNUM ,CM.2AI ; ;N
CT% ; ;O
CT% PICKUP ; ;P
CT% ; ;Q
CT% OPNRD ,NOFLG ,<CS.INS> ; ;R
CT% BSAVE ; ;S
CT% TPREG ,CM.2AI ; ;T
CT% UNLD ; ;U
CT% ; ;V
CT% OPNWR ,NOFLG ,<CS.INS> ; ;W
CT% EXCOM ; ;X
CT% YLOAD ,CM.NAI!CM.MOD ; ;Y
CT% ; ;Z
CT% SOPENB ,CM.0AI!CM.2AI ; ;[
CT% RAND ,CM.0AI ; ;\
CT% SCLOSB ,CM.NAI ; ;]
SEMLEN=.-SEMTAB
IF2, <PURGE CTR%,CT%>
PURGE %TMP,%%TMP
ZEROW: ;Guaranteed zero word.
ARGTAB: 0 ;0 offset to ARGTAB is meaningless.
ARGTA1: LIT ;the macros defined strings in literals -
; punch them out as an array at ARGTAB
;START HERE FOR DEBUGGING. THIS ENTRY MAKES TV THINK YOU STARTED
;IT WITH THE COMMAND "TV FOO.BAR"
IFN FTDEB,<
DEBUG: HRROI A,[ASCIZ /TV FOO.BAR
/]
RSCAN%
JSHLT
SETOM VIRGIN ;SO RSCAN STUFF HAPPENS ON RESTART
JRST TECO
>
;STARTUP TIME INITIALIZATION
TECO: RESET%
XMOVEI A,20
TLNE A,-1 ;ARE WE IN A NON-ZERO SECTION?
JRST [HRROI A,[ASCIZ/
?TV does not run in non-zero sections; those sections are reserved for data./]
PSOUT%
HALTF%
JRST TECO] ;YES, DIE NOW
;**;[512] At TECO: +1L, Inserted 4 lines SM 9-Jul-82
MOVE A,[SIXBIT/TV/] ;[512] SET UP FOR SETSN
MOVE B,A ;[512] BOTH NAMES TO "TV"
SETSN% ;[512] SET IT
ERJMP .+1 ;[512] IGNORE NON-EXISTANT ERROR RETURN
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 FF,0 ;CLEAR FLAG REGISTER
;**;[503] At TECO: +53L, Deleted 1 line SM 24-Mar-82
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
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,[POINT 7,BBUF1] ;INITIALIZE POINTER TO BACKUP BUFFER
MOVEM A,BBPTR
MOVEM A,BBUFX
SETZM WTOGGL ;START WITH FIRST WINDOW
SETO A, ;GET INFO ABOUT OUR JOB.
HRROI B,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,.PRIOU ;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,[7B5!OF%RD]
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
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: TXZE FF,RSCNF2 ;RESCANNED DATA AVAILABLE?
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,CPOPJ ;JUST RETURN IF NONE
MOVN C,A ;THAT MANY TO READ
MOVEI A,.PRIIN ;READ FROM PRIMARY
SETZ B, ;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>
IFN FTRSC,< ;;DO RESCANS ON RESTARTS?
SKIPE VIRGIN
RET > ;IF PROGRAM IS RESTARTED, NO MESSING ALLOWED
SETZM CREAF ;NOT CREATE COMMAND YET
SETZB A,ENTFLG ;NOT SURE HOW WE GOT HERE YET
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,CPOPJ ;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 OUT SIXBIT NAME IN c
MOVE P1,[POINT 6,C] ;AND A BYTE POINTER TO IT IN p1
MOVE P2,[POINT 7,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
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) ;YES?
JRST RSCANR ;CONTINUE COMPARING NAME
MOVEI P1,1 ;IF "EDIT" WE WILL STORE 1 IN ENTFLG
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
HRROI B,[ASCIZ /PERUSE/]
STCMP%
JUMPE A,RSCANE ;PERUSE?
HRROI A,ATMBFR ;NOT "EDIT", MAYBE "CREATE"
HRROI B,[ASCIZ /CREATE/]
STCMP%
JUMPE A,[SETOB P1,CREAF ;YES, "CREATE", AND ENTFLG WILL BE -1
JRST RSCAN2]
RET ;NOT RECOGNIZABLE COMMAND, DON'T USE RESCANNED DATA
RSCANE: TXO FF,PERUS
RSCAN2: MOVEM P1,ENTFLG ;SO USER CAN GET THE WAY WE ENTERED
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
MOVEI A,[CMOFIX] ;READ OUTPUT SPEC
CALL RFIELD
JRST RS3 ;DON'T OPEN OUTPUT FILE IF CAN'T READ NAME
RS3A: 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
JRST CPOPJ1 ;SKIP TO MARK THAT COMMAND LINE WAS GIVEN
RSOUT: MOVEI A,[CMOFIX]
CALL READFL
JRST RS3A
;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,ZEROW ;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,.PRIOU ;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
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
JRST CPOPJ1
;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
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
JRST CPOPJ1 ;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,.PRIIN
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
FTUVAL: EXP FTUNS ;STORE THE ASSEMBLY FLAGS
FTESEC: EXP MAXSEC ;STORE THE NUMBER OF SECTIONS ALLOWED
REE: MOVX A,PC%USR
MOVEI B,REE0 ;GET TO SECT 0 ALWAYS
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
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
;**;[503] At GO: +1L, Deleted 2 lines SM 24-Mar-82
TXZ FF,-1-TRACEF-FORM-UREAD-UWRITE-RSCNF2-DUMPF-PERUS
TXNE FF,DUMPF ;INTERRUPTED OUT OF LARGE OUTPUT?
CALL FIXOUT ;YES
MOVEI A,.FHSLF
EIR% ;MAKE SURE INTERRUPTS ARE ON
MOVEI A,^D10
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
;Extended buffer code
;This implementation was suggested by God. Please direct inquiries
; to Him.
SM%RWX==PM%RWX ;ACCESS WANTED TO SECTIONS
;This code will not work on a machine without extended addressing.
CDESEC=1 ;SECTION THE CODE AND DATA START IN
FDGSEC=MAXSEC+CDESEC ;FDGSEC IS WHERE WE GO TO CREATE XBLT HANDLER
IFG MAXSEC,< ;IF turned on, a lot of code is added.
IFG FDGSEC-37, FOAD <Unacceptable values for CDESEC and MAXSEC>
CDEL: TDZA A,A ;TELL THE CODE TO KILL A PIECE
CIN: SETO A, ;TELL THE CODE TO READ A PIECE
SKIPN MSECF ;HAVE WE DONE SAVES YET?
JRST EXTQE ;NO, SO WE CAN'T FIND ANYTHING
MOVEM A,SYL ;SAVE FUNCTION CODE FOR A SEC...
MOVX A,.FHSLF ;MUST DISABLE INTERRUPTS SO THEY DONT HAPPEN..
DIR% ;DURING NON-0 SECTION CODE
;From this point, errors must leave via RETCPY (to turn interrupt code back on)
MOVE A,SYL ;GET IT BACK
TXNE FF,ARG ;ANY ARGS?
CAIN C,0 ;OR ARG OF ZERO?
SETOM FARG ;DEFAULT BUFFER NAME IS -1
JRST GOSAV3 ;OK
COUT: TXNE FF,ARG ;ANY ARG?
CAIN C,0 ;OR ARG OF 0?
SETOM FARG ;DEFAULT BUFFER NAME IS -1
MOVX A,.FHSLF ;MUST TURN OFF INTERRUPTS FOR THIS
DIR% ;OFF...
SKIPE MSECF ;DONE ANY MULTIPLE SECTION STUFF?
JRST GOSAVS ;YES, SO SECTION CDESEC IS SET UP
;..
;This is "once only" code. It is done on the first call to COUT only
; (and calls to CDEL or CIN return errors if COUT was never called.)
;At the end, MSECF is set nonzero.
MOVSI A,.FHSLF ;WE NEED TO GO NON-0 TO GO THIS
MOVE B,[.FHSLF,,FDGSEC] ;.. USE A FAR OUT SECTION TO SET UP,
MOVX C,SM%RWX+SM%IND+1 ;WITH ALL ACCESSES, 1 SECT ONLY
SMAP% ;JUST LIKE SECTION 0
ERJMP SMAPQE
SETZ A, ;NOW CREATE SECTIONS CDESEC ON UP
MOVE B,[.FHSLF,,CDESEC] ;..
MOVX C,SM%RWX+MAXSEC ;VIRGIN WITH ALL ACCESSES
SMAP%
ERJMP SMAPQE ;SNH
XJRSTF [PC%USR
FDGSEC,,COUATL] ;INTO CODE IN SECTION FDGSEC FOR XBLTS
;.. INTO SECTION FDGSEC ..
COUATL: MOVEI A,CDLEN1 ;XBLT THE CODE FROM SECT 0 TO SEC CDESEC
MOVEI B,CDFDG
MOVE C,[CDESEC,,BTRF]
EXTEND A,[XBLT] ;..
MOVEI A,VAR1E-VAR1SP+1 ;NOW CLEAR THE CDESEC VARIABLE SPACE
MOVE B,[CDESEC,,VAR1SP]
MOVE C,[CDESEC,,VAR1SP+1]
EXTEND A,[XBLT] ;..
MOVEI A,2 ;AND PUT IN THE 2 WORDS AT NPGES1
MOVEI B,[EXP <MAXSEC*1000*1000-NPGES1-1000>,0]
MOVE C,[NPGES1]
EXTEND A,[XBLT] ;THIS INITIALISES THE FREESPACE
XJRSTF [PC%USR
0,,COUT1] ;NOW BACK TO SECT 0
;.. BACK TO SECTION 0 ..
COUT1: SETO A, ;NOW DESTROY SECTION FDGSEC, ITS NOT NEEDED
MOVE B,[.FHSLF,,FDGSEC]
MOVEI C,1
SMAP% ;..
ERJMP .+1 ;IF CANT, DONT CARE
SETOM MSECF ;OK, WE HAVE THE UNIVERSE SET UP NOW
GOSAVS: MOVE A,ZEE ;GET CHARACTER POSITION OF END
CALL MOVHOL ;MOVE HOLE TO END SO NEEDN'T SAVE IT
SETO A, ;"INDEX" INTO LIST OF ITEMS WE ARE BUILDING
MOVE B,[BFINFO,,BFINFE] ;THIS SAVES PT, ZEE, ETC.
ADDI A,1 ;+1 FOR EACH ENTRY
MOVEM B,MVELST(A) ;FOR SAVING BUFFER
MOVE B,ZEE
SUB B,BEG ;HOW MANY CHARACTERS? (HOLE IS AT END)
IDIVI B,5 ;MAKE THAT A WORD LENGTH
ADDI B,2 ;AND DONT MISS ANYTHING
HRLI B,MTBUF0 ;PUT BUFFER START IN LH, LEN IS IN RH
ADDI A,1 ;NOW STORE THIS ENTRY
MOVEM B,MVELST(A)
;..
;Come here to gate to code at BTRF in section CDESEC. The "name" of the
;info wanted is in FARG, and A contains one of the following:
; -1 to read the info down into section 0 (RETRIEve)
; 0 to quamp the info named by FARG (DELETe Block)
; 1 or more to save the information in section 0 referenced by the MVELST
; array into an extended section. In this case, A is the highest
; index valid in MVELST.
GOSAV3: MOVE C,FARG
XJRSTF [PC%USR
CDESEC,,BTRF] ;AND GO
SMAPQE: MOVEI P1,3 ;THE ERROR CODE FOR NO SMAP MESSAGE
;.. ;AND FALL INTO RETCPY
;Back here after BTRF has run. Always come here (to reenable interrupts).
;P1 contains 0 if all ok, .GT. 0 is an error index.
RETCPY: MOVX A,.FHSLF
EIR% ;REENABLE INTERRUPTS
JUMPG P1,EXTQE-1(P1) ;ERROR? GO TO CORRECT MESSAGE
TXZN FF,ARG2 ;NO ERROR. IF 2 ARGS...
JRST CFLUSH ;NO
MOVE P1,SARG ;THEN CHECK FOR FLAGS
TXNE P1,1 ;1B35=HK
CALL HK
JRST CFLUSH ;NO MORE FLAGS
EXTQE: ERROR <Cannot find that saved buffer> ;1
ERROR <Extended buffer space exhausted> ;2
ERROR <SMAP not available> ;3
;Punch out Literals so there aren't problems with literals in wrong sections.
;Listing off for neatness
XLIST
LIT
LIST
;The following code ends up in section CDESEC starting at BTRF. It lives there
;so the XBLTs between section 0 and other sections will work.
;The values of A and C are important here.
BTRF==140
CDFDG: PHASE BTRF ;THIS CODE GOES TO SECTION 1
MOVEM C,NAMEI ;SAVE INFO NAME
JUMPL A,RETRIE ;A.LT.0 MEANS RETRIEVE INFO NAMED (C)
JUMPE A,DELETB ;A.EQ.0 MEANS DELETE IT
MOVEM A,NUMBI ;NUMBER OF WORDS IN "COMMAND LIST"
ADDI A,1 ;CORRECT COUNT FOR XBLT
MOVEI B,MVELST ;ADDR, SECTION 0, OF "COMMAND LIST"
XMOVEI C,CMDLST ;TO COPY UP HERE FOR EASIER MANIPULATION
EXTEND A,[XBLT] ;..
MOVE C,NAMEI ;DOES THIS BLOCK EXIST NOW?
SETO D, ;USE TO POINT TO FIRST ZERO SLOT
MOVSI A,-NAMLEN ;GO AND SEE
NAMCHK: MOVE B,NAMLST(A)
CAME C,B ;MATCH?
JRST CCMPCK
JSP I,DELBA ;DELETE BLOCK REF'D BY WHERE(A)
JRST OPSLOT
CCMPCK: JUMPN B,NXTNAM ;IF A REAL NAME, SKIP 0 MEMORY
OPSLOT: CAIGE D,0 ;HAVE WE SEEN A ZERO LOC BEFORE?
HRRZ D,A ;NO, REMEMBER THIS ONE
NXTNAM: AOBJN A,NAMCHK ;OK, LOOK NEXT
JUMPL D,SPACQE ;IF NO OPEN SLOTS, GO COMPLAIN
MOVEM D,SLOT ;REMEMBER CHOSEN SLOT
SETZ A, ;COUNT UP NUMBER OF WORDS NEEDED
SKIPA B,CMDLST ;IN THE ARRAY AT CMDLST
CNTWRD: ADD B,CMDLST(A)
ADDI B,3 ;EACH SECTION NEEDS +3 WORDS
CAMGE A,NUMBI ;COUNTED UP COMMAND LIST?
AOJA A,CNTWRD ;NO, AGAIN FOR NEXT
MOVEI B,1(B) ;TOSS OUT LH, IT CONTAINS TRASH, ADD 1
XMOVEI C,FRELST
MOVE D,FRELST+1 ;POINT TO FREELIST
NXTCHK: CAMG B,(D) ;ENOUGH SPACE HERE?
JRST OKSPAC ;YES, WE CAN GO
MOVE C,D ;WE NEED THIS SO AS TO UPDATE FRELST LATER
SKIPE D,1(D) ;ADVANCE THROUGH CHAIN
JRST NXTCHK
SPACQE: MOVEI P1,2 ;OUT OF SLOTS
JRST LEAVE1
OKSPAC: MOVE A,SLOT ;GET SLOT CHOSEN
MOVEM D,WHERE(A) ;SAVE POINTER TO BLOCK
MOVE A,(D) ;HOW MANY HERE?
SUB A,B ;HOW MANY WILL BE LEFT?
MOVE P1,A ;COPY THE "SIZE LEFT"
SUBI P1,4 ;SEE IF LESS THAN 4
JUMPG P1,NOTALL ;JUMP IF 4 OR MORE LEFT
MOVE A,1(D) ;GET THIS WORD'S "NEXT" POINTER
MOVEM A,1(C) ;AND HAVE THIS BLOCK SKIPPED OVER
JRST GBLK
NOTALL: ADDB B,1(C) ;ADJUST POINTER DOWN BY NUMBER USING
MOVEM A,(B) ;SAY HOW MANY AT NEW BLOCK
MOVE A,1(D) ;GET OLD BLOCK'S NEXT POINTER
MOVEM A,1(B) ;COPY IT HERE
GBLK: MOVE A,SLOT
MOVE D,WHERE(A) ;GET START BLOCK ADDRESS
SETZ A, ;TIME TO SCAN CMDLST
XBLTLP: HRRZ B,CMDLST(A) ;LENGTH IN B
MOVEM B,(D) ;ALSO AT TOP OF BLOCK
MOVE C,D
ADDI C,3 ;POINT TO WHERE DATA WILL LAND
MOVEM C,1(D) ;TO MAKE FUTURE XBLTS EASY
HLRZ C,CMDLST(A) ;GET SECTION 0 ADDR OF INFO
MOVEM C,2(D) ;STORE THAT
ADDI D,3 ;ADVANCE POINTER TO BEGINNING OF DATA RANGE
EXTEND B,[XBLT] ;THIS COPIES THE DATA
SETZM (D) ;POINTS TO WORD AFTER, MAKE 0 (TO MARK END)
CAMGE A,NUMBI ;DONE LIST?
AOJA A,XBLTLP
MOVE A,SLOT ;WHERE DOES THIS GO?
MOVE C,NAMEI
MOVEM C,NAMLST(A) ;STORE NAME IN THAT SLOT
LEAVOK: SETZ P1, ;0 = OK
LEAVE1: XJRSTF [PC%USR
0,,RETCPY]
DELETB: MOVSI A,-NAMLEN
SETZ I, ;STAYS 0 IF NO NAMLST ENTRY MATCHES
DELB1: CAMN C,NAMLST(A)
JSP I,DELBA ;DELETE BLOCK AT WHERE(A)
AOBJN A,DELB1
JUMPN I,LEAVOK ;NONZERO IF JSP EVER DONE
TXNE FF,COLONF ;DOES USER CARE IF NOT FOUND?
JRST LEAVOK ;COLON SEEN, HE DOESNT CARE
JRST NFNDQE ;HE CARES, SET UP TO GIVE ERROR
RETRIE: MOVSI A,-NAMLEN
SCANR: CAMN C,NAMLST(A)
JRST GOTBLK
AOBJN A,SCANR
NFNDQE: MOVEI P1,1
JRST LEAVE1
GOTBLK: MOVE C,WHERE(A)
GNXTB: SKIPN B,(C) ;IS THERE DATA HERE?
JRST LEAVOK
DMOVE C,1(C) ;NEATLY LOAD C & D FOR XBLT
EXTEND B,[XBLT] ;BONZAI!
BONZAI=CDESEC,,. ;FOR FUN
JRST GNXTB ;GO SEE
DELBA: DMOVEM A,S1TMP ;SAVE A & B
DMOVEM C,S1TMP2 ;AND C & D
SETZM NAMLST(A) ;KILL THE NAME
MOVE D,WHERE(A) ;GET WHERE IT IS
MOVEM D,WHRKIL ;IT WILL BE KILLED
SETZ B, ;READY TO COUNT UP SPACE
MSBLK: SKIPN A,(D) ;ANY DATA HERE?
AOJA B,GKILL ;NO, ACCOUNT FOR 0 WORD AND GO KILL
ADDI B,3(A) ;COUNT UP SPACE
ADDI D,3(A) ;ADVANCE POINTER OVER BLOCK
JRST MSBLK
GKILL: MOVEM B,SIZKIL ;SAVE SIZE TO BE ADDED TO FRELST CHAIN
MOVE D,WHRKIL ;WHERE DOES IT START?
MOVEM B,(D) ;FIRST WORD OF FREEBLOCK IS LENGTH
XMOVEI C,FRELST
MOVE D,FRELST+1 ;GET ADDRESSES TO SCAN FRELST WITH
MOVE A,WHRKIL ;GET ADDRESS OF THIS BLOCK IN MEMORY
FPIFL: CAMG A,D ;ARE WE BELOW THE RIGHT PLACE?
JRST KILHRE
MOVE C,D ;TRAILING CHASER
MOVE D,1(D) ;GET THE NEXT ADDRESS
JUMPN D,FPIFL
KILHRE: MOVE A,1(C)
MOVE B,WHRKIL ;POINT TO BLOCK TO GO IN AGAIN
MOVEM A,1(B) ;SECOND WORD IS "WHERE NEXT"
MOVEM B,1(C) ;MAKE LAST BLOCK POINT TO NEW ONE
MOVE A,WHRKIL ;NOW SEE IF PMAPING CAN FREE PAGES UP
MOVE B,A ;THIS IS MERELY TO REDUCE SWAPPING SPACE STRAIN
ADD B,SIZKIL ;LENGTH+START YIELDS LOC+1 OF END
SUBI B,1 ;POINT TO END
LSH B,-9 ;GET PAGE #
SUBI B,1 ;LESS ONE
LSH A,-9
ADDI A,1 ;AND 1 DOWN FROM TOP FOR START PAGE
CAMLE A,B ;IS START PAGE .LE. THAN END PAGE?
JRST CHKSET ;NO, NO PMAP TO DESTROY PAGES
SUB B,A ;HOW MANY PAGES?
MOVEI B,1(B) ;+1 TO GET REPETITION COUNT
TXO B,PM%CNT ;SET IT SO
MOVE C,B ;AND PUT IN C FOR PMAP
HRRZ B,A ;GET FIRST PAGE # IN RH B
HRLI B,.FHSLF ;DONE TO SELF
SETO A,
PMAP% ;BLOW PAGES AWAY
ERJMP CHKSET ;OH, WELL
CHKSET: MOVE C,FRELST+1 ;GET WHAT FRELST POINTS TO TO START
CHKADJ: MOVE A,(C)
ADD A,C ;IF BLOCK LOC+BLOCK LEN IS
CAME A,1(C) ; .EQ. LOC NEXT BLOCK
JRST CHKAD2 ;(NO)
MOVE B,1(C) ;THEN THE LEN OF THE NEXT BLOCK
MOVE A,(B) ;GETS ADDED TO THIS ONE
ADDM A,(C) ;..
MOVE A,1(B) ;AND THE "WHERE NEXT" OF THAT BLOCK
MOVEM A,1(C) ;BECOMES THIS ONE (THE BLOCKS ARE COMBINED)
CHKAD2: SKIPE C,1(C) ;IF THERE IS A NEXT BLOCK
JRST CHKADJ ;THEN GO AGAIN
DMOVE A,S1TMP ;ALL DONE, RESTORE AC'S
DMOVE C,S1TMP2
SETZM WHERE(A) ;FOR NEATNESS
JRST (I) ;CALLED BY JSP I,
CDLENI=.-BTRF
XLIST
LIT
LIST
S1TMP: BLOCK 2
S1TMP2: BLOCK 2
WHRKIL: 0 ;LOC OF FIRST PAGE TO PMAP AWAY
SIZKIL: 0
NAMEI: 0
NUMBI: 0 ;# OF WORDS IN "COMMAND LIST"
SLOT: 0
CMDLST: BLOCK 30 ;DONT EXPECT MORE THAN 30 ENTRIES
VAR1SP: 0
NAMLEN==200 ;MAX NUMBER OF ENTRIES
NAMLST: BLOCK NAMLEN
WHERE: BLOCK NAMLEN
VAR1E==.-1
FRELST: 0 ;ZERO WORD FOR ALGORITHM TO CHEW ON
NPGES1 ;PAGE ADDRESS OF FREESPACE
NPGES1=CDESEC,,<.&777000>+1000 ;WHERE FIRST LOC OF FREESPACE IS
CDLEN1==.-BTRF+1 ;# OF WORDS TO COPY TO SEC CDESEC
DEPHASE
> ;END OF IFG MAXSEC
;Back to a semblence of reality.
;Routines to play with the array, part 1
WZERO: TXNN FF,ARG
SETZ C, ;If no value given, assume 0
EXCH C,USRARY ;Store user value, return old
WZERO1: MOVE B,[USRARY,,USRARY+1] ;Ready to propagate value
BLT B,USRARY+USARYL-1 ;Cascade it
JRST ARGINC ;And return value
WSUM: TXZN FF,ARG2 ;2 ARGS?
TDZA P1,P1 ;NO, SET PRECOMMA ARG TO 0
JUMPL P1,ARRYQE
CAIL P1,USARYL ;IN BOUNDS?
JRST ARRYQE
TXNN FF,ARG ;ONE ARG?
MOVEI C,USARYL-1 ;NO, PROVIDE THAT DEFAULT TOO
JUMPL C,ARRYQE
CAIL C,USARYL ;USUAL RANGE CHECK
JRST ARRYQE
CAMLE P1,C ;ARGS IN CANONICAL ORDER?
EXCH P1,C ;NO, SWITCH THEM FOR HIM
SKIPA A,USRARY(P1) ;BETTER THAN SETZ A, AND EXTRA ADD
WSUM1: ADD A,USRARY(P1) ;SUM IN NEXT ARRAY LOC
CAMGE P1,C ;WAS THAT THE LAST ONE REQUESTED?
AOJA P1,WSUM1 ;NO, ADD IN NEXT
JRST ARGINA ;YES, SUM IN A
IFN FTDEB,< ;NOT NORMALLY USED
;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
> ;end of FTDEB
;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 <
%Quota exceeded or disk full - expunging deleted files
>
SETZM QUOJFN ;CLEAR CELL SO WE DON'T LOOP
SETZ A, ;NO SPECIAL BITS
RCDIR% ;SEE WHICH DIRECTORY WE'RE WRITING TO
ERJMP OVR1 ;FAILED, SO GIVE REAL ERROR
SETZ A, ;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
JRST CFLUSH ;[502] DONE
;NOAUTO-EXPUNGE DISALLOWS AUTO-EXPUNGE TO BE DONE WHEN OVER QUOTA
NOAUTO: SETZM EXPFLG
JRST CFLUSH ;[502] DONE
;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
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
HALTED: CALL SYSMOD ;USER CONTINUED, GET NEW MODES
JRST CFLUSH ;[502] DONE
;INTERRUPT TO HERE WHEN USER TYPES CTRL/G
TTYINT: CALL SAVACS
MOVEI A,.PRIOU
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 A,"G"-100
PBOUT% ;DO DING
JRST IOER1 ;RETURN
TTYI1: MOVEI 1,.PRIIN
CFIBF% ;CLEAR INPUT BUFFER
SKIPE ABORTF ;FIRST REQUEST?
JRST TTYI2 ;NO, STOP IMMEDIATELY
JRST TTYI3
ABORT: PSTR <
Aborted
>
JRST REE1
TYOQT: MOVEI A,.PRIOU ;QUIT FROM TYPEOUT, CLEAR OUTPUT BUFFER
CFOBF%
JRST REE1
;IMMEDIATE STOP
TTYI2: MOVEI 1,.FHSLF ;JIC!
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
JRST CPOPJ1 ;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,^D150 ;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 A,.PRIOU
CFOBF% ;FLUSH OUTPUT
PSTR <^O...
>
SETOM COFLG ;SET FLUSH FLAG
XMOVEI B,20 ;GET SECTION # IN LEFT HALF
HRRZ A,LEV3PC ;SEE WHERE WE CAME FROM
TLNE B,-1 ;NON-ZERO SECTION?
HRRZ A,LEV3PC+1 ;YES, PC IS IN 2ND WORD
MOVSI B,(PC%USR)
CAIN A,TYOLOC+1 ;THE BOUT?
IORM B,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 B,IAC+A ;ASSUME JFN IN A
CAMN B,INJFN ;THE INPUT ONE?
JRST IOERI ;YES
CAMN B,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,.PRIOU
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: SKIPE SILFLG
JRST SHHH
PSTR <
End of >
MOVEI A,.PRIOU ;OUTPUT TO PRIMARY
MOVE B,TYIJFN ;TYPE FILESPEC BEING ENDED
SETZ C, ;PRINT IT IN STANDARD FORMAT
JFNS%
CALL CRR
SHHH: MOVE A,TYIJFN ;GET JFN WE'RE GETTING RID OF.
CLOSF% ;CLOSE THE FILE.
JFCL ;COULDN'T BUT DON'T WORRY.
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
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 ACCUM'D CHARS SINCE LAST UPDATE
CAMGE A,BAKLEN ;ENOUGH 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 KNOW # 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..
MOVE A,[<POINT 7,BBUF1>+<POINT 7,BBUF2>] ; AT RIGHT TIME
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
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,(POINT 7) ;CHANGE -1 TO 440700
TLC A,-1
TLCN A,-1
HRLI A,(POINT 7) ;CHANGE -1 TO 440700
MOVEM B,TFROM
MOVEM A,TWHERE
MOVEM C,TCNT
TU1: JUMPE C,CPOPJ ;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,,0]
MOVEM B,TWHERE ;REMEMBER THE POINT 7 VERSION
TRZ B,777000 ;GET RID OF PAGE NUMBER
SKIPN WTOGGL ;CHOOSE APPROPRIATE WINDOW
TROA B,FRKWIN ;GET BYTE POINTER AS TRANSLATED FOR OTHER FORK
TRO B,FRKWI2
MOVEM B,TPTR ;REMEMBER TRANSLATED POINTER
CALL SUBBP ;CALCULATE NUMBER OF BYTES WE CAN DO
MOVEM A,INUM ;REMEMBER HOW MANY WE CAN DO BEFORE UPING PAGE#
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
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, CHAR 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 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 CHAR RECEIVED..
MOVEM A,RDBFP ; FROM NON-TERMINAL
SETZ B,
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
PSOUT% ; STILL READING FROM NON-TERMINAL
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
SETO B, ;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
HRLOI 2,.FHSLF ;THIS FORK, LAST ERROR
SETZ 3,
ERSTR% ;PRINT ERROR MSG
JFCL
JFCL
CALL CRR
RET
IFN FTDEB,< ;NOT NORMALLY USED
;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,.PRIOU ;AND SAY TO PRINT ERROR ON TTY
SETZ C, ;SAY TO PRINT WHOLE MESSAGE
PSTR <
?>
HRLI B,.FHSLF
ERSTR% ;PRINT MESSAGE
JFCL
JFCL
CALLRET CRR
> ;END OF FTDEB
;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,.PRIOU
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) ;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
CAIGE C,0 ;DID THAT FETCH IT POSITIVE OR ZERO?
SETZ C, ;HE JUST INVENTED -0 (1B0)
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
TRNN B,-1 ;AT LEFT MARGIN?
AOS (P) ;YES
RET ;NO
;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
MOVSI B,(<BYTE(7)177>)
MOVEM B,CBUF
MOVE B,[POINT 7,CBUF]
MOVEM B,CPTR
CALL MFILE0 ;READ FILE INTO Q-REG AREA
CALL MAC0
CALL CFLUSH
JRST ICMD
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
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
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,.PRIOU
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!
TRNA ;NO SCREEN CLEARING IF PRESERVED OUTPUT!
CALL EOS ;CLEAR PAD FOR COMMAND TYPEIN
SKIPE SCRNF
CALL EOL ;ALWAYS CLEAR LINE IF DISPLAY TERMINAL.
CLEARM INTDPH ;INTDPH:=0
CLEARM PCISG
ZSYMT: CLEARM SYMS
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND
MOVE C,CBUFH
CALL SETOCP ;CALCULATE INITIAL OLD COMMAND POINTER
TXNN FF,RSCANF ;ARE WE RESCANNING?
JRST LINRS ;NO
MOVE B,[POINT 7,[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 EOBUFFER ALREADY DISPLAYED, <SP> NO-OPS.
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,[POINT 7,[ASCII /LT/]] ;
SKIPE SLENTH ;DON'T DO THE "T" IF A WINDOW IS BEING USED.
MOVE B,[POINT 7,[ASCII /L/]]
LI69NL: CAIE A,"^" ;UP ARROW?
JRST LI69NU ;NO.
MOVE B,[POINT 7,[ASCIZ /-LT/]]
SKIPE SLENTH ;NO "T" IF A WINDOW IS BEING USED.
MOVE B,[POINT 7,[ASCII /-L/]]
LI69NU: MOVE C,TRMTYP
CAIE C,12 ;ONLY VT05 HAS FUNNY ARROWS.
JRST LI83
CAIN A,C.UP
MOVE B,[POINT 7,[ASCII /-L/]] ;FIRST CHARACTER IS "UP ARROW"
CAIN A,C.DOWN
MOVE B,[POINT 7,[ASCII /+L/]] ;FIRST CHARACTER IS "DOWN ARROW"
CAIN A,C.RITE
MOVE B,[POINT 7,[ASCII /+C/]] ;FIRST CHARACTER IS "RIGHT ARROW"
CAIN A,C.LEFT
MOVE B,[POINT 7,[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,[POINT 7,[ASCII /-L/]] ;YES
CAIN CH,V52.DN
MOVE B,[POINT 7,[ASCII /+L/]]
CAIN CH,V52.LT
MOVE B,[POINT 7,[ASCII /-C/]]
CAIN CH,V52.RT
MOVE B,[POINT 7,[ASCII /+C/]]
CAIN B,0 ;ANY ESCAPE SEQUENCE CALCULATED?
LINONE: MOVE B,[POINT 7,[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
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%
MOVE A,RDDBP
MOVE B,CPTR
CALL SUBBP ;SUBTRACT POINTERS TO CALCULATE LEN 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: TXNE FF,TRACEF ;ARE WE TRACING?
CALL WINCLS ;YES, SO DON'T LET SCREEN WIPE OUT TRACINGS!
CALL CFLUSH ;[502] CLEAR MISC FLAGS
SETZM EXECOP ;[502] CLEAR THESE HERE
SETZM LASTOP ;[502] ..
JRST ICMD ;[502] GO DO WORK
;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
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
CAIE CH,.CHESC ;IS CHARACTER AN ESCAPE
AOS (P) ;YES, SO NO FLAG
RET ;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?
AOS (P) ;GIVE SKIP
RET
LI84: CAIN A,C.LEFT
MOVE B,[POINT 7,[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,[POINT 7,[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?
SKRCQE: 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,CPOPJ ;JUMP IF THERE ISN'T
MOVE CH,CPTR ;THERE IS, SO PEEK AT NEXT CHARACTER
ILDB CH,CH
JRST CPOPJ1
;GET CHARACTER W/O TRACE - USED WHEN SKIPPING IN CONDITIONALS
SKRCH1: SOSGE COMCNT ;ANY CHARACTERS LEFT?
JRST SKRCQE ;NO, GO ERROR
ILDB CH,CPTR ;YES. GET A CHARACTER.
RET ;RETURN.
;These blocks are used by the command "parser" to point to the proper
;range and table for each command type.
PREPTR: 0,,CMDPTR ;PREFIX TYPE 0 (NONE)
0,,SEMPTR ;PREFIX TYPE PRE.SM
0,,UPAPTR ;PREFIX TYPE PRE.UP
COLFLG,,CMDPTR ;PREFIX TYPE PRE.CL
ATSFLG,,CMDPTR ;PREFIX TYPE PRE.AT
COLFLG: COLONF
ATSFLG: SLSL
UPAPTR: 0,,CMDTAB ;USE MAIN TABLE FOR ^ COMMANDS
"@" ;OFFSET BY "@"
"@"+UPALEN ;LENGTH IS CONTROL CHAR RANGE
CMDPTR: 0,,CMDTAB ;UNPREFIXED COMMANDS
0 ;THERE IS NO OFFSET FOR THESE!
0+CMDLEN ;MAX LEGAL IS TABLE LENGTH
SEMPTR: 0,,SEMTAB ;SEMICOMMANDS USE SEMTAB TABLE
" " ;OFFSET BY SPACE
" "+SEMLEN ;MAX IS TABLE LENGTH OF SEMTAB
ICMD: SKIPE ABORTF ;<RUB>, ^G, I/O ERROR
JRST ABORT ;ARE ALL EXCUSES TO QUIT
SETZM DLIMIT ;NO FUNNY DELIMITERS WHILE SCANNING
ICMD2: CALL RCH ;GET THE COMMAND CHARACTER
CAIN CH,177 ;MAGIC EOC CHARACTER?
JRST [SETZM INIJFN
JRST GO] ;YES, END OF TV.INI
CAIE CH,140 ;EXPLICIT TEST FOR GRAVE, IT'S NOT AN ATSIGN
CAILE CH,172 ;ABOVE A LOWER CASE Z
JRST NOSUCH ;IS CONSIDERED ILLEGAL
CAIL CH,141 ;IS THIS CHARACTER LOWERCASE?
SUBI CH,40 ;YES, CONVERT TO UPPER CASE
MOVE A,PREFXC ;GET PREFIX TYPE (OR 0)
MOVE B,PREPTR(A) ;B POINTS TO RANGE/INFO BLOCK
HLRZ A,B ;LH (IF >0) IS LOC OF FLAGS TO OR IN
CAIE A,0 ;IS IT?
OR FF,(A) ;YES, OR IN FLAGS
SETZM PREFXC ;GOT TYPE, CLEAR PREFIX STATE
NPREFX: MOVE C,1(B) ;GET LOW LIMIT IN C
CAMG CH,2(B) ;DOES IT EXCEED THE UPPER BOUND?
CAMGE CH,C ;OR IS IT LESS THEN THE LOWER BOUND?
NOSUCH: ERROR <Undefined command> ;COMMAND LOSES
SUBM CH,C ;OFFSET BY LOWER BOUND AND STORE IN C
ADD C,(B) ;AND ADD POINTER TO PROPER TABLE
MOVE A,(C) ;PICKUP COMMAND INFO
HRRZ B,A ;GET DISPATCH ADDR, PREFIX TYPE OR 0
JUMPE B,NOSUCH ;IF ZERO, NONESUCH
TXNE A,CM.PRE ;IS THIS A PREFIX CHARACTER?
JRST [MOVEM B,PREFXC ;YES, STORE AS SUCH (TYPE IN B)
JRST ICMD2] ;AND GO GET THE REST OF THE COMMAND
TXNN A,CM.EXE ;IS THIS COMMAND EXECUTED EVEN WHILST SCANNING?
TXNN FF,SCANF ;NO, ARE WE SCANNING?
JRST GODO ;THIS COMMAND ACTUALLY GETS DONE
LDB A,[POINT 9,A,17] ;SCANNING - FETCH OFFSET INTO ARG TABLE
JUMPE A,ICMD ;IF ZERO, THIS COMMAND HAS NO TRAILING ARGS
MOVEI C,ARGTAB(A) ;ELSE FETCH THE POINTER TO THEM.
HRLI C,(POINT NBACS) ;STORED IN A STRING, BYTE SIZE NBACS
MOVEM C,SKPPNT ;STORE POINTER FOR ILDBing
SKPTRL: ILDB A,SKPPNT ;PICKUP TRAILING ARG TYPE
JUMPE A,ICMD ;IF ZERO, DONE SCANNING OVER TRAILING ARGS
CALL @SKPTAB(A) ;ELSE, GO DO ROUTINE TO SKIP THE TYPE OF ARG
JRST SKPTRL ;UNTIL ALL TYPES ARE DONE
GODO: TXNE FF,SCANF ;IF EXECUTING WHILE SCANNING...
JRST DOCALL ;THEN SKIP REST OF CHECKING, AND PUSHJ OUT
TXNE FF,SLSL ;IS ATSIGN SET FOR THIS COMMAND?
TXNE A,CM.ATS ;YES, IS IT MEANINGFUL?
SKIPA C,LASTOP ;YES, SKIP WITH LAST OP SEEN
ERROR <Atsign modifier seen for command that cannot accept it>
MOVEM C,EXECOP ;STORE OP TO DO AFTER THIS COMMAND
SETZM LASTOP ;AND LEAVE LASTOP EMPTY
MOVE C,FARG ;IT'S OK, GET THE FIRST ARG
TXNE A,CM.OPR ;IS THIS AN OPERATOR COMING UP?
MOVEM C,PREOPV ;STORE THE PRE-OP VALUE
TXNN FF,ARG ;IS THERE AN ARG HERE?
TXNN A,CM.0AI ;NO. IS THAT LEGAL?
SKIPA P1,SARG ;COMBO OK, PICK UP ANY SECOND ARG
AG0QE: ERROR <Argument is missing>
SETO T, ;ASSUME NO ARGS
TXNN FF,ARG ;IS THERE ONE?
JRST DOCALL ;NO, OK TO DO THIS COMMAND
TXNN FF,ARG2 ;YES, ARE THERE TWO?
TDZA T,T ;NO
MOVEI T,1 ;YES!
XCT [TXNN A,CM.1AI ;ONE ARG WHEN ONE IS ILLEGAL
TXNN A,CM.2AI](T) ;TWO WHEN TWO IS WRONG
JRST DOCALL ;NO, ITS OK, GO DO
CAIE T,0 ;WHICH ERROR?
AG2QE: ERROR <Two args where two args aren't allowed>
SKIPL EXECOP ;WEAK OP CARRYING A VALUE?
AG1QE: ERROR <Arg given where it isn't allowed>
SETZM EXECOP ;IT WAS MEANINGLESS, JUST KILL IT
SETO T, ;SET TO RIGHT NUMBER OF ARGS
TXZ FF,ARG ;AND SAY NONE, AND GO ON
;Commands branch here. They see the number of passed args -1 in T, the
;first arg (if any) in C, the second arg (if any) in P1.
DOCALL: CALL (B) ;GO DO IT
JFCL ;IN CASE SOMETHING HAS A SKIP RET
SKIPN A,EXECOP ;IS THERE AN OP TO DO?
JRST ICMD ;NO, GO GET NEXT COMMAND
SKIPN B,LASTOP ;DID WE JUST SEE ANOTHER OP?
JRST GODOOP ;NO, GO DO OP (IF ARGS ARE THERE)
JUMPG B,ICMD ;IF REAL LASTOP, LOSE ANY EXECOP
JUMPL A,ICMD ;WEAK LASTOP. IF EXECOP WEAK, REPLACE IT
DOP: MOVEM A,LASTOP ;WEAK LASTOP. DEFER EXECOP TO GET PAST SPACE!
JRST ICMD ;AND GO
GODOOP: TXNE FF,ARG ;GOT A GOOD EXECOP. GOT ARGS FOR IT?
JRST GARGOP ;GOT AN ARG TO OP ON
JUMPL A,DOP ;DONT. IF OP IS WEAK, DEFER IT
ERROR <Nothing returned a value after an Operator or Comma>
GARGOP: MOVE C,PREOPV ;GET PRE-OP ARG
MOVE B,FARG ;AND THE POST OP ONE
TXZE A,OPF.NG ;REQUEST 2ND ARG BE NEGATED FIRST?
MOVN B,B ;DONE
XCT BINFUN(A) ;AND DO THE BINARY FUNCTION
MOVEM C,FARG ;AND STORE RESULT
JRST ICMD ;GO GET NEXT COMMAND
;Table that indicates what function is to be done when a binary op becomes due.
;OP.nnn is used to index into it
OP.NOP==1
OP.ADD==2
OP.SUB==3
OP.MUL==4
OP.DIV==5
OP.AND==6
OP.IOR==7
OP.XOR==10
OP.ANC==11 ;AND /W COMPLEMENT
OPF.NG=1B18 ;NEGATE SECOND VALUE (A op -B)
;TRNA IS USED TO SKIP OVER THE MOVEM (IE, DO NOTHING)
BINFUN: TRNA ;NOT INDEXED BY 0
MOVE C,B ;USED IF "OP" DEMANDS TRAILING VALUE
ADD C,B ;ADD IS 2
SUB C,B ;SUB IS 3
IMUL C,B ;IMUL IS 4
CALL DODIVI ;IDIV IS 5, GO DO AND SAVE REMAINDER
AND C,B ;AND IS 6
IOR C,B ;OR IS 7
XOR C,B ;XOR IS 10
ANDCM C,B ;ANDCM IS 11
DODIVI: IDIV C,B ;IDIV IS 5
MOVEM D,DIVREM ;KEEP REMAINDER AROUND FOR THE ;/ COMMAND.
RET
;This table is index by the SC.xxx values. The represent the addresses of
;routines to CALL when a certain type of trailing arg is to be skipped
SKPTAB: 0 ;NOT INDEXED BY ZERO
SKRCH1 ;HERE TO SKIP ONE CHARACTER !CS.SY1
SKRCH1 ;HERE TO SKIP QREG (ONE CHARACTER) !CS.QRG
SKPDIG ;HERE TO SKIP A DIGIT STRING, LEN.GE.0 !CS.DIG
SKPSTR ;HERE TO SKIP SIMPLE STRING !CS.STR
SKPINS ;HERE TO SKIP INSERT STR !CS.INS
SKPSRS ;HERE TO SKIP SEARCH STRING !CS.SRS
;Skip a string of digits of length greater or EQUAL to zero.
SKPDIG: CALL PEEKCH ;CHECK NEXT CHAR IF ANY
RET ;NONE, NUMBER SKIPPED OVER
CAIN CH,"." ;IS IT THE OCTAL INDICATOR?
JRST SKRCH1 ;YES, READ IT, AND NUMBER ENDS HERE
CAIL CH,"0"
CAILE CH,"9" ;IS IT A DIGIT?
RET ;STOP ON NONNUMERIC
PUSHJ P,SKRCH1 ;SKIP THE DIGIT
JRST SKPDIG ;AND GO FOR NEXT CHAR
;Skip over a simple string, such as ^Atext$ uses.
SKPSTR: CALL GETDLM ;GO FIGURE OUT DELIMITER, STORE IN DLIMIT
SKPST1: CALL SKRCH1 ;SCAN UNTIL GOT IT
CAME CH,DLIMIT ;..
JRST SKPST1 ;NOT YET...
RET ;GOTCHA.
;Skip over an Insert string, such as Itext$ or Rtext1$text2$ uses.
SKPINS: CALL GETDLM ;GET DELIMITER INTO DLIMIT
SKPIN1: CALL SKRCH1 ;GET CHARACTER FROM STRING
CAMN CH,DLIMIT ;IS CHARACTER MEANING "END"?
RET ;YES, JUST LEAVE
CAIE CH,C.LOWR ;IS CASE OF NEXT CHAR BEING SHIFTED?
CAIN CH,C.RAIS ;..?
MOVEI CH,C.QUOT ;YES, TREAT EXACTLY LIKE QUOTING CHAR
CAIN CH,C.QUOT
CALL SKRCH1 ;WE ARE QUOTING SOMETHING, GOBBLE WHAT'S QUOTED
JRST SKPIN1 ;AND GO GET NEXT CHAR
;Skip over search strings. This can involve recursion and things of like
;messiness, esp. with ^N or ^E in the string.
SKPSRS: CALL GETDLM ;GET DELIMITER INTO DLIMIT
SKPSR1: CALL SKRCH1 ;GET INITIAL CHARACTER IN TOKEN
CAMN CH,DLIMIT ;IS IT END-OF-STRING?
RET ;YES, HAPPY DAYS
CALL IDNTKN ;GO SCAN OVER IF ITS A TOKEN
JRST SKPSR1 ;AND GET NEXT
IDNCHR: CALL SKRCH1 ;HERE IF IDNTKN NEEDS A NEW CHAR BUT CARES
;NOT ABOUT END-OF-STRING CHAR
IDNTKN: CAIN CH,"N"-100 ;IS IT THE ^N TOKEN?
CALLRET IDNCHR ;YES, FETCH NEXT TOKEN AND LEAVE
CAIE CH,^D17 ;IS IT OLD-STYLE QUOTE
CAIN CH,C.QUOT ;OR NEW STYLE QUOTE?
CALLRET SKRCH1 ;YES, READ A CHARACTER AND LEAVE
CAIE CH,"E"-100 ;IS IT AN ^E?
RET ;NO, ITS A SINGLE CHAR TOKEN, DONE
;(^X,^S need nothing special)
CALL SKRCH1 ;WHAT KIND OF ^E ARE YOU?
CAIN CH,^D60 ;AN OPEN ANGLE BRACKET?
JRST [CALL SKPDIG ;YES, SKIP THE NUMBER FOLLOWING...
CALL SKRCH1 ;AND WHAT SHOULD BE A CLOSEANGLE
RET] ;AND LEAVE
CAIE CH,"[" ;MAYBE HEAVY RECURSION AHEAD
RET ;NO, IT WAS ^Ex
CEBSCN: CALL IDNCHR ;RECURSION... "TURNING AND TURNING IN THE
;WIDENING GYRE..."
CALL SKRCH1 ;FETCH A CHARACTER, SHOULD BE ] OR ,
CAIN CH,"," ;LOOK AND SEE
JRST CEBSCN ;ITS A REQUEST FOR THE NEXT IN-^E TOKEN
CAIN CH,"]" ;IS THIS THE END OF THE ^E[] ?
RET ;GOOD, UNWIND
ERROR <Comma or "]" required, can't skip over string>
;This decides what the delimiter is for the string about to be scanned over -
;ie, ESC unless atsign form is indicated. The delimiter is returned in DLIMIT.
GETDLM: SKIPE DLIMIT ;DO WE ALREADY HAVE A KNOWN DELIMITER?
RET ;YES, USE IT
MOVEI CH,.CHESC ;DEFAULT STRING END IS <ESC>
TXZE FF,SLSL ;BUT IF ATSIGN FLAG IS LIT
TXNN A,CM.ATS ;AND IS NOT MEANINGLESS HERE
CAIA ;(NOT CHANGING DELIMITER)
CALL SKRCH1 ;THEN THE NEXT CHAR IS THE DELIMITER
MOVEM CH,DLIMIT ;STORE IT.
RET
;Routines to return args.
;CFLUSH is what CRET used to be (clears all args & flags)
;All commands should exit by JRSTing here, except for special convolutions and
; fudgery. Commands not changing the arguments may simply RET.
;The meanings are:
;
;ARGXNA - the command stores athe arg in AC A. This wont turn off SLSL or
; COLONF, but is otherwise like ARGINA. CDNUM needs this.
;ZERINA - command returns a 0
;NE1INA - command returns -1
;ARGINA - the command stores the arg in AC A. This makes sure that the one
; arg is on, unless two args have already been specified. This turns
; off SLSL and COLONF.
;ARGINC - same as ARGINA, except the arg is in AC C.
;ARGIN - lights the arg returned (ARG) flag. assumes arg(s) already stored
CFLUSH: TXZ FF,COLONF!FINDR!PCHFLG!SLSL!ARG2!ARG ;HERE TO TOSS OUT FLAGS
SETZM PREOPV
SETZM FARG ;CANT CLEAR EXECOP/LASTOP HERE
RET ;THE WORLD
ARGXNA: MOVEM A,FARG ;STORE THE ARG IN A
JRST ARGIN ;BUT DON'T MEDDLE WITH SLSL OR COLONF
ZERINA: TDZA A,A ;COMMAND RETURNS A ZERO
NE1INA: SETO A, ;COMMAND RETURNS A -1
ARGINA: MOVE C,A ;STORE THE ARG IN A
ARGINC: MOVEM C,FARG ;STORE THE ARG IN C
ARGINF: TXZ FF,SLSL!COLONF ;CLEAR THIS-COMMAND-ONLY FLAGS
ARGIN: TXO FF,ARG ;RETURNING AN ARG
CPOPJ: RET
;MAIN COMMANDS BRANCHED TO BY COMMAND PARSER START HERE.
SPACC: TXNN FF,ARG ;IS THERE AN ARG FOR ME?
RET ;NO, LEAVE THINGS JUST AS THEY ARE...
SKIPA A,[1B0+OP.ADD] ;SET LASTOP FOR OP ADD, 1B0 MEANS TENTATIVE
PLUS: MOVEI A,OP.ADD ;OPERATION REQUESTED IS ADD
SETBOP: MOVEM A,LASTOP
CAIL A,0 ;IF NOT A TENTATIVE OP,..
TXZ FF,ARG ;SAY NO ARG WAITING
RET
MINUS: MOVEI A,OP.SUB ;SUBTRACT
SKIPN EXECOP ;IS AN ARG WAITING?
JRST SETBOP ;GO SET BINARY OP CONDITION
MOVEI A,OPF.NG ;OH! THIS IS DIFFERENT...
XOR A,EXECOP ;REMEMBER OPERATION, BUT SAY TO NEGATE POSTOP
SETZM EXECOP
MOVEM A,LASTOP
RET ;AND GO PLAY
COMMA: MOVEM C,SARG ;STORE ARG
TXO FF,ARG2 ;TWO ARG2 CONDITION
TXZ FF,ARG ;BUT NOT ONE ARG CONDITION, YET.
MOVEI A,OP.NOP ;BINARY OP CONDITION FORCES FOLLOWING NUMBER
JRST SETBOP ;GO STORE AND RETURN
CAND: MOVEI A,OP.AND ;AND OPERATION
TXNE FF,COLONF ;:& FUNCTION?
MOVEI A,OP.ANC ;YES, AND WITH COMPLEMENT
JRST SETBOP
COR: MOVEI A,OP.IOR ;OR OPERATION
TXNE FF,COLONF ; :# FUNCTION?
MOVEI A,OP.XOR ;YES, XOR
JRST SETBOP
TIMES: MOVEI A,OP.MUL ;MULTIPLY OPERATION
JRST SETBOP
SLASH: MOVEI A,OP.DIV ;DIVIDE OP
JRST SETBOP
CDNUM: MOVEI C,-60(CH) ;[502] CONVERT FIRST DIGIT TO A VALUE
;**;[505] At CDNUM: +1L, Added 1 line SM 13-Apr-82
MOVE D,C ;[505] TWO COPIES; DECIMAL AND OCTAL
CDNUM1: CALL PEEKCH ;[502] GET NEXT DIGIT OR DOT, IF ANY
JRST ARGINC ;[502] NONE, THE VALUE IS IN C
CAIN CH,"."
JRST CDNUM2 ;[502] IF A DOT, MUST GO CONVERT TO OCTAL
CAIL CH,"0" ;[502] IS A DIGIT?
CAILE CH,"9" ;[502] ..
JRST [MOVE A,C ;[502] NO, SO WE ARE DONE
JRST ARGXNA] ;[502] GO EXIT OUT, PRESERVING FLAGS
IMULI C,^D10 ;[502] A POWER OF 10 UP...
ADDI C,-60(CH) ;[502] AND IN THE NEW LOWORDER DIGIT
;**;[505] At CDNUM1: +10L, Added 2 lines SM 13-Apr-82
LSH D,3 ;[505] GET OCTAL JUST IN CASE
IORI D,-60(CH) ;[505] AND ADD IN THE DIGIT.
CALL RCH ;[502] TOSS READ DIGIT
JRST CDNUM1 ;[502] AND GO GET NEXT
CDNUM2: CALL RCH ;[502] TOSS DOT OUT
;**;[505] At CDNUM2: +1L, Replaced 2 lines with 1 SM 13-Apr-82
MOVE A,D ;[505] GET THE OCTAL
JRST ARGXNA ;[502] RETURN WITH VALUE IN PLACE
RNGE: MOVM C,C ;GET MAGNITUDE OF FIRST ARG
TXZE FF,ARG2 ;IS THERE A SECOND ARG?
SUB C,P1 ;YES, SUBTRACT IT OFF
JRST ARGINC ;RETURN RESULT
VRSN: MOVE C,VRSNI
JRST ARGINC ;RETURN VERSION NUMBER FOR USER
QCVAL: 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
TXZE FF,SLSL ;@FORM?
JRST QABSOL ;YES, RETURN BYTE POINTER TO QREG...!
MOVE A,P1 ;GET QREG LEN IN A, IN CASE NO ARGS
TXNN FF,ARG ;ANY ARGS?
JRST ARGINA ;NO ARGS, JUST RETURN LENGTH
QCV2: SKIPLE FARG
CAMGE A,FARG ;IS REFERENCE WITHIN QREG LENGTH?
JRST QCVLQE ;NO, GO DECIDE ON ERROR TYPE
MOVE I,QTAB-"0"(C)
TLZ I,(-1B14)
ADD I,QRBUF
ADDI I,3
ADD I,FARG ;PUT CHARACTER ADDRESS INTO I
CALL GETX ;GET POINTER TO BYTE IN TT
MOVE C,SARG
LDB A,TT
TXZE FF,ARG2 ;READ OR WRITE?
DPB C,TT
JRST ARGINA
QCVLQE: TXNN FF,COLONF ;DID HE EXPECT THE WORST?
ERROR <Qreg character reference out of bounds>
JRST NE1INA ;RETURN -1 IF ILLEGAL (YES, UNCONVENTIONAL...)
QABSOL: MOVE I,QTAB-"0"(C)
TLZ I,(-1B14)
ADD I,QRBUF
ADDI I,3
CALL GETX
MOVE C,TT
JRST ARGINC
REMDIV: MOVE C,DIVREM
JRST ARGINC ;GET REMAINDER FROM LAST IDIV
RAND: TXNE FF,ARG
CAIN C,0
MOVEI C,^D100
SKIPE A,ISEED
JRST WRAND1
GTAD%
AND A,CONS4
CAIN A,0
MOVEI A,^D123457
MOVEM A,ISEED
WRAND1: MUL A,CONS3
DIV A,CONS4
MOVEM B,ISEED
MOVSI A,237K
DFAD A,[EXP 0,0]
FLTR C,C
FMP C,A
FIX C,C
JRST ARGINC
CONS3: ^D16807
CONS4: 17777,,-1
ARRY: TXNE FF,SLSL ;ATSIGN?
JRST [MOVEI A,USRARY ;@^Y RETURNS PHYSICAL LOC OF ARRAY!
TXNE FF,COLONF ;:@^Y RETURNS THE LENGTH OF THE ARRAY!
MOVEI A,USARYL
JRST ARGINA] ;DONE
JUMPL T,AG0QE ;IF NO ARGS, COMPLAIN BITTERLY
ARRY1: CAIL C,0 ;ILLEGAL ARRAY REFRENCE IF .LE. 0
CAIL C,USARYL ;IN LEGAL RANGE FOR ARRAY?
ARRYQE: ERROR <Reference to array is out of bounds>
MOVE A,USRARY(C) ;GET VALUE THAT IS THERE
TXZE FF,ARG2 ;DOES HE WANT TO STORE A NEW VALUE?
MOVEM P1,USRARY(C) ;YES, STORE IT FOR HIM
JRST ARGINA ;DONE
DUJSI: HLRZ A,FARG ;DID HE SPECIFY HIS OWN OPCODE/AC/ETC?
JUMPN A,DUXCT
MOVEI A,(JSYS) ;THE OPCODE OF A JSYS
HRLM A,FARG ;THE USER PROVIDED A JSYS NUMBER
DUXCT: DMOVE 1,USRARY+1 ;GET USER AC'S
DMOVE 3,USRARY+3 ;..
DMOVE 5,USRARY+5 ;..
SETOM USRARY+0 ;SET ERROR FLAG TO -1 (NO ERROR YET)
XCT FARG ;BE IT ON HIS OWN HEAD...
ERJMP DUJSIE ;HE LOSES
JRST CLNJSI
JRST CLNJSI ;SOME JSI HAVE MULTIPLE SKIPS
DUJSIE: DMOVEM A,USRARY+1
MOVEI A,.FHSLF ;GO DISCOVER WHAT HIS ERROR WAS
GETER% ;..
ERJMP CLNJS2 ;IT WONT FAIL.
HRRZM B,USRARY+0
JRST CLNJS2 ;WE ALREADY STORED AC1/2
CLNJSI: DMOVEM 1,USRARY+1
CLNJS2: DMOVEM 3,USRARY+3
DMOVEM 5,USRARY+5 ;RESTORE AC'S BACK
TXZN FF,ARG2 ;DOES HE WANT A WORD RETURNED?
JRST DUJEN1 ;NO, GO SEE IF HE WANTS ERRORS RETURNED
MOVE C,SARG ;THE SECOND ARG IS THE INDEX OF THE WORD
TXZ FF,SLSL ;CLEAR ATSIGN
JRST ARRY1 ;AND BECOME AN ARRY COMMAND
DUJEN1: TXNN FF,COLONF ;RETURN ERROR INDICATION OR -1?
JRST CFLUSH ;NOPE
MOVE C,USRARY+0 ;RETURN VALUE
JRST ARGINC ;AND DONE
HLFWRD: TXZE FF,SLSL ;ATSIGN FORM?
JRST SPLWRD ;YES, GO SPLIT LH,,RH
TXZN FF,ARG2 ;DID HE PROVIDE BOTH ARGS?
SETZ P1, ;NOPE, ASSUME ZERO
HRL C,P1 ;BUILD PRECOMMA ARG LH, POST RH
TXNE FF,COLONF ;ETO CHTO ONI KHOTCHUT?
MOVSS C ;NYET, TOVARISHCH, NYET...
JRST ARGINC ;UVIDIMSYA
SPLWRD: TXZE FF,COLONF ;CUANDO?
HLRZS C ;LA OTRA, POR FAVOR
ANDI C,-1 ;DAMELO,
JRST ARGINC ;Y ADIOS.
ENTFVR: MOVE C,ENTFLG
JRST ARGINC ;NO, GIVE USER THE ENTRY FLAG
UDFFLS: TXNN FF,ARG ;ARG GIVEN?
SETZM FARG ;NO, ASSUME ZERO
SKIPE CEYFLG ;DID SOME SEARCH USE THIS?
SETOM SRPF ;YES, MUST REPARSE
MOVEI CH,.CHESC ;ASSUME DELIMITER WILL BE ESCAPE
TXNE FF,SLSL ;WERE WE RIGHT?
CALL SKRCH ;NO, GET USER CHOICE
MOVEM CH,DLIMIT ;AND REMEMBER IN EITHER CASE
MOVE P1,FARG ;GET USER SELECTED COMMAND MODE
ANDI P1,3 ;0-3 ONLY
MOVX C,CH%USR ;WE WILL BE DIDDLING /W THIS FLAG
JUMPN P1,UDFFS1 ;IF NON-0, WE WILL NOT HAVE TO CLEAR THE ARRAY
MOVEI CH,177 ;ARRAY IS 177 LONG...
ANDCAM C,CHRTAB(CH) ;CLEAR THE BIT IN EACH ARRAY LOC
SOJGE CH,.-1 ;..
MOVEI P1,1 ;AND THE FUNCTION BECOMES 1
UDFFS1: SKIPE ABORTF ;^G TYPE INTERRUPT?
RET ;YES, GIVE UP NOW
CALL SKRCH ;NO, GET NEXT CHARACTER.
CAMN CH,DLIMIT ;DELIMITER?
JRST CFLUSH ;YES, ALL DONE!
XCT TDLTAB-1(P1) ;NO, DO THE FUNCTION BASED ON C & CH
JRST UDFFS1 ;AND GET NEXT CHARACTER
TDLTAB: IORM C,CHRTAB(CH) ;1=TURN ON
ANDCAM C,CHRTAB(CH) ;2=TURN OFF
XORM C,CHRTAB(CH) ;3=COMPLEMENT
UDFFL: MOVEI A,1 ;ASSUME DEF OF 1
TXNN FF,ARG ;DID HE GIVE AN ARG?
MOVEM A,FARG ;YES, STUFF AWAY FOR LATER
SKIPE CEYFLG ;DID SOME SEARCH USE THIS OPTION?
SETOM SRPF ;YES, WE WILL NEED A REPARSE
CALL QREGVI ;WHICH QREG?
MOVE C,A ;QTST WANTS THE ENTRY IN C
MOVEM C,SYL ;WE'LL WANT THIS AGAIN LATER
CALL QTST ;IS IT WHAT IT SHOULD BE?
JRST QGETQE ;NO. WE WANT TEXT!
CALL QGET2T ;HOW MANY CHARACTERS? INTO P1.
MOVE I,SYL ;GET THE ENTRY BACK
TLZ I,(-1B14)
ADD I,QRBUF
ADDI I,4 ;POINT AT QREG TEXT
MOVX A,CH%USR ;BIT TO TWIDDLE
SETZ P2, ;POINTER INTO CHARACTER ARRAY.
MLP1: SOSGE P1 ;DONE ALL CHARACTERS IN USER QREG YET?
SKIPA CH,FARG ;YES, USE DEFAULT
CALL GETINC ;NO, READ USER CHOICE
ANDI CH,3 ;PARSE DOWN TO 2 BITS
XCT TWITAB(CH) ;DO THE OPERATION REQUESTED
CAIGE P2,177 ;AT END OF TABLE?
AOJA P2,MLP1 ;NO, GET NEXT
JRST CFLUSH ;DONE NOW
TWITAB: ANDCAM A,CHRTAB(P2) ;0 INDEX, TURN BIT OFF
CAIL P2,177 ;1 INDEX, DO NOTHING (SAVES 1 INSTRUCTION...)
IORM A,CHRTAB(P2) ;2 INDEX, TURN ON BIT
XORM A,CHRTAB(P2) ;3 INDEX, COMPLEMENT BIT
;^F returns or modifies the iteration count
FITER: TXNE FF,COLONF
JRST [TXNN FF,ARG ;IS THERE AN ARG GIVEN?
SOSA C,ITERCT ;NO, ASSUME -1
ADDB C,ITERCT
JRST ARGINC] ;GO RETURN
TXNN FF,ARG
SKIPA C,ITERCT
JRST [MOVEM C,ITERCT
JRST CFLUSH]
JRST ARGINC
;^N BRANCHES TO THE BEGINNING OR END OF THE CURRENT ITERATION
ALTFLW: SKIPN INTDPH
JRST TCONQE ;IF NOT IN A LOOP, THIS IS AN ERROR
TXNE FF,COLONF ;IS THERE A COLON MODIFIER?
JRST ALTFL2 ;YES, GO HANDLE
TXNN FF,ARG ;IS THERE JUST AN ARG?
JRST RSLOP ;NO, JUST ^N - GO TO BEGINNING OF LOOP
MOVEM C,ITERCT ;n^N - GO ALTER ITERATION COUNT AND MAYBE LEAVE
JRST ALTFLM
ALTFL2: TXNN FF,ARG ;ARG GIVEN?
SOSA C,ITERCT ;NO, ASSUME -1
ADDB C,ITERCT ;YES, ADD IN AND RETURN VALUE
ALTFLM: JUMPLE C,INCMA ;IF 0 OR LESS, WE WANT TO LEAVE THIS LOOP
JRST RSLOP ;ELSE, WE WANT TO GET TO LOOP'S BEGINNING
;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: TXNN FF,PERUS
JRST EXCOM1
SETZM DEFSPC
SETZM DEFNAM
SETZM DEFEXT
EXCOM1: CALL UNLOAD ;DO A ;U COMMAND
;SEMICOLON H COMMAND JUST RETURNS TO EXEC
DECDMP: CALL SINK ;WAIT FOR COMMAND STRINGS TO BE SAVED
TXNE FF,COLONF ;IF : FORM, DONT BOTHER TO CLEAR SCREEN
JRST DOHALT ;JUST FLY AWAY
CALL CLRSCN ;CLEAR THE SCREEN
SETOM MESFLG ;ASSUME SCREEN MESSED UP IF RETURNING TO EXEC
JRST DOHALT ;DO A HALT
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: TXNE FF,FORM ;IS IT SET?
JRST NE1INA ;YES, GO RETURN -1
JRST ZERINA ;NO, GO RETURN 0
;AN ABBREVIATION FOR B,ZEE
HOLE: CLEARM SARG ;SET SECOND ARGUMENT TO 0.
TXOA FF,ARG2 ;RETURNING 2 ARGS
;.=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 ARGINA
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN
OPEN: POP P,CH ;[502] GET RETURN ADDRESS FOR LATER JRST
PUSH P,PREOPV ;[502] SAVE THE OPERAND
TXNE FF,ARG2 ;[502] IS THERE A SECOND ARG?
PUSH P,SARG ;[502] YES, SAVE IT
MOVE A,EXECOP ;[502] GET THE OP THAT'S DUE
SETZM EXECOP ;[502] CLEAR IT, IT'S NOT PENDING ANYMORE
TXNE FF,ARG2 ;[502] DID WE STORE A 2ND VALUE?
TLO A,(1B17) ;[502] YEAH, RIGHT, FLAG IT
PUSH P,A ;[502] AND SAVE THIS MESS
PUSH P,PARCHK ;[502] ADD ON PAREN HEADER
AOS LEV ;[502] INCREMENT ( LEVEL.
PUSH P,CH ;[502] PUT THE RETURN ADDRESS BACK
JRST CFLUSH ;[502] CLEAR ARG2 AND ALL ELSE
CLOSE: SOSGE LEV ;IS THERE A (?
CLOSX: ERROR <Unmatched right parenthesis>
TXZE FF,ARG2 ;2 ARGS AT CLOSE PAREN TIME?
ERROR <Two args given to a close parenthesis>
POP P,CH ;[502] FETCH OUR RETURN ADDRESS FOR LATER JRST
POP P,A ;[502] POP OFF THE "IS THIS A PAREN?" WORD
CAME A,PARCHK ;[502] IS THIS A PAREN?
JRST CLOSX ;[502] IT LOSES
POP P,A ;[502] GET OP & FLAGS
TLZN A,(1B17) ;[502] DID WE SAVE A SECOND ARG?
JRST CLOSY ;[502] NAY, SKIP THE 2ARG CODE
TXO FF,ARG2 ;[502] YES, MARK ITS COMING BACK
POP P,SARG ;[502] PUT IT BACK
CLOSY: POP P,PREOPV ;[502] RETURN PRE-OP VALUE
MOVEM A,EXECOP ;[502] STORE OP BACK
JRST (CH) ;[502] AND DONE (ACT LIKE RET)
PARCHK: 707070,,CLOSX ;[502] PAREN HEADER
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TXNN FF,COLONF ;DONT LOCK DOWN SCREEN IF COLON FORM
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,FARG ;GET THE NUMBER
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
TXNN FF,COLONF ;DONT CRLF IF COLON FORM
CALL CRR ;[502] CRLF AND...
JRST CFLUSH ;[502] DONE.
;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,FARG ;REMEMBER CHARACTER
CALL BCHAR ;BACKUP THE CHARACTER
JRST ARGINF ;[502] AND RETURN IT PROPER
;WDATE-AND-TIME INPUTS CURRENT DATE AND TIME INTO BUFFER
WDATIM: HRROI A,DATBUF ;POINT TO DATA BUFFER
SETO B, ;WE WANT CURRENT DATE AND TIME
SETZ C, ;NO SPECIAL FLAGS
ODTIM% ;GET THE DATE AND TIME
MOVE A,[POINT 7,DATBUF] ;GET POINTER TO THE STRING
CALL INSRTZ ;[502] INSERT IT...
JRST CFLUSH ;[502] AND RETURN
; ^H HAS THE VARIOUS TIMES
GTIME: TXNN FF,ARG
JRST GTMID
JUMPLE C,GTMID
CAIE C,1
JRST GRUNTM
GTAD%
JRST ARGINA
GRUNTM: MOVEM C,SYL
MOVX A,.FHSLF
RUNTM%
MOVE B,SYL
CAIE B,2
JRST ARGINC
JRST ARGINA
GTMID: SETO B, ;SAY WE WANT CURRENT TIME
SETZ D, ;NO SPECIAL FEATURES
ODCNV%
HRRZ C,D
JRST ARGINC ;AND RETURN
;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING.
CNTRUP: CALL RCH ;^^ HAS VALUE OF CHAR FOLLOWING IT
MOVE C,CH
JRST ARGINC
;^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
TXNN FF,ARG ;ARG GIVEN?
JRST ARGINA ;NO, RETURN PRESENT VALUE
MOVEM C,EXACTF ;SET NEW VALUE
SETOM SRPF ;REMEMBER TO REPARSE SEARCH
JRST CFLUSH
;wflaguppers$ - flag upper case letters
FLAGU: SETOM FLAGF ;SAY FLAGGING
MOVEI A,.PRIIN
RFMOD%
TXO B,TT%UOC ;FLAG UPPER CASE CHARACTERS
TXZ B,TT%LCA ;SYSTEM PREVENTS FLAGGING UNLESS THIS BIT OFF
STPAR% ;TELL SYSTEM
JRST CFLUSH ;[502] DONE
;wnoflag$ - flag nothing
NOFLAG: SETZM FLAGF
MOVEI A,.PRIIN
RFMOD%
TXZ B,TT%UOC ;CLEAR FLAG BIT
STPAR%
JRST CFLUSH ;[502] DONE
;wnoshift$ - don't change case of input
NSHIFT: MOVEI A,.PRIIN
RFMOD%
TXZ B,TT%LIC ;CLEAR "RAISE" BIT
STPAR%
JRST CFLUSH ;[502] DONE
;wraise$ - raise typed in lower case letters
TERRAS: MOVEI A,.PRIIN
RFMOD%
TXO B,TT%LIC ;SET "RAISE" BIT
STPAR%
JRST CFLUSH ;[502] DONE
;WSAVLEN$ - SET OR GET NUMBER OF CHARACTERS TO INPUT BETWEEEN SAVES.
BETSAV: MOVE A,BAKLEN ;GET CURRENT SETTING
TXNN FF,ARG ;DID USER SUPPLY ARGUMENT?
JRST ARGINA ;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
JRST CFLUSH ;[502] DONE
;WWIDTH$ - SET OR GET TERMINAL WIDTH
WTHSET: MOVE A,SWIDTH ;GET CURRENT SETTING
TXNN FF,ARG ;DID YOU SUPPLY ARG?
JRST ARGINA ;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
JRST CFLUSH ;[502] DONE
;ROUTINE TO SET TERMINAL WIDTH
;ACCEPTS: A/ NEW WIDTH
;RETURNS: +1: FAILED
; +2: WON
SETWID: MOVE C,A
MOVEI A,.PRIOU ;PRIMARY OUTPUT
MOVEI B,.MOSLW ;SET LINE WIDTH
MTOPR% ;TRY TO DO IT
ERJMP CPOPJ ;FAILED
JRST CPOPJ1 ;SUCCEEDED
;GET WIDTH INTO A, SKIP IFF SUCCESS
GETWID: MOVEI A,.PRIOU
MOVEI B,.MORLW
MTOPR%
ERJMP CPOPJ
MOVE A,C
JRST CPOPJ1
;GET PAGE (SCREEN) SIZE INTO A, SKIPS IFF SUCCESSFUL
GETLEN: MOVEI A,.PRIOU
MOVEI B,.MORLL
MTOPR%
ERJMP CPOPJ
MOVE A,C
JRST CPOPJ1
;WWINDOW$ - SET OR RETURN NUMBER OF SCREEN LINES USED FOR WINDOW
WINSET: MOVE A,SLENTH ;GET CURRENT SIZE OF WINDOW IN LINES
TXNN FF,ARG ;ARGUMENT TO COMMAND?
JRST ARGINA ;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
JRST CFLUSH ;[502] DONE
OPTION ENC,<
;WENCRYPT - SET/CLEAR ENCRYPTION FLAG
COMMENT ~
If this code is enabled, and the command nWENCRYPT$ is given, where
n is non-zero, the commands that read in files (;Y and related) will prompt
for a "password". This is a decryption keyword; the file is assumed to be
encoded. If it is not, type Carriage Return, and no decryption will be
applied. If the keyword is wrong, you will see the appearance of quantities
of trash in the buffer.
Also, output commands (;X and related) will ask for an encryption
keyword; as before, if just a Carriage Return is typed, no encryption will
be applied. For paranoia's sake, this is requested twice - the typed strings
must match. Case of letters does not matter.
If you interrupt TV during reads and writes when encryption is on,
the results are likely to be indeterminate - mostly, you will lose the
buffer.
0Wencrypt$ turns the encrypt functions off. Without an arg,
Wencrypt$ returns the value of the current flag. ~
ENCPT: MOVE A,ENCFLG
TXNN FF,ARG ;WANT VALUE OR SET VALUE?
JRST ARGINA ;RETURN
MOVEM C,ENCFLG
JRST CFLUSH
>
;WSILENCE - SET OR CLEAR ALLOWING "END OF..." MESSAGE AFTER ;Efile$
SETSHH: MOVE A,SILFLG
TXNN FF,ARG ;WANT VALUE OR SET VALUE?
JRST ARGINA ;RETURN
MOVEM C,SILFLG
JRST CFLUSH
;WPERUSE$ - GET OR SET PERUSE MODE BIT
WPERUS: TXNN FF,ARG
JRST WPERU1
TXNE C,1
TXOA FF,PERUS
TXZ FF,PERUS
JRST CFLUSH
WPERU1: TXNN FF,PERUS
JRST ZERINA
MOVEI C,1
JRST ARGINC
;WSCREENSIZE - SET OR RETURN NUMBER OF LINES EXISTING ON ENTIRE SCREEN.
SCNSET: MOVE A,SSIZE ;GET CURRENT SETTING
TXNN FF,ARG ;DID USER SUPPLY ARG TO COMMAND?
JRST ARGINA ;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
CALL WINSTN ;[502] SET UP STANDARD WINDOW SIZE
JRST CFLUSH ;[502] DONE
;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.
JRST CFLUSH ;[502] DONE
;WEDITREGULAR$ - FILTER LINE NUMBERS AS USUAL.
ERGLR: SETZM BASICF ;SAY TO FILTER THE LINE NUMBERS.
JRST CFLUSH ;[502] DONE
;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: TXNE FF,ARG ;WHICH KIND OF BACKSLASH?
JRST BAKSL1 ;ARG TO MEMORY
MOVEI A,^D10 ;SPECIFY DECIMAL
PKNM1: CALL PKNUM ;DO THE WORK
JRST ARGINA ;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 ARGINA
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: TXNN 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
JRST PICKQE
CALL GET ;CH:=CHARACTER TO THE RIGHT OF PT.
MOVE C,CH ;RETURN CH AS VALUE.
JRST ARGINC
PICKQE: TXNN FF,COLONF ;DID HE EXPECT THE ERROR?
ERROR <Pointer is at end of buffer>
JRST NE1INA ;YES, RETURN -1
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: TXNN 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: CALL QREGVI ;YES. CH:=Q-REGISTER INDEX.
EXCH C,QTAB-"0"(CH) ;STORE NEW, FETCH OLD
TXNE FF,COLONF ;COLON MODIFIED?
JRST ARGINC ;YES, GO RETURN OLD VALUE
JRST CFLUSH ;NO, DON'T.
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: CALL QREGVI
JRST ARGINA
; n;&I RETURNS THE VALUE IN I ANDED WITH n, AND THEN TURNS OFF THE BITS IN QI
; SELECTED BY n.
TXZNC: CALL QREGVI ;GET QREG AND VALUE
MOVE B,FARG ;AND GET ARG PASSED IN
AND A,B ;RETURN QREG CONTENTS AND'D WITH ARG
ANDCAM B,QTAB-"0"(CH) ;BUT TURN OFF THOSE BITS IN THE QREG
JRST ARGINA ;GOOD FOR ONCE-ONLY TESTS
;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"
QREGQE: ERROR <Illegal Q-reg name>
CAILE CH,"9"
CAIL CH,"A" ;CHECK FOR LONELY 7 BETWEEN DIGITS AND LETTERS
CAIA
JRST QREGQE
QREGVC: 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.
TXNE FF,COLONF ;DECR OR INCR?
SOSA C,QTAB-"0"(CH) ;DECREMENT Q-REG.
AOS C,QTAB-"0"(CH) ;INCREMENT Q-REG.
JRST ARGINC ;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 PTR TO Q-REG AND MAKE SURE NAME IS LEGAL
MOVEM CH,QNAM ;SAVE Q-REG NAME
TXNN FF,SLSL ;IF ATSIGN SEEN, DONT REMOVE TEXT!
CALL KLBUF1 ;NORMAL X, JUST REMOVE TEXT
MOVE CH,QNAM
MOVE C,OLDEBF
SUB C,QRBUF ;ADDRESS RELATIVE TO C(QRBUF)
TLO C,400000
MOVEM C,QTAB-"0"(CH) ;[502] MAKE QTAB ENTRY
JRST CFLUSH ;[502] DONE
;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 ;SAVE QREG POINTER
CALL QTST ;IS THERE TEXT THERE?
JRST [TXZN FF,COLONF ;NO, DO WE CARE?
JRST QGETQE ;YES, GO YITCH
POP P,CH ;NO, BALANCE STACK
JRST BAKSL1] ;AND GO INSERT IT AS A DIGIT STRING
CALL QGET2T ;GET NUMBER OF CHARS (1ST PART DONE BY QTST)
POP P,C ;Q-REG INDEX
JUMPLE P1,CFLUSH ;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 CFLUSH ;DONE
; ;T - TYPE CONTENTS OF Q REG
TPREG: CALL WINCLS ;START PRESERVED OUTPUT
TXNN FF,ARG
JRST COMM ;TYPE LITERAL STRING IF NO ARG
;(THIS GOES AWAY SOMEDAY. USE ^A.)
MOVE C,FARG ;[502] C GETS LOST BY SUBROUTINES
CALL QGET2
TPR1: JUMPE P1,CFLUSH
CALL GETINC
MOVE A,CH
CALL TYO
SKIPE ABORTF ;ABORTING?
JRST TYOQT ;YES
SOJA P1,TPR1
QTST: TLZN C,377770 ;TEST FOR TEXT IN QREG
TLZN C,400000
RET ;NONSKIP IF NO TEXT
MOVE I,QRBUF
ADD I,C
CALL GETINC ;GET FIRST CHAR
CAIN CH,141 ;141 MEANS THIS IS A QREG
AOS (P)
RET ;DONE W/ TEST
QGET2: TLZN C,377770 ;DOES Q-REG CONTAIN TEXT?
TLZN C,400000
JRST QGETQE
ADD C,QRBUF ;YES
MOVE I,C ;I:=Q-REG BUFFER ADDRESS
CALL GETINC ;IS FIRST CHARACTER IN BUFFER 141?
CAIE CH,141
QGETQE: ERROR <Qreg does not contain text>
QGET2T: 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
TXNE FF,ARG ;IS THERE AN ARGUMENT?
RET ;[502] YES. LEAVE THINGS ALONE THIS WAY
JRST CFLUSH ;NO. CLEAR FLAGS.
SOPENB: MOVE B,PF ;GET STACK
PUSH B,C ;PUSH VALUE IN C
MOVEM B,PF ;AND DONE
JRST CFLUSH ;..
SCLOSB: MOVE B,PF ;GET STACK
POP B,C ;RETURN A VALUE
MOVEM B,PF ;KEEP STACK POINTER
JRST ARGINC ;GO RETURN C
;UNLOAD (;U, ;D) COMMANDS
;**; At DNLOAD:, change label SM 4-Mar-82
DNLD: 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
CALL UNLOAX ;[502] DO A PROPER UNLOAD
JRST CFLUSH ;[502] DONE
UNLD: CALL UNLOAD ;[502] DO THE UNLOAD
JRST CFLUSH ;[502] AND RETURN PROPERLY
UNLOAD: SETZM DUNFLG ;SAY ;U MODE
;**; At UNLOAD: +1L, Added one label SM 4-Mar-82
UNLOAX: 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,2000 ;A LARGE NUMBER OF PAGES
TXO FF,ARG ;MAKE BELIEVE IT WAS TYPED IN
CALL PUNCH ;PUNCH THOSE PAGES
CALLRE CLOSEF ;CLOSE AND RENAME FILES
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,[POINT 7,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,.PRIOU ;AND DIRECT OUTPUT TO TTY
SETZ C, ;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
JRST CPOPJ1
;routine to store filename string in nambfr. pass it the jfn in a.
STORNM: MOVE B,A ;JFN IN B
STORN1: 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: SETZM SYL
TXZE FF,COLONF
SETOM SYL ;REMEMBER IF COLON FLAG ON
TXNN FF,UREAD ;FILE OPEN?
CALL YLD1 ;NO, GO OPEN ONE
CALL SINLDS
SKIPE SYL ;DOES HE CARE HOW MANY CHARS..?
JRST CFLUSH ;NO
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
>
JRST CFLUSH
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,.PRIIN ;DON'T CLEAR RESCAN FLAG YET IF NOT PRIIN
TXZ FF,RSCANF ;NOTE THAT WE'RE NOT RESCANNING ANYMORE.
JRST OPNIN ;GO OPEN THE FILE.
;FAST LOAD OF FILE USING SIN
SINLDS: SETZM YAMODE ;DOING ;Y NOT Y OR A
SINLD: STKVAR <LCS,FSPC>
SINLD2: TXZ 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 A,INJFN
MOVE OU,ZEE ;PUT FILE AT END OF BFR
CALL PUT ;COMPUTE BYTE PTR
CALL DBP ;BACKUP 1
MOVE B,TT ;SET IT FOR SIN
OPTION ENC,< ;FOR CODING
movem b,cdestr ;start decoding here
>
SKIPG C,FSPC ;GET NUMBER OF CHARACTERS WE CAN READ
JRST [ SKIPN YAMODE ;NO ROOM? IF NOT Y OR A...
ERROR <File too large for buffer> ;COMPLAIN
JRST CFLUSH] ;ELSE JUST RETURN
MOVN C,C ;MAKE NEG FOR SIN
PUSH P,C ;AND SAVE THAT WAY
SKIPN YAMODE ;Y OR A MODE?
JRST SUCKSI ;NO, ITS ;Y AND ;Y DOESNT *DO* <FF>
MOVN C,C ;Y OR A - MAKE IT POSITIVE AGAIN,
MOVEI D,"L"-100 ;AND STOP ON <FF>
SUCKSI: SIN% ;DO ALL OF FILE OR AS MUCH AS FITS
SUCKIN: SKIPE YAMODE ;DID WE NEGATE BEFORE?
MOVN C,C ;YES, ACCOUNT FOR THAT
POP P,TT
SUBM C,TT ;COMPUTE AMOUNT DONE
OPTION ENC,< ;FOR CODING ALGORITHM
movmm tt,cdecnt ;number bytes to read
>
ADDM TT,ZEE ;UPDATE Z
ADDM TT,HOLBEG ;NOTE THAT HOLE STARTS FURTHER TO THE RIGHT
OPTION ENC,<
skipe encflg
skipn cdecnt
jrst ncodes
push p,b
skipe cdewin ;need an input password?
jrst nopasw
call getpsd
setom cdewin ;we have one now
move b,cdewrd
movem b,cdewri
nopasw: movei a,cdewri
skipe (a)
call hack
ncode: pop p,b
ncodes:
>
LDB CH,B ;GET LAST CHAR STORED
MOVEM CH,LCS ;REMEMBER IT
CALL SETHPT ;SET HOLE POINTERS
MOVE A,INJFN ;RESTORE CLOBBERED JFN
GTSTS%
TLNE B,(1B8)
TXOA FF,FINF
TXZ FF,FINF ;FINF ON OR OFF FOR EOF
SKIPE YAMODE
JRST NCLSF ;DOING Y OR A, DONT TRY TO CLOSE FILE
TXNN FF,FINF ;DOING ;Y. EOF?
JRST SINLD2 ;NO, TRY S'MORE (PROB. AN I/O ERROR)
CALL CLSINF ;YES, NOW CLOSE OFF
NCLSF: MOVE CH,LCS ;GET LAST CHARACTER STORED
CAIN CH,"L"-100 ;IS LAST CHAR FORMFEED?
TXO FF,FORM ;YES
RET
OPTION ENC,< ;coding algorithm
;This code is not supported, principally because this is not an optimal
;encryption scheme.
;perhaps someday, it will be supported.
hack: movem a,whrcde
hackl: sosge cdecnt
ret
setcm a,@whrcde
rot a,5
move b,a
rot b,2
add a,b
jffo a,.+2
movei a,37424
addb a,b
tlnn b,100
xori a,653201
tlce a,401 ;an exercise in randomness
trce a,20004
xor a,[375001674315]
tlnn a,1002
rot a,6
trne b,1000
xor a,[130064220717]
movsm a,@whrcde
ildb b,cdestr
xor b,a
dpb b,cdestr
jrst hackl
>
;ER PREPARE TO READ FILE
OPNRD: TXNE FF,UREAD ;FILE NOW OPEN?
CALL CLSINF ;CLOSE INPUT FILE
CALL FILSPC ;GET FILE SPEC
MOVSI A,(1B2+1B17) ;OLD FILE+SHORT FORM
CALL DOGTJ ;DO GTJFN, AND REMEMBER FILENAME
JRST TYINPT
DPB CH,CPTR ;PUT ESCAPE BACK IN
OPNIN: HRRZM A,INJFN
HRROI A,DEFNAM ;GET COMPLETE NAME OF FILE JUST OPENED
MOVE B,INJFN ;FOR POSSIBLE LATER USE AS DEFAULT
MOVSI C,(1B8) ;NAME ONLY
JFNS%
HRROI A,DEFEXT
MOVSI C,(1B11) ;EXTENSION ONLY
JFNS%
ERJMP .+1
MOVE A,INJFN ;GET THE JFN
CALL SETFDS ;SET FILENAME DEFAULT STRING
MOVE A,INJFN
MOVE B,[7B5+OF%RD] ;BYTE SIZE+READ
SKIPE BASICF ;ARE WE FILTERING OUT LINE NUMBERS?
TXO B,OF%PLN ;NO. (MAYBE A "BASIC" FILE).
OPENF%
JRST TYNOPN
OPTION ENC,<
setzm cdewin ;New file, will need password
>
TXO FF,UREAD ;FILE OPEN
TXZ FF,FINF ;NOT EOF
OPNT2: TXNN FF,COLONF
JRST CFLUSH ;NO COLON, NO VALUE
JRST NE1INA ;IT WORKED, RETURN -1
;TYPE INPUT DEVICE ERROR
TYNOPN: MOVE A,INJFN ;RELEASE JFN
RLJFN%
JFCL
CAIA
TYINPT: DPB CH,CPTR ;UNCLOBBER COMMAND STRING
SETOM INJFN
FLERR: TXNE FF,COLONF
JRST ZERINA ;COLON FLAGGED, RETURN 0, NOT ERROR
CALL JSER
ERROR <File operation failed>
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)
OPNWR: CALL SKPWRT ;OUTPUT FILE NOW OPEN?
CAIA ;NO
CALL CLOSEF ;CLOSE IT
CALL FILSPC
MOVSI A,(1B0+1B3+1B17) ;WRITE+PRINT OLD/NEW+SHRT
CALL DOGTJ ;DO GTJFN AND REMEMBER FILESPEC
JRST OPNBAD
DPB CH,CPTR
OPNOUT: HRRZM A,OUTJFN
HRROI A,DEFNAM ;GET COMPLETE NAME OF FILE JUST OPENED
MOVE B,OUTJFN ;FOR POSSIBLE LATER USE AS DEFAULT
MOVSI C,(1B8) ;NAME ONLY
JFNS%
HRROI A,DEFEXT ;EXTENSION STRING
MOVSI C,(1B11) ;EXTENSION ONLY
JFNS%
MOVE A,OUTJFN
CALL SETFDS ;SET FILENAME DEFAULT STRING
MOVE B,[7B5+OF%WR]
MOVE A,OUTJFN
OPENF%
ERJMP OUTER1
OPTION ENC,<
setzm cdewon ;will need password
>
SETZM WRITEF ;MARK THAT NO OUTPUT HAS HAPPENED YET
TXO FF,UWRITE ;SAY WE HAVE OUTPUT FILE OPEN
OPNWR2: TXNN FF,COLONF
JRST CFLUSH
JRST NE1INA
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?
JRST CPOPJ1 ;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
JRST CPOPJ1 ;SAY OUTPUT FILE OPEN
;PUT HEADING INTO OUTPUT FILE
HEDING: MOVEI B,";"
CALL BOUTX
HRRZ B,OUTJFN
MOVE C,[1B5+1B8+1B11+1B14+1B35]
CALL JFNSX
HRROI B,[ASCIZ /, /]
SETZ C,
CALL SOUTX
SETO B,
SETZ C,
CALL ODTIMX
HRROI B,[ASCIZ /, Edit by /]
CALL SOUTX
PUSH P,A ;SAVE STRING POINTER
GJINF%
MOVE B,A
POP P,A
CALL DIRSTX
JFCL
MOVEI B,15
CALL BOUTX
MOVEI B,12
CALL BOUTX
RET
OUTER1: MOVE A,OUTJFN
RLJFN% ;RELEASE JFN
JFCL
SETZM CREJFN ;DON'T LET NEXT ATTEMPT USE SAME JFN
OUTERR: SETOM OUTJFN
JRST FLERR ;FILE ERROR, GO RETURN 0 OR ERROR
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
SEMIC: CALL CLOSEF
JRST CFLUSH
CLOSEF: CALL SKPWRT ;OPEN LATENT OUTPUT FILE NOW
JFCL ;WE DON'T CARE WHETHER THERE WAS ONE
TXZN FF,UWRITE!DUMPF
RET
CLOS2: MOVE A,OUTJFN
CLOSF%
JFCL
SETZM WRITEF ;MARK THAT NO DATA WRITTEN IN OUTPUT FILE
SETOM OUTJFN ; (ANYMORE...YET...WHAT HAVE YOU)
RET
;CLOSE INPUT FILE
CLSINF: TXZN FF,UREAD
RET
MOVE A,INJFN
CLOSF%
ERJMP .+1
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
;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: CALL YANKS
JRST CFLUSH
;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, (BULLSHIP!) OR
; (C) AN END OF FILE IS READ, OR
; (D) THE BUFFER IS COMPLETELY FULL.
;THE FORM FEED (IF PRESENT) DOES ENTER THE BUFFER.
DYANK: CALL YANK
JRST CFLUSH
YANK: TDZA I,I ;HK AND READ BUFFER COMES HERE (Y,N,P)
YANKS: SETO I, ;APPEND JUMPS HERE
TXNN FF,UREAD ;HAS AN INPUT FILE BEEN SPECIFIED?
YANKQE: ERROR <No file for input> ;NO.
SKIPE ABORTF ;ABORT REQUEST?
RET ;YES, DON'T CLOBBER BUFFER
SETOM YAMODE ;TELL SINLD THAT THIS IS Y OR A
CAIN I,0
CALL HK ;KILL ENTIRE BUFFER
JRST SINLD ;GO DO SIN STUFF
JRST CFLUSH
;^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,[POINT 7,[BYTE (7).CHTAB]] ;PREPARE TO INSERT TAB
MOVEI B,1 ;ONLY ONE CHARACTER
;**;[502] At TAB: +2L, REMOVE EDIT 500 IFF INSTALLED SM 4-Mar-82 (2 LINES)
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: TXNE 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.
TXNE 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
SETO B, ;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: 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
JRST CFLUSH ;[502] 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,CFLUSH ;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 CFLUSH
;WHOLE$ - RETURN CHARACTER LOC OF HOLE IN BUFFER
WHOLE: MOVE C,HOLBEG
SUB C,BEG
JRST ARGINC
;WBACKUP$ - TURN ON BACKUP SYSTEM
BACKUP: SETOM BAKFLG
JRST CFLUSH ;[502] DONE
;WNOBACK$ - TURN OFF BACKUP SYSTEM
NOBACK: SETZM BAKFLG
JRST CFLUSH ;[502] DONE
;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.
VTXXX: CALL SETPAR
JRST CFLUSH ;[502] SET PARAMETERS AND LEAVE
;WVT100 - DECLARE VT100 FLAVOR
VT100: MOVEI A,.TT100
MOVEM A,TRMTYP
SETOM SCRNF
JRST VTXXX
;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
JRST VTXXX ;[502] GO SETUP
;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
SFMOD% ; (FOR READING FIRST CHARACTER OF COMMAND)
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,.PRIIN
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,.PRIIN ;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
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 <0 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: MOVE A,[070700,,FARG] ;POINTER TO "STRING"
MOVEI B,1 ;WE'RE ONLY INSERTING ONE CHARACTER
CALL INSRT0 ;[502] INSERT IT
JRST CFLUSH ;[502] AND DONE
OVWR: MOVE I,PT ;WHERE ARE WE?
CAMN I,ZEE ;AT END?
JRST OVWRND ;YES, WILL HAVE TO USE INS1A
CALL GETX ;BYTE POINTER TO NEXT CHAR, PLEASE
LDB A,TT ;GET CHARACTER THAT'S THERE
DPB C,TT ;AND SET THE USERS VALUE
AOS PT ;AND ADVANCE OVER IT
JRST ARGINA ;AND RETURN WITH OLD CHARACTER IN A
OVWRND: CALL INS1A ;GO INSERT GIVEN CHARACTER
JRST NE1INA ;AND RETURN -1
;@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.
;NBACKSLASH INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
; EQUAL TO N.
BAKSL1: PUSH P,RADIX ;SAVE OLD RADIX
TXZN FF,ARG2 ;SECOND ARG?
JRST BAKSLR
SKIPG T,SARG ;YES, FETCH
MOVEI T,^D10 ;DEFAULT IS 10
MOVEM T,RADIX
BAKSLR: MOVE T,[XWD 700,BAKTAB-1]
SETZ P1, ;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,[POINT 7,BAKTAB] ;POINT TO NUMBER
MOVE B,P1 ;COUNT OF CHARACTERS
CALL INSRT0 ;INSERT THE NUMBER
POP P,RADIX ;RESTORE OLD RADIX
JRST CFLUSH
BAKSL4: IDPB A,T ;STORE DIGIT IN BAKTAB
AOJA P1,CPOPJ ;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?
JRST CFLUSH ;[502] DONE
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
;P IS THE SAME AS 1P
;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: CALL PUNCHA ;[502] DO THE WORK
JRST CFLUSH ;[502] DONE
PUNCHA:
;**;[511] At PUNCHA: +2L, Modified 1 line SM 9-Jun-82
TXNE FF,ARG2 ;I,JP? ;[511] DON'T CLEAR ARG2 YET
JRST PCH0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
TXNN FF,ARG
MOVEI C,1
MOVE D,C ;NO. d:=N
JUMPL D,CPOPJ ;IF N .L. 0, IGNORE P.
STKVAR <DCNT> ;(HOLDS DE COUNT) (HOW CORNEY!)
MOVEM D,DCNT ;REMEMBER HOW MANY PAGES TO DO
PUN1: CALL PUNCHR ;PUNCH OUT 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 YANK ;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?
RET
JRST PUN1 ;NO, KEEP GOING
PUNCHR: MOVE P1,BEG ;OUTPUT DATA BUFFER.
MOVE C,ZEE
JRST PCH1
; ;W - WRITE OUT BUFFER AND DELETE
WRBUF: TXNN 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 pch1
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: 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
ERROR <No file for output>
OPTION ENC,<
skipe encflg
skipe cdewon ;need an output password?
jrst nogpsd
call getps2 ;ask twice
setom cdewon ;got it now
move a,cdewrd
movem a,cdewro
nogpsd:
>
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 THE LEFT OF THE
; 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 2ND PART
CALL SOUT1 ;WRITE SECOND PART
NOAFT: RET ;DONE!
SOUT1: JUMPE C,CPOPJ ;DO NOTHING IF NO CHARACTERS
STKVAR <SVCNT>
MOVEM C,SVCNT ;SAVE NEGATIVE CHARACTER COUNT
CALL GET1 ;GET LDB POINTER TO START IN TT
SETO B, ;BACK UP BY ONE BYTE
ADJBP B,TT ;TO GET ILDB POINTER IN B
MOVE C,SVCNT ;GET CHARACTER COUNT
OPTION ENC,< ;FOR CODING ALGORITHM
skipn encflg
jrst nooutc
jumpe c,nooutc
movmm c,cdecnt
movem b,cdestr
push p,c
push p,b
movei a,cdewro
skipe (a)
call hack
pop p,b
pop p,c
nooutc:
>
MOVE A,OUTJFN ;GET JFN TO USE FOR OUTPUT
CALL SOUTX ;WRITE THE ^%$#&@$ DATA!
SETOM WRITEF ;SHOW THAT OUTPUT FILE HAS SOME DATA IN IT
RET ;DONE
OPTION ENC,<
;Code to fetch and encrypt password.
blen==100 ;max is 100 (319 letters)
getpse: hrroi a,[asciz/Did not match, type both again...
/]
psout
getps2: hrroi a,[asciz/ Output/]
setzm syl
jrst getpsn
getpsd: setom syl
hrroi a,[asciz/ Input/]
getpsn: psout
hrloi a,(tl%cor!tl%cro)
seto b,
tlink
erjmp .+1
movx a,.priin
rfmod
move d,b
txz b,tt%eco
sfmod
setzm cdewrd
hrroi a,[asciz/ password: /]
move c,a
psout
setzm datbuf
move a,[datbuf,,datbuf+1]
blt a,datbuf+177
hrroi a,datbuf
move b,[rd%bel!rd%crf!rd%rai+blen*5-1]
rdtty
erjmp .+1
movei a,.chcrt
pbout
skipe syl
jrst gogcde
hrrzm b,syl
ldb b,[point 7,datbuf,6]
cain b,.chlfd
jrst goytr
hrroi a,[asciz/ Retype for paranoia: /]
move c,a
psout
hrroi a,datbuf+blen
move b,[rd%bel!rd%crf!rd%rai+blen*5-1]
rdtty
erjmp .+1
hrrzs b
came b,syl
jrst getpse
subi b,<blen+1>*5
idivi b,5
hrli b,datbuf
movss b
cmppas: move a,blen(b)
came a,(b)
jrst getpse
aobjn b,cmppas
gogcde: move b,d
movx a,.priin
sfmod
call crr
move c,[point 7,datbuf]
setz b,
geyt: ildb a,c
cain a,.chlfd
jrst goytr
setob d,cdewrd
geyt2: rot b,^d9 ;these 3 instrs must not ref relocatables
xor b,a
hll a,c
sub b,a
aosl a
geyt1: xori a,553023
addi b,443
jfcl 17,geyt1
trne b,1000
xor b,geyt1
addi a,-3(b)
ldb a,[point 2,a,15]
xor b,geyt2(a)
eqv b,d
tlne b,014000
aoja d,geyt2
soja b,geyt
goytr: cain b,0
movei b,114411
skipe cdewrd
movem b,cdewrd
ret
>
;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
IOWAIT: JFCL ;PARANOIA
SETZM QUOJFN ;CLEAR THIS, 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: TXNE FF,ARG!ARG2 ;[506] DID THE USER GIVE ARGS?
JRST [CALL GETARG ;[506] YES, SET THEM UP...
JRST BSAVE1] ;[506] AND USE THEM
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.
CALL PCH1 ;OUTPUT THE SPECIFIED BUFFER PORTION
JRST SEMIC ;AND DO THE ;C OPERATION
;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: TXZE FF,SLSL ;@J?
JRST ATSGNJ ;YES.
ADD C,BEG ;PT:=N+BEG
JRST JMP1
; R - REPLACE ... BY ...
REPLAC: CALL CHK2
;**;[510] At REPLAC: +1L, Inserted 1 line SM 26-May-82
MOVEM FF,TMPFLG ;[510] REMEMBER FLAGS FOR LATER
TXO FF,RPLFG
TXZ FF,ARG+ARG2 ;SO AS NOT TO CONFUSE S K AND I
MOVEM C,REPARG ;REMEMBER ARGUMENT TO R COMMAND
RPLC3: CALL SAVCMD ;REMEMBER CMD STATE FOR GARBAGE COLLECTOR
SKIPE ABORTF ;ABORT?
JRST RPLC4 ;YES, STOP
MOVEI A,1 ;WANT 1ST OCCURENCE
SKIPGE REPARG ;IS ARG NEGATIVE ??
SETO A, ;YES, SO WANT -FIRST OCCURANCE
CALL SERCH0 ;SEARCH AND ADVANCE PT
TXNN 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 CHAR 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, :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
;**;[504] Fix code at NOREPL: to use SKPIN1
NOREPL: MOVEI CH,.CHESC ;FIRST ASSUME TERMINATOR IS ALTMODE
TXNE FF,SLSL ;SEE IF @
CALL RCH ;YES, SO READ TERMINATOR
MOVEM CH,DLIMIT ;SKPIN1 WANTS DELIMITER IN DLIMIT
CALL SKPIN1 ;SKIP INSERT STRING
RPLC4: ADJSP P,-CBLEN ;GET RID OF SAVED COMMAND STATE
TXZ FF,RPLFG
;**;[510] At RPLC4: +2L, Inserted 3 lines SM 26-May-82
MOVE A,TMPFLG ;[510] GET ORIGINAL FLAGS BACK
TXNE A,COLONF ;[510] DID HE ASK FOR A COLON MODE REPLACE?
TXO FF,COLONF ;[510] YES, BUT THE FLAG GOT CLOBBERED.
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 CFLUSH
;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: CALL GETARG ;NO. p1:=FIRST STRING ARGUMENT ADDRESS,
XOR C,P1 ;C:=SECOND STRING ARGUMENT ADDRESS.
XORM C,PT
JRST CFLUSH
; n,m;L RETURNS THE NUMBER OF LINEFEEDS BETWEEN n AND m.
CNLINE: CALL GETARG
MOVE I,P1 ;GO HUNTING FOR LINEFEEDS
SETZ A, ;ACCUMLATE COUNT HERE
CNTLF1: CAML I,C ;GOT TO END OF RANGE?
JRST ARGINA ;YES, RETURN ANSWER
CALL GET ;GET CHARACTER
CAIN CH,.CHLFD ;GOT A LINE FEED?
ADDI A,1 ;YES, COUNT IT
AOJA I,CNTLF1 ;AND GO GET NEXT CHARACTER
;"E" - 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: SKIPN EXECOP ;[502] IS AN OP WAITING?
TXNE FF,ARG ;[502] OR AN ARG?
JRST .+2 ;[502] YES, GO HANDLE LIKE THE "L" COMMAND
JRST ELINE0 ;[502] NEITHER, GET TO END OF THIS LINE
CALL GETARG
XOR C,P1 ;SET PT TO WHICHEVER ARG ISN'T PT
XORM C,PT
ELINE0: CALL TOEOL ;MOVE PT TO END OF CURRENT LINE
JRST CFLUSH
;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,CPOPJ ;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: TXNN FF,ARG ;IS THERE AN ARGUMENT?
JRST CHK22 ;NO, GO CONJURE ONE UP
MOVE C,FARG ;[502] YES, GET IT
RET ;DONE
CHK22: MOVE C,EXECOP ;[502] WHAT IS THE CURRENT OP?
SETZM EXECOP ;[502] AND BLOW AWAY THE OP
CAIE C,OP.SUB ;[502] REAL MINUS SIGN?
TDZA C,C ;[502] NO, 0 (WILL BECOME 1)
HRROI C,-2 ;[502] YES, -2 (WILL BE -1)
AOJA C,CPOPJ
;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
JRST HKC ;[502] BECOME AN HK COMMAND
MOVEM P1,PT ;PT:=C(p1)
SUB C,P1 ;C:=NO. OF CHARACTERS TO KILL.
JUMPE C,CFLUSH ;[507] NONE. GO CLEAR FLAGS.
JRST KLB1
KLBUF1: TXO FF,RPLFG
CALL KLBUF
TXZ 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
CALL ERASE ;[502] DO IT
JRST CFLUSH ;[502] AND DONE
;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.
HKC: CALL HK ;[502] DO THE WORK
JRST CFLUSH ;[502] AND DONE
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:=MAXI(BEG,C),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 argument is 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,[POINT 7,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,[POINT 7,SCHBUF] ;POINTER TO SEARCH STRING BUFFER
MOVEM A,SCHPTR
SETZM SSLEN ;INITIALIZE THE SEARCH STRING LENGTH
SER1: SKIPE RPRSF ;REPARSING?
JRST [ SKIPG RPCNT ;YES, HAVE WE REACHED END OF STRING?
JRST SP1 ;YES
CALL GETSCH ;NO, GET NEXT CHARACTER (CNT DEC'D AT GETSCH)
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,[POINT 1,A] ;1-BIT BYTE POINTER TO BITS (440100)
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
;*
;1 TURN ALL BITS ON IN POSITIONS WHERE THIS CHARACTER ISN'T SUPPOSED TO MATCH
;2 TURN ALL BITS OFF IN COLUMNS THAT AREN'T SUPPOSED TO MATCH THIS CHARACTER
;3 ACCUMULATE BIT POSITIONS THAT ARE ON FOR ALL CHARACTERS THAT MAY MATCH
;4 ACCUMULATE BITS THAT ARE OFF FOR ALL CHARACTERS THAT MAY MATCH THIS POSITION
ORCM P1,MSKTAB(D) ;*1
AND P2,MSKTAB(D) ;*2
AND A,P1 ;*3
ANDCM B,P2 ;*4
AOBJN C,ZLUP1 ;LOOP FOR ALL CHARACTERS
IOR A,B ;NOW A HOLDS ALL BITS THAT ARE THE SAME
; FOR ALL CHAR THAT MATCH IN FIRST 5 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 5 CHARS OF
; THE SEARCH STRING
SETO C, ;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 1ST 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
SOS RPCNT ;GET THE $%$^%# COUNT RIGHT!
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
MOVX A,CMMSK ;GET VALUE TO CHECK AT RESCMD TIME...
MOVEM A,CMSMK ;AND STORE
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 READ SAVED STATE BUT *NOT* REMOVE IT FROM THE STACK
REACMD: POP P,A ;GET RET ADDRESS
MOVX B,CMMSK ;GET CHECK WORD
CAME B,(P) ;IS LAST WORD CORRECT?
JRST RESQE ;NOPE!
MOVSI B,1-CBLEN(P) ;GET ADDRESS OF STATE
HRRI B,CBBLK ;ADDRESS OF BLOCK TO RESTORE STATE TO
BLT B,CBBLK+CBLEN-1 ;RESTORE IT
JRST (A) ;GO LEAVE
;HERE TO RESTORE PREVIOUS COMMAND STATE
RESCMD: POP P,A ;GET RETURN ADDRESS
MOVX B,CMMSK ;CHECK LEGALITY
CAME B,(P) ;OK?
RESQE: ERROR <Command state not saved, check angle brackets and parentheses>
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
;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 ;VERY SLIGHTLY CLEVER
SETZM NOTFLG ;HAVEN'T SEEN ^N YET
SCHNOT: CAIN CH,"N"-100 ;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,"Q"-100 ;^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,"E"-100 ;IS IT SPECIAL SEARCH OPTION CHARACTER?
JRST DOCE ;YES, GO HANDLE IT
CAIN CH,"X"-100 ;NO. ^X?
JRST CNTRX ;YES
CAIN CH,"S"-100 ;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 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,74 ;NUMBER COMING UP? (74 IS OPEN ANGLE BRACK)
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!
CAIL CH,"0" ;OCTAL DIGIT?
CAILE CH,"7" ;..
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,76 ;76 IS CLOSE ANGLE
ERROR <Angle bracket missing after number in search string>
JUMPL P2,CPOPJ ; 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,"P"
JRST SBPUN ;PUNCTUATION
CAIN CH,"V"
JRST SBLOW ;ANY LOWERCASE LETTER
CAIN CH,"W"
JRST SBHGH ;ANY UPPERCASE
CAIN CH,"Y"
JRST SBUSR ;USER DEFINED HITS
CAIN CH,"X"
JRST CNTRX ;ANYTHING
ERROR <Illegal character after CTRL/E in search string>
;Edit 509
;The following defines are used to build the code to OR in bits to SMAT0.
;I$MSK clears the bits, and should be done before each set of MA$MSKs.
;Each MA$MSK generates 3 (or 6) instructions which light all the bits that
;represent the two characters passed to it, and all the ones inbetween. IE,
;MA$MSK "E","H" would turn on the bits for E,F,G and H in the SMAT0 array.
;This could have been done a LOT simpler, but future expansion is easier
; this way.
;Isolate the RH or the LH moved to the RH with these.
DEFINE $RH(V),< <<V>&<0,,-1>> >
DEFINE $LH(V),< <<<V>&<-1,,0>>_-^D18> >
;DMOVXX tries to load AC,AC+1 with V1 and V2 in the least number of words.
DEFINE DMOVXX (AC,V1,V2),<
%%A1==$RH <V1>
%%A2==$LH <V1>
%%B1==$RH <V2>
%%B2==$LH <V2>
IFE $RH <%%A1+1>,<%%A1==0>
IFN %%A1,<%%A1==-1>
IFE $RH <%%A2+1>,<%%A2==0>
IFN %%A2,<%%A2==-1>
IFE $RH <%%B1+1>,<%%B1==0>
IFN %%B1,<%%B1==-1>
IFE $RH <%%B2+1>,<%%B2==0>
IFN %%B2,<%%B2==-1>
%%A== <%%A1&%%A2>!<%%B1&%%B2>
IFN %%A,< DMOVE AC,[EXP <V1>,<V2>]>
IFE %%A,< MOVX AC,<V1>
MOVX <AC+1>&17,<V2> > >
DEFINE I$MSK,<
%%W0==0
%%W1==0
%%W2==0
%%W3==0>
DEFINE OR$MSK (SY,BI),<
%%W'SY'==%%W'SY'!BI>
DEFINE MA$MSK (CH1,CH2,PTQ<-1>),<
%%C==CH1
%%N==CH2-%%C+1
IFLE %%N,<FOAD <Bad args to MA$MSK>>
REPEAT %%N,<
%%W==%%C/44
%%B==<1B0>_<%%W*44-%%C>
OR$MSK \%%W,%%B
%%C==%%C+1>
IFN PTQ,<
IFN %%W0,<
IFE %%W1,< MOVX A,%%W0
IORM 0+SMAT0>
IFN %%W1,< DMOVXX A,%%W0,%%W1
IORM A,0+SMAT0
IORM B,1+SMAT0
%%W1==0>
>
IFN %%W1,<
IFE %%W2,< MOVX A,%%W1
IORM A,1+SMAT0>
IFN %%W2,< DMOVXX A,%%W1,%%W2
IORM A,1+SMAT0
IORM B,2+SMAT0
%%W2==0>
>
IFN %%W2,<
IFE %%W3,< MOVX A,%%W2
IORM A,2+SMAT0>
IFN %%W3,< DMOVXX A,%%W2,%%W3
IORM A,2+SMAT0
IORM B,3+SMAT0
%%W3==0>
>
IFN %%W3,< MOVX A,%%W3
IORM A,3+SMAT0>
> >
;^EA MATCHES ANY ALPHABETIC
SBALPH: I$MSK
MA$MSK "a","z",0 ;get lowercase, inhibit code gen.
MA$MSK "A","Z" ;ADD UPPERCASE AND PUNCH OUT CODE
JRST SCHOUT
;^ED MATCHES ANY DIGIT
SBDIG: I$MSK
MA$MSK "0","9"
JRST SCHOUT
;^EV MATCHES ANY LOWERCASE LETTER
SBLOW: I$MSK
MA$MSK "a","z"
JRST SCHOUT
;^EW MATCHES ANY UPPERCASE LETTER
SBHGH: I$MSK
MA$MSK "A","Z"
JRST SCHOUT
PURGE %%W,%%B,%%N,%%C,%%W0,%%W1,%%W2,%%W3
IF2, <PURGE I$MSK,OR$MSK,MA$MSK>
;End edit 509
;DO ANY CHARACTER THAT THE USER FLAGGED WITH THE ;@q COMMAND
SBUSR: SETOM CEYFLG ;NOTE THAT ^EY IS BEING DONE
MOVX C,CH%USR
JRST SBSETA
;DO ANY NON-SYMBOL CHARACTER (^S=^N^EC)
CNTRB: SETCMM NOTFLG ;SAY "NOT" AND FALL INTO SYMBOL CODE
;JRST SBSYM
;^EC MATCHES ANY SYMBOL CONSTITUENT
SBSYM: MOVX C,CH%SBL
JRST SBSETA
;DO ANY PUNCTUATION CHARACTER (^EP)
SBPUN: MOVX C,CH%PN1 ;PUNCTUATION
;JRST SBSETA
;HERE TO LIGHT BITS IN SMAT0 ACCORDING TO THE CONTENTS OF C AND
; THE CHRTAB ARRAY.
SBSETA: MOVEI CH,177 ;SCAN CHRTAB
SBUSR1: MOVE A,CHRTAB(CH) ;GET VALUE FROM TABLE...
TDNE A,C ;DID USER LIGHT THE BIT FOR THIS CHAR?
CALL SETBIT ;AH HA! FLAG IT.
SOJGE CH,SBUSR1 ;AND GO FOR NEXT
JRST SCHOUT
;SET THE BIT INDICATED BY CH IN SMAT0
SETBIT: MOVE A,CH
IDIVI A,44 ;FIGURE OUT WHICH WORD AND BIT
ADDI A,SMAT0 ;SMAT0 IS AN INDEXED REFRENCE
MOVE B,SBITS(B) ;GET CORRECT BIT
IORM B,(A) ;TURN IT ON IN THE PROPER WORD
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,[POINT 7,SCHBUF] ;GET POINTER TO LAST SEARCH STRING
MOVE C,COMCNT ;GET MAXIMUM CHARACTERS TO COMPARE
NOTS1: SOJL C,CPOPJ1 ;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,CPOPJ1 ;STRINGS DIFFERENT IF LAST ONE SHORTER
ILDB CH,B ;AND ONE FROM LAST SEARCH STRING
CAME D,CH ;THE SAME?
JRST CPOPJ1 ;DIFFERENT SEARCH, SKIP RETURN
JRST NOTS1 ;LOOP TO CHECK REST OF STRINGS
NOTS2: JUMPE T,CPOPJ ;IF LAST SEARCH STRING RUNS OUT WHEN WE
; FIND DELIMITER IN BUFFER, WE'VE GOT SAME SEARCH AS LAST TIME
JRST CPOPJ1 ;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: TXOA FF,FINDR ;FINDR:=1 FOR LEFT ARROW SEARCH
SERCHP: TXO 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
TXNE FF,SLSL ;@ SEEN?
CALL RCH ;YES. CH:=USER SPECIFIED DELIMITER.
MOVEM CH,SDELIM ;REMEMBER DELIMITER
;SET UP SEARCH TABLE
SERCH2: CALL PEEKCH ;PEEK AT NEXT CHARACTER
JRST SERCH4 ;IF THERE ISN'T ONE, IT'S NOT THE ONE SOUGHT!
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
SETZM CEYFLG ;WE HAVEN'T SEEN A ^EY YET
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 CHARS IN THE SEARCH STRING
CALL MVCST ;COPY THE CHARS
MOVE I,[5*MATCH] ;POINTER TO STRING GUARANTEED TO MATCH
MOVE OU,SCHLNN ;WE WANT TO PUT IT ALMOST THIS MANY CHARS 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
MOVEM C,NXTFRM ;REMEMBER WHEN GOING TO NEXT FRAME
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.
;START OF FORWARD SEARCH LOOP.
S00: MOVE B,(D) ;GET WORD FROM BUFFER
S0: LDB C,SLAST ;GET RIGHTMOST CHARACTER IN FRAME
SKIPE SMAT(C) ;IS THAT CHAR 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 CHAR ADDRESS OF FIRST CHAR
IMULI A,5 ;NOW WE'VE GOT CHAR ADDRESS IF WE DID NO SHIFTING
ADD A,C ;ADD NUMBER OF TIMES WE SHIFTED TO GET EXACT CHAR ADDRESS
MOVEM A,SENDPT ;SAVE CHAR ADDRESS OF FIRST CHAR 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 CHAR 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 CHAR ADDRESS OF LEFTMOST CHAR 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 CFLUSH ;NO, DON'T RETURN VALUE
JRST ARGINA ;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 CHAR EXAMINED ISN'T IN
; SEARCH STRING AT ALL (ONE EXTRA FOR B35!)
HRRZM A,SLIDE ;REMEMBER, BUT CLEAR LH BECAUSE REF'D WITH @
MOVE A,PT
SOJ A, ;FIGURE OUT WHICH CHAR 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
; CHAR IN STRING
IMULI A,5
ADDI A,5
SUB A,C ;A HOLDS LEFTMOST CHARACTER ADDRESS OF THE
MOVE B,HOLEND ; 5 THAT MATCHED
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 CHAR ADDRESS OF CHAR 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 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 CHAR 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 CHAR 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,CPOPJ1 ;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
;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
TXNE FF,PCHFLG+FINDR ;S SEARCH?
JRST NOFND1 ;NO.
TXNN FF,COLONF ;YES. COLON MODIFIER?
JRST NOFND2 ;NO
TXZ FF,PCHFLG+FINDR ;YES.
TXNE FF,RPLFG ;ARE WE DOING A REPLACE COMMAND?
RET ;YES, SO JUST RETURN
JRST ZERINA ;NO, RETURN 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.
;**;[503] At NOFND1: +5L, Replaced 2 lines SM 24-Mar-82
TXNE FF,FINF ;[503] ALREADY AT EOF?
JRST NOFND3 ;[503] YES, SEARCH FAILS, QUAMP THE BUFFER
MOVEI C,1 ;PUNCH 1 PAGE ONLY
TXNE FF,PCHFLG ;N SEARCH?
CALL PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TXNE FF,FINDR ;LEFT ARROW SEARCH?
CALL YANK ;YES. FILL BUFFER.
;**;[503] At NOFND1: +14L, Deleted 1 line SM 24-Mar-82
JRST SERCHS ;CONTINUE SEARCHING
;**;[503] At NOFND2: -1L, Added 4 lines SM 24-Mar-82
NOFND3: MOVEI C,1 ;[503] PUNCH 1 BUFFER IF ANY
TXNE FF,PCHFLG ;[503] NEED TO OUTPUT LAST BUFFER?
CALL PUNCHA ;[503] YES, PUNCH IT
CALL HK ;[503] SEARCH FAILED, CLEAR BUFFER.
;**;[510] At NOFND2:, Inserted 2 lines SM 26-May-82
NOFND2: TXNE FF,COLONF ;[510] IS HE INTERCEPTING ERRORS?
JRST ZERINA ;[510] YES, GIVE HIM ZERO.
STKVAR <SFLPTR,SFLLEN> ;O.K., SINCE P IS RESET AT "GO"
LERROR <Search failed for: >
MOVE A,[POINT 7,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
;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
JRST QGETQE
POP P,SYL ;[502] SAVE RETURN ADDRESS
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
JRST QGETQE ;OOPS
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
JRST @SYL ;[502] RETURN TO CALLER
;MXFILENAME$ PUTS THE CONTENTS OF THE FILE IN Q-REG X
MFILE: CALL QREGVI ;GET Q-REG NAME TO USE & MAKE SURE 'TIS 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"
JRST CFLUSH ;[502] DONE
;WLIBRARY$FILENAME$ DOES THINGS LIKE ;MI, BUT DIFFERENT
WLIBR: CALL FACCES
MOVEM A,JFNIS
DVCHR% ;SEE IF THIS JFN IS A TERMINAL
LDB A,[221100,,B] ;GET DEVICE TYPE NUMBER
CAIN A,.DVTTY ;SKIP IF IT IS A TERMINAL
JRST [MOVEI C,[ERROR <Cannot load a Library from the terminal>]
JRST BADLIB] ;IT IS, ILLEGAL
WLIB1: MOVE A,JFNIS
NQREGN: BIN% ;GET THE QREG NAME
ERJMP NOMOR
CAIE B,12 ;ALLOW CR, LF, ...
CAIN B,15
JRST NQREGN
CAIE B,"\" ;AND BACKSLASH AND SPACE...
CAIN B,40 ;AS DROSS
JRST NQREGN
MOVE CH,B ;CANT CALL QREGVx HERE, SINCE AN ILL QREG
CAIE CH,"#" ;# MEANS ARRAY REFERENCE
JRST QLOADL ;GO LOAD Q-REG LOC
MOVE A,JFNIS
MOVEI C,^D10
NIN%
ERJMP ILAQE
CAIL B,0
CAIL B,USARYL
JRST UABNQE
MOVEI T,USRARY(B)
BKJFN%
ERJMP GREF
JRST GREF
QLOADL: CAIL CH,140 ; WOULDNT LET US DROP THE JFN. LC LETTER?
TRZ CH,40 ;MAKE UC
CAIL CH,"0" ;LETTER OR DIGIT?
CAILE CH,"Z"
JRST BADQRE
CAILE CH,"9"
CAIL CH,"A" ;CHECK FOR LONELY 7 BETWEEN DIGITS AND LETTERS
TRNA
JRST BADQRE
CALL QREGVC ;NOW DO THE TRANSLATION
MOVE T,CH ;SAVE THE INDEX
ADDI T,QTAB-"0"
GREF: MOVE A,JFNIS
BIN%
ERJMP ILIBQE ;ILLEGAL LIBRARY FORMAT
CAIE B,"="
JRST NORFET
MOVE A,JFNIS
MOVEI C,^D10
NIN%
ERJMP INULQE ;ILLEGAL NUMBER
MOVEM B,(T) ;STORE THE NUMBER
BKJFN%
ERJMP WLIB1 ;ASSUME OK?
BIN%
CAIE B,"\" ;BACKSLASH IS LEGAL
CAIG B,40 ;DID THE NUMBER END WITH SPACE OR LESS?
JRST WLIB1
JRST INULQE ;NO, GO COMPLAIN
NORFET: MOVEM B,STOPAT ;STOP AT THIS CHARACTER...
CALL MFILE1 ;GO LOAD UP
TRNA ;NONSKIP IS OK
JRST BADLIB ;IF SKIP, DO ERROR IN AC C
MOVEM A,(T) ;AND THE Q-REG IS ALL SET
JRST WLIB1
NOMOR: MOVE A,JFNIS
CLOSF%
ERJMP .+1
JRST CFLUSH
UABNQE: MOVEI C,ARRYQE ;Array reference out of bounds
JRST BADLIB
ILAQE: MOVEI C,[ERROR <Number not in a readable format after "#">]
JRST BADLIB
INULQE: MOVEI C,[ERROR <Number not in a readable format after "=">]
JRST BADLIB
ILIBQE: MOVEI C,[ERROR <EOF while looking for delimiter>]
JRST BADLIB
BADQRE: MOVEI C,QREGQE ;BAD Q REGISTER
BADLIB: MOVEM C,SYL
LERROR <Library file error, at file position >
MOVE A,JFNIS
RFPTR% ;WHERE DID IT HAPPEN?
ERJMP NOPOSI ;DONT KNOW
MOVX A,.PRIOU
MOVEI C,^D10
NOUT%
ERJMP .+1
NOPOSI: MOVE A,JFNIS
CLOSF%
ERJMP .+1
JRST @SYL ;GO JUMP TO ERROR CODE AS APPROPRATE
;ROUTINE TO LOAD A FILE INTO A Q-REG. GIVE IT JFN IN A. IT RETURNS
;HANDLE IN A.
;ENTER AT MFILE0 TO READ UNTIL EOF, MFILE1 TO READ UNTIL CHAR IN
; STOPAT. CALLING MFILE1 WITH A NON-NEGATIVE STOPAT MEANS THE FILE
; IN JFN A WILL NOT BE CLOSED ON RETURN, AND A +2 RETURN IS GIVEN IF
; AN ERROR OCCURS (+1 OTHERWISE)
MFILE0: SETOM STOPAT ;GO UNTIL EOF
MFILE1: 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,MFILQE
PUSH P,A ;SAVE JFN FOR A MOMENT
PUSH P,C ;LIKEWISE COUNT
DVCHR% ;BE THIS DEVICE A TERMINAL?
LDB A,[POINT 9,B,17] ;ISOLATE THE TYPE
SETZM SYL ;ASSUME NOT A TTY
CAIN A,.DVTTY ;ARE YOU A TTY?
SETOM SYL ;IT *IS* A TTY! IT GETS SPECIAL TREATMENT
POP P,C ;RESTORE COUNT
POP P,A ;RESTORE JFN
MOVE OU,EQRBUF
MOVEI CH,141
CALL PUT ;CREATE BYTE POINTER TO BEGINNING
; OF FREE SPACE AND PUT IN FLAG
PUSH P,TT ;SAVE BYTE POINTER
IBP TT
IBP TT
IBP TT
MOVE B,TT ;TELL SYSTEM WHERE TO READ FILE INTO
MOVE P1,C ;SAVE AMOUNT WE'LL ATTEMPT TO READ IN
SKIPL SYL ;IS THIS A TTY?!?
JRST SININ ;NO, GO SIN IT IN
;HERE IF INPUT DEV IS A TTY: - WE WILL DO A TEXTI
MOVNM C,TXTI+.RDDBC ;STORE POS NUMBER OF BYTES IN TEXTI BLOCK
HRLI A,.PRIOU ;SET UP JFN STUFF
MOVSM A,TXTI+.RDIOJ ;..
TXNE FF,ARG ;WAS AN ARG GIVEN?
JRST [ SKIPN A,FARG ;GET USER FLAGS
JRST .+1 ;IF NONE REALLY GIVEN, USE NORMAL DEFAULTS
TRNE A,(RD%BTM) ;DID USER SET A FUNNY BIT (IE, -1 PASSED IN?)
MOVEI A,(RD%BEL) ;YES, PROVIDE ALTERNATE DEFAULTS
HRLZS A ;MOVE TO LEFT HALF
TXO A,RD%JFN ;WE INSIST ON THIS
JRST .+2] ;NOW SKIP OVER DEFAULT FLAGS
MOVX A,RD%BRK!RD%JFN ;BRK ON <ESC><^Z>
MOVEM A,TXTI+.RDFLG ;..
MOVEM B,TXTI+.RDDBP ;DEST WAS IN B
MOVEI A,.RDDBC ;HIGHEST ADDRESS IN BLOCK
MOVEM A,TXTI+.RDCWB ;..THATS THE BLOCK COUNT
MOVEI A,TXTI ;POINT AT BLOCK...
TEXTI% ;AND READ FROM TTY: INTO CORE
ERJMP .+1 ;THIS DOESNT FAIL
MOVE A,TXTI+.RDFLG ;CHECK THE FLAGS
TXNE A,RD%BFE ;RUBOUT BACK TO BEFORE BEGINNING?
JRST [SETZ C, ;YES, MEANING NO CHARS READ
JRST NTXTIN]
TXNN A,RD%BTM ;DID WE END ON A BREAK CHARACTER?
JRST MFILQE ;NO, GO DIE HORRIBLY - COUNT EXHAUSTED
ADD C,TXTI+.RDDBC ;#CHARS LEFT+(-#ALLOCATED)
MOVN C,C ;GET THE POSITIVE # CHARS READ IN
NTXTIN: HLRZ A,TXTI+.RDIOJ ;GET JFN BACK
CLOSF% ;AND BAG IT
ERJMP MFILCL ;SHAN'T FAIL
JRST MFILCL ;GO FIGURE OUT WHATS WHERE
SININ: SKIPL D,STOPAT ;DOING THE FUNNY STOPAT STUFF?
MOVN C,C ;YES, THE MAX COUNT GOES POSITIVE
SININ2: SIN% ;READ ENTIRE FILE INTO CORE
SKIPGE STOPAT ;NORMAL READ TO EOF?
JRST SINTST ;YES, GO SEE
MOVN C,C ;SET IT NEGATIVE AGAIN
SUBI C,1 ;WE *DONT* WANT THE TERMINATOR
JRST NOCLOS ;DONT CLOSE THE FILE, THATS FOR THE CALLER
SINTST: GTSTS% ;GET EOF BIT INTO b
CLOSF% ;CLOSE THE FILE
ERJMP .+1 ;IF CANT, TOO BAD
TXNN B,GS%EOF ;WAS THERE ENOUGH ROOM FOR WHOLE FILE?
JRST MFILQE
NOCLOS: SUB C,P1 ;SEE HOW MANY CHARACTERS WE READ IN
MFILCL: ADDI C,4 ;4 FOR FLAG AND COUNT.
MOVE B,[250700,,C] ;PREPARE TO PICK UP AMOUNT IN THREE INSTALLMENTS
POP P,D ;RESTORE BYTE POINTER
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
MFILQE: SKIPGE STOPAT ;DO WE RETURN ERRORS TO THE CALLER?
MFI2QE: ERROR <Not enough qreg space> ;NO. (WE DIDN'T REACH EOF)
MOVEI C,MFI2QE ;YES, IN AC C
MFILER: AOS (P) ;SKIP FOR ERROR
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,[POINT 7,NAMBFR] ;POINTER TO FILESPEC
CALL INSRTZ ;[502] INSERT THE FILENAME
JRST CFLUSH ;[502] AND LEAVE
;EFILENAME$ PUSHES TYPIN JFN AND INPUTS FROM NAMED FILE.
DOFILE: CALL FACCES ;OPEN THE FILE
MOVE C,TYIP ;GET TYPIN STACK POINTER
PUSH C,TYIJFN ;SAVE OLD TYPIN JFN
;**;[513] At DOFILE: +3L, Inserted 1 line SM 31-Aug-82
ERJMP PCMDQE ;[513] IF THATS ILLEGAL, WE WILL GO COMPLAIN
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.
JRST CFLUSH ;[502] DONE
;**;[513] At DOFILE: +13L, Inserted 3 lines SM 31-Aug-82
PCMDQE: CLOSF% ;[513] CLOSE THE FILE WE OPENED
ERJMP .+1 ;[513] DOESNT MATTER
ERROR <Too many command streams pushed>
;<> 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 CFLUSH]
POP P,SYL ;[502] STORE THIS FOR THE RETURN
AOS INTDPH
PUSH P,ITERCT ;SAVE ITERATION COUNT
TXZN 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
PUSH P,SYL ;[502] RESTORE RETURN
SKIPG C,ITERCT
JRST INCMA ; 0<...> DOES NOTHING FEATURE.
JRST CFLUSH
GRTH: TXNE FF,SCANF ;SCANNING?
JRST [ MOVEI A,^D62 ;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
RSLOP: POP P,SYL ;[502] SAVE THE RETURN ADDRESS
CALL REACMD ;RESTORE COMMAND STATE TO BEGINNING OF LOOP
PUSH P,SYL ;[502] RESTORE RETURN ADDRESS
TXNE FF,TRACEF ;TRACING?
CALL CRR ;YES. OUTPUT CRLF
JRST CFLUSH
;: 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 < > ?
TCONQE: ERROR <No iteration loop currently in progress>
TXNN FF,ARG ;YES. IF NO ARG,
MOVE C,SFINDF ;LAST SEARCH SWITCH
JUMPL C,CFLUSH ;IF ARG .L. 0, JUST RET + EXECUTE LOOP
INCMA: MOVEI A,^D62 ;WHAT WE'RE LOOKING FOR (RIGHT ANGLE BRACK.)
CALL SCAN ;SET IT
INCMA2: POP P,SYL ;[502] SAVE HIS RETURN ADDRESS
SOS INTDPH ;POP OUT A LEVEL
ADJSP P,-CBLEN ;THROW AWAY SAVED COMMAND STATE
POP P,ITERCT
PUSH P,SYL ;[502] RESTORE HIS RETURN ADDRESS
JRST CFLUSH
;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
RET ;[502] RETURN
;!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 EXCLAM
JRST CFLUSH
;OTAG$ GO TO THE TAG NAMED TAG. THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OG: TXNE FF,COLONF ; : FLAG LIT?
JRST OGNFA ;YES, FOR SOME REASON, USER WANTS RE-INTERPERT
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
OGNFA: 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
CALL SAVCMD ;SAVE COMMAND STATE NOW
MOVEI 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
CALL RESCMD ;IT FAILS. RESTORE STATE
TXNN FF,COLONF ;NONESUCH LABEL. DID USER EXPECT THAT?
ERROR <Tag not found> ;NO, GIVE HIM HIS ERROR MESSAGE
JRST CFLUSH ;CONTINUE, THE USER WANTS TO DEAL WITH IT.
OG3: ADJSP P,-CBLEN ;BLOW AWAY OLD SAVED STATE
TXNE FF,COLONF ;DID USER INDICATE FUNNY : MODE?
JRST CFLUSH ;YES, WE ARENT USING THE HASH TABLE
POP P,A
POP P,SYMS(A)
MOVEM B,CNTS(A)
MOVEM C,VALS(A)
JRST CFLUSH
OGFND: MOVE A,VALS(C)
MOVEM A,CPTR
MOVE A,CNTS(C)
MOVEM A,COMCNT
JRST CFLUSH
;APOSTROPHE MARKS END OF CONDITIONAL FOR DOUBLE QUOTE
APOST: TXNN FF,SCANF ;SCANNING?
JRST CFLUSH ;NO, NOTHING TO DO
MOVEI A,"'" ;YES, SEE FOR WHAT
SCAN1: CAME A,LCHAR ;FOR APOSTROPHE?
JRST CFLUSH ;NO
SOSGE SCNEST ;[502] DEPTH RIGHT YET?
TXZA FF,SCANF ;[502] YES! BACK TO NORMAL SNAFU
JRST CFLUSH ;[502] ..
MOVEM A,SYL
CALL TRACS ;IF TRACING, I WANT TO SEE THE END
MOVE A,SYL
CAIE A,"'"
JRST CFLUSH
POP P,SYL ;SAVE OUR RETURN ADDRESS
CALL SAVCMD
PUSH P,TRACS ;SAVE THE CURRENT TRACE MODE
MOVSI CH,(<RET>) ;AND NUKE IT
MOVEM CH,TRACS ;SO THIS CANT TRACE TWICE
SCANA: SKIPN COMCNT
JRST SCANB
CALL RCH ;IGNORE INTERVIENING SPACES AND CRLFS
CAIE CH,12
CAIN CH," "
JRST SCANA
CAIN CH,15
JRST SCANA
CAIE CH,"""" ;IS FIRST NON-BLANK A QUOTE COMMAND?
JRST SCANB ;NO, SO GO RESET TO NORMAL
SKIPLE COMCNT
CALL RCH ;OK, IS " SOMETHING. IS IT "#?
SETOM PCISG ;ASSUME OK
CAIE CH,"#" ;IF IT IS, WE WANT THE NEXT "# DONE
SETZM PCISG ;CHECK AND SEE
SCANB: POP P,TRACS
CALL RESCMD
PUSH P,SYL
JRST CFLUSH
DQUOTE: CALL RCH
TXNE FF,SCANF ;SCANNING?
JRST DQS ;YES
CAIN CH,"#"
JRST [MOVE A,PCISG
SETZM PCISG
JRST DQ2]
JUMPL T,AG0QE ;IF MISSING AN ARG, AND NOT "#, COMPLAIN
CALL EVCOND ;GO EVAL A CONDITIONAL
DQ2: JUMPL A,CFLUSH ;IF TRUE, GO GET NEXT COMMAND
;ELSE...
NOGO: MOVEI A,"'" ;SAY WE'RE LOOKING FOR AN APOSTROPHE
CALL SCAN ;SCAN COMMAND STRING FOR END OF CONDITIONAL
JRST CFLUSH
CCOND: CALL RCH ;GET CONDITIONAL CHARACTER
CALL EVCOND ;TEST C AGAINST IT
JRST ARGINA ;0 OR -1 IN A
;EVCOND - GET NEXT COMMAND CHARACTER, SEE IF ITS A LEGAL CONDITIONAL CHAR
;IF IT ISNT, DIE
;IF IT IS, TEST THE VALUE IN C AND RETURN 0 IN A IF FAILED, -1 IF OK
EVCOND: CAIN CH,"#" ; "# ALWAYS fails.
JRST DFAIL
LOAD CH,UPRCOD,(CH)
SUBI CH,"A" ;UPPERCASE, MINUS "A"
CAIL CH,0 ;IN RANGE?
CAILE CH,DQLEN ;..?
DQQE: ERROR <Undefined command, no such conditional test>
SKIPN B,DQXCT(CH) ;GET WORD TO XCT TO TEST THIS CONDITION
JRST DQQE ;IF 0, THIS ISN'T A LEGAL COMMAND
LDB A,[POINT 4,B,12] ;GET THE AC FIELD!
CAIN A,A ;REF'ING AC A? IF SO...
JRST [JUMPL C,DFAIL ;ONLY CHARACTERS CAN BE LEGAL VALUES
CAILE C,177 ;SO CHECK THAT FIRST
JRST DFAIL ;WASN'T A CHARACTER
MOVE A,CHRTAB(C) ;IT WAS, GET THE CHARACTER INFO TO TEST
JRST .+1] ;AND GO.
XCT B ;PERFORM THE TEST
DFAIL: TDZA A,A ;NONSKIP MEANS FAILED, MARK /W 0
DOK: SETO A, ;SKIP OR JUMP HERE MEANS PASSED
TXNE FF,COLONF ;INVERT THE TEST?
SETCA A, ;YES
RET ;RETURN WITH ANSWER
;INDEX THIS TABLE TO DO VALUE TESTS (IE, "E, "C STUFF)
;IF THE INSTRUCTION HAS "A" IN THE AC FIELD, THE VALUE BEING TESTED
;MUST BE IN THE RANGE 0-177, AND THE ENTRY FROM CHRTAB MUST BE IN A,
;FOR THE TEST TO MAKE SENSE.
DQXCT: TXNN A,CH%ALP ;A ALPHABETIC CHARACTERS
TXNN A,CH%BL1 ;B BLANKS <SP><TAB><CR><LF><FF>
TXNN A,CH%SBL ;C SYMBOL (A-Z 0-9 .%$)
TXNN A,CH%DIG ;D DIGIT
JUMPE C,DOK ;E .EQ. 0
JUMPGE C,DOK ;FALSE, FAILED (.GE. 0)
JUMPG C,DOK ;G .GT. 0
0 ;H
JUMPA A,DOK ;I ANY CHARACTER
JUMPLE C,DOK ;J .LE. 0
CALL CNTCHK ;K ANY CONTROL CHARACTER
JUMPL C,DOK ;L .LT. 0
0 ;M
JUMPN C,DOK ;N .NE. 0
TRNN C,1 ;O ODD
TXNN A,CH%PN1 ;P PUNCTUATION
CALL QTST ;Q TEXT QREG
0 ;R
0 ;S
JUMPL C,DOK ;TRUE (.LT. 0)
TXNN A,CH%UPR ;U UPPER CASE
TXNN A,CH%DWN ;V LOWER CASE
TXNN A,CH%UPR ;W UPPER CASE
TXNN A,CH%BL0 ;X SPACING TYPES THAT AREN'T END-OF LINE
TXNN A,CH%USR ;Y USER SETTABLE CONDITION
CALL ZCHK ;Z BETWEEN 0 AND Z INC
DQLEN=.-DQXCT
CNTCHK: JUMPL C,CNTCK2 ;CONTROL CHARACTER, 0 TO 37
CAIGE C,40 ;SPACE OR BETTER?
AOS (P) ;NO, SKIP, THIS IS A CONTROL CHARACTER
CNTCK2: RET
ZCHK: JUMPL C,CNTCK2 ;BETWEEN 0 AND Z. NONSKIP IF <0...
ADD C,BEG ;OFFSET BY BEG SO WE CAN COMPARE
CAMG C,ZEE ;MUST BE .LE. ZEE TO BE ACCEPTED
CPOPJ1: AOS (P)
RET
;GET HERE WHEN "x ENCOUNTERED DURING A SCAN
DQS: MOVEI A,"'"
DQS1: CAMN A,LCHAR ;ARE WE SCANNING FOR APOSTROPHE
AOS SCNEST ;YES, SO NEST DEEPER
JRST CFLUSH ;RETURN FOR NEXT COMMAND
;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?
UUOQE: IERROR <Undefined LUUO> ;NO
CALL UUOTAB(TT) ;GO TO ROUTINE
MOVSI 16,UUOACS
BLT 16,16 ;RESTORE AC'S
RET ;END OF UUO.
UUOTAB: JRST UUOQE ;ILLEGAL, GO DIE
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
HRLOI B,.FHSLF ;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
HRROI A,[ASCIZ/
Please submit an SPR. Version /]
PSOUT%
MOVX A,.PRIOU
MOVEI B,.EDIT
MOVEI C,^D10
NOUT%
ERJMP .+1
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]
TXCE FF,TRACEF
MOVSI A,(<RET>)
MOVEM A,TRACS
TXNE FF,TRACEF ;DID WE TOGGLE INTO TRACE MODE?
CALL WINCLS ;DON'T ERASE TRACINGS
JRST CFLUSH
COMM: MOVEI CH,.CHESC ;ASSUME ESCAPE ENDS STRING
TXNN FF,SLSL ;ATSIGN MODIFIER?
JRST COMM0 ;NAY, GO ACT AS NORMAL
CALL DISCOC ;ATSIGN FORM ALLOWS CONTROL CHARACTER OUTPUT
CALL SKRCH ;GET THE DLIMIT CHAR
COMM0: MOVEM CH,DLIMIT ;SET DELIMITER
COMM1: PUSHJ P,SKRCH ;GET A COMMENT CHAR
SKIPE ABORTF ;ABORT?
JRST TYOQT ;YES, QUIT TYPEOUT
CAMN CH,DLIMIT ;END OF STRING?
JRST [TXNE FF,SLSL ;YES, WE WE DOING LITERAL OUTPUT?
CALL REGCOC ;YES, SET IT BACK
JRST CFLUSH] ;AND LEAVE.
MOVE A,CH
PUSHJ P,TYO ;TYPE IT
JRST COMM1
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 LINE.
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:
OPTION ENC,<
skipn encflg ;encryption turned on?
jrst updata ;no
hrloi a,(tl%cor!tl%cro)
seto b, ;yes, break links before typing out
tlink
erjmp .+1
updata:
>
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 SCROLL
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, KILL 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 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
RET ;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
JRST CFLUSH ;[502] DONE
;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 ;CHAR 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?
JRST CFLUSH ;[502] DONE
CALL TYIX ;SEE IF HE WANTS TO SEE MORE
CAIE A,C.MORE ;USER WANT TO SEE MORE?
JRST [CALL RECHAR ;NO
JRST CFLUSH]
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 EO-BUFFER AND USER
; HASN'T TYPED ANYTHING
JRST LASTV ;USER TYPED SOMETHING
MOVE A,TTYOUT ;GET OUTPUT CHANNEL
HRROI B,[IFE FTUNS,<ASCIZ /--More--/>
IFN FTUNS,<ASCIZ /--Less--/>]
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: CALL CLRSCN
JRST CFLUSH ;[502] CLEAR SCREEN AND LEAVE
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
CEOS: 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"
;***; [477] ADD 1 line @ V100HM:+0 LEM 11-12-81
V100HM: PSTR <[?1l> ;[477] reset Cursor Key Mode
DSPANS "H"
;VT50 ROUTINES
DEFINE DSPANS(CHR)
< MOVEI A,V52.ES
CALL TYO
MOVEI A,CHR
CALLRET TYO
>
V50EOS: DSPANS 112 ;CLEAR TO END OF SCREEN
V50EOL: DSPANS V52.EL ;CLEAR TO END OF LINE
V50HOM: DSPANS 110 ;HOMEUP
V50CUP: DSPANS V52.UP ;LINE STARVE
;VT05 CURSOR CONTROL
CLREOL: SKIPA CH,[C.EOL] ;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,[POINT 7,WINDOW] ;COMPLETE POINTER TO CURRENT WINDOW
MOVEM B,OLDPTR
MOVEM B,OLDBEG ;REMEMBER POINTER TO BEGINNING OF OLD LINE
ADD C,[POINT 7,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,[POINT 7,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 EOL 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,[POINT 7,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,[POINT 7,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 CHAR
; 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 THE 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!)
;**;[476] DELETE one line at MOVRIT LEM 20-OCT-81
;**;[476] DELETE one line at MOVRIT+3 LEM 20-OCT-81
MOVRIT: MOVE A,TRMTYP ;GET FLAVOR OF TERMINAL
CALL @RITTAB(A) ;DO TERMINAL DEPENDENT MOVING
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 <Hardcopy linestarve>
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,[POINT 7,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
SETO P1, ;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
SETO A,
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,"$" ;DOLLAR SIGN
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,CPOPJ ;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 CFLUSH ;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 CFLUSH ;WE WEREN'T, SO GIVE UP.
MOVEM I,PT ;WE'RE O.K., SO CHANGE "POINT".
JRST CFLUSH
;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 CLEARS ARG2. IT DOES NOT CLOBBER A (SOME ROUTINES DEPEND ON THIS).
GETARG: MOVE C,FARG ;[502] GET FIRST ARG IF ANY
TXZE FF,ARG2 ;[506] IS THERE A SECOND ARGUMENT?
JRST GETAG6 ;YES
;N SIGN INDICATES DIRECTION RELATIVE TO PT.
TXON FF,ARG ;NO. IS THERE AN ARGUMENT?
CALL CHK22 ;[502] C=1 OR -1 (-1 IF OP="-")
;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
TXNN 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
TXNN 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 CHAR ADDRESS OF LEFTMOST CHAR IN SOURCE
CALL ADDPTR ;MAKE LDB POINTER TO FIRST CHARACTER
SETO I,
ADJBP I,A ;MAKE ILDB POINTER TO FIRST CHAR IN I
MOVE A,OU ;LIKEWISE GET IDPB POINTER TO
; LEFTMOST DESTINATION CHARACTER
CALL ADDPTR
SETO OU,
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... BUT YOUR PRAYERS COULDN'T
;HURT
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,(POINT 7) ;WAS -1 SO MAKE IT 440700
TLC OU,-1
TLCN OU,-1
HRLI OU,(POINT 7)
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,CPOPJ ;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 PTR 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,CPOPJ ;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 PTR 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 I.
GETINC: CALL GET
AOJA I,CPOPJ
;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 BEGIN 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.
;THIS ALSO CLEARS THE TAG CACHE
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
MOVEI T,CPTR ;COMMAND BUFFER
CALL GCMA
HRRZ T,P
CAIL T,PDL ;PUSHDOWN 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
MOVE T,[XWD -USARYL,USRARY] ;CHECK IT FOR STRINGS
CALL GCM ;LOOP THROUGH THE ENTRIES
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: IERROR <GC 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
SETZ A,
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
MOVE C,FARG ;[502] JUST GET THE ARG
JRST @1(B) ;GO EXECUTE THE COMMAND
;WLIST$ - LIST ALL THE DEFINED WORDS
WRDLST: CALL WINCLS ;THIS IS PRESERVED OUTPUT.
MOVSI CH,-WLEN ;AOBJN WORD OF SORTS
MOVE I,SWIDTH ;WHAT DO WE THINK THE WIDTH IS?
SUBI I,21 ;LESS ABOUT 2 TAB STOPS
MOVEM I,SYL ;WE STOP IF WE WOULD TAB TO HERE
SETZ I, ;I IS POSITION ON LINE, START AT BEGINNING
WRDLS1: HLRZ C,WORDS+1(CH) ;(466)GET ADDRESS OF WORD NAME
UPSTR @C ;TYPE OUT WORD
AOBJP CH,WRDELX ;IF THATS THE LAST WORD, LEAVE LOOP NOW
SETZ A, ;NO, MUST COUNT # CHARACTERS TYPED
HRLI C,(POINT 7) ;READ EACH CHARACTER WE TYPED
WRDLSC: ILDB B,C ;..
CAIE B,0 ;AT END OF STRING?
AOJA A,WRDLSC ;NO, ADD ONE TO COUNT AND COUNT ON
TRZ A,7 ;CONVERT TO TABS STOPS-1
JUMPG A,WRDLS3 ;IF 10 OR MORE CHARACTERS, GO
MOVEI B,1 ;NO, NEED 2 TABS, NOT 1
MOVEI A,10 ;AND ACCOUNT FOR TYPED TAB
WRDLS3: ADDI I,10(A) ;IF TABS TYPED, WE ARE AT CHARACTER LOC (I)
CAML I,SYL ;AT/PAST MAX FOR THIS LINE?
JRST [ SETZ I, ;YES, CLEAR COUNT
CALL CRR ;AND START AN NEW LINE
JRST WRDLS1] ;AND GO GET NEXT WORD
WRDTBO: CTYPE < > ;TYPE TAB
SOJGE B,WRDTBO ;MIGHT NEED ANOTHER ONE
JRST WRDLS1 ;[502] DONE
WRDELL: TXNN FF,ARG
WRDELX: SETZM FARG
WRDEL1: CALL CRR
SOSLE FARG
JRST WRDEL1
JRST CFLUSH
PRESCR: MOVE A,WINFLG ;MIGHT WANT WINFLG RETURNED
CAILE A,0 ;IF .GT. 0...
SETZ A, ;RETURN 0
TXNN FF,ARG ;TAKE OR RETURN?
JRST ARGINA ;RETURN
CAIGE C,0 ;TAKE. IF C .LT. 0,...
SETO C, ;SET TO -1
MOVEM C,WINFLG ;STORE
JRST CFLUSH ;AND DONE
;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]>
;**; [502] At WORDS:, remove references to flags CH%TOR SM 4-Mar-82
;CURRENTLY DEFINED WORD COMMANDS:
WORDS: WLEN,,WLEN
WORD AUTO-EXPUNGE,AUTO ;AUTO-EXPUNGE WHEN OVER QUOTA
WORD BACKUP,BACKUP ;TURN ON COMMAND SAVING
WORD CLEOS,CEOS ;CLEAR TO END OF SCREEN
WORD CRLF,WRDELL ;TYPE A CRLF (NOT PRESERVED)
WORD DATE-AND-TIME,WDATIM ;INSERT CURRENT DATE AND TIME
WORD EDITBASIC,EBASIC ;DON'T FILTER OUT LINE #'S.
WORD EDITREGULAR,ERGLR ;FILTER LINE NUMBERS AS USUAL.
OPTION ENC,<
WORD ENCRYPT,ENCPT ;TURN ENCRYPTION FLAG ON/OFF
>
WORD ENTER,ENTFVR ;RETURN ENTER FLAG
IFG MAXSEC,<
WORD FETCH-BUFFER,CIN ;RESTORE TV STATE
>
WORD FILENAME,WFILEN ;LAST FILENAME IN COMMAND
WORD FLAGUPPERS,FLAGU ;FLAG CAPITALS
IFG MAXSEC,<
WORD FREE-BUFFER,CDEL ;GO DELETE BUFFER
>
WORD HOLE,WHOLE ;RETURN LOC OF INTERNAL HOLE
WORD LIBRARY,WLIBR ;LOAD Q-REGS FROM A FILE
WORD LIST,WRDLST ;LIST ALL THE DEFINED WORD
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 PERUSE,WPERUS ;GET/SET/CLEAR PERUSE BIT
WORD PRESERVE,PRESCR ;SET UP TO PRESERVE SCREEN OUTPUT
WORD RAISE,TERRAS ;RAISE INPUT LETTERS
WORD SAVLEN,BETSAV ;GET/SET # CHARS TO INPUT BEFORE SAVING.
WORD SCREENSIZE,SCNSET ;SET OR GET SCREEN SIZE
WORD SILENCE,SETSHH ;SET/CLEAR NO "END OF..." MSG
IFG MAXSEC,<
WORD STORE-BUFFER,COUT ;"SAVE" TV STATE
>
WORD SUM,WSUM ;RETURN ARRAY SUM
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 ;SET OR GET CURRENT LINE WIDTH
WORD WINSIZE,WINSET ;GET OR SET WINDOW SIZE
WORD ZERO,WZERO ;PROPAGATE 0 (OR SOMETHING) THROUGH THE ARRAY
WLEN==.-WORDS-1
;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 OTHER FORK
FRKWPN==<.+1000>_-9
FRKWIN==FRKWPN_9
FRKWP2==FRKWPN+1
FRKWI2==FRKWP2_9
LOC FRKWI2+1000 ;LEAVE ROOM FOR WINDOWS
;PATCH SPACE
PATS:
PAT: BLOCK 50
;DATA AREA FOR TV
DATAIS: ;ADDR OF BEGINNING OF VARIABLE SPACE
;IF 0, THIS IS THE VIRGIN RUN (FIRST TIME SINCE LOADING)
VIRGIN: -1
;ROUTINE TO MOVE STRING STARTING WITH RIGHTMOST END. IT'S HERE
;BECAUSE THE "000"S GET FILLED IN AT RUN TIME. YES, CRUDE.
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 ;-1 IF WE INSIST "NO FILTER LINE #S"
FLAGF: 0 ;-1 = FLAGGING UPPERS
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
BAKTAB: BLOCK 20 ;RECEIVES ASCII CONVERSION OF NUMERICAL ARGUMENT
TRACS: 0 ;RET OR JRST OUTPUT ROUTINE
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 ;PTR TO CMD STRING INVOKED BY "TV FILENAME"
LSTCB: 0 ;BEG OF LAST COMMAND STRING
LSTCE: 0 ;END OF LAST COMMAND STRING
ISEED: 0 ;FOR RANDOM NUMBER GENERATION (!)
OPTION ENC,< ;FOR (UNSUPPORTED) CODING ALGORITHM
encflg: 0
cdestr: 0
cdecnt: 0
cdewrd: 0
whrcde: 0
cdewri: 0
cdewro: 0
cdewin: 0
cdewon: 0
>
DIVREM: 0 ;REMAINDER AFTER LAST USER IDIV
ENTFLG: 0 ;HOW WE GOT HERE (0=?, 1=EDIT, -1=CREATE)
SYL: 0 ;TEMP FOR MANY RANDOM ROUTINES
JFNIS: 0 ;USED BY WLIBRARY.
STOPAT: 0 ;USED BY MFILE0/1
WLCKF: 0 ;LOCK FLAGS
;**;[510] At TMPFLG:, Inserted 1 line SM 26-May-82
TMPFLG: 0 ;[510] USED FOR STORING FF
DLIMIT: 0 ;[502] DELIMITER USED IN SCANNING STRINGS
FARG: 0 ;[502] FARG, Not NUM, and DLIM not needed
SARG: 0
EXECOP: 0 ;[502] BINARY OP DUE TO BE DONE
LASTOP: 0 ;[502] BINARY OP BEING REQUESTED
SKPPNT: 0 ;[502] POINTER WHILST SKIPPING TRAILING ARGS
PREFXC: 0 ;[502] COMMAND PREFIX
PREOPV: 0 ;[502] VALUE BEFORE BINARY OP
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
YAMODE: 0 ;DOING Y OR A, OR ;Y
SILFLG: 0 ;NON-0 IF "END OF ..." MESSAGE TO BE SKIPPED.
WRITEF: 0 ;NON-0 IF OUTPUT FILE HAS SOME OUTPUT IN IT
SCNEST: 0 ;NEST LEVEL WHILE SCANNING
LCHAR: 0 ;CHARACTER BEING SCANNED FOR
ITERCT: 0
INTDPH: 0 ;DEPTH IN ITERATIONS
PCISG: 0 ;USED FOR "# HACK
SRPF: 0 ;-1 IF REPARSE NEEDED OF SEARCH STRING
CEYFLG: 0 ;-1 IF ^EY HAS CHANGED SINCE LAST SEARCH
EXACTF: 0 ;0= SEARCHES MATCH EITHER CASE, 1= EXACT
SFINDF: 0
ERR1: 0
RADIX: 0 ;holds radix for number printout
LISTF5: 0 ;OUTPUT DISPATCH
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 ***
CMMSK==370037,,RESQE ;USUALLY STUFFED IN TO SAY "THIS IS A CSB"
CBBLK==. ;BEGINNING OF AREA TO STACK WHEN CHANGING COMMAND STATE
COMAX: 0
CPTR: 0
COMCNT: 0
CMSMK: 0 ;MUST BE LAST WORD OF THIS BLOCK
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 ;CHAR ADDRESS OF CHAR 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 1ST 5 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
GCTAB: BLOCK GCTBL ;GCS3+4,GCM2+13
GCTAB2: BLOCK GCTBL
ACNR: BLOCK 20 ;SAVED ACS IN GC
;THESE ARE REF'D BY: [(0)=ZERO'D BY]
SYMS: BLOCK 22 ;ZSYMS(0),OG3+1,GC+3(0)
VALS: BLOCK 22 ;ZSYMS(0),OG3+3,GC+3(0)
CNTS: BLOCK 22 ;ZSYMS(0),OG3+2,GC+3(0)
SYMEND=.-1
IFN MAXSEC,< ;;IF and only if allowing extended addressing
MSECF: 0 ;MULSEC FLAG
MVELST: BLOCK 30 ;SPACE TO CREATE COMMAND LISTS FOR FOR XTN GAMES
>
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
PFINFO: ;QREG STACK
PF: 0 ;Q-REG STACK POINTER
PFL: BLOCK LPF ;Q-REG STACK
PFINFE=.-1
QINFO: ;QREG INFO
QTAB: BLOCK 45 ;Q-REGISTER TABLE
QTABE=.-1
QRBUF: 0
EQRBUF: 0 ;END OF QREG BUFFER AREA
QINFE=.-1
BFINFO: ;BUFFER STATE INFO
HOLBEG: 0 ;CHARACTER ADDRESS OF BEGINNING OF HOLE
HOLEND: 0 ;CHAR ADDRESS OF FIRST CHARACTER NOT IN HOLE
HOLBPT: 0 ;BYTE POINTER (LDB) TO BEGINNING OF HOLE
HOLEPT: 0 ;BYTE PTR (LDB) TO FIRST CHAR TO RIGHT OF HOLE
HOLSIZ: 0 ;NUMBER OF CHARACTERS IN HOLE
BEG: 0
PT: 0
ZEE: 0 ;CHAR PTR TO END OF BFR
BFINFE=.-BFINFO
;ARRAY
USRARY: BLOCK USARYL ;USER ARRAY
;**** 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 ;CHAR ADDRESS OF FIRST CHAR TO BE DISPLAYED
ILDBPT: 0 ;LDB POINTER TO CHARACTER BEFORE POINTER
SCNEND: 0 ;CHAR 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
TXTI: BLOCK .RDDBC+1 ;TEXTI BLOCK FOR MFILE0:
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 ;CHAR 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
DATAE=.-1 ;END OF TV VARIABLE SPACE
;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 CHARS
; 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 CHARS 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
POINT 7,[ASCIZ /COMMANDS/]
POINT 7,[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
POINT 7,[ASCIZ /TV/]
POINT 7,[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
TXO A,CO%NRJ ;CLOSE FILE BUT DON'T RELEASE JFN
CLOSF%
JSHLT
SETO B, ;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 #...
; 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>