File: TECOVX.MA of Tape: OS8/OS8-Latest/new-15
(Source file text)
/4 X-OVERLAY TO TECO
/ 08-APR-79 FIXED RELOC BUG
/ ADDED ERRONEOUS E COMMANDS
/ MADE QSIZE GLOBAL
.ENABLE 7BIT
.MACRO .ERROR ERNUM
.GLOBAL ERR'ERNUM
ERR'ERNUM: ERR
.ENDM
.MACRO .SORT ARG1,ARG2
SORT; ARG1; ARG2-ARG1
.ENDM
MTWO=CLL STA RAL
CCLADR=400 /CCL OVERLAY LOAD ADDRESS
CCLOVL=67 /BLOCK OF CCL OVERLAY
CCLOST=602 /CCL OVERLAY SECONDARY START ADDRESS
JSBITS=7746 /JOB STATUS BITS - IN FIELD 0
MREAD=7757 /V40- FOR ENTRY POINT TO MYSYS
SBLOCK=7776 /V40- MYSYS CHAIN DEVICE - FIELD 0
OSHNDT=7647 /OS/8 DEVICE HANDLER TABLE - IN FIELD 1
.EXTERNAL IOVRLC,QOVRLC,EOVRLC,FOVRLC
.EXTERNAL PUSHJ,CTL.C,QPNTR
.ZTERNAL OUTR,ZNXTBUF,REND,ZZ,OCRCNT,Z177,MQ,ODEV,OUTHND
.ZTERNAL EBFLG,Z200,Z7,CAFF,TFLG,FFFLAG,OSCANP,SCANP,NFLG,ZIREST
.ZTERNAL OCMDLN,ZQPNTR,ERROR,N,NLINK,MEMSIZ,QZ,Z52
.EXTERNAL ERR,OUTPUT,GETUSR,NORMAL,OCNT,OUNAM,POPJ
.EXTERNAL PUSHJ,NRET,CHR.T,NCHK,GETNUM,NCOM,TYPE,QREF,QSKP
.EXTERNAL NCOMCL,NNEW13,QCHK,QUOTST,GETUSR,ECDISM,CHREY
.EXTERNAL ADJQ,NOTRCE,QUOTST,QPUT,ENTRCE,TYPE,TCTLS,NCOM14
.GLOBAL CHR.EA,CHR.EE,CHR.EI,CHR.EL,CHR.EM
.GLOBAL CHR.EN,CHR.EP,CHR.EQ
.GLOBAL CHR.EV,CHR.EY,CHR.EZ
.GLOBAL XOVRLY,TSAV,CQSM,PSHPOP
.GLOBAL CHR.EC,CHR.EF,CHR.EG,CHR.EJ,CHR.EK,CHR.EX,CHR.UB,CHR.V
.GLOBAL CTL.B,CTL.E,CTL.F,CTL.L,CTL.N,CTL.U,CTL.V,CTL.W
.GLOBAL QSIZE
.ASECT TECOVX
*6600
RELOC 3200
IOVRLC
QOVRLC
EOVRLC
XOVRLY, 0
FOVRLC
.SBTTL Cmd EX
CHR.EX, PUSHJ /"EX" COMMAND
CHR.EC /CLOSE OUT THE FILES
JMP I (CTL.C /AND GO AWAY
.SBTTL Cmd EC
CHR.EC, TAD OUTR /"EC" COMMAND
CIA /CHECK FOR OPEN OUTPUT FILE
TAD ERROR
SNA CLA
JMP FASTEX /NOPE, EXIT ALREADY
L$: JMS I ZNXTBUF /GET NEXT BUFFER
TAD REND
CIA
TAD ZZ /CHECK FOR END-OF-FILE AND
SZA CLA /TEXT BUFFER EMPTY
JMP L$ /NOT YET
.SBTTL Cmd EF
CHR.EF, TAD OCRCNT /CAN FALL IN FROM ABOVE
CMA /REDUCE THE OUTPUT DOUBLEWORD COUNT
AND Z177 /TO REFLECT ONLY THOSE WORDS REMAINING
CMA /UNTIL THE NEXT BLOCK BOUNDARY
DCA OCRCNT
TAD L7200 /USED TO BE 'DV7200'
DCA MQ /SET COUNTER FOR ONE BLOCK WORTH OF STUFF
TAD (32 /^Z END-OF-FILE
OUTPUT
ISZ MQ
JMP .-2 /FILL AT LEAST THE CURRENT BUFFER AND OUTPUT IT
TAD ODEV /MAKE SURE THE USR KNOWS THE HANDLER
TAD (OSHNDT-1 /*K* - POINTER INTO
DCA TY / OS/8 DEVICE RESIDENCY TABLE
CDF 10
TAD OUTHND
DCA I TY /MARK THE HANDLER AS IN CORE
JMS I (GETUSR /LOCK THE USR INTO CORE
TAD EBFLG /IS THIS AN EDIT BACKUP?
SNA CLA
JMP I (NORMAL /NO, JUST CLOSE FILE
TAD I (OCNT-1 /YES, LOOKUP OLD FILE TO CHANGE NAME
DCA TY-1
CIF 10
TAD ODEV /INPUT AND OUTPUT ARE ON SAME DEVICE
JMS I Z200
2
OUNAM
TY, 0 /USELESS LENGTH--USE IT FOR TEMPORARY
JMP I (NORMAL /ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY
CDF 10 /ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE
STA /SO WE COULD FIDDLE WITH IT
TAD I (17 /FORM POINTER TO DIRECTORY ENTRY
TAD I (1404
DCA TY
TAD ('BK /CHANGE EXTENSION TO .BK
DCA I TY
TAD I Z7 /DIRECTORY BLOCK IT CAME FROM
AND Z7
DCA DIRBLK
CDF 0
L7200, CLA
JMS I OUTHND
4210 /WRITE IT BACK OUT
1400
DIRBLK, 0
JMP L7200 /ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
JMP I (NORMAL
FASTEX, TAD ZZ
SNA CLA
POPJ /FAST EXIT
.ERROR 42 /TRIED TO EX WITH NO OUTPUT FILE AND TEXT IN BUFFER
.SBTTL Cmd EK
CHR.EK, TAD ERROR
DCA OUTR
POPJ
.SBTTL Cmd V
CHR.V, CLL
PUSHJ
NRET
PUSHJ /DO A 0T
CHR.T
JMP I .-1 /NOW DO A T
.SBTTL Cmd ^W
CTL.W, .ERROR 27 /^W
.SBTTL Cmd ^V
CTL.V, .ERROR 35 /^V
.SBTTL Chr ^_
CHR.UB, NCHK
.ERROR 40 /NO ARG BEFORE ^_
GETNUM
CML CMA
JMP I (NCOM
.SBTTL Cmd ^L
CTL.L, TAD CAFF
TYPE
POPJ
.SBTTL Cmd ^F
CTL.F, CLA OSR /^F COMMAND - VALUE OF CONSOLE SWITCHES
JMP I (NCOMCL
.SBTTL Cmd ?
CQSM, TAD TFLG
CMA /TRACE FLAG ALTERNATES BETWEEN 0 AND 7777
DCA TFLG
POPJ
.SBTTL Cmd ^N
CTL.N, TAD REND
CMA
JMP I (NNEW13
.SBTTL Cmd ^E
CTL.E, TAD FFFLAG /^E COMMAND - RETURNS FORM FEED FLAG
JMP I (NNEW13
CTL.B, CDF 10 /^B COMMAND - OS/8 SYSTEM DATE
TAD I (7666
CDF 0
JMP I (NCOM
CHR.EE,
CHR.EL,
CHR.EQ,
CHR.EV,
CHR.EA,
CHR.EP,
CHR.EI,
CHR.EM,
CHR.EN,
CHR.EZ,
.ERROR 36
CHR.EY, JMP I (CHREY /OVERLAYS HAVE SPECIAL CALL
TBL, (256. /-1EJ COMPUTER ID (PDP-8)
MEMSIZ /-2EJ MEMORY SIZE (IN 512 WORD CHUNKS?)
QSIZE /-3EJ AVAILABLE Q-REGISTER STORAGE IN CHARACTERS
QZ /-4EJ NUMBER OF CHARS IN Q-REGISTER SPACE
SBLOCK /-5EJ NUMBER OF MYSYS CHAIN DEVICE
QSIZE, 2000. /LENGTH OF Q-REGISTER STORAGE (2944. IF 12K)
PAGE
.SBTTL Cmd EG
CHR.EG, PUSHJ /DO AN EC TO CLOSE OUT FILE
CHR.EC
QCHK /ALLOW @
DCA STOCD /MAKE REUSABLE IN CASE .START
TAD L7600
DCA CDPTR
TAD (-47 /47 ENTRIES IN CD TABLE
DCA EGCNT
EG1, QUOTST
JMP EG2
TAD Z200 /TURN ON PARITY BIT FOR OS/8
JMS STOCD
JMP EG1
STOCD, 0
ISZ EGCNT
SKP
.ERROR 33 /EG ARG TOO BIG
CDF 10
DCA I CDPTR
CDF 0
ISZ CDPTR
JMP I STOCD
CDPTR, 7600
EGCNT, -41
EG2, TAD STOCD
SNA CLA /ANYTHING IS ARG
JMP REGEG /NO
JMS STOCD /STORE 0 AT END
JMS I (GETUSR
TAD (CCLNAM
DCA ARG1 /JUST IN CASE PREVIOUS EG FAILED
TAD I (SBLOCK /GET MYSYS CHAIN DEVICE V40
SNA /IF NOT V40
CLA IAC /USE SYS
CIF 10
JMS I Z200
2 /LOOKUP
ARG1, CCLNAM
0
JMP CCLERR
TAD (2001
DCA I (JSBITS /KEEP USR IN CORE
TAD ARG1
DCA CHNBLK
TAD I (MREAD-1 /USE MYSYS DEV ENTRYPOINT
CIF 10
JMS I Z200
6 /CHAIN
CHNBLK, 0
CCLERR, PUSHJ
ECDISM
JMP ERR33
CCLNAM, FILENAME CCL.SV
REGEG, /EDIT AND GO - A CCL SPECIAL
JMS I (7607 /CALL THE OS/8 SYSTEM HANDLER
0200 /TO READ IN THE CCL OVERLAY
CCLADR
CCLOVL
JMP ERR33 /ERROR ON SYSTEM DEVICE!
JMP I .+1 /GO TO THE OVERLAY
CCLOST /AT OUR "SPECIAL" LOCATION
.SBTTL Cmd ^U
CTL.U, QREF /COMMAND ^U
QSKP /COUNT UP STRING
TAD OSCANP
CMA
TAD SCANP /LENGTH OF STRING
/
/ *** PROHIBIT STRING > 2047 CHARS (NO WAY CAN BE CREATED)
/
ADJQ /ADJUST Q-REGISTERS AND SET NEW LENGTH
TAD OSCANP /RESET SCAN POINTER
DCA SCANP
DCA NFLG
NOTRCE / ?WHY?
1$: QUOTST
JMP 2$
QPUT
JMP 1$
2$: ENTRCE / ?WHY?
JMP I ZIREST
.SBTTL Imm *
.SBTTL Imm ^S
TSAV, TAD Z52
TYPE /TYPE A "*Z"
TAD ("Z /TYPE "Z"
TYPE /AFTER A *
MTWO /DROP OFF THE TWO BELLS OR ALTMODES
TAD OCMDLN
SPA
JMP L7600 /IGNORE SOME IMMEDIATE COMMANDS
ADJQ /SET COMMAND STRING LENGTH TO OLD VALUE
TAD (44
QREF /SET UP POINTERS TO Q-REG Z
ADJQ /KILL CONTENTS OF Q-REG Z
TAD I ZQPNTR
DCA I (QPNTR-2
DCA I ZQPNTR /DO A QUICK SHUFFLE OF Q-REG LENGTHS
L7600, 7600 /CLA
JMP I (TCTLS
CHR.EJ, TAD NLINK
SNA CLA
JMP TERMNO
TAD N
/ AND (7 /WHO CARES IF WE ARE OUT OF RANGE
CIA
TAD (TBL-1
DCA T$
TAD I T$
DCA T$
TAD I T$
JMP I (NCOM14 /RETURN SYSTEM-DEPENDENT VALUES
T$: 0
TERMNO, 6254 /ARE WE UNDER MULTI8?
JMP I (NCOM14 /NO, GIVE BACK TERMINAL #0
CLA IAC /GIOT 1: GET TERMINAL NUMBER
6770
JMP I (NCOM14 /POSITIVE EJ RETURNS 0 (JOB NUMBER, TERMINAL NUMBER)
.SBTTL Cmd [
.SBTTL Cmd ]
PSHPOP, .ERROR 41 /UNIMPLEMENTED [ OR ]
PAGE
RELOC