Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0085/zap.mac
There is 1 other file named zap.mac in the archive. Click here to see a list.
TITLE ZAP PROGRAM TO ZAPEROO A FILE - CHANGE A WORD ON DISK
SUBTTL DANIEL KOHANSKI/CCIS SYSTEMS - RUTGERS UNIVERSITY/1974
TWOSEG
; ACUMULATORS
F==0 ;FLAGS
P==17 ;STACK
A1==1 ;MAIN TEMPORARIES
A2==2
A3==3
A4==4
T1==5 ;SUBROUTINE TEMPS
T2==6
T3==7
T4==10
BK==11 ;BREAK CHAR
OCT==T3 ;OCTAL VALUE
INF==12 ;SIXBIT VALUE
PTR==INF+1 ;POINTER
M==14 ;EXAMINE/DEPOSIT MODE
X==15 ;EXTRA FLAGS (WITHIN ONE ROUTINE ONLY)
; FLAGS
FL.OPN==1 ;FILE IS OPEN
FL.ZAP==2 ;BLOCK IS BEING MODIFIED
FL.BIC==4 ;BLOCK IS IN CORE
FL.SIX==10 ;ARGUMENT IS SIXBIT (HAS SOME NON-NUMERIC CHAR)
FL.LDZ==FL.SIX ;SKIPPING ;LEADING ZEROS (SUBROUTINE OUTPUT)
FL.ZON==20 ;FIRST CHAR MUST BE 0 OR 1 (FOR ASCII MODE)
FL.XIS==FL.ZON ;X-VALUE FOR CURRENT PART (INSTRUCTION MODE)
FL.RRD==40 ;REREAD OR CLOSE ZAPPED BLOCK WITHOUT WRITING
FL.HCP==100 ;TERMINAL IS HARDCOPY
FL.XBD==200 ;SEARCH STRING FOUND ACROSS WORD BOUNDARY
FL.XIT==400 ;EXIT SWITCH OR ^C^C
FL.SIP==1000 ;SEARCH IN PROGRESS CAN BE CONTINUED
FL.SMP==2000 ;MULTIPLE BLOCK SEARCH IN PROGRESS CAN BE CONTINUED
FL.FFL==4000 ;^L ALLOWED IN INPUT EDIT (ZAP)
FL.BBD==10000 ;STRING SEARCH CROSSING BLOCK BOUNDARY
FL.AST==20000 ;AUTO START IN PROGRESS
FL.DZC==FL.AST ;SYSTEM DISPLAY/ZAP IN CORE
FL.DDT==40000 ;RUNNING WITH DDT
FL.PRO==100000 ;FILE IS WRITE-PROTECTED
FL.PRX==200000 ;FILE IS READ-ONLY (LOOKUP BUT NOT ENTER)
FL.SYS==400000 ;SYSTEM TESTING
FR.FWS==1B18 ;FULL-WORD SEARCH
FR.RPL==1B19 ;SEARCH AND REPLACE WITH PRE-ENTERED VALUE
FR.ASR==1B20 ;AUTOMATIC SEARCH (AND REPLACE)
FR.SGW==1B21 ;STRING MUST BE IN ONE WORD
FR.MSX=1 ;MODE IS SIXBIT
FR.MSC=2 ;MODE IS ASCII
FR.MOC=0 ;MODE IS OCTAL
FR.MIS=4 ;MODE IS INSTRUCTION (M = 3)
FR.MKC=10 ;MODE IS ASCII CHARACTER (M = 4)
MASK==FL.HCP!FL.XIT!FL.DDT!FL.SYS!FL.AST ;LEFT HALF BITS TO RETAIN PAST A CLOSE
MMASK==FR.MSX!FR.MSC!FR.MOC!FR.MIS!FR.MKC ;MODE MASK
SRCFLG==FR.FWS!FR.RPL!FR.ASR!FR.SGW ;SPECIAL SEARCH BITS
; ETRA FLAG REGISTER FLAGS
XR.CLI==400000 ;CALLI INSTRUCTION
XR.EXT==200000 ;EXTENDED INSTRUCTION
XR.OFC==1 ;OP CODE PART COMPLETE
XR.AFC==2 ;A/F FIELD COMPLETE
XR.YFC==4 ;Y FIELD COMPLETE
XR.IFC==10 ;INDIRECT BIT ON
XR.XFS==20 ;X FIELD STARTED
; OTHER FLAGS
IS.CLI==400000 ;CALLI VALUE
IS.EXT==200000 ;EXTENDED INSTRUCTION
IS.ILI==100000 ;ILLEGAL INSTRUCTION
INDRCT==20 ;INDIRECT BIT(LH)
; CHANNELS
ZAP==1 ;BOTH LOOKUP AND ENTER
TTY==2 ;USED FOR SETTING SUPPRESS STATUS
; TTY MODE EQUATES
TTMODE==1 ;IMAGE DUMP
TTNOEC==1B28!TTMODE ;SUPPRESS ECHO
TTECHO==TTMODE ;RESTORE TO NORMAL
; OTHER EQUATES
.JBDDT==74 ;DDT VALUE
; MACRO PERFORMS HARDCOPY TSEST. IF ON, ISSUES LINEFEED.
DEFINE HCOPY
<TLNE F,FL.HCP
OUTCHR [12]>
SUBTTL DATA AREAS
; VERSION
VERSION==1
VUPDATE==0
VEDIT==0
VCUSTOM==0
LOC 137
<VCUSTOM>B2+<VERSION>B11+<VUPDATE>B17+VEDIT
LOC 134
CTRLC ;JB INTERRUPT LOC
RELOC 0
PSIZE==^D20 ;STACK SIZE
STACK: BLOCK PSIZE ;PUSHDOWN STACK
OPSPEC: EXP 17 ;OPEN DISK FILE SPECIFICATION DUMP MODE
SIXBIT /DSK/
XWD 0,0
TTSPEC: EXP TTMODE ;TTY SPEC
SIXBIT /TTY/
XWD 0,0
; EXTENDED LOOKUP ARGUMENT AREA
.RBCNT: 5 ;SIZE OF AREA
.RBPPN: Z
.RBNAM: Z
.RBEXT: Z
Z
.RBSIZ: Z ;SIZE OF FILE IN WORDS. DIVIDE BY BLKSIZ, +1
FILSIZ=.RBSIZ
; ENTER ARGUMENT AREA - MUST BE CONTIGUOUS TO LOOKUP AREA
ENTNAM: Z
ENTEXT: Z
Z
ENTPPN: Z
PPN: Z ;USER'S PPN
TTYLIN: BLOCK ^D10 ;TELETYPE INPUT BUFFER
INFTMP: BLOCK 3 ;ARGUMENT TEMP AREA
CURBLK: Z ;NUMBER OF BLOCK IN CORE
BLKSIZ=200 ;BLOCK SIZE (TOPS-10)
ZAPPED: BLOCK BLKSIZ ;WORK AREA
ZAPMOR: BLOCK BLKSIZ ;OVEFLOW IN SEARCH MULITPLE
XAMBEG: Z ;BEGINNING OF EXAMINE AREA
XAMEND: Z ;END OF EXAMINE AREA
FILPTR: Z ;POINTER IF ESCAPE DEPOSIT
SKPCHR: Z ;NO OF CHARS TO SKIP TO POSITION
; I/O INSTRUCTIONS - MUST BE IN LOW CORE
INSTR: IOWD BLKSIZ,ZAPPED
Z
INSCON: IOWD BLKSIZ,ZAPMOR ;FOR CROSSING BLOCK BOUNDARIES
Z
; VALUES MAINTAINED FOR CONTINUED SEARCH
SZPVAL: Z ;SEARCH VALUE
SZPMSK: Z ;SEARCH MASK
SZPPTR: Z ;POINTER TO ZAPPED AREA
SZPCNT: Z ;COUNT OF BITS IN SEARCH STRING
SZPPOS: Z ;POINTER VALUE WHEN SPLIT ACROSS WORD BOUND
SZPRPL: Z ;REPLACEMENT VALUE, RIGHT-JUSTIFIED
; JB INTERRUPT BLOCK
CTRLC: XWD 4,CLCHK ;EXIT ROUTINE
XWD 0,2 ;WORRY OVER ^C ONLY
Z
Z
SUBTTL MAIN ZAPPER!
; ZAP IS A CUSP WHICH MODIFIES DISK FILES ON THE SPOT; IT IS
; ESPECIALLY USEFUL FOR BINARY FILES WHICH CANNOT BE TECO'D.
; MODIFICATIONS ARE DONE ONE BLOCK AT A TIME, AND FOR ONE
; WORD WITHIN THE BLOCK. THE OUTPUT FILE IS THE SAME AS THE
; INPUT FILE - THAT IS, MODIFICATION IS DONE BY UPDATES AND
; USETI/O UUO'S. IT IS SUGGESTED THE USER CREATE A BACKUP FILE
; BEFORE STICKING HIS FINGERS WHERE THEY MAY GET BURNED.
; IT IS ALSO RECOMMENDED THAT THIS CUSP BE PROTECTED FROM
; THE AVERAGE HACKER AND USED ON [1,2] ONLY.
; ZAP WILL GUARD AGAINST SOME STUPID MISTAKES, SUCH AS
; TRYING TO ZAP THE RIB, OR A BLOCK BEYOND THE END, BUT THE
; USER IS EXPECTED TO KNOW WHAT HE IS DOING. OR IS THAT
; ASKING TOO MUCH?
RELOC 400000
ZZZZAP: RESET
MOVE P,[IOWD PSIZE,STACK]
GETPPN A1, ;WHO MIGHT WE BE?
JFCL
MOVEM A1,PPN
SETZB F,M ;GENERAL HOUSEKEEPING
CAMN A1,[1,,2] ;SYS PPN
TLO F,FL.SYS ;DIVINITY
CAMN A1,[1001,,1011] ;LESSER ANGELS
TLO F,FL.SYS
OPEN TTY,TTSPEC ;OPEN SO CAN DO THINGS
JRST [OUTSTR [ASCIZ /??CAN'T OPEN TTY
/]
EXIT] ;CURSES! FOILED AGAIN
; ZAP MUST RUN ON AN HONEST-TO-GOODNES TERMINAL,
; SO THE USER CAN SEE WHAT HE'S GOOFING UP. SO BACTH JOBS
; ARE VERBOTEN. SO IS OPSER, BECAUSE OF ALL THE
; EDITING COMMANDS THAT HE NEEDS. THEREFORE.....THROW THE BUM
; OUT IF HE TRIES TO PSEUDO HIS WAY.
SETO A1, ;ASK IF SELF BEING CONTROLLED
CTLJOB A1,
JRST WELCOM
JUMPL A1,WELCOM ;NO CONTROL
OUTSTR [ASCIZ /??ZAP RUNS ON REAL TERMINAL ONLY
/]
EXIT
WELCOM: OUTSTR [ASCIZ /ZAP!
TYPE H FOR HELP
/]
SKIPE .JBDDT ;SEE IF RUNNING DDT
TLOA F,FL.DDT ;IF SO, TURN ON DEBUG MODE
SKIPA
SETZM 134 ;LET ^C BE
SETZ T1,
TLNE F,FL.SYS ;IF PLAYING GOD,
SETUWP T1, ;ALLOW WRITE IN HIGH CORE
JFCL
; IF USER HAS REQUESTED A FILE ON COMMAD LEVEL, GET IT.
; ALSO READ IN BLOCK 1 AND PRINT OUT INFO STATUS.
RESCAN 1 ;LOOK OVER COMMAND
SKIPA
JRST ZAPCMD ;THAT'S ODD
RESCAN: INCHRW A2 ;MOVE UP TO - OR EOL
CAIN A2,15 ;CHECK VARIOUS EOL'S
JRST ZAPERR
CAIN A2,12
JRST ZAPERR
CAIN A2,33
JRST ZAPERR
CAIE A2,"-" ;GOLD AT THE END OF THE RAINBOW
JRST RESCAN ;BUT NO LEPRECHAUNS
; LITTLE DEVILS CAME ACROSS. NOW MINE THE GOLD
PUSHJ P,TTYINP ;REALLY TTYIN WITHOUT THE NOISE
MOVE PTR,[POINT 6,TTYLIN]
TLO F,FL.AST
JRST FILEIN ;AND BE ON OUR MERRY WAY
ZAPERR: CLRBFI ;COMMAND ERROR RETURN
ZAPCMD: TLZ F,FL.AST ;GOT THAT OVER WITH
SETSTS TTY,TTECHO ;NO LONGER NEEDED
SETZM SKPCHR ;KEEP IT CLEAN
PUSHJ P,TTYIN ;THY WISH IS THY COMMAND
MOVE PTR,[POINT 6,TTYLIN,5] ;BUT LET ME THINK ABOUT IT FIRST
LDB A1,PTR ;PTR WILL BE USED LATER BY GETARG
LSH A1,^D12
MOVEI A3,CMDTBL
TLZE F,FL.RRD ;RESET IF ON AND USE DIFFERENT TABLE
MOVEI A3,RRDTBL ;SELECT FOR REREAD
ZAPCHK: HLRZ A2,(A3) ;CHECK OUT THE WISH
JUMPE A2,CMDERR ;WISHFUL THINKING
CAMN A1,A2
JRST @(A3) ;SHIDDOCH!
AOJA A3,ZAPCHK ;WELL, HOW ABOUT THIS ONE?
CMDTBL: XWD 'R ',BLCKIN ;READ BLOCK N
XWD 'C ',CLOSEF ;CLOSE OUT FILE
RRDTBL: XWD 'F ',FILEIN ;LIST OF VALID COMMANDS
XWD 'A ',ATOFIL ;PERFROM AUTO OPEN & READ
XWD 'R ',REREAD ;REREAD ZAPPED BLOCK
XWD 'Z ',DEPSIT ;DEPOSIT A WORD
XWD 'T ',SETTTY ;SET TTY TYPE
XWD 'E ',CLEXIT ;CLOSE AND EXIT
XWD 'D ',XAMCOM ;EXAMINE IN CURRENT MODE
XWD 'S ',SRCZAP ;SEARCH AND ZAP
XWD 'W ',WRTBLK ;WRITE BLOCK N
XWD 'C ',RECLOS ;CLOSE OUT FILE
XWD 'I ',GVINFO ;GIVE INFO ON FILE
XWD 'M ',SETMOD ;SET MODE
XWD 'P ',SETPRO ;SET PROTECTION
XWD 'H ',HLPMES ;HELP!!!!!!!!!!!!!
XWD '% ',SYSTST ;SYSTEM TESTING COMMANDS
XWD 770000,ZAPCMD ;BLANK LINE
Z
NOTIMP: OUTSTR [ASCIZ /%NOT YET IMPLEMENTED. PATIENCE, PLEASE.
/]
JRST ZAPERR
; PERFORM SYSTEM TEST COMMANDS IF PRIVELEGED
SYSTST: TLNN F,FL.SYS
JRST CMDERR
MOVEI A3,SYCTBL
PUSHJ P,GETARG ;GET SPECIFIC COMMAND
SYSCHK: HLLZ A1,(A3)
JUMPE A1,CMDERR
CAME A1,INF
AOJA A3,SYSCHK
HRRZ A3,(A3)
JRST (A3)
SYCTBL: 'DDT',,GETDDT ;START DDT IF LOADED
'XAM',,XAMCOR ;EXAMINE WORDS IN CORE
'ZAP',,ZAPCOR ;ZAP A WORD ANYWHERE IN CORE
'MON',,MONRET ;RETURN TO MONITOR WITHOUT CLOSE
Z
GETDDT: SKIPN .JBDDT
JRST [OUTSTR [ASCIZ /?DDT NOT LOADED
/]
JRST ZAPERR]
HRRZ A3,.JBDDT ;START ADDR OF DDT
JRST (A3) ;GO MAN GO
; EXAMINE LOCATIONS IN CORE
XAMCOR: CAIE BK,':' ;SYNTAX CHECK
JRST ILLSYN
TLO F,FL.DZC ;MARK FOR THE ROAD AHEAD
SETZM XAMBEG ;DIFFERENT DEFAULTS
MOVEI T1,ENDALL
MOVEM T1,XAMEND ;END OF CORE
JRST XAMCRS
; ZAP A SPOT OF CORE
ZAPCOR: CAIE BK,':'
JRST ILLSYN
TLO F,FL.DZC
JRST DEPCOR
MONRET: EXIT 1, ;RETURN TO MONTIOR AT ONCE
JRST ZAPCMD ;IN CASE OF CONT
; TELL STUPID BUTTERFINGERS OUT THERE WHAT GIVES, AND HOW
; TO GIVE IT.
; EDIT THIS PAGE IN UPPER/LOWER CASE.
HLPMES: PUSHJ P,GETARG ;CHECK WHAT KIND OF HELP
JUMPE INF,GENHLP ;JUST FOR STARTERS
MOVEI A3,HLPTBL
HLPSRX: HLLZ A2,(A3)
JUMPE A2,CMDERR ;WE DON'T SERVE THAT HERE
CAME INF,A2
AOJA A3,HLPSRX ;KEEP ON TRUCKING
JRST @(A3)
; GENERAL HELP FOR THE INNOCENT
GENHLP: OUTSTR HLPMSG
JRST ZAPCMD
DEFINE MSG<
XLIST
ASCIZ &
Z.A.P. - THE ZOFTIG ALTERATION PROGRAM
ALL COMMANDS ARE ONE LETTER, FOLLOWED IMMEDIATELY BY
THE ARGUMENT(S).
ARGUMENTS IN <> ARE OPTIONAL. ALL NUMBERS ARE OCTAL.
COMMANDS:
Ffile<.ext><[p,pn]> - OPEN file.ext
Afile<.ext><[p,pn]> - AUTO OPEN
C - CLOSE FILE
E - CLOSE FILE IF OPEN AND EXIT
(SAME AS ^C)
Rn OR R+/-<N> - READ A BLOCK
W - WRITE CURRENT BLOCK
D<loc<,n>> - DISPLAY IN CURRENT MODE
Zloc - ZAP IN CURRENT MODE
S - SEARCH AND ZAP IN CURRENT OR CHARACTER MODE
Mk - SET MODE
Pn - SET WRITE PROTECT
I - TYPE CURRENT STATUS
Tk - SET TERMINAL TYPE
H - THIS MESSAGE
FOR MORE INFORMATION, TYPE "Hc", WHERE c IS SOME COMMAND.
&
LIST>
; DANIEL KOHANSKI
; CCIS SYSTEMS GROUP
; RUTGERS UNIVERSITY
; JANUARY 1975
HLPMSG: MSG
; TABLE OF DETAILD HELP ROUTINES. EACH ACCOMPANIES
; THE APPROPRIATE CODE.
HLPTBL: XWD 'R ',HLPRED
XWD 'E ',HLPCLS
XWD 'C ',HLPCLS
XWD 'F ',HLPFIL
XWD 'A ',HLPATO
XWD 'Z ',HLPZAP
XWD 'D ',HLPDIS
XWD 'S ',HLPSRC
XWD 'W ',HLPWRT
XWD 'I ',HLPINF
XWD 'P ',HLPPRO
XWD 'M ',HLPMOD
XWD 'H ',HLPHLP
XWD 'T ',HLPTTY
Z
; JUST FOR SUCKERS:
HLPHLP: OUTSTR [ASCIZ /WISE GUY!
/]
JRST ZAPCMD
; SO YOU DON'T LIKE IT A LA MODE, HUH?
HLPMOD: OUTSTR MODMSG
JRST ZAPCMD
DEFINE MSG,<
XLIST
ASCIZ &Mk -SET CURRENT MODE
ALL DISPLAY AND ZAPPING IS DONE IN THE CURRENT MODE.
THE EXCEPTION IS K(CHARACTER ZAP - SEE THE K COMMAND).
THE THREE MODES ARE:
O - OCTAL
S - SIXBIT
A - ASCII
K - ASCII CHARACTER
I - INSTRUCTION
ASCII IS DISPLAYED AS 7-BIT BINARY BYTES, WITH THE CHARACTER
EQUIVALENTS TO THE SIDE. CONTROL CHARACTERS ARE DISPLAYED
AS "\". SIXBIT MODE DISPLAYS AND ENTERS AS CHARACTERS; OCTAL
AS NUMERALS. OCTAL IS DEFAULT.
&
LIST>
MODMSG: MSG
SETMOD: PUSHJ P,GETARG ;SET MODE
JUMPGE BK,ILLSYN
SETZ A2,
SETCHK: SKIPN SETTBL(A2) ;FIND OUT WHICH MODE
JRST [OUTSTR [ASCIZ /?INVALID MODE
/]
JRST ZAPERR]
HLLZ A3,SETTBL(A2)
CAME A3,INF
AOJA A2,SETCHK
TRZ F,MMASK ;MASK OUT OLD MODE
TRO F,@SETTBL(A2) ;AND RING IN THE NEW
MOVEM A2,M ;INDEX INTO TABLE = MODE INDEX
TLZ FL.SIP!FL.SMP ;MODE CHANGE INVALIDATES SEARCH
TLNE F,FL.OPN ;IF HAVE OPEN FILE WHEN REQ
TRNN F,FR.MIS ;INSTR MODE, WARN HIM IF NOT REL
JRST ZAPCMD
SETZ T1,
INSBIN: MOVE T2,BINLST(T1)
JUMPE T2,INNBIN ;NOT A BINARY FILE
CAMN T2,.RBEXT ;COMPARE W/ LIST OF VALID EXT
JRST ZAPCMD
AOJA T1,INSBIN
INNBIN: OUTSTR [ASCIZ /%NOT A BINARY FILE
/]
JRST ZAPCMD
SETTBL: 'O ',,FR.MOC ;TABLE ORDER IS EQUAL TO MODE VALUE. THE ORDER OF
'S ',,FR.MSX ;ALL MODE TABLES MUST MATCH THIS ONE.
'A ',,FR.MSC
'I ',,FR.MIS
'K ',,FR.MKC
Z
BINLST: SIXBIT /REL/ ;TABLE OF VALID BINARY EXTENSIONS
SIXBIT /BIN/
SIXBIT /SAV/
SIXBIT /HGH/
SIXBIT /LOW/
SIXBIT /SHR/
Z
; SET WRITE PROTECTION SO CAN EXAMINE IN PEACE
HLPPRO: OUTSTR [ASCIZ &
Pn - SET WRITE PROTECTION
IF SET TO ZERO (INITIAL CONDITION), FILE CAN BE ZAPPED.
IF SET TO 1, ZAP WILL NOT WORK, AND SEARCH WILL DISPLAY ONLY.
&]
JRST ZAPCMD
SETPRO: TLNN F,FL.OPN ;ANYTHING TO PROTECT?
JRST NFLERR
TLNE F,FL.PRX ;IF READ-ONLY, YOU'RE STUCK
JRST [OUTSTR [ASCIZ /?FILE IS READ-ONLY
/]
JRST ZAPERR]
PUSHJ P,GETARG
JUMPGE BK,ILLSYN
TLNN F,FL.OPN
JRST NFLERR ;GOTTA HAVE A FILE TO PROTECT
TLNE F,FL.SIX ;ARG MUST BE BINARY
JRST ILLNUM
CAILE OCT,1 ;ARG MUST BE 0 OR 1
JRST CMDERR
XCT ONFPRO(OCT) ;CLEAR: SET AS DESIRED
TLZN F,FL.ZAP ;IF ALREADY ZAPPED, UN-ZAP
JRST ZAPCMD
JRST REREAD ;GET ORIGINAL COPY BACK- FILE IS PROTECTED
ONFPRO: TLZ F,FL.PRO ;P0
TLO F,FL.PRO ;P1
; SET TTY TYPE - HARDCOPY OR CRT
HLPTTY: OUTSTR TTYMSG
JRST ZAPCMD
DEFINE MSG<
XLIST
ASCIZ &
Tk - SET TERMINAL STATUS
FOR OPERATION ON A HARDCOPY TELETYPE, TYPE "TH". DEFAULT
IS CRT ("TC").
&
LIST>
TTYMSG: MSG
SETTTY: PUSHJ P,GETARG
JUMPGE BK,ILLSYN
SETZ A2,
STTCHK: SKIPN STTTBL(A2) ;CHECK OUT REQ
JRST [OUTSTR [ASCIZ /?INVALID TYPE
/]
JRST ZAPERR]
HLLZ A3,STTTBL(A2)
CAME INF,A3 ;CHECK?
AOJA A2,STTCHK
XCT @STTTBL(A2) ;TURN SOMEHOW
JRST ZAPCMD
STTTBL: XWD 'H ',ONHCP ;HARDCOPY
XWD 'C ',ONCRT ;CRT IS DEFAULT
Z
; TO BE EXECUTED AT DAWN
ONHCP: TLO F,FL.HCP
ONCRT: TLZ F,FL.HCP
; START AUTO FILE PROCESS
HLPATO: OUTSTR ATOMSG
JRST ZAPCMD
DEFINE MSG<
XLIST
ASCIZ &
Afile<.ext><[p,pn]> - AUTO OPEN file.ext
CLOSE CURRENT FILE, IF OPEN (UNLESS ZAPPED BLOCK STILL IN
CORE). OPEN FILE.EXT AND READ IN BLOCK 1. (THIS IS BASCALLY
THE SAME AS THE AUTO START PROCEDURE - SEE THE F COMMAND.)
&
LIST>
ATOMSG: MSG
ATOFIL: TLO F,FL.AST ;MARK
TLNE F,FL.OPN ;UNFINISHED BUSINESS?
JRST CLOSEF
JRST FILEIN
; GET THE FILE NAMED IN THE COMMAND. HIER BEGINNT...
HLPFIL: OUTSTR FILMSG
JRST ZAPCMD
DEFINE MSG,<
XLIST
ASCIZ &Ffile<.ext><[p,pn]> - OPEN FILE FOR WORK
NO WORK CAN BE DONE UNTIL A FILE HAS BEEN SPECIFIED, EITHER WITH
THE F COMMAND, OR AT THE MONITOR LEVEL: R ZAP-file.ext.
IF A DIFFERENT P,PN FROM THE USER IS GIVEN, THE USER MUST
HAVE WRITE PRIVILEGES TO THAT UFD.
&
LIST>
FILMSG: MSG
FILEIN: TLNE F,FL.OPN ;CHECK IF OPEN FILE LYING AROUND
JRST [OUTSTR [ASCIZ /?FILE ALREADY OPEN
/]
JRST ZAPERR] ;WE BEGINNT ALREADY
OPEN ZAP,OPSPEC ;OPEN SESAME
JRST [OUTSTR [ASCIZ /??CAN'T OPEN DISK
/]
EXIT] ;ALLADIN WENT ON STRIKE
SETZM .RBPPN ;CLEAR OUT LOOKUP/ENTER AREAS
MOVE A1,[.RBPPN,,.RBNAM]
BLT A1,ENTPPN ;CUT THE MUSTARD
PUSHJ P,GETARG ;GET FIRST ARGUMENT - FILE NAME
JUMPE INF,[OUTSTR [ASCIZ /?NO FILE NAME
/]
JRST ZAPERR] ;MAYBE I SHOULD READ MINDS?
MOVEM INF,.RBNAM
MOVEM INF,ENTNAM
JUMPL BK,FILLKP ;DEFAULTS FOR REST - ZERO
CAIN BK,'['
JRST FILPPN ;EXTENSION DEFAULT
CAIE BK,'.'
JRST ILLSYN ;AW, YA BLEW IT!
PUSHJ P,GETARG ;GET THE MAN AN EXTENSION
HLLZM INF,.RBEXT
HLLZM INF,ENTEXT
JUMPL BK,FILLKP ;NOW CAN WE GO?
CAIE BK,'[' ;EXACTLY PPN
JRST ILLSYN ;GOTCHA!
FILPPN: PUSHJ P,GETARG ;PROJ PART
TLNE F,FL.SIX
JRST ILLNUM ;MUST BE OCTAL
SKIPN OCT
HLRZ OCT,PPN ;USE OUR OWN PROJ
HRLZM OCT,.RBPPN
HRLZM OCT,ENTPPN
CAIE BK,','
JRST ILLSYN ;NO EXCUSES
PUSHJ P,GETARG ;PROG PART
TLNE F,FL.SIX
JRST ILLNUM ;SOME PEOPLE NEVER LEARN
SKIPN OCT
HRRZ OCT,PPN
HRRM OCT,.RBPPN
HRRM OCT,ENTPPN
FILLKP: LOOKUP ZAP,.RBCNT ;EXTENDED LOOKUP GETS FILE SIZE
JRST LKPERR ;OH NO YOU DON'T
ENTER ZAP,ENTNAM ;SAME CHANNEL FOR UPDATE
JRST ENTERR ;NOW WHAT?!
FLLEPX: HLLZS .RBEXT ;FOR LATER USE
TLO F,FL.OPN ;MARK IT OPEN
TLZ F,FL.BIC!FL.ZAP ;CLEAR OTHER THINGS
MOVE A1,FILSIZ ;COMPUTE FILSIZ IN BLOCKS
IDIVI A1,BLKSIZ
SKIPE A2
AOJ A1, ;FOR PARTIAL BLOCKS
MOVEM A1,FILSIZ
TLNN F,FL.AST ;CHECK FOR AUTO START
JRST ZAPCMD ;WHEW!
MOVEI OCT,1 ;BLOCK ONE
JRST BLCPOS ;ROUND ONE
; TYPE OUT GENERAL INFO IN CASE DOPE OUT THERE
; DOESN'T KNOW WHAT'S GOING ON.
HLPINF: OUTSTR [ASCIZ &
I - TYPE CURRENT STATUS
TYPE OUT THE NAME OF THE OPEN FILE, THE CURRENT BLOCK,ETC.
FOR EXAMPLE:
&]
GVINFO: TLNN F,FL.OPN ;MAKE SURE HAVE SOMETHING TO GIVE
JRST NFLWRN ;THOUGHT YOU COULD SLIP ONE PAST, EH?
OUTSTR [ASCIZ /FILE: /]
MOVE T2,ENTNAM ;FILE NAME
PUSHJ P,SIXOUT
HLLZ T2,ENTEXT ;AND EXTENSION
JUMPE T2,GVSCON ;BUT WE HAVEN'T ANY
OUTCHR ["."]
PUSHJ P,SIXOUT
GVSCON: OUTSTR [ASCIZ / LENGTH: /]
HRLZ T2,FILSIZ
PUSHJ P,BINOUT
OUTSTR [ASCIZ / BLOCKS
/]
TLNE F,FL.PRO ;FILE PROTECTED?
OUTSTR [ASCIZ /WRITE-PROTECTED
/]
TLNE F,FL.BIC
JRST GVIBIC ;TESTING FOR BLOCKHEAD IN CORE
OUTSTR [ASCIZ /NO BLOCK IN CORE
/]
JRST ZAPCMD ;MY, WASN'T THAT EASY?
GVIBIC: OUTSTR [ASCIZ /BLOCK /] ;NOT SO FAST
HRLZ T2,CURBLK
PUSHJ P,BINOUT
OUTSTR [ASCIZ / IN CORE/]
TLNE F,FL.ZAP ;HAS HE ZAPPED IT YET?
OUTSTR [ASCIZ / ZAPPED/]
OUTSTR [ASCIZ &
DISPLAY/ZAP MODE: &]
OUTSTR @DISMOD(M)
TLNN F,FL.SMP!FL.SIP ;DESCRIBE SEARCH CONDITIONS
JRST ZAPCMD ;NO SEARCH
TLNE F,FL.SMP
OUTSTR [ASCIZ /MULTIPLE /]
TRNE F,FR.FWS
OUTSTR [ASCIZ /FULLWORD /]
OUTSTR [ASCIZ /SEARCH FOR "/]
MOVE T2,SZPVAL ;INCLUDE SEARCH VALUE IN MSG
PUSHJ P,DISCUR
OUTSTR [ASCIZ /" CAN BE CONTINUED.
/]
TRNN F,FR.RPL ;REPLACEMENT AVAILABLE?
JRST ZAPCMD
OUTSTR [ASCIZ /REPLACEMENT VALUE IS "/]
MOVE T2,SZPRPL
PUSHJ P,DISCUR ;DISPLAY SAME AS SEARCH VALUE
OUTSTR [BYTE(7) 42,15,12,0] ; "CRLF
JRST ZAPCMD ;NOW, THAT DIDN'T HURT TOO MUCH, DID IT?
DISMOD: [ASCIZ /OCTAL
/]
[ASCIZ /SIXBIT
/]
[ASCIZ /ASCII
/]
[ASCIZ /INSTRUCTION
/]
[ASCIZ /ASCII CHARACTER
/]
; FURTHER ADVENTURES OF ZAP KOMIKS
HLPRED: OUTSTR [ASCIZ &
Rn - READ BLOCK n
R+<n> - READ AHEAD n BLOCKS (DEFAULT IS ONE)
R-<n> - READ BACK n BLOCKS
YOU MUST SPECIFY THE BLOCK TO READ BEFORE DOING ANY WORK.
&]
JRST ZAPCMD
; READ IN A BLOCK FOR BLOCKO BLOCKBUSTER, BUSTER
BLCKIN: TLNN F,FL.OPN ;ALREADY BUSTING?
JRST NFLERR ;NO FILE - BUST HIM
TLNE F,FL.ZAP ;IS THERE A BLOCK IN CORE BEEN ZAPPED?
JRST BLCRRD ;BLOCK ZAPPED, SUGGEST REREAD
PUSHJ P,GETARG
JUMPGE BK,BLCMOV ;CHECK FOR +/- COMMAND
TLNE F,FL.SIX
JRST ILLNUM ;MUST BE OCTAL
BLCPOS: SKIPLE OCT ;CANNOT BE ZERO
CAMLE OCT,FILSIZ ;MUST BE IN RANGE - BE FUSSY
JRST BLCORN
MOVEM OCT,CURBLK ;MARK FOR POSTERITY
REREAD: USETI ZAP,@CURBLK ;POSITION ARM
TLO F,FL.BIC ;WE ARE GETTING THERE
TLZ F,FL.ZAP!FL.XIT!FL.SIP ;RESET VARIOUS CONDITIONS
MOVE T1,SRXPTR(M) ;IN CASE IN MIDDLE OF SEARCH
MOVEM T1,SZPPTR ;MULTIPLE, RESET POINTER
IN ZAP,INSTR ;SEND OUT THE NETS
JRST BLKATO
STATZ ZAP,1B22 ;IF ON, GONE PAST FILE
JRST BLCMAC ;WARNING AND ERROR
FIOERR: GETSTS ZAP,T2 ;WE JUST CAN'T WIN
HRLZS T2
OUTSTR [ASCIZ *??I/O ERROR: STATUS = *]
PUSHJ P,BINOUT
RESDV. ZAP, ;GIVE UP THE GHOST
EXIT ;THUD
BLKATO: TLNN F,FL.AST ;STILL IN AUTO START?
JRST ZAPCMD ;SPLIT
JRST GVINFO ;TELL HIM WHAT WE'VE DONE
BLCRRD: CLRBFI ;GIVE HIM ANOTHER CHANCE
OUTSTR [ASCIZ /?ZAPPED BLOCK STILL IN CORE. TYPE R TO REREAD
/]
TLO F,FL.RRD ;MARK FOR COMMAND
JRST ZAPCMD
BLCMOV: JUMPN INF,ILLSYN ;CHECKING +/- N
CAIN BK,'+'
JRST BLCADM
CAIE BK,'-'
JRST ILLSYN ;FALSE HOPES
BLCADM: MOVEM BK,A1
PUSHJ P,GETARG ;GET COUNT IF ANY
JUMPGE BK,ILLSYN
JUMPE INF,BLCSET ;BLANK := +/- 1
TLNE F,FL.SIX
JRST ILLNUM
JUMPE OCT,ZAPCMD ;LEAVE US NOT BE SIMPLETONS
SKIPA
BLCSET: MOVEI OCT,1 ;DEFAULT ARG
CAIE A1,'+' ;NOW - WHICH IS WHICH?
MOVNS OCT
ADD OCT,CURBLK ;RECOMPUTE
JRST BLCPOS ;AND TRY IT OUT
; TRUCKING ALONG...
HLPDIS: OUTSTR DISMSG
JRST ZAPCMD
DEFINE MSG,<
XLIST
ASCIZ &D<loc<,n>> DISPLAY IN CURRENT MODE
IF NO ARGUMENTS ARE GIVEN, DISPLAY THE ENTIRE BLOCK.
IF NO loc IS GIVEN, DISPLAY n WORDS STARTING AT LOC 0.
IF ONLY loc IS GIVEN, DISPLAY LOC.
OTHERWISE, DISPLAY n WORDS STARTING AT loc.
&
LIST>
DISMSG: MSG
; DISPLAY SOME PRETTIES
XAMCOM: PUSHJ P,TSTBLC ;MAKE SURE ALL THERE
SETZM XAMBEG ;SET DEFAULTS
MOVEI A1,BLKSIZ
MOVEM A1,XAMEND
XAMCRS: PUSHJ P,GETARG
SKIPN INF ;IF ARGS, PUT IN
JUMPL BK,XAMDIS ;NO ARGS MEANS EXAMINE ALL
TLNE F,FL.SIX
JRST ILLNUM ;Y'GOTTA BE OCTAL
TLNE F,FL.DZC ;IF EXAMINING ALL CORE,
JRST XAMBST ;ACCEPT ARG
CAIL OCT,BLKSIZ
JRST LRGERR ;DON'T BE GREEDY
XAMBST: MOVEM OCT,XAMBEG ;ACCEPT AS BEGINNING
SKIPGE BK ;IF ONLY ARG, THEN END AS WELL
MOVEM OCT,XAMEND ;STORE AS ENDPOINT
JUMPL BK,XAMDIS ;SO IT'S ENDING
CAIE BK,','
JRST ILLSYN ;MUST BE COMMA
PUSHJ P,GETARG ;GET COUNT
JUMPGE BK,ILLSYN ;THAT'S ENOGUH ARGUMENT
TLNE F,FL.SIX
JRST ILLNUM
TLNE F,FL.DZC ;ON SYS EXAM OF CORE,
JRST XAMEST ;TRUST ME
ADD OCT,XAMBEG ;COMBINE START AND COUNT
CAILE OCT,BLKSIZ
JRST LRGERR ;OUT OF RANGE AGAIN
XAMEST: MOVEM OCT,XAMEND ;ACCEPTED
XAMDIS: MOVE A2,XAMBEG
XAMLIN: OUTSTR CRLF
HRLZ T2,A2 ;GET REL ADDR
PUSHJ P,BINOUT
OUTCHR [":"]
MOVE A3,LNSIZE(M) ;WORDS/LINE DEPENDS ON MODE
XAMWRD: SOJLE A3,XAMLIN ;COUNT DOWN WORDS/LINE
OUTSTR DBLSP ;SPACING
TLNE F,FL.DZC ;EXAMINE CORE OR REGULAR?
MOVE T2,(A2) ;CORE
TLNN F,FL.DZC
MOVE T2,ZAPPED(A2) ;REG - THIS WAY PRESERVES THE REL ADDR
PUSHJ P,@DISOUT(M) ;DISPLAY IN MODE
AOJ A2,
CAMGE A2,XAMEND ;GOT THERE YET?
JRST XAMWRD ;KEEP GOING
OUTSTR CRLF
JRST ZAPCMD ;GOT THAT OVER WITH
; TABLE OF SUBROUTINES
DISOUT: DISOCT ;OCTAL
SIXOUT ;SIXBIT
DISASC ;ASCII
DISMIS ;INSTRUCTION
DASCII ;ASCII CHAR
; TABLE OF WORDS/LINE
; VALUE IS ONE GREATER THAN NUMBER THAT WILL BE PRINTED
LNSIZE: 5 ;OCTAL
^D9 ;SIXBIT
3 ;ASCII
3 ;INSTR
^D10 ;CHAR
; WE HAVE COME TO THE HEART OF THE MATTER - THE DARK OF THE FOREST.
; FOLLOW THE YELLOW BRICK BAT AND MAKE YOUR NIGHT DEPOSITS HERE
HLPZAP: OUTSTR ZAPMSG
JRST ZAPCMD
DEFINE MSG,<
XLIST
ASCIZ &Zloc - ZAP ONE WORD IN CURRENT MODE
THE VALUE OF loc IS DISPLAYED, AND THE USER TYPES IN THE
NEW VALUE UNDERNEATH. ONLY THOSE CHARACTERS RECOGNIZED IN THE
CURRENT MODE ARE VALID. THE FOLLOWING KEYS HAVE SPECIAL MEANING:
ESCAPE ZAP UP TO POINT OF ESCAPE
RUBOUT DELETE NEW VALUE AND RETAIN OLD ONE.
CTRL-H BACKSPACE ONE CHARACTER
CTRL-L FORWARD SPACE ONE CHARACTER
IN ASCII MODE, THE FIRST CHARACTER OF EACH BYTE MUST BE ZERO OR
ONE, AS MUST THE LAST BIT (BIT 35).
&
LIST>
ZAPMSG: MSG
DEPSIT: PUSHJ P,TSTBLC ;USUAL CHECKS
TLNE F,FL.PRO ;MUST BE ABLE TO WRITE
JRST WPOERR
DEPCOR: PUSHJ P,GETARG ;LOCATION TO PATCH
JUMPE INF,LRGERR
JUMPGE BK,ILLSYN
TLNE F,FL.SIX
JRST ILLNUM
TLNE F,FL.DZC ;IF ZAPPING CORE,
JRST DEPALL ;DO IT DIFFERENTLY
CAIL OCT,BLKSIZ
JRST LRGERR
MOVEM OCT,A4 ;NUMBER IS KOSHER
DEPSHW: MOVE T2,ZAPPED(A4) ;WORD TO ZAP
PUSHJ P,@DISOUT(M) ;SELECT A FORMAT BY MODE
OUTSTR CRLF
DEPOVR: MOVE INF,ZAPPED(A4) ;TO BE OVERLAID
TLO F,FL.FFL ;PERMIT ^L IN EDIT
PUSHJ P,INPVAL ;GET INPUT VALUE
DEPZRP: ANDCAM A3,ZAPPED(A4) ;CLEAR OUT ZAPPED PART
IORM A2,ZAPPED(A4) ;RING IN THE NEW
DEPDSP: MOVE T2,ZAPPED(A4) ;FOR EXTRA DISPLAY
TRNE F,FR.RPL ;IF REPLACED, SHOW WORK
PUSHJ P,@DISOUT(M)
TLNN F,FL.DDT ;BE FORGETFUL IF DEBUGGING
TLO F,FL.ZAP ;REMEMBER THE OCCASION
PUSHJ P,TRFBBD ;CLEAN UP IF NECESSARY
TLZE F,FL.XBD ;IS THERE A PARTY OF THE SECOND PART?
JRST DEPLTR
OUTSTR CRLF
TRNN F,FR.ASR ;AUTOMATIC CONTINUE?
JRST ZAPERR ;ALSO CLEAN OUT ANY GARBAGE
JRST SRCCON ;CONTINUE
DEPLTR: OUTSTR [ASCIZ /
(SECOND PART)
/]
TRNN F,FR.RPL ;SEE IF AUTO REPLACE
AOJA A4,DEPSHW ;GO DO NEXT WORD - HAS SEARCH STRING ALSO
MOVE T2,ZAPPED+1(A4) ;SHOW OLD VERSION - BE POLITE (FOR ONCE)
PUSHJ P,@DISOUT(M)
OUTSTR CRLF
AOJA A4,DEPZRP ;GET REST OF REPL STRING
; ZAPPING CORE - SYSTEM PRIV. WRITE-PROTECT HAS BEEN CLEARED
; AT THE START OF THE PRGRAM.
DEPALL: MOVEM OCT,A4 ;ADDRESS
MOVE T2,(A4)
PUSHJ P,@DISOUT(M) ;DISPLAY
OUTSTR CRLF ;USUAL PRETTIES
MOVE INF,(A4) ;SET UP FOR INPVAL
TLO F,FL.FFL
PUSHJ P,INPVAL ;GET ARG TO ZAP
ANDCAM A3,(A4) ;SURGERY!
IORM A2,(A4) ;TRANSPLANT
OUTSTR CRLF ;BURP
JRST ZAPERR ;CLEAN UP ANY LEFT OVER BLOOD
;
; SEARCH/REPLACE SIMULATES THE INPUTTING OF THE REPLACEMENT VALUE.
; IN FULLWORD SEARCH THERE IS NO PROBLEM. IF THE WORD IS ALL
; IN ONE WORD, THE MASK IS SHIFTED AND USED AS USUAL.
; WHEN A STRING IS SPREAD ACROSS THE WORD BOUND, THE MASK IS SHIFTED
; IN DOUBLE WORD FASHION IN SUCH A WAY AS TO MINIMIZE THE RESETTING
; OF VALUES FOR THE SECOND PART. INSTRUCTION MODE IS A LITTLE SIMPLER.
ZAPREP: TRNN F,FR.RPL ;ENTRY FROM SEARCH. CHECK IF REPLACE
JRST DEPOVR ;MANO A MANO
TRNE F,FR.FWS ;FULLWORD?
JRST ZRPFWL
MOVE A3,SZPMSK ;SET UP FOR VARIOUS POSSIBILITIES
MOVE A2,SZPRPL ;REPLACEMENT VALUE
TRNE F,FR.MIS
JRST DEPZRP ;IF INSTRUCTION, THAT'S ALL
TLNE F,FL.XBD ;IS WORD SPLIT?
JRST ZRPSPL
MOVN T1,SKPCHR ;CALCULATE SHIFT COUNT AS
IMUL T1,SRXSIZ(M) ; (36-SZPCNT) - (SKPCHR*BYTESIZE)
SUB T1,SZPCNT
ADDI T1,^D36 ;POSITIVE NUMBER FOR LEFT SHIFT
LSH A2,(T1) ;DO THIS ONE AT A TIME
LSH A3,(T1)
SETZM SKPCHR ;IN CASE OF FUTURE REFERENCE
JRST DEPZRP ;THAT'S ALL, FOLKS....
ZRPSPL: MOVE T1,SKPCHR ;SPLIT WORD - SHIFT RIGHT
SETZM SKPCHR
IMUL T1,SRXSIZ(M)
SUBI T1,^D36 ;-(SZPCNT-(36- SKPCHR*BYTESIZE)))
MOVMS T1
SUB T1,SZPCNT
MOVE A2,SZPMSK
MOVE T3,SZPRPL ;GET REPLACEMENT VALUE
SETZB A3,T4 ;THESE WILL HOLD THE SECOND PART VALUES
TRNE F,FR.MKC!FR.MSC ;IF ASCII, SHIFT
SOJ T1, ;RIGHT ANOTHER
LSHC A2,(T1) ;ADJUST MASK
LSHC T3,(T1)
TRNN F,FR.MKC!FR.MSC ;IF ASCII, ADJUST AGAIN
JRST ZRPSPX
LSH A2,1
LSH T3,1
ZRPSPX: ANDCAM A2,ZAPPED(A4) ;OK, PUT IT IN
IORM T3,ZAPPED(A4)
MOVE A2,T4 ;FOR SAFEKEEPING AND TO MINIMIZE LATER
JRST DEPDSP ;WORK - A3 ALREADY CONTAINS CORRECT MASK
ZRPFWL: MOVE A2,SZPRPL ;FULLWORD ZAP - NOTHIN' TO IT
MOVEM A2,ZAPPED(A4)
JRST DEPDSP ;SHOW WHAT YOU'VE DONE TO HIM
; HUNT DOWN OFFENDING BYTE AND ZAPPO!
HLPSRC: OUTSTR SRCMSG
JRST ZAPCMD
DEFINE MSG,<
XLIST
ASCIZ &S[/s] - SEARCH FOR VALUE AND ZAP
SM[/s] - SEARCH MULTIPLE BLOCKS
SC - CONTINUE SEARCH FROM LAST FOUND VALUE
SCM - CONTINUE MULTIPLE SEARCH
SEARCH IS CONDUCTED IN CURRENT MODE; THUS, CHANGING THE MODE
WILL DISCONTINUE THE SEARCH. WHEN THE SEARCH VALUE IS FOUND,
IT IS DISPLAYED, AND THE USER HAS A CHANCE TO CHANGE IT. RUBOUT
WILL RETAIN THE ORIGINAL VALUE AND RETURN THE USER TO COMMAND
LEVEL. IF THE VALUE IS FOUND TO LIE ACROSS A WORD BOUNDARY, BOTH
WORDS MAY BE ZAPPED.
SEARCH MULTIPLE WILL WRITE OUT ANY BLOCK THAT HAS BEEN ZAPPED
IN THE PROCESS OF CONTINUING THE SEARCH. A NEW BLOCK MAY BE
READ IN WITHOUT INVALIDATING THE MULTIPLE SEARCH.
S/F (OR SM/F) REQUESTS A FULLWORD SEARCH - THE ENTIRE WORD MUST
MATCH THE SEARCH STRING (RIGHT JUSTIFIED). EXCEPT IN ASCII MODE,
SEARCHING FOR ALL 36 BITS DOES NOT AUTOMATCIALLY INVOKE THE
FULLWORD SEARCH.
S/R (SM/R) REQUESTS AUTO REPLACEMENT ON A SUCCESSFUL SEARCH. EXCEPT
ON A FULLWORD SEARCH, THE SEARCH AND REPLACEMENT STRINGS MUST BE THE
SAME SIZE.
S/C (SM/C) WILL CONTINUE SEARCH AUTOMATICALLY AFTER ZAP IS COMPLETE
(FOR A PROTECTED FILE, AFTER DISPLAY). WHILE RUNNING, TYPING ^C (CTRL-C)
WILL STOP ACTION - EVENTUALLY. USE WITH CAUTION.
S/W (SM/W) REQUIRES THAT THE MATCH TO THE SEARCH STRING BE FOUND
ENTIRELY WITHIN ONE WORD.
&
LIST>
SRCMSG: MSG
; IF S, START NEW SEARCH. IF SC, TRY TO CONTINUE FROM WHERE
; LEFT OFF. IF NEW SEARCH, GET VALUE FROM USER.
SRCZAP: PUSHJ P,TSTBLC ;USUAL PRELIMINARIES
PUSHJ P,GETARG
JUMPE INF,SRCNEW ;NEW SEARCH
MOVEI A2,SRCTBL ;CHECK REST OF COMMAND
SRCSRC: HLLZ A1,(A2)
JUMPE A1,CMDERR ;OUT OF POSSIBILITIES
CAME INF,A1
AOJA A2,SRCSRC
JRST @(A2) ;WE WENT THATAWAY
SMSINP: TLNE F,FL.SMP ;CONTINUE MULTIPLE SEARCH. SEE IF CAN
JRST SRCCON
JRST SRCERR
SCSINP: TLNN F,FL.SIP!FL.SMP ;CHECK IF SINGLE SEARCH ACTIVE
JRST SRCERR ;NEITHER ONE
TLZ F,FL.SMP ;STOP MULITIPLE IF ON
JRST SRCCON
SRCNMP: TLOA F,FL.SMP ;ENTRY FOR NEW MULITPLE SEARCH
SRCNEW: TLZ F,FL.SMP
TRZ F,SRCFLG ;TURN OFF SPECIAL SEARCH SWITCHES
SRCSWC: CAIE BK,'/' ;SEE IF COMMAND HAD A SWITCH
JRST SRCNMS
PUSHJ P,GETARG ;GET SWITCH
MOVEI T1,SWFTBL ;SWITCH TABLE
SRSWCK: HLLZ T2,(T1)
JUMPE T2,CMDERR ;ILLEGAL SWITCH
CAME INF,T2
AOJA T1,SRSWCK ;KEEP AT IT
TLO T1,INDRCT ;PUT SWITCH IN F
TRO F,@T1 ;LEFT-HANDED PASS
JRST SRCSWC ;SEE IF ANY MORE SWITCHES
SRCNMS: TRNN F,FR.RPL
JRST SRCSMS
TLNE F,FL.PRO ;CANNOT DO S/R IF PROTECT ON
JRST WPOERR
SRCSMS: OUTSTR [ASCIZ /SEARCH MODE IS /]
OUTSTR @DISMOD(M) ;INTRODUCE YOURSELF
OUTSTR [ASCIZ /ENTER SEARCH VALUE: /] ;ASK, MY SON
TLZ F,FL.FFL ;NO FORWARD SPACING
SETZM SKPCHR ;JUST A CHECK
PUSHJ P,INPVAL ;GET SEARCH VALUE
JUMPE A3,ZAPCMD ;SAFETY
TRNE F,FR.MIS ;HANDLE INSTR DIFFERENTLY
JRST SRCMIS
SETZ T3,
SRCCTB: TRNE A3,1 ;VALUES ARE LEFT-JUSTIFIED; RIGHT-JUST. THEM
JRST SRCLWF ;RIGHT END REACHD
LSH A3,-1 ;ONE BIT AT A TIME
SOJA T3,SRCCTB ;SHI....FTING
SRCLWF: LSH A2,(T3) ;SO VALUE MATCHES MASK
TRC F,FR.MKC!FR.FWS ;IF FULLWORD IN ASCII CHAR MODE,
TRCN F,FR.MKC!FR.FWS
LSHC A2,1 ;ADJUST MASK AND VALUE (SEE NOTE IN ZRP SECTION)
MOVEI T2,^D36
ADD T2,T3
MOVEM T2,SZPCNT ;SIZE OF SEARCH STRING
MOVMS T3 ;CALCULATE MIN VALUE FOR POINTER IF
ADD T3,SRXSIZ(M) ;WORD IS SPLIT ACROSS BOUND
MOVEM T3,SZPPOS
TRNN F,FR.MSC ;IF ASCII MODE, AND
JRST SRCSAV
CAIN T2,^D36 ;IF ALL 36 BITS ARE BEING LOOKED FOR
TRO F,FR.FWS ;START AUTO FULL WORD SEARCH
JRST SRCSAV
SRCMIS: MOVEI T1,^D36 ;VALUES ARE FIXED FOR INSTR MODE
MOVEM T1,SZPCNT ;FULL WORD
MOVEM T1,SZPPOS
SRCSAV: MOVEM A2,SZPVAL ;PRESERVE SEARCH VALUE
MOVEM A3,SZPMSK ;AND MASK
OUTSTR CRLF ;NEETNESZ
TRNN F,FR.RPL ;REPLACEMENT NEEDED?
JRST SMCCNT
; GET REPLACEMENT VALUE. IF NOT FULLWORD, MUST BE SAME SIZE
OUTSTR [ASCIZ /ENTER REPLACEMENT: /]
PUSHJ P,INPVAL
JUMPE A3,ILNRPL ;NULL VALUE NOT ALLOWED
TRNE F,FR.MIS ;SKIP ALL THIS FOR INSTRUCTIONS
JRST SRCRMV
SETZ T3,
SRCRFF: TRNE A3,1 ;RIGHT-JUSTIFY MASK AND VALUE
JRST SRCRFG
LSH A3,-1
SOJA T3,SRCRFF
SRCRFG: LSH A2,(T3) ;SHIFT RIGHT
TRNE F,FR.FWS ;NO CHECK FOR MATCH
JRST SRCRMV ;IF FULLWORD SEARCH
CAME A3,SZPMSK ;MASKS MUST MATCH
JRST ILLRPL
SRCRMV: MOVEM A2,SZPRPL ;GOT A REPLACEMENT VALUE!!
; MULTIPLE SEARCH ENTRY FROM BLOCK READ
SMCCNT: MOVE T1,SRXPTR(M) ;SELECT A POINTER
MOVEM T1,SZPPTR
TLO F,FL.SIP ;SEARCH IN PROGRESS
TRNN F,FR.FWS ;IF FULLWORD SEARCH,
JRST SRCCON ;SET POINTER
MOVEI T1,^D36 ;TO GRAB THE FULL WORD
DPB T1,[POINT 6,SZPPTR,11]
; LOOK FOR NEEDLE IN HAYSTACK
SRCCON: TLNN F,FL.DDT
SETSTS TTY,TTNOEC ;IN CASE OF CONTINUED SEARCH
SETZB A1,A3
MOVE T4,SRXSIZ(M) ;VALUE FOR ADDING
MOVN T1,SRXSIZ(M) ;FOR SHIFTING RIGHT
SRCCND: ILDB A2,SZPPTR ;GET NEXT BYTE FROM CORE
HRRZ A4,SZPPTR ;SEE IF PAST END OF ZAP AREA
CAIL A4,ZAPPED+BLKSIZ
JRST SRCEND ;FINAL CURTAIN, ACT II
SRCXTR: TRNE F,FR.MIS!FR.FWS ;SPECIAL FOR INSTRUCTION AND FULLWORD
JRST SRCIMK ;SWALLOW WORD WHOLE
ROT A2,(T1) ;POSITION PROPERLY...
LSHC A1,@SRXSIZ(M) ;...AND COMBINE WITH PREVIOUS BYTES
ADD A3,T4 ;SEE IF HAVE ACQUIRED ENOUGH CHARS YET
CAMGE A3,SZPCNT
JRST SRCCND ;NOT YET
SKIPA T4,[Z] ;SKIP OVER INSTR PART AND RESET ADD VALUE SO NO OFLOW
SRCIMK: MOVE A1,A2 ;INSTRUCTION GATHERS ORIGINAL
TRNN F,FR.FWS ;NO MASKING ON FULLWORD - ALL OR NOTHING
AND A1,SZPMSK ;REMOVE LAST HIGH ORDER
;IF INSTR, REMOVE FIELDS NOT LOOKING FOR
CAME A1,SZPVAL ;S E A R C H ! ?
JRST SRCCND ;DASHED AGAIN
SUBI A4,ZAPPED ;GOT A LIVE ONE. PREPARE FOR DEPOSIT
TRNE F,FR.MIS!FR.FWS
JRST SRCANC ;ADVANCE TO THE REAR
LDB A2,[POINT 6,SZPPTR,5] ;CHECK POSITION OF POINTER
CAML A2,SZPPOS ;TO SEE IF STRING SPREAD ACROSS WORD BOUND
TLOA F,FL.XBD ;MARK SPLIT WORD FOR DEPOSIT ROUTINES
AOJ A4,
SOJ A4, ;YES - MOVE BACK ONE
TRNN F,FR.SGW
JRST SRCANC
TLZE F,FL.XBD ;IF /W, CANNOT BE SPLIT
JRST SRCCON
SRCANC: TLNN F,FL.SMP
JRST SRCLOC
HRLZ T2,CURBLK ;ANNOUNCE BLOCK ON MULTIPLE SEARCH
OUTSTR [ASCIZ /
BLOCK /]
PUSHJ P,BINOUT
SRCLOC: OUTSTR [ASCIZ /
LOC /]
HRLZ T2,A4
PUSHJ P,BINOUT ;PRINT LOCATION
TLNE F,FL.XBD ;IF WENT BACK, SAY SO
OUTSTR [ASCIZ / (FIRST PART)/]
OUTSTR CRLF
TLNE F,FL.PRO ;IF FILE PROT, DISPLAY ONLY
JRST SRCPRO
MOVE T2,ZAPPED(A4)
PUSHJ P,@DISOUT(M) ;DISPLAY IN MODE
OUTSTR CRLF
SETZM SKPCHR
TRNE F,FR.MIS!FR.FWS ;IF INSTR MODE OR FULLWORD,
JRST ZAPREP ;ASSUME WHOLE WORD
TLNN F,FL.XBD ;CALC DEPENDS ON SPLIT
JRST SRCPWD ;NOT SPLIT
MOVEI A1,^D72
SUB A1,A2 ;N = (71-P)-S
SUB A1,SZPCNT
JRST SRCPXD
SRCPWD: MOVEI A1,^D36 ;ONLY ONE WORD
ADD A2,SZPCNT ;N = 35 - (S+P)
SUB A1,A2
SRCPXD: IDIV A1,SRXSIZ(M) ;DIVIDE TO GET NO. OF CHARS
MOVEM A1,SKPCHR ;WHEW!
JRST ZAPREP ;THIS IS JUST THE BEGINNING...
SRCPRO: MOVE T2,ZAPPED(A4) ;PROTECT ON MEANS SEARCH AND DISPLAY ONLY
PUSHJ P,@DISOUT(M)
TLZN F,FL.XBD ;DISPLAY ONLY. CHECK IF SPLIT
JRST SRCPRA
PUSHJ P,TRFBBD ;HOUSEKEEPING
OUTSTR [ASCIZ /
LOC /]
AOJ A4, ;ADJUST CORRECTLY
HRLZ T2,A4
PUSHJ P,BINOUT ;PRINT LOC
OUTSTR [ASCIZ / (SECOND PART)
/]
MOVE T2,ZAPPED(A4) ;ACTUAL WORD
PUSHJ P,@DISOUT(M)
SRCPRA: OUTSTR CRLF
TRNN F,FR.ASR ;IF AUTO,
JRST ZAPCMD
JRST SRCCON ;CONTINUE SEARCH
SRCEND: TLNE F,FL.SMP ;CHECK FOR MULTIPLE SEARCH
JRST SMCCON
OUTSTR [ASCIZ /%END OF BLOCK REACHED
/]
TLZ F,FL.SIP ;END O' THE LINE
JRST ZAPCMD
; MULTIPLE SEARCH KEEPS ON GOING. WRITE OUT THIS BLOCK
; IF IT WAS MODIFIED AND GET A NEW ONE. GIVE
; UP ONLY WHEN OUT OF FILE.
SMCCON: TLNE F,FL.BBD ;SEE IF ACROSS A BLOCK BOUND
JRST SMCTST ;YES, AND HAVE ALREADY READ IN NEXT
MOVE A3,CURBLK ;READ IN NEXT BLOCK
AOJ A3,
CAMLE A3,FILSIZ ;STILL IN BOUNDS?
JRST SMCEND ;GONE PAST - GO FISHING
USETI ZAP,(A3) ;DON'T SET CURBLK YET
IN ZAP,INSCON ;PUT IN ZAPMOR
SKIPA
JRST FIOERR ;CAUGHT IN THE ACT
SMCTST: CAILE A4,ZAPPED+BLKSIZ ;ONLY ALLOWED ONE WORD PAST
JRST SMCTRF ;END OF BLOCK
LDB A3,[POINT 6,SZPPTR,5] ;OR LESS IF STRING WILL FIT
CAMGE A3,SZPPOS ;IN NEW BLOCK
JRST SMCTRF
TLOE F,FL.BBD ;SET AND CHECK
JRST SRCXTR ;IF NOT FIRST TIME, THEN ALREADY ARRANGED
HLL A4,SRXPTR(M) ;THE NEW POINTER
HRRI A4,ZAPMOR
MOVEM A4,SZPPTR
ILDB A2,SZPPTR ;START IT OFF
HRRZ A4,SZPPTR
JRST SRCXTR
SMCTRF: TLO F,FL.BBD ;BE SURE OLD BLOCK GETS ITS CHANCE
PUSHJ P,TRFBBD ;WHEN TRANSFERRING THE MANTLE
JRST SMCCNT
; THIS SUBROUTINE IS USED BY SEARCH AND THE ZAP ROUTINES TO CHECK
; IF A NEW BLOCK WAS READ IN TO ZAPMOR - THE HOLDING AREA - TO
; COVER THE CHANCE THAT A STRING SPREADS ACROSS A WORD BOUNDARY.
; WE COME HERE WHEN WE HAVE GONE FAR ENOUGH INTO THE NEW BLOCK THAT
; THE STRING HAS TO BE ALL HERE. THEREFORE, WRITE THE OLD BLOCK
; OUT(IF ZAPPED), AND BLT THE NEW IN INTO ITS PROPER HOME.
; UPDATE CURBLK TO BE THE NUMBER OF THE BLOCK
; AT ZAPPED.
TRFBBD: TLZN F,FL.BBD
POPJ P, ;NOT CROSSING
TLZN F,FL.ZAP
JRST TRFBLT ;NOT WRITING
USETO ZAP,@CURBLK ;POINT TO RIGHT ADDR
OUT ZAP,INSTR ;HEAVE-HO!
SKIPA
JRST FIOERR ;SLIPPED...
WAIT ZAP, ;GIVE IT A CHANCE
TRFBLT: AOS CURBLK ;NEXT
MOVE T1,[ZAPMOR,,ZAPPED] ;SHUFFLE
BLT T1,ZAPPED+BLKSIZ-1 ;PUMPERNICKEL,THIS TIME
SETO A4, ;IN CASE CALLED BY ZAP
POPJ P,
SMCEND: OUTSTR [ASCIZ /%%END OF FILE REACHED.
/]
TLZ F,FL.SMP!FL.SIP ;TURN OFF THE LIGHTS AS YOU LEAVE
JRST ZAPCMD ;SPLIT
; TABLE OF SEARCH ROUTINES. COMMAND IN LH, ADDR IN RH
SRCTBL: XWD 'C ',SCSINP ;CONTINUE SEARCH
XWD 'CM ',SMSINP ;CONTINUE MULTIPLE SEARCH
XWD 'M ',SRCNMP ;BEGIN MULTIPLE SEARCH
Z
; TABLE OF SWITCHES AND MATCHING FLAGS
SWFTBL: 'F ',,FR.FWS ;FULLWORD SEARCH
'R ',,FR.RPL ;SEARCH AND REPLACE
'W ',,FR.SGW ;STRING MUST BE IN ONE WORD - NO SPLITS
'C ',,FR.ASR ;AUTO CONTINUE SEARCH/DIS/ZAP/REPLACE
Z
; THESE TABLES ARE ALL INDEXED BY MODE (M)
; POINTER TO CORE
SRXPTR: POINT 3,ZAPPED
POINT 6,ZAPPED
POINT 7,ZAPPED
POINT 36,ZAPPED
POINT 7,ZAPPED
; SIZE OF BYTE
SRXSIZ: EXP 3,6,7,6,7
; SCRIBBLE A NOTE SOMEWHERE ON DISK. USE A LEAD PENCIL
HLPWRT: OUTSTR [ASCIZ &
W - WRITE CURRENT BLOCK
SELF-EXPLANATORY.
&]
JRST ZAPCMD
WRTBLK: PUSHJ P,TSTBLC
TLNE F,FL.PRO ;IS WRITE PROTECT?
JRST WPOERR
TLZN F,FL.ZAP ;CLEAR MODIFIED
JRST ZAPCMD ;NOTHING TO WRITE
USETO ZAP,@CURBLK ;RESET TO LAST BLOCK READ
OUT ZAP,INSTR ;OUT,OUT, DAMN SPOT!
JRST ZAPCMD
JRST FIOERR ;ZOT!
; NOW THAT ALL IS SAID AND DONE, BE DONE...
HLPCLS: OUTSTR CLSMSG
JRST ZAPCMD
DEFINE MSG<
XLIST
ASCIZ &
C - CLOSE FILE.
E - CLOSE AND EXIT.
ONE OR THE OTHER MUST BE DONE BEFORE EXITING. IF A ZAPPED BLOCK
IS STILL IN CORE, THE ROUTINE WILL OFFER THE CHOICE OF CLOSING
WITHOUT WRITING IT BACK OR REREADING IT. THE USER CAN OF
COURSE WRITE IT OUT THROUGH THE W COMMAND.
&
LIST>
CLSMSG: MSG
CLOSEF: TLNN F,FL.OPN ;SEE IF HAVE A FILE TO CLOSE
JRST NFLERR
TLNE F,FL.ZAP ;WARN USER IF FORGOT TO WRITE OUT
JRST RRDCLS ;A ZAPPED BLOCK
RECLOS: CLOSE ZAP,0 ;TAPS, PLEASE
RELEAS ZAP, ;LOCK THE DOOR BEHIND YOU
AND F,[MASK,,0] ;CLEAR 'MOS EV'RYTHIN'
TLNE F,FL.AST ;AUTO START CONTINUES?
JRST FILEIN
TLNN F,FL.XIT ;SEE IF EXITING AFTER CLOSE
JRST ZAPCMD
RESXIT: RESET ;CLEAR YE IN THE WILDERNESS...
EXIT ;EXIT, STAGE LEFT, CUTRAIN
; VARIATION ON A CLOSE - TWO ^C OR E COMMAND
CLEXIT: TLO F,FL.XIT ;INDICATE FOR POSTERITY
TLNN F,FL.OPN ;FILE AROUND
JRST RESXIT ;ALL'S WELL...
TLNN F,FL.ZAP ;MODIFIED FILE?
JRST RECLOS ;NO, DO AS HE SAYS
RRDCLS: OUTSTR [ASCIZ /?ZAPPED BLOCK STILL IN CORE.
TYPE C TO CLOSE WITHOUT WRITING OR R TO REREAD.
/]
TLO F,FL.RRD
SETZM CTRLC+2 ;CLEAR ^C INTERRUPT
JRST ZAPERR
; CTRL-C INTERRUPT - CHECK IF DOING S/C
CLCHK: TRZN F,FR.ASR
JRST CLEXIT ;NO - CLOSE OUT
SETZM CTRLC+2 ;FOR THE NEXT ONE
OUTSTR [ASCIZ /
%SEARCH ABORTED
/]
JRST ZAPERR ;CLEAN OUT TIME
SUBTTL SUBROUTINES
; TTY INPUT ROUTINE
TTYIN: OUTCHR ["*"]
TTYINP: MOVE T1,[POINT 6,TTYLIN]
TTYGET: INCHWL T2 ;HEAR YE THE WORD
TTYFND: CAIN T2,12 ;OUT OF WORD YET?
JRST TTYFIN
CAIN T2,15 ;CR - PULL FOLLOWING LF
JRST TTYPLF
CAIN T2,33 ;ESCAPE!
JRST TTYESC
SUBI T2,40 ;CONVERT TO SIXBIT
JUMPL T2,CHRERR ;HUH?
IDPB T2,T1 ;DEPOSIT IN THE GOOD BOOK...
JRST TTYGET ;SERMON'S NOT OVER YET
TTYPLF: INCHRW T2 ;SWALLOW LF ON CR
SKIPA
TTYESC: OUTSTR CRLF ;SEND TO BEGINNING OF LINE
TTYFIN: SETO T2, ;MARK EOL AS 77
IDPB T2,T1
POPJ P, ;RETURN FORGIVEN - THIS TIME
; GET AN ARGUMENT - AND GIVE ONE IF NOT PRETTY.
; INPUT PARAMETER:
; PTR - POINTER TO SIXBIT CHAR BEFORE CURRENT IN TTYLIN.
; OUTPUT PARAMETERS:
; INF - ARGUMENT IN SIXBIT
; BK - BREAK CHAR. IF 77, BK = -1.
; IF ARGUMENT IS ALL OCTAL, ALSO HAVE:
; OCT (=T3) - BINARY VALUE OF ARGUMENT
; FL.SIX (FLAG) - OFF TO INDICATE OCTAL, ON FOR SIXBIT
GETARG: TLZ F,FL.SIX
MOVE T1,[POINT 6,INFTMP] ;POINT TO TEMP OUTPUT
SETZB OCT,INFTMP
GETONE: ILDB T4,PTR ;GET ONE CHAR
MOVEI T2,BRKTBL
GETBLK: SKIPGE (T2) ;CHECKING FOR BREAKS, LEAKS,...
JRST GETREG ;STILL SOLID
CAME T4,(T2)
AOJA T2,GETBLK ;WANNA TRY AGAIN?
CAIN T4,77 ;IF EOL,
SETO T4, ;MAKE -1
MOVEM T4,BK
MOVE INF,INFTMP ;SO ONLY USE FIRST SIX CHAR
POPJ P, ;BYE-BYE...
GETREG: IDPB T4,T1 ;DEPOSIT IN TEMP AREA
SUBI T4,20 ;CONVERT TO BINARY
JUMPL T4,ILLSYN ;SNUCK ONE IN THERE
CAILE T4,7 ;ALPHA - CAN'T CONVERT
TLO F,FL.SIX
TLNE F,FL.SIX ;IF ANY ALPHA,
JRST GETONE ;DON'T BOTHER
LSH OCT,3 ;MAKE ROOM
IOR OCT,T4 ;AND THROW IT IN FOR FREE
JRST GETONE ;BACK FOR MORE
BRKTBL: '[' ;TABLE OF BREAK CHARS
']'
'.'
','
'+'
'-'
':'
'/'
' ' ;SPACE
77
-1 ;END OF TABLE
; TTY OUTPUT SUBROUTINES
; OUTPUT WORD IN T2 IN SIXBIT. PRODUCE SIX CHARS, EVEN IF BLANK
SIXOUT: MOVEI T3,6
SIXONE: SETZ T1,
LSHC T1,6 ;ONE CHAR
ADDI T1,40 ;CONVERT TO ASCII
OUTCHR T1
SOJG T3,SIXONE
POPJ P,
; OUTPUT LH OF T2 AS AN OCTAL NUMBER. GIVE SIX DIGITS, EVEN IF ZERO
BINOUT: MOVEI T3,6
BINONE: SETZ T1,
LSHC T1,3
ADDI T1,60
OUTCHR T1
SOJG T3,BINONE
POPJ P,
; OUTPUT WORD T2 IN OCTAL, BOTH HALVES
DISOCT: MOVE T4,T2 ;SAFETY
HLLZS T2
PUSHJ P,BINOUT ;HALF
OUTCHR [","] ;MARK
HRLZ T2,T4
JRST BINOUT ;HALF AND EXIT
; OUTPUT WORD IN T2 AS ASCII BYTES - BINARY
; ENTRY POINTS:
; DISASC - DISPLAY AS BINARY AND CHARACTERS
; DASCII - DISPLAY AS CHARACTERS
; CONTROL CHARACTERS ARE CONVERTED TO \(BACKSLASH)
DISASC: MOVEI T3,5 ;FIVE BYTES
MOVE T4,T2
DISAON: SETZ T1,
LSHC T1,1 ;HIGH ORDER BIT
ADDI T1,60
OUTCHR T1
REPEAT 2, ;NEXT 2 DIGITS
< SETZ T1,
LSHC T1,3
ADDI T1,60
OUTCHR T1>
OUTCHR [" "]
SOJG T3,DISAON ;COUNT OF BYTES
SETZ T1,
LSHC T1,1 ;LAST BIT - USUALLY ZERO
ADDI T1,60
OUTCHR T1
OUTSTR DBLSP
SKIPA ;OVER SECOND ENTRY POINT
DASCII: MOVE T4,T2 ;RECOVER VALUE
MOVEI T2,5 ;PREPARE TO OUTPUT AS CHAR
MOVE T1,[POINT 7,INFTMP]
SETZM INFTMP+1
DISACH: SETZ T3,
LSHC T3,7 ;GET A CHAR
CAIGE T3,40 ;IS IT CONTROL?
MOVEI T3,"\" ;REPLACE
CAILE T3,176 ;HOW ABOUT THESE?
MOVEI T3,"\" ;SAME THING
IDPB T3,T1 ;BUILD LINE
SOJG T2,DISACH
OUTSTR INFTMP ;SHOW OFF
POPJ P,
DASCSP: OUTSTR DBLSP ;FOR PRETTY IF ZAPPED
JRST DASCII
; OUTPUT WORD IN T2 IN CURRENT MODE ACCORDING TO COUNT IN SZPCNT
DISCUR: TRNE F,FR.FWS ;IF FULLWORD SEARCH ON,
JRST @DISOUT(M) ;SHOW EVERYTHING
TRNE F,FR.MIS ;IF INSTRUCTION MODE, LET GEORGE DO IT
JRST DSMINS ;HI, GEORGE
MOVEI T3,^D36
SUB T3,SZPCNT ;CALCULATE SHIFT COUNT
LSH T2,(T3)
MOVE T3,SZPCNT
DISCLP: SETZ T1,
TRNE F,FR.MSC ;IF ASCII,
JRST DISCAS ;JRST TO BE DIFFERENT
LSHC T1,@SRXSIZ(M) ;GET ONE BYTE
ADD T1,SRXCNV(M) ;CONVERT FOR OUTPUT
OUTCHR T1 ;DO SO
DISCOM: SUB T3,SRXSIZ(M) ;COUNTDOWN
JUMPG T3,DISCLP
POPJ P,
DISCAS: LSHC T1,1 ;FIRST BIT IN ASCII MODE
ADDI T1,60
OUTCHR T1
REPEAT 2,<
SETZ T1,
LSHC T1,3
ADDI T1,60
OUTCHR T1
>
OUTCHR [" "]
JRST DISCOM
; OUTPUT INSTRUCTION IN T2 IN INSTR MODE ACCORDING TO MAK IN SZPMSK
DSMINS: SETZ T4,
PUSH P,T2
SKIPG X,SZPMSK
PUSHJ P,DMIOPC ;OP PART INCLUDED
POP P,T2 ;OP DISPLAY DESTROYS T2
TRNN T4,IS.EXT ;IF NOT EXTENDED INSTR,
TLNN X,740 ;AND MASK INCLUDES,
SKIPA
PUSHJ P,DMIAFC ;SHOW A/F PART
TRNN T4,IS.CLI ;SAME PROC FOR Y PART ON CALLI INSTR
TRNN X,777777
SKIPA
PUSHJ P,DMIYFC
TLNE X,17 ;ALL INSTR CAN HAVE X
PUSHJ P,DMIXFC
POPJ P,
; CHECK IF FILE OPEN AND BLOCK IN CORE. IF SO, RETURN. IF NOT,
; FIX STACK POINTER AND PRINT APPRPRIATE ERROR.
TSTBLC: SUB P,[1,,1] ;JUST IN CASE
TLNN F,FL.OPN ;MOUTH OPEN?
JRST NFLERR
TLNN F,FL.BIC ;CAUGHT ANYTHING?
JRST NBKERR
AOBJP P,.+1 ;SO YA MADE IT
POPJ P, ;NOW WHAT ELSE CAN YOU DO?
SUBTTL SEARCH/ZAP VALUE INPUT SUBROUTINE
; VALUE INPUT SUBROUTINE (SEARCH / ZAP)
; THE BASIC USER INTERACTION SUBROUTINE. USER INPUTS TO IT TO
; SPECIFY SEARCH VALUE AND ZAP REPLACEMENT. ALL EDITING FUNCTIONS
; ARE HANDLED BY THIS ROUTINE. IF FL.FFL IS ON, CTRL-L (FORWARD
; SPACING IS ALLOWED; ELSE NOT. THIS DISTINGUISHES BETWEEN
; SEARCH AND ZAP. IF USER DELETES (RUBOUT), RETURN TO COMMMAND
; LEVEL.
; RETURN VALUES:
; A2 VALUE (LEFT-JUSTIFIED)
; A3 MASK (LEFT-JUSITIFED)
; THE MASK INDICATES THOSE BITS TYPED, TO BE USED IN SEARCH OR TO
; MASK OUT WHEN ZAPPING.
; IF CALL IS THE RESULT OF SEARCH/ZAP, SKPCHR WILL
; BE CHECKED TO DETERMINE BYTES TO SKIP.
; ALL MODES ARE HANDLED. INSTRUCTION MODE SENDS BACK A FULL WORD
; IN ALL CASES, AND REQUIRES NO ADJUSTMENTS. IN INSTRUCTION
; MODE SEARCH, AN X VALUE TYPED IN WILL CAUSE A ZERO
; MASK TO BE BUILT FOR THAT PART, SO THAT ANY VALUE IS VALID.
; IN ZAP, 'X' IS NOT ALLOWED. ^L IN INSTR MODE GOES FORWARD ONE
; PART(MORE ON EXTENDED INSTRUCTIONS); ^H WILL ONLY GO BACK AS
; FAR AS THE BEGINNING OF THE CURRENT PART. PARTS IN INSTR MODE
; ARE OP CODE, A/F, Y AND X. THE INDRECT BIT IS PART OF Y.
INPVAL: TLZ F,FL.ZON
MOVE PTR,IPMPTR(M)
SETZB A1,A2 ;PRELIMINARY MISHEGOS
SETZ A3,
MOVE T3,IPMBYT(M) ;NO OF BYTES PER WORD
TLNN F,FL.DDT ;IF DEBUGGING, LEAVE TTY ALONE
SETSTS TTY,TTNOEC ;NO ECHOOOOOOOOO, WE CAN DO IT
CLRBFI
TRNN F,FR.MSC ;ASCII MODE?
JRST INPPMS
MOVE T1,SKPCHR ;ADJUST SKIP COUNT TO REFLECT SPECIAL
IMULI T1,3 ;ASCII PROBLEMS
MOVEM T1,SKPCHR
JRST INPRST
INPPMS: TRNN F,FR.MIS
JRST INPRST
SETZ X, ;ADDITIONAL PREP FOR I MODE
TLNN F,FL.FFL
JRST INPRST ;NO ^L - PREP NOT NEEDED
HRRZ X,MISTBL+1(BK) ;BK SET BY DISMIS POINTS TO OLD VAL OF INST
ANDI X,XR.CLI!XR.EXT ;REMOVE LINK - SET UP FOR FUTURE ^L
INPRST: MOVE T2,IPMSIZ(M) ;START OF BYTE - CHARS/BYTE SET
TRNE F,FR.MSC ;IF A-MODE, START OF BYTE
TLO F,FL.ZON ;MUST BE 0 OR 1
INPREQ: SOSL SKPCHR ;SEE IF SKIPPING ANY BYTES (POSITIONING)
JRST @IPTFFL(M) ;PERFORM A ^L
INCHRW T1 ;LET THE USER TALK
CAIN T1,15 ;IF CR, SWALLOW LF
INCHRW XAMBEG ;GULP!
CAIN T1,33 ;ESCAPING?
JRST @IPTESC(M) ;EVERY MODE HAS ITS OWN OF DUCKING OUT
CAIN T1,10 ;BACKSPACE?
JRST @IPTBKS(M)
CAIN T1,177 ;GIVING UP? - RUBOUT
JRST INPDEL ;EVERYBODY SURRENDERS THE SAME WAY
TLNN F,FL.FFL ;IF ZAPPING CHECK FOR FORM FEED (^L)
JRST INPCNV
CAIN T1,14 ;FORWARD SPACE?
JRST @IPTFFL(M)
INPCNV: TRNN F,FR.MKC ;CHAR MODE ACCEPTS ANYTHING
CAIL T1,40 ;NO MORE CONTROL ALLOWED
SKIPA
JRST INPINV
SUB T1,IPMVAL(M) ;CONVERT TO LOCAL RELIGION
JUMPL T1,INPINV ;HERETIC
CAMLE T1,IPMMAX(M) ;MAXIMUM ALLOWED VALUE IN MODE
JRST INPINV
JRST @IPTCNV(M) ;LOCAL CONVERT/STORE DEPEDNDS ON MODE
; ESCAPE ROUTINES. ESC (ALTMODE) MEANS THE USER HAS FINISHED. EITHER
; THAT'S ALL THE SEARCH VALUES HAS WANTS, OR THE REST OF THE
; WORD CAN KEEP ITS OLD VALUE.
IPTESC: ITAGNL ;O
ITAGNL ;S
ITAGNL ;A
ITAINS ;I
ITAGNL ;K
ITAGNL: CAMLE T3,IPMBYT(M) ;SEE IF DID ANYTHING
JRST INPDEL ;STILL AT START = DELETE
ITACOM: TLNN F,FL.FFL ;IF ZAP, DISPLAY WHOLE VALUE
JRST ITASRC
ANDCM INF,A3
OR INF,A2 ;FILL IN FOR DISPLAY
OUTCHR [15] ;START OF LINE
HCOPY
MOVE T2,INF
PUSHJ P,@DISOUT(M) ;DISPLAY
SKIPA
ITASRC: JUMPE A3,INPDEL ;IF NO MASK ON SEARCH, CALL IT RUBOUT
POPOUT: SETSTS TTY,TTECHO ;UNGAG HIM
POPJ P, ;BACK TO MASTER
ITAINS: SKIPN A1 ;ESCAPE IN I-MODE
JUMPE A3,INPDEL ;NOTHING DOEN, NOTHING DOING
TRNE X,XR.OFC ;OP CODE DONE?
JRST IAIAFD
PUSHJ P,CHKMIS ;CHECK OUT OP
JRST ICICOM ;YOU LOSE
TLZE F,FL.XIS ;X GIVEN?
JRST POPOUT
MOVE A2,T2 ;VALUE
MOVE A3,T1 ;MASK
JRST ITACOM
IAIAFD: TRNE X,XR.YFC ;ON ESCAPE, ASSUME WANTS Y FIELD
JRST ITACOM ;SINCE A/F AND X MUST TERMINATE W/ CHAR
JUMPE A1,ITACOM ;NO Y FIELD INPUT
PUSHJ P,SXBCNV ;CONVERT INPUT TO BINARY
JRST ICICOM ;NO GOOD
TLZE F,FL.XIS ;X VALUE?
JRST ITACOM
HRRI A3,777777 ;MASK OUT Y FIELD
HRR A2,T1 ;AND GET VALUE
JRST ITACOM
; BUILD VALUE IN A2, MASK IN A3. COUNT DOWN CHAR/BYTE AND BYTES.
; DEF OF CHAR AND BYTE VARIES FOR MODES.
IPTCNV: ITCGNL ;O
ITCGNL ;S
ITCASC ;A
ITCINS ;I
ITCKAS ;K
ITCGNL: IDPB T1,PTR ;OCTAL/SIXIBT/(ASCII): DEPOSIT CHAR
ADD T1,IPMVAL(M) ;BACK TO ORIGINAL
CAIGE T1,40 ;IN CASE OF ASCII FORWARD SPACE
MOVEI T1,"\" ;OVER A CTRL CHAR
OUTCHR T1 ;AND ECCHHHHHOOOOOOOOO
MOVN T1,IPMSFT(M) ;SHIFT RIGHT
LSH A3,(T1) ;TO MAKE ROOM
OR A3,IPMASK(M) ;FOR ADDITIONAL PART OF MASK
SOJG T2,INPREQ ;COUNT DOWN CHAR/BYTE
CAIE T3,1 ;IF NOT LAST BYTE...
OUTCHR IPMSPC(M) ;OUT SPACE VAL BTWN BYTES
SOJG T3,INPRST ;COUNT DOWN BYTES/WORD
JRST POPOUT ;END O' THE LINE
ITCASC: TLNN F,FL.ZON ;ASCII - IS IT FIRST BIT?
JRST ITCGNL ;NO - LIKE EVERYBODY ELSE
CAILE T1,1
JRST INPINV ;MUST BE 0 OR 1
MOVEI T4,1
DPB T4,[POINT 6,PTR,11] ;CHANGE BYTE SIZE
IDPB T1,PTR ;AND MAKE DEPOSIT
MOVEI T4,3
DPB T4,[POINT 6,PTR,11] ;BACK TO NORMAL
ADD T1,IPMVAL(M) ;CONVERT FOR OUTPUT
OUTCHR T1
LSH A3,-1 ;ADJUST MASK
TLO A3,400000 ;ONE BIT
TLZ F,FL.ZON
SOJ T2, ;ADJUST CHAR/BYTE COUNTER
CAILE T3,1 ;LAST BIT? (BIT 35)
JRST INPREQ ;NO
JRST POPOUT ;YES
ITCINS: TRNE X,XR.OFC ;INSTR - DECIDE WHICH PART NEXT
JRST ICIAXY ;ALREADY DID OP
CAIN T1,' ' ;SPACE CAN END OP PART
JRST ICIOCK
IDPB T1,PTR ;JUST A CHARACTER
ADD T1,IPMVAL(M) ;MAKE PRETTY FOR OUTPUT
OUTCHR T1
SOJG T2,INPREQ ;ALLOWED UP TO 6 CHAR
ICIOCK: MOVEM T2,XAMEND ;SAVE
PUSHJ P,CHKMIS ;CHECK INSTRUCTION
JRST ICICOM ;NONE THAT WE EVER HEARD OF
MOVE A1,XAMEND ;RESTORE
ICIOPT: OUTCHR [" "] ;SPACE OVER SO EVEN
SOJGE A1,ICIOPT ;WITH REST
TRO X,XR.OFC ;OP CODE GOTTEN
TLZE F,FL.XIS ;X-VALUE?
JRST ICICOM ;FORGET IT
TRNE T4,IS.CLI ;IS IT CALLI TYPE?
TRO X,XR.CLI!XR.YFC ;MARK Y PART FILLED
TRNE T4,IS.EXT ;HOW ABOUT EXTENEDED?
TRO X,XR.EXT!XR.AFC ;A/F FIELD TAKEN CARE OF
ICFIOP: MOVE A2,T2 ;GET OP VALUE
MOVE A3,T1 ;AND MASK
ICICOM: MOVE PTR,IPMPTR(M) ;NEW POINTER
SETZ A1,
MOVEI T2,6 ;MAX CHAR/BYTE
JRST INPREQ ;PLEASE SIR, I WANT SOME MORE...
ICIAXY: CAIN T1,'@' ;INDIRECTION
JRST ICIIND
CAIN T1,',' ;END OF A/F FIELD?
JRST ICIEAF
CAIN T1,'(' ;END OF Y/START OF X?
JRST ICIBYX
CAIN T1,')' ;END OF X/ALL?
JRST ICIEIX
IDPB T1,PTR ;STILL BANKING
ADD T1,IPMVAL(M)
OUTCHR T1 ;DISPLAY
SOJG T2,INPREQ ;IF RUN OUT, BECOMES Y PART
TROE X,XR.YFC ;GOT ONE ALREADY?
JRST ICIERR
ICICVY: PUSHJ P,SXBCNV ;CONVERT Y PART
JRST ICIBNX ;OOPS
TLZE F,FL.XIS
JRST ICICXX
HRR A2,T1 ;BUILD VALUE
HRRI A3,777777 ;AND MASK
ICICXX: TRNE X,XR.XFS ;IF X PART STARTED,
OUTCHR ["("] ;SHOW SOMETHING
JRST ICICOM
ICIBYX: TROE X,XR.XFS ;ALREADY STARTED X PART?
JRST INPINV
TRNE X,XR.YFC
JRST ICICXX ;ALREADY DID Y PART
JRST ICICVY ;GO ADD Y PART
ICIBNX: TRZ X,XR.XFS ;ERROR IN Y PART
JRST ICICOM
ICIIND: JUMPN A1,INPINV ;ALREADY STARTED SOMETHING ELSE
TROE X,XR.IFC ;INDIRECT - ALREADY HAVE ONE?
JRST INPINV
OUTCHR ["@"] ;SHOW WORK
TLO A2,INDRCT ;BUILD INTO VALUE
TLO A3,INDRCT
JRST INPREQ
ICIEAF: TROE X,XR.AFC ;A/F FIELD
JRST INPINV
PUSHJ P,SXBCNV ;GET VALUE
JRST ICICOM
CAIG T1,17
JRST ICIPAF ;MUST FIT INTO A/F FIELD
ICIERR: PUSHJ P,CHKMER ;CLEAN OUT INPUT ON SCREEN
JRST ICICOM
ICIPAF: OUTCHR [","] ;ACCEPTED
TLZE F,FL.XIS
JRST ICICOM
ICFIAF: LSH T1,^D23 ;POSITION FOR INCLUSION
OR A2,T1
OR A3,[740,,0] ;MASK
JRST ICICOM
ICIEIX: TRNN X,XR.XFS ;HAVE WE STARTED AN INDEX?
JRST INPINV
PUSHJ P,SXBCNV ;CONVERT
JRST ICICOM
CAILE T1,17
JRST ICIERR
OUTCHR [")"]
TLZE F,FL.XIS
JRST POPOUT
ICFIDX: TSO A2,T1 ;POSITION AND INCLUDE
OR A3,[17,,0] ;MASK
JRST POPOUT ;POPPIES!
ITCKAS: CAIE T1,"!" ;ASCII CHAR MODE - IF !, NEXT CHAR IS CTRL
JRST ICKDEP
INCHRW T1 ;GET THE CHAR
CAIN T1,15 ;IF CR
INCHRW XAMBEG ;SWALLOW LF
CAIN T1,177 ;IF NOT DELETE,
TRZ T1,100 ;FORCE INTO CTRL
ICKDEP: IDPB T1,PTR ;MAKE DEP
CAIGE T1,40 ;IF CTRL,
MOVEI T1,"\" ;DISPLAY AS BACKSLASH
CAIN T1,177
MOVEI T1,"\" ;DELETE IS BACKSLASH ALSO
OUTCHR T1
LSH A3,-7 ;SHIFT OVER MASK
OR A3,IPMASK(M) ;ADD TO HIGH-ORDER END
SOJG T3,INPREQ ;ONE CHAR = ONE BYTE
JRST POPOUT
; BACKSPACE ROUTINES. ACCOUNT FOR BYTE BOUNDARIES. IF BACKSPACE PAST
; BEGINNING OF WORD, EQUIVALENT TO DELETE. INSTR MODE ALLOWS
; BACKSPACE ONLY TO BEGINNING OF PART.
BKPCUR: BYTE (7) 10,40,10,0 ;ERASE ONE CHAR FROM SCREEN
IPTBKS: ITBGNL ;O
ITBGNL ;S
ITBASC ;A
ITBINS ;I
IBGBYT ;K
ITBGNL: AOJ T2, ;CHAR/BYTE
CAMG T2,IPMSIZ(M) ;BEGINNING OF BYTE?
JRST IBGCOM ;GONE PAST
TRNE F,FR.MIS ;IF GONE PAST IN INSTR MODE,
JRST INPRST ;START FROM BEGINNING OF CURRENT PART
IBGBYT: AOJ T3, ;CROSSING BYTE BOUND
CAMLE T3,IPMBYT(M) ;BACK TO START OF WORD?
JRST INPDEL ;GIVE UP
MOVEI T2,1 ;LAST CHAR OF BYTE
TRNN F,FR.MKC ;ASCII CHAR DOES NOT HAVE SPACE
OUTSTR BKPCUR ;EXTRA TRACKS TO COVER
IBGCOM: SETZ T4,
DPB T4,PTR ;ZERO OUT AREA
LSH A3,@IPMSFT(M) ;RESHIFT MASK
LDB T4,[POINT 6,PTR,5]
ADD T4,IPMSFT(M) ;ADJUST POS OF POINTER
DPB T4,[POINT 6,PTR,5]
IBGCOT: OUTSTR BKPCUR ;BLANK IT OUT
HCOPY
JRST INPREQ
ITBASC: TLZE F,FL.ZON ;ASCII - TEST FOR FIRST BIT
JRST IBGBYT ;CROSS BYTE LINE
AOJ T2,
CAME T2,IPMSIZ(M) ;NOW AT FIRST CHAR?
JRST IBGCOM ;NO
TLO F,FL.ZON ;MARK
MOVEI T1,1
DPB T1,[POINT 6,PTR,11]
SETZ T1, ;CLEAR BIT
DPB T1,PTR
MOVEI T1,3 ;ORIGINAL PTR VALUE - SIZE
DPB T1,[POINT 6,PTR,11]
LSH A3,1 ;ADJUST MASK
LDB T1,[POINT 6,PTR,5] ;ADJUST PTR VALUE - POS
AOJ T1,1
DPB T1,[POINT 6,PTR,5]
JRST IBGCOT
ITBINS: JUMPE A1,INPREQ ;BACKSPACE ONLY TO START OF CURRENT WORKSPACE
JRST ITBGNL ;LIKE EVERYBODY ELSE
; FORWARD SPACE - ZAP ONLY.
; THE APPROPRIATE VALUE IS RETRIEVED FROM INF AND PASSED ON TO THE
; DEPOSIT ROUTINE, MAKING IT APPEAR THAT THE USER HAD TYPED IN THAT
; VALUE INSTEAD OF ^L. IN INSTR MODE, THE NEXT PART (OP, A/F, Y OR
; X) IS DISPLAYED AND PASSED ON. IF THE OP IS CALLI OR EXTENDED,
; THE APPROPRIATE VALUES ARE SET.
IPTFFL: ITFGNL ;O
ITFGNL ;S
ITFASC ;A
ITFINS ;I
ITFGNL ;K
ITFGNL: HLL T4,PTR ;O/S/K - BUILD POINTER INTO INF
HRRI T4,INF
ILDB T1,T4 ;GET VALUE
JRST ITCGNL ;AND PASS IT ON
ITFASC: TLNN F,FL.ZON
JRST ITFGNL ;IF NOT FIRST BIT, NORMAL
HLL T4,PTR
HRRI T4,INF
MOVEI T1,1
DPB T1,[POINT 6,T4,11] ;BUILD SPECIAL PTR
ILDB T1,T4
JRST ITCASC
ITFINS: JUMPN A1,INPINV ;INSTR - NO PARTIAL SKIPS ALLOWED
MOVE T2,INF ;FOR USE BY DISPLAY ROUTINES
TRON X,XR.OFC ;DECIDE WHAT'S BEEN DONE
JRST IFIOPC
TRON X,XR.AFC
JRST IFIAFC ;DO THE A/F FIELD
TRON X,XR.YFC
JRST IFIYFC
TRNE X,XR.XFS ;HAVE WE STARTED X PART?
JRST INPINV
PUSHJ P,DMIXFC ;DISPLAY X PART
LDB T1,[POINT 4,INF,17] ;GET VALUE FOR DEPOSIT
JRST ICFIDX ;BEHAVE AS THOUGH ENTERED VALUE
IFIOPC: PUSHJ P,DMIOPC ;DISPLAY OP CODE PART
MOVE T2,INF
TLZ T2,27 ;REMOVE INDEX AND INDIRECT
HRLZI T1,777000 ;MASK
TRNN T4,IS.CLI ;SEE IF CALLI INSTR
JRST IFIOAF
HRRI T1,-1 ;MASK IN CALLI PART
TRO X,XR.CLI!XR.YFC ;SHOW FILLED
TLZ T2,740 ;AND REMOVE A/F FIELD
JRST ICFIOP
IFIOAF: TRNN T4,IS.EXT ;MAYBE EXTENDED INSTR
JRST IFIORD ;JUST ORDINARY
TRO X,XR.EXT!XR.AFC ;MARK IT FILLD
HLLZS T2
TLO T1,740 ;INCLUDE A/F IN MASK
JRST ICFIOP
IFIORD: TLZ T2,740 ;ORDINARY - REMOVE X AND A/F
HLLZS T2
JRST ICFIOP
IFIAFC: PUSHJ P,DMIAFC ;DISPLAY A/F PART
LDB T1,[POINT 4,INF,12] ;GET VALUE
JRST ICFIAF
IFIYFC: PUSHJ P,DMIYFC ;DISPLAY Y FIELD
HRR A2,INF ;BUILD Y FIELD DIRECTLY
HRRI A3,-1 ;INCLUDE IN MASK
TLNN INF,INDRCT ;INDIRECT?
JRST ICICOM
TLO A2,INDRCT ;SET BITS IN VALUE
TLO A3,INDRCT ;AND MASK
JRST ICICOM
; MISCELLANEOUS
INPINV: OUTSTR [BYTE (7) 77,10,0] ;CLEAR INVALID CHAR
HCOPY
JRST INPREQ ;CONTINUE
INPDEL: TLNN F,FL.FFL ;DELETE
OUTSTR [ASCIZ /DELETED
/]
TLNE F,FL.FFL
OUTSTR [ASCIZ /UNCHANGED
/]
SETSTS TTY,TTECHO ;LAST MINUTE DETAILS
TLZE F,FL.XBD
PUSHJ P,TRFBBD
POP P,T1 ;ADJUST STACK
TLNE F,FL.FFL ;IF ZAPPING,
TRNN F,FR.ASR ;AND ON AUTOMATIC S/Z,
JRST ZAPERR ;FOR CLEAR INPUT
JRST SRCCON ;CONTINUE AUTO S-Z
; CONVERSION SUBROUTINE - CONVERT TO BINARY. CHECK FOR X-VALUE
; INPUT VALUE IN A1; RETURN IN T1. FL.XIS SET APPROPRIATELY. IF
; ERROR, CLEAR LINE AND RETURN +1, ELSE RETURN +2
SXBCNV: SETZB T1,T2
TLNE F,FL.FFL
JRST SXBSRC ;X VALUE ALLOWED ONLY ON SEARCH
TLO F,FL.XIS
CAMN A1,[SIXBIT /X/]
JRST SXBVLD
SXBSRC: TLZ F,FL.XIS ;NOT X VALUE
SKIPN T3,A1
JRST SXBVLD ;BLANK = 0
SXBCON: SETZ T2,
LSHC T2,6 ;CONVERT CHAR AT A TIME
SUBI T2,20
JUMPL T2,CHKMER ;NOT A NUMBER
CAILE T2,7
JRST CHKMER ;DITTO
LSH T1,3
IOR T1,T2 ;ADD TO COLLECTION
JUMPN T3,SXBCON
SXBVLD: AOS (P) ;SKIP RETURN
POPJ P,
; OUTPUT 4 BITS IN T1
TWODIG: LSHC T1,-3
ADDI T1,60
OUTCHR T1 ;HIGH ORDER BIT
SETZ T1,
LSHC T1,3
ADDI T1,60
OUTCHR T1 ;LOW ORDER BYTE
POPJ P,
; TABLES - INDEXED BY MODE
IPMBYT: EXP 2,1,6,4,5 ;NO OF BYTES
IPMSIZ: EXP 6,6,3,6,1 ;SIZE OF BYTE - CHAR/BYTE
SRXCNV:
IPMVAL: EXP 60,40,60,40,0 ;CONVERSION FACTOR
IPMMAX: EXP 7,77,7,77,177 ;MAX ALLOWED VALUE
IPMSFT: EXP 3,6,3,6,7 ;SHIFT VALUE - SIZE OF CHAR
IPMSPC: "," ;SPACING CHAR
0
" "
0
0
IPMPTR: POINT 3,A2 ;BYTE POINTERS
POINT 6,A2
POINT 3,A2
POINT 6,A1
POINT 7,A2
IPMASK: 700000,,0 ;MASK FOR ONE BYTE - HIGH ORDER
770000,,0
700000,,0
0
774000,,0
SUBTTL OTHER SUBROUTINES
; SUBROUTINES FOR INSTR MODE TO HANDLE INSTRUCTION NAMES AND DISPLAY
; MAIN SUBROUTINE (DISMIS) DISPLAYS INSTRUCTION AND ALL PARTS, USING
; THE OTHER SUBROUTINES. SPACING IS INCLUDED.
; VALUES PASSED ARE: T2 - EENTIRE INSTRUCTION
; VALUES RETURNED:
; BK - REL POINTER INTO MACHT TABLE
; T4 - INSTRUCTION FLAGS
; SUB-SUBROUTINES:
; DMIOPC - DISPLAY OP CODE PART, FIX VALUES FOR BK AND T4
; DMIAFC - DISPLAY A/F FIELD, IF NOT ZERO
; DMIYFC - DISPLAY Y PART. IF ZERO, PRINT "0".
; DMIXFC - DISPLAY FIELD, IF NOT ZERO
; ALL SUBROUTINES CAN BE CALLED INDEPENDENTLY. ALL PASS VALUE IN
; T3 BETWEEN THEM TO COUNT THE NUMBER OF SPACES REMAINING, BUT THIS
; CAN BE IGNORED IF NOT THE MAIN DISPLAY ROUTINE.
DISMIS: PUSH P,T2 ;MAIN DISPLAY ROUTINE - SHOW ALL, WITH TRAILING BLANKS
PUSHJ P,DMIOPC ;DISPLAY OP CODE
MOVEI T3,^D14 ;NUMBER OF SPACES TO BE FILLED
MOVE T2,(P) ;RECOVER VALUE
TRNN T4,IS.EXT ;A/F PART NEEDED?
PUSHJ P,DMIAFC ;YES
MOVE T2,(P)
TRNN T4,IS.CLI ;Y PART NEEDED?
PUSHJ P,DMIYFC
MOVE T2,(P)
PUSHJ P,DMIXFC ;ALWAYS DO X PART
DISMPS: SOJL T3,DISMEX ;ADD TRAILING BLANKS - T3 SAYS HOW MANY
OUTCHR [" "]
JRST DISMPS
DISMEX: POP P,T2 ;CLEAR STACK
POPJ P,
DMIOPC: SETZ T1, ;DISPLAY OPCODE AND SET BK, T4 VALUES
LSHC T1,^D9 ;GET INSTRUCTION CODE
HRLZ T3,T1 ;SAVE IF NECESSARY
LSH T1,1 ;DOUBLE FOR TABLE
MOVE T4,MISTBL+1(T1) ;GET VALUE OF INSTR
MOVE BK,T1
TRNN T4,IS.CLI!IS.EXT ;SPECIAL CASE?
JRST DISMPR ;REGULAR
LSH T1,-1
TRZE T4,IS.EXT ;EXTENDED?
LSHC T1,4 ;GET A/F VALUE
LSH T1,^D23 ;LEFT-JUSTIFY
LSH T2,-^D9
TRZE T4,IS.CLI
HRLZ T1,T2 ;IF CALLI, GET SUBVAL
SKIPA BK,T4 ;GET FIRST LINK
DISMSR: LDB BK,[POINT 9,MISTXC+1(BK),35] ;GET LINK
JUMPE BK,DISMDT ;DATA
LSH BK,1 ;DOUBLE LINK
HLLZ T4,MISTXC+1(BK) ;GET VALUE
CAME T4,T1 ;MATCH?
JRST DISMSR
HRRZ T4,MISTXC+1(BK) ;SET FLAGS
ADDI BK,MISTXC-MISTBL ;ADJUST RELATIVE ADDRESS
DISMPR: MOVE T2,MISTBL(BK) ;GET SIXBIT NAME
JUMPE T2,DISMDT ;NULL NAME MEANS DATA
PUSHJ P,SIXOUT ;AND OUTPUT
OUTCHR [" "]
CPOPJ: POPJ P, ;END OF OP CODE
DISMDT: LSHC T2,^D45 ;DATA - RECOVER AND OUTPUT AS BINARY
MOVEI T3,3 ;FORCE 3 DIGITS
PUSHJ P,BINONE
OUTSTR [BYTE (7) 40,40,40,40,0]
SETZ T4,
POPJ P,
DMIAFC: LDB T1,[POINT 4,T2,12] ;A/F - GET VALUE
JUMPE T1,CPOPJ
PUSHJ P,TWODIG
OUTCHR [","]
SUBI T3,3 ;COUNT DOWN SPACES REMAINING
POPJ P, ;END OF A/F FIELD
DMIYFC: TLNE T2,INDRCT ;DISPLAY Y FIELD - CHECK FOR INDIRECT
OUTCHR ["@"]
TLNE T2,INDRCT
SOJ T3,
HRLZS T2
JUMPE T2,BINNOZ
TLO F,FL.LDZ ;START OUT W/ LEADING ZEROS
MOVEI T4,6
BINNLP: SETZ T1,
LSHC T1,3 ;OUTPUT Y PART, ELIMINATING LEADING ZEROS
TLNE F,FL.LDZ ;STILL LEADING?
JUMPE T1,BINNCT
TLZ F,FL.LDZ
ADDI T1,60 ;BAPTISM
OUTCHR T1
SOJ T3, ;ANOTHER SPACE GONE
BINNCT: SOJG T4,BINNLP ;6 DIGITS MAX
POPJ P,
BINNOZ: OUTCHR ["0"] ;IF ZERO, PRINT ONE
SOJ T3,
POPJ P, ;END OF Y FIELD
DMIXFC: LDB T1,[POINT 4,T2,17] ;DISPLAY X FIELD
JUMPE T1,CPOPJ ;ZERO INDEX
OUTCHR ["("]
PUSHJ P,TWODIG
OUTCHR [")"]
SUBI T3,4
POPJ P, ;END OF X FIELD
; SUBROUTINE TO TAKE SIXBIT VALUE IN A1 AND PERFORM LOOKUP IN
; INSTR TABLE. RETURN INSTR VAL IN T2, MASK IN T1. SET FL.XIS IF
; INSTR IS X - ALL INSTR VALID. IF INVALID INSTR, CLEAR SCREEN
; LINE AND SET T2 TO 0. T4 CONTAINS CLI, EXT BITS
; RETURN +1 IF ERROR
; RETURN +2 IF OK
CHKMIS: SETZB T2,T1
TLNE F,FL.FFL ;IF CAN HAVE ^L,
JRST CHKSRC ;CAN'T HAVE X
TLO F,FL.XIS
CAMN A1,[SIXBIT /X/]
JRST CHKLVE ;RETURN OF THE STRANGER
CHKSRC: TLZ F,FL.XIS ;NO GOOD, THAT ONE
JUMPE A1,CHKMER ;BLANK IS NOT X
; CHECK IF ALL NUMERIC; IF SO, RETURN BINARY EQUIVALENT
HRRZ T3,A1
JUMPN T3,CHKNAM ;MORE THAN 3 CHAR
HLLZ T3,A1
CHKNUM: LSHC T2,6
SUBI T2,20 ;CONVERT FROM SIXBIT TO BINARY
JUMPL T2,CHKMER ;WON'T CONVERT
CAILE T2,7
JRST CHKNAM ;NOT A NUMBER
LSH T2,^D33
LSHC T1,3 ;ADD TO THE COLLECTION
JUMPN T3,CHKNUM
LSHC T1,-^D9 ;PLACE VALUE IN OUPUT REG
SETZ T4,
JRST CHKMSK ;SET UP MASK
; NOT A NUMBER. LOOKUP ON TABLE. LINEAR SEARCH.
; (INEFFICIENT, BUT RARELY DONE.)
CHKNAM: MOVEI T1,40 ;SKIP THE L-UUO'S
CHKCHK: MOVE T3,MISTBL(T1) ;GET SIXBIT NAME
AOJ T1, ;FOR ODD VALUE
CAMN T3,[-1] ;END OF TABLE?
JRST CHKMER
CAME A1,T3
AOJA T1,CHKCHK ;KEEP PLUGGING
HRRE T4,MISTBL(T1) ;FIND OUT WHAT WE GOT
JUMPL T4,CHKCAL ;CALLI TYPE
HLLZ T2,MISTBL(T1) ;GET INSTRUCTION VALUE
CHKMSK: MOVE T1,[777000,,0] ;MASK VALUE
TRNE T4,IS.EXT ;EXTENDED INSTR?
TLO T1,740 ;EXTEND MASK
CHKLVE: AOS (P) ;NORMAL RETURN
POPJ P,
CHKCAL: HLRZ T2,MISTBL(T1) ;GET CALLI PART
HRLI T2,047000 ;ADD CALLI OP CODE
MOVE T1,[777000,,777777] ;CALLI MASK
AOS (P) ;NORMAL RETURN
POPJ P,
CHKMER: HCOPY ;INVALID INSTRUCTION. ERASE FROM SCREEN
MOVE T3,A1
CHKERC: SETZ T2,
LSHC T2,6 ;FOR EVERY CHAR TYPED, BACKSPACE ONE AND CLEAR
SKIPN T2
JRST CHKERF
OUTSTR BKPCUR
JRST CHKERC
CHKERF: OUTSTR [BYTE (7) 77,10,0] ;QUESTION THE WHOLE THING
POPJ P, ;T2 IS ALREADY ZERO. GOTTA WATCHTHOSE
;LEFT-HANDED MANUEVERS...
; TABLE OF MACHINE INSTRUCTIONS
; THIS TABLE IS ARRANGED IN INSTRUCTION ORDER, AS TWO WORDS
; PER INSTRUCTION:
; WORD 0: NAME OF INSTR IN SIXBIT
; 1: BITS 0-17: OP CODE+A/F VALUE(IF EXTENDED)
; OR CALLI VALUE (Y PART)
; 18: =1 FOR CALLI INSTRUCTION
; 19: =1 FOR EXTENDED INSTRUCTION
; 20: =1 FOR ILLEGAL INSTRUCTION
; 26-35: LINK OR NULL
; MACRO FOR DEFINING INSTRUCTIONS IN TABLE ACCORDING TO ABOVE FORMAT
DEFINE MACHT($NAME,$VAL,$SUBV,$LINK<0>,$CALLI<0>)
<
XLIST
SIXBIT /$NAME/
IFE $CALLI,<
IFG $SUBV,<$EXP==1
$A==$SUBV>
IFE $SUBV,<$EXP==0
$A==0>
IFL $SUBV,<$EXP==1
$A==0>
EXP <$VAL>B8+<$A>B12+<$EXP>B19+<$LINK>B35
>
IFN $CALLI,<
EXP <$VAL>B17+<1>B18+<$LINK>B35
>
LIST
>
; LINK IS RELATIVE TO MISTXC - THE START OF THE EXTENDED TABLE.
; THE TABLE ENDS WITH -1.
; MACRO FOR FILL AREAS - ILLEGAL INSTRUCTIONS
DEFINE MFILL($N)
<
XLIST
REPEAT $N,<EXP 0,IS.ILI>
LIST
>
XALL
MISTBL: MFILL(40) ;L-UUO'S
MACHT(CALL,40)
MACHT(INIT,41)
MFILL(5) ;RESERVED FOR SPECIAL MONITORS
MACHT(CALLI,0,,32,1)
MACHT(OPEN,50)
MACHT(TTCALL,51,17,14) ;INVALID SUBVALUE FORCES LINK SEARCH
MFILL(3) ;RESERVED FOR DEC
MACHT(RENAME,55)
MACHT(IN,56)
MACHT(OUT,57)
MACHT(SETSTS,60)
MACHT(STATO,61)
MACHT(GETSTS,62)
MACHT(STATZ,63)
MACHT(INBUF,64)
MACHT(OUTBUF,65)
MACHT(INPUT,66)
MACHT(OUTPUT,67)
MACHT(CLOSE,70)
MACHT(RELEAS,71)
MACHT(MTAPE,72)
MACHT(UGETF,73)
MACHT(USETI,74)
MACHT(USETO,75)
MACHT(LOOKUP,76)
MACHT(ENTER,77)
MACHT(UJEN,100)
MFILL(3) ;UNIMPLEMENTED
MACHT(JSYS,104) ;FOR LATER TENEX EXPANSION
MFILL(3)
MACHT(DFAD,110)
MACHT(DFSB,111)
MACHT(DFMP,112)
MACHT(DFDV,113)
MFILL(4)
MACHT(DMOVE,120)
MACHT(DMOVN,121)
MACHT(FIX,122)
MFILL(1)
MACHT(DMOVEM,124)
MACHT(DMOVNM,125)
MACHT(FIXR,126)
MACHT(FLTR,127)
MACHT(UFA,130)
MACHT(DFN,131)
MACHT(FSC,132)
MACHT(IBP,133)
MACHT(ILDB,134)
MACHT(LDB,135)
MACHT(IDPB,136)
MACHT(DPB,137)
MACHT(FAD,140)
MACHT(FADL,141)
MACHT(FADM,142)
MACHT(FADB,143)
MACHT(FADR,144)
MACHT(FADRI,145)
MACHT(FADRM,146)
MACHT(FADRB,147)
MACHT(FSB,150)
MACHT(FSBL,151)
MACHT(FSBM,152)
MACHT(FSBB,153)
MACHT(FSBR,154)
MACHT(FSBRI,155)
MACHT(FSBRM,156)
MACHT(FSBRB,157)
MACHT(FMP,160)
MACHT(FMPL,161)
MACHT(FMPM,162)
MACHT(FMPB,163)
MACHT(FMPR,164)
MACHT(FMPRI,165)
MACHT(FMPRM,166)
MACHT(FMPRB,167)
MACHT(FDV,170)
MACHT(FDVL,171)
MACHT(FDVM,172)
MACHT(FDVB,173)
MACHT(FDVR,174)
MACHT(FDVRI,175)
MACHT(FDVRM,176)
MACHT(FDVRB,177)
MACHT(MOVE,200)
MACHT(MOVEI,201)
MACHT(MOVEM,202)
MACHT(MOVES,203)
MACHT(MOVS,204)
MACHT(MOVSI,205)
MACHT(MOVSM,206)
MACHT(MOVSS,207)
MACHT(MOVN,210)
MACHT(MOVNI,211)
MACHT(MOVNM,212)
MACHT(MOVNS,213)
MACHT(MOVM,214)
MACHT(MOVMI,215)
MACHT(MOVMM,216)
MACHT(MOVMS,217)
MACHT(IMUL,220)
MACHT(IMULI,221)
MACHT(IMULM,222)
MACHT(IMULB,223)
MACHT(MUL,224)
MACHT(MULI,225)
MACHT(MULM,226)
MACHT(MULB,227)
MACHT(IDIV,230)
MACHT(IDIVI,231)
MACHT(IDIVM,232)
MACHT(IDIVB,233)
MACHT(DIV,234)
MACHT(DIVI,235)
MACHT(DIVM,236)
MACHT(DIVB,237)
MACHT(ASH,240)
MACHT(ROT,241)
MACHT(LSH,242)
MACHT(JFFO,243)
MACHT(ASHC,244)
MACHT(ROTC,245)
MACHT(LSHC,246)
MFILL(1)
MACHT(EXCH,250)
MACHT(BLT,251)
MACHT(AOBJP,252)
MACHT(AOBJN,253)
MACHT(JRST,254,-1,2)
MACHT(JFCL,255,-1,7)
MACHT(XCT,256)
MACHT(MAP,257)
MACHT(PUSHJ,260)
MACHT(PUSH,261)
MACHT(POP,262)
MACHT(POPJ,263)
MACHT(JSR,264)
MACHT(JSP,265)
MACHT(JSA,266)
MACHT(JRA,267)
MACHT(ADD,270)
MACHT(ADDI,271)
MACHT(ADDM,272)
MACHT(ADDB,273)
MACHT(SUB,274)
MACHT(SUBI,275)
MACHT(SUBM,276)
MACHT(SUBB,277)
MACHT(CAI,300)
MACHT(CAIL,301)
MACHT(CAIE,302)
MACHT(CAILE,303)
MACHT(CAIA,304)
MACHT(CAIGE,305)
MACHT(CAIN,306)
MACHT(CAIG,307)
MACHT(CAM,310)
MACHT(CAML,311)
MACHT(CAME,312)
MACHT(CAMLE,313)
MACHT(CAMA,314)
MACHT(CAMGE,315)
MACHT(CAMN,316)
MACHT(CAMG,317)
MACHT(JUMP,320)
MACHT(JUMPL,321)
MACHT(JUMPE,322)
MACHT(JUMPLE,323)
MACHT(JUMPA,324)
MACHT(JUMPGE,325)
MACHT(JUMPN,326)
MACHT(JUMPG,327)
MACHT(SKIP,330)
MACHT(SKIPL,331)
MACHT(SKIPE,332)
MACHT(SKIPLE,333)
MACHT(SKIPA,334)
MACHT(SKIPGE,335)
MACHT(SKIPN,336)
MACHT(SKIPG,337)
MACHT(AOJ,340)
MACHT(AOJL,341)
MACHT(AOJE,342)
MACHT(AOJLE,343)
MACHT(AOJA,344)
MACHT(AOJGE,345)
MACHT(AOJN,346)
MACHT(AOJG,347)
MACHT(AOS,350)
MACHT(AOSL,351)
MACHT(AOSE,352)
MACHT(AOSLE,353)
MACHT(AOSA,354)
MACHT(AOSGE,355)
MACHT(AOSN,356)
MACHT(AOSG,357)
MACHT(SOJ,360)
MACHT(SOJL,361)
MACHT(SOJE,362)
MACHT(SOJLE,363)
MACHT(SOJA,364)
MACHT(SOJGE,365)
MACHT(SOJN,366)
MACHT(SOJG,367)
MACHT(SOS,370)
MACHT(SOSL,371)
MACHT(SOSE,372)
MACHT(SOSLE,373)
MACHT(SOSA,374)
MACHT(SOSGE,375)
MACHT(SOSN,376)
MACHT(SOSG,377)
MACHT(SETZ,400)
MACHT(SETZI,401)
MACHT(SETZM,402)
MACHT(SETZB,403)
MACHT(AND,404)
MACHT(ANDI,405)
MACHT(ANDM,406)
MACHT(ANDB,407)
MACHT(ANDCA,410)
MACHT(ANDCAI,411)
MACHT(ANDCAM,412)
MACHT(ANDCAB,413)
MACHT(SETM,414)
MACHT(SETMI,415)
MACHT(SETMM,416)
MACHT(SETMB,417)
MACHT(ANDCM,420)
MACHT(ANDCMI,421)
MACHT(ANDCMM,422)
MACHT(ANDCMB,423)
MACHT(SETA,424)
MACHT(SETAI,425)
MACHT(SETAM,426)
MACHT(SETAB,427)
MACHT(XOR,430)
MACHT(XORI,431)
MACHT(XORM,432)
MACHT(XORB,433)
MACHT(IOR,434)
MACHT(IORI,435)
MACHT(IORM,436)
MACHT(IORB,437)
MACHT(ANDCB,440)
MACHT(ANDCBI,441)
MACHT(ANDCBM,442)
MACHT(ANDCBB,443)
MACHT(EQV,444)
MACHT(EQVI,445)
MACHT(EQVM,446)
MACHT(EQVB,447)
MACHT(SETCA,450)
MACHT(SETCAI,451)
MACHT(SETCAM,452)
MACHT(SETCAB,453)
MACHT(ORCA,454)
MACHT(ORCAI,455)
MACHT(ORCAM,456)
MACHT(ORCAB,457)
MACHT(SETCM,460)
MACHT(SETCMI,461)
MACHT(SETCMM,462)
MACHT(SETCMB,463)
MACHT(ORCM,464)
MACHT(ORCMI,465)
MACHT(ORCMM,466)
MACHT(ORCMB,467)
MACHT(ORCB,470)
MACHT(ORCBI,471)
MACHT(ORCBM,472)
MACHT(ORCBB,473)
MACHT(SETO,474)
MACHT(SETOI,475)
MACHT(SETOM,476)
MACHT(SETOB,477)
MACHT(HLL,500)
MACHT(HLLI,501)
MACHT(HLLM,502)
MACHT(HLLS,503)
MACHT(HRL,504)
MACHT(HLRI,505)
MACHT(HRLM,506)
MACHT(HRLS,507)
MACHT(HLLZ,510)
MACHT(HLLZI,511)
MACHT(HLLZM,512)
MACHT(HLLZS,513)
MACHT(HRLZ,514)
MACHT(HRLZI,515)
MACHT(HRLZM,516)
MACHT(HRLZS,517)
MACHT(HLLO,520)
MACHT(HLLOI,521)
MACHT(HLLOM,522)
MACHT(HLLOS,523)
MACHT(HRLO,524)
MACHT(HRLOI,525)
MACHT(HRLOM,526)
MACHT(HRLOS,527)
MACHT(HLLE,530)
MACHT(HLLEI,531)
MACHT(HLLEM,532)
MACHT(HLLES,533)
MACHT(HRLE,534)
MACHT(HRLEI,535)
MACHT(HRLEM,536)
MACHT(HRLES,537)
MACHT(HRR,540)
MACHT(HRRI,541)
MACHT(HRRM,542)
MACHT(HRRS,543)
MACHT(HLR,544)
MACHT(HLRI,545)
MACHT(HLRM,546)
MACHT(HLRS,547)
MACHT(HRRZ,550)
MACHT(HRRZI,551)
MACHT(HRRZM,552)
MACHT(HRRZS,553)
MACHT(HLRZ,554)
MACHT(HLRZI,555)
MACHT(HLRZM,556)
MACHT(HLRZS,557)
MACHT(HRRO,560)
MACHT(HRROI,561)
MACHT(HRROM,562)
MACHT(HRROS,563)
MACHT(HLRO,564)
MACHT(HLROI,565)
MACHT(HLROM,566)
MACHT(HLROS,567)
MACHT(HRRE,570)
MACHT(HRREI,571)
MACHT(HRREM,572)
MACHT(HRRES,573)
MACHT(HLRE,574)
MACHT(HLREI,575)
MACHT(HLREM,576)
MACHT(HLRES,577)
MACHT(TRN,600)
MACHT(TLN,601)
MACHT(TRNE,602)
MACHT(TLNE,603)
MACHT(TRNA,604)
MACHT(TLNA,605)
MACHT(TRNN,606)
MACHT(TLNN,607)
MACHT(TDN,610)
MACHT(TSN,611)
MACHT(TDNE,612)
MACHT(TSNE,613)
MACHT(TDNA,614)
MACHT(TSNA,615)
MACHT(TDNN,616)
MACHT(TSNN,617)
MACHT(TRZ,620)
MACHT(TLZ,621)
MACHT(TRZE,622)
MACHT(TLZE,623)
MACHT(TRZA,624)
MACHT(TLZA,625)
MACHT(TRZN,626)
MACHT(TLZN,627)
MACHT(TDZ,630)
MACHT(TSZ,631)
MACHT(TDZE,632)
MACHT(TSZE,633)
MACHT(TDZA,634)
MACHT(TSZA,635)
MACHT(TDZN,636)
MACHT(TSZN,637)
MACHT(TRC,640)
MACHT(TLC,641)
MACHT(TRCE,642)
MACHT(TLCE,643)
MACHT(TRCA,644)
MACHT(TLCA,645)
MACHT(TRCN,646)
MACHT(TLCN,647)
MACHT(TDC,650)
MACHT(TSC,651)
MACHT(TDCE,652)
MACHT(TSCE,653)
MACHT(TDCA,654)
MACHT(TSCA,655)
MACHT(TDCN,656)
MACHT(TSCN,657)
MACHT(TRO,660)
MACHT(TLO,661)
MACHT(TROE,662)
MACHT(TLOE,663)
MACHT(TROA,664)
MACHT(TLOA,665)
MACHT(TRON,666)
MACHT(TLON,667)
MACHT(TDO,670)
MACHT(TSO,671)
MACHT(TDOE,672)
MACHT(TSOE,673)
MACHT(TDOA,674)
MACHT(TSOA,675)
MACHT(TDON,676)
MACHT(TSON,677)
MISTXC: MFILL(2) ;DUMMY - ELSE LINK TO HERE WOULD BE ZERO=NULL
MACHT(JRST,254,-1,3)
MACHT(PORTAL,254,4,4)
MACHT(JRSTF,254,10,5)
MACHT(HALT,254,20,6)
MACHT(JEN,254,50) ;END OF JRST GROUP
MACHT(JFOV,255,4,10)
MACHT(JCRY1,255,10,11)
MACHT(JCRY0,255,20,12)
MACHT(JCRY,255,30,13)
MACHT(JOV,255,40)
MACHT(INCHRW,51,-1,15)
MACHT(OUTCHR,51,1,16)
MACHT(INCHRS,51,2,17)
MACHT(OUTSTR,51,3,20)
MACHT(INCHWL,51,4,21)
MACHT(INCHSL,51,5,22)
MACHT(GETLCH,51,6,23)
MACHT(SETLCH,51,7,24)
MACHT(RESCAN,51,10,25)
MACHT(CLRBFI,51,11,26)
MACHT(CLRBFO,51,12,27)
MACHT(SKPINC,51,13,30)
MACHT(SKPINL,51,14,31)
MACHT(IONEOU,51,15)
MACHT(LIGHTS,777777,,33,1)
MACHT(RESET,0,,34,1)
MACHT(DDTIN,1,,35,1)
MACHT(SETDDT,2,,36,1)
MACHT(DDTOUT,3,,37,1)
MACHT(DEVCHR,4,,40,1)
MACHT(DDTGT,5,,41,1)
MACHT(GETCHR,6,,42,1)
MACHT(DDTRL,7,,43,1)
MACHT(WAIT,10,,44,1)
MACHT(CORE,11,,45,1)
MACHT(EXIT,12,,46,1)
MACHT(UPTCLR,13,,47,1)
MACHT(DATE,14,,50,1)
MACHT(LOGIN,15,,51,1)
MACHT(APRENB,16,,52,1)
MACHT(LOGOUT,17,,53,1)
MACHT(SWITCH,20,,54,1)
MACHT(REASSI,21,,55,1)
MACHT(TIMER,22,,56,1)
MACHT(MSTIME,23,,57,1)
MACHT(GETPPN,24,,60,1)
MACHT(TRPSET,25,,61,1)
MACHT(TRPJEN,26,,62,1)
MACHT(RUNTIM,27,,63,1)
MACHT(PJOB,30,,64,1)
MACHT(SLEEP,31,,65,1)
MACHT(SETPOV,32,,66,1)
MACHT(PEEK,33,,67,1)
MACHT(GETLIN,34,,70,1)
MACHT(RUN,35,,71,1)
MACHT(SETUWP,36,,72,1)
MACHT(REMAP,37,,73,1)
MACHT(GETSEG,40,,74,1)
MACHT(GETTAB,41,,75,1)
MACHT(SPY,42,,76,1)
MACHT(SETNAM,43,,77,1)
MACHT(TMPCOR,44,,100,1)
MACHT(DSKCHR,45,,101,1)
MACHT(SYSSTR,46,,102,1)
MACHT(JOBSTR,47,,103,1)
MACHT(STRUUO,50,,104,1)
MACHT(SYSPHY,51,,105,1)
MACHT(DEVTYP,53,,106,1)
MACHT(DEVSTS,54,,107,1)
MACHT(DEVPPN,55,,110,1)
MACHT(SEEK,56,,111,1)
MACHT(RTTRP,57,,112,1)
MACHT(LOCK,60,,113,1)
MACHT(JOBSTS,61,,114,1)
MACHT(LOCATE,62,,115,1)
MACHT(WHERE,63,,116,1)
MACHT(DEVNAM,64,,117,1)
MACHT(CTLJOB,65,,120,1)
MACHT(GOBSTR,66,,121,1)
MACHT(HPQ,71,,122,1)
MACHT(HIBER,72,,123,1)
MACHT(WAKE,73,,124,1)
MACHT(CHGPPN,74,,125,1)
MACHT(SETUUO,75,,126,1)
MACHT(OTHUSR,77,,127,1)
MACHT(CHKACC,100,,130,1)
MACHT(DEVSIZ,101,,131,1)
MACHT(DAEMON,102,,132,1)
MACHT(JOBPEK,103,,133,1)
MACHT(ATTACH,104,,134,1)
MACHT(DAEFIN,105,,135,1)
MACHT(FRCUUO,106,,136,1)
MACHT(DEVLNM,107,,137,1)
MACHT(PATH.,110,,140,1)
MACHT(METER.,111,,141,1)
MACHT(MTCHR.,112,,142,1)
MACHT(JBSET.,113,,143,1)
MACHT(POKE.,114,,144,1)
MACHT(TRMNO.,115,,145,1)
MACHT(TRMOP.,116,,146,1)
MACHT(RESDV.,117,,147,1)
MACHT(UNLOK.,120,,150,1)
MACHT(DISK.,121,,151,1)
MACHT(DVRST.,122,,152,1)
MACHT(DVURS.,123,,153,1)
MACHT(CAL11.,125,,154,1)
MACHT(MTAID.,126,,155,1)
MACHT(IONDX.,127,,156,1)
MACHT(CNECT.,130,,157,1)
MACHT(MVHDR.,131,,160,1)
MACHT(ERLST.,132,,161,1)
MACHT(SENSE.,133,,162,1)
MACHT(CLRST.,134,,163,1)
MACHT(PIINI.,135,,164,1)
MACHT(PISYS.,136,,165,1)
MACHT(DEBRK.,137,,166,1)
MACHT(PISAV.,140,,167,1)
MACHT(PIRST.,141,,170,1)
MACHT(IPCFR.,142,,171,1)
MACHT(IPCFS.,143,,172,1)
MACHT(IPCFQ.,144,,173,1)
MACHT(PAGE.,145,,174,1)
MACHT(SUSET.,146,,,1)
-1 ;INDICATE END OF TABLE
SUBTTL ERROR ROUTINES
NFLERR: OUTSTR [ASCIZ /?FILE NOT OPENED
/]
JRST ZAPERR
ILLSYN: OUTSTR [ASCIZ /?ILLEGAL SYNTAX
/]
JRST ZAPERR
BLCMAC: OUTSTR [ASCIZ /%MORE BLOCKS ALLOCATED THAN USED IN FILE
/]
BLCORN: OUTSTR [ASCIZ /?BLOCK # OUT OF RANGE
/]
TLZ F,FL.BIC ;TOO OPTIMISTIC
SETZM CURBLK
JRST ZAPERR
CHRERR: OUTSTR [ASCIZ /?ILLEGAL CHARACTER
/]
JRST ZAPERR
ILLNUM: OUTSTR [ASCIZ .?NOT AN OCTAL NUMBER
.]
JRST ZAPERR
CMDERR: OUTSTR [ASCIZ /?ILLEGAL COMMAND
/]
JRST ZAPERR
NFLWRN: OUTSTR [ASCIZ /%NO FILE OPEN
/]
JRST ZAPCMD
NBKERR: OUTSTR [ASCIZ /?NO BLOCK IN CORE
/]
JRST ZAPERR
SRCERR: OUTSTR [ASCIZ /?NO SEARCH IN PROGRESS
/]
JRST ZAPERR
ILNRPL: OUTSTR [ASCIZ /?NULL REPLACEMENT ILLEGAL
/]
SKIPA
ILLRPL: OUTSTR [ASCIZ /?SEARCH AND REPLACEMENT VALUES NOT THE SAME SIZE
/]
TRZ F,SRCFLG ;TURN OFF SPECIAL SWITCHES
TLZ F,FL.SIP!FL.SMP ;NO MORE SEARCH
JRST ZAPERR
WPOERR: OUTSTR [ASCIZ /?FILE IS WRITE-PROTECTED
/]
JRST ZAPERR
LRGERR: OUTSTR [ASCIZ /?LOCATION OUT OF RANGE
/]
JRST ZAPERR
CRLF: BYTE (7) 15,12,0
DBLSP: BYTE (7) 40,40,0
; LOOKUP/ENTER ERROR INFORMATION ROUTINE (WHAT A TITLE!)
ENTERR: HRRZS A1,ENTEXT ;IF LOOKUP SUCCEEDED, BUT ENTER
CAIE A1,2 ;FAILED ON PROTECTION, ALLOW READ-ONLY
JRST LKPERR+1
TLO F,FL.PRX!FL.PRO ;WRITE-PROTECT LOCKED
JRST FLLEPX
LKPERR: HRRZS A1,.RBEXT ;LOOKUP DOES NOT FORGIVE
OUTSTR [ASCIZ .? (FILE I/O): .]
OUTSTR @LENMSG(A1) ;SELECT A MESSAGE
OUTSTR [BYTE (7) 15,12,0]
JRST ZAPERR
LENMSG: [ASCIZ /FILE NOT FOUND/]
[ASCIZ /NO UFD FOR P,PN/]
[ASCIZ /PROTECTION FAILURE/]
[ASCIZ /FILE BEING MODIFIED; TRY LATER/]
[ASCIZ /SYSTEM ERROR P-ERAEF%/]
[ASCIZ /SYSTEM ERROR P-ERISU%/]
[ASCIZ /DEVICE OR RIB ERROR/]
0
0
0
0
0
0
[ASCIZ /QUOTA EXCEEDED/]
[ASCIZ /STRUCTURE WRITE-LOCKED/]
[ASCIZ/SYSTEM ERROR S-ERNET%/]
[ASCIZ /PARTIAL ALLOCATION/]
[ASCIZ /BLOCK NOT FREE/]
[ASCIZ /SYSTEM ERROR P-ERCSD%/]
0
0
[ASCIZ /SEARCH LIST EMPTY/]
0
0
0
XLIST ;HIDE LITERALS
LIT
LIST
ENDALL==. ;MARK END OF CORE
END ZZZZAP