File: CCLSUB.MA of Tape: OS8/OS8-V40/v40-6
(Source file text)
/CCL SUBROUTINES 1 FOR KBM V40
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/3 CCL SIMPLE COMMAND SUBROUTINES
/ VERSION=4A
.ENTRY VERTN /CALLED INDEPENDENTLY BY CCL
.ENTRY CCSUB
.EXTERNAL REMD,REGO,FLAG,FOREVER,EXSUB
.EXTERNAL LISPRT,ERROR,VMES,MMES,MSGLST
.EXTERNAL RDMON,BATCH,ARLOC,MOVE
.EXTERNAL ASSIGN,FUDG,DVICE,LOOK
.EXTERNAL GETSPC,ZEROCD,LBEGIN
.GLOBAL USRSUB,BASUB,DEASSIGN
.GLOBAL CRSUB,EDSUB,FOSUB,ZERSUB
.GLOBAL TECSUB,MAKSUB,MNGSUB,TLKSUB
.GLOBAL SQSUB,KILRT,RENRT,MOVRT
.NOLIST
.INCLUDE OUT:CCLDEF
.LIST
.SBTTL UA,UB,UC COMMANDS
.RSECT CCLSUB
FIELD 1
SETPA, 0
JMS I (SETX
"P;"A /KEEP HERE TO MAKE EASY TO PATCH
JMP I SETPA
CCSUB, 0 /USED TO FORCE THIS OVERLAY IN
JMP I CCSUB
/TEST END OF TABLE
USRSUB, 0
TAD I (REMD
SMA CLA
JMP I (REGO /REMEMBERED A NEW LINE
JMS I (FOREVER /NO DATE
TAD I (FLAG /WANT TO
AND (70
CLL RTR
RAR
TAD (-1 /IN THIS REM-LINE
JMS I (EXSUB
JMP I USRSUB
.SBTTL BASIC COMMAND
BASUB, 0
TAD (200 /SET /Q SWITCH
DCA I (MPARAM+1
JMP I BASUB
.SBTTL SQUISH COMMAND
SQSUB, 0
TAD I (MOFILE+1
TAD I (MIFILE+1
SZA CLA
JMS I (ERROR /DON'T ALLOW FILES
24. /#Error in command
TAD I (MOFILE
SZA CLA
JMP I SQSUB
TAD I (MIFILE
DCA I (MOFILE
JMS I (BATCH /IS BATCH RUNNING?
JMP I SQSUB /NO
CLA
TAD I (MOFILE
TAD (DVHNDL-1 /POINT INTO DEVICE HANDLER RESIDENCY TABLE
DCA T$
TAD I T$ /GET HANDLER STARTING ADDRESS
TAD (-SHNDLR
SZA CLA /IS SQUISHED DEVICE SYS:?
JMP I SQSUB /NO
CLA STL IAC RAL /3
JMS I (LISPRT /%Batch squishing SYS:!
MSGLST /YES, WARN USER
JMP I SQSUB
T$: 0
.SBTTL DEASSIGN COMMAND
/ALLOW DEASSIGN FOO ?
DEASSIGN,0
TAD (7740
DCA XR
TAD (-17
DCA D$
DCA I XR
ISZ D$
JMP .-2
CDF 0
TAD I (JSBITS
AND (6777
TAD (1000
DCA I (JSBITS
CDF 10
JMP I DEASSIGN
D$: 0
CHKSUP, 0
JMS I (FUDG
JMS I (ASSIGN
TAD NAME1
SNA CLA
JMP I CHKSUP /CAN'T SUP IF NO FILENAME
TAD I (DVICE
JMS I (LOOK /LOOK UP FILE
NAME1
JMP I CHKSUP /NOT FOUND (GOOD)
CLA STL RTL /MSG #2 %Superseding
JMS I (LISPRT
MSGLST
JMP I CHKSUP
.SBTTL ZERO COMMAND
ZERSUB, 0
TAD I (MOFILE+1
SNA CLA /WAS FILENAME SPECIFIED ON ZERO CMD?
TAD I (MOFILE /OR WAS NO OUT DEVICE SPECIFIED?
SNA CLA
JMS I (ERROR /YES... ERROR
9. /#Illegal syntax
JMP I ZERSUB /NO, OKAY.
TECEND, 0 /TRANSFER TECO COMMAND TO 17400
JMS I (TPUT /TERMINATE COMMAND
TAD (-200
JMS I (MOVE
CDF 0
BFR
CDF 10
7400
TAD .-1
DCA I (MOFILE /SET CONTINUATION POINTER
JMP I TECEND
PAGE
.SBTTL PUT MACRO
.NOLIST ME
.MACRO PUT TXT
JMS TECPUT
.IF IDN TXT[1],$<
.ENABLE ASCII
;TEXT <ALTMODE>"TXT[2:0]"
.ENABLE SIXBIT
>
.IF DIF TXT[1],$<
.ENABLE ASCII
;TEXT /TXT/
.ENABLE SIXBIT
>
.ENDM
.SBTTL MAKE COMMAND
ALTMODE=233
MAKSUB, 0
TAD DELIM
SNA CLA
JMS I (ERROR /DON'T ALLOW MAKE <CR>
24. /#Error in command
JMS SETLXR
JMS I (GETSPC
PUT "EW"
JMS TECMOV
JMS I (SETPA
PUT "$"
JMS I (CHKSUP
JMS I (LOVE
CLA CLL IAC RAL /REMEMBER IN CHANNEL #2
JMS I (EXSUB
JMS I (TECEND
JMP I MAKSUB
SETLXR, 0
TAD I (LBEGIN
DCA LXR
TAD (BFR-1
DCA I (TYR
TAD (-5 /ZERO OPTION TABLE TOO
JMS I (ZEROCD
TAD LXR
DCA SAVLXR
JMP I SETLXR
/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR
TECPUT, 0
TAD I TECPUT
ISZ TECPUT
SNA
JMP I TECPUT
JMS I (TPUT
JMP TECPUT+1
/MOVE CHARS FROM FIELD 0 LINE BUFFER
/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
/INTO TECO LINE BUFFER AT 'BFR'
TECMOV, 0
TAD SAVLXR
DCA XR2
TAD SAVLXR
CMA
TAD LXR
SNA CLA
JMS I (ERROR /NO FILE SPEC
9. /#Illegal syntax
L$: CDF 0
TAD I XR2
CDF 10
JMS I (TPUT
TAD XR2
CMA
TAD LXR
SNA CLA
JMP I TECMOV
JMP L$
.SBTTL TECO COMMAND
TECSUB, 0
JMS SETLXR
JMS I (GETSPC
TAD DELIM
SNA
JMP TECNORM
TAD (-"< /ALLOW "_" AS WELL AS "<"
SZA
TAD ("<-"=
SZA
TAD ("=-"_
SZA CLA
JMS I (ERROR
9. /#Illegal syntax
1$: CDF 0
DCA I LXR /CHANGE < TO 0
CDF 10
PUT "EW"
JMS TECMOV
JMS I (SETPA
TAD LXR
DCA SAVLXR
JMS I (CHKSUP
JMS I (GETSPC
PUT "$ER"
JMP TECLV
TECNORM,PUT "EB"
TECLV, JMS TECMOV
JMS I (SETPA
PUT "$Y"
CLA CLL IAC RAL /CHANNEL #2
JMS I (EXSUB
JMS I (TECEND
JMP I TECSUB
SAVLXR, 0
PAGE
.SBTTL MUNG COMMAND
TPUT, 0
AND (177 /TECO LIKES 7-BIT
ISZ TYR
CDF 0
DCA I TYR
CDF 10
TAD TYR
TAD (-<BFR+200-1> /CHECK FOR OVERFLOW OF 'BFR' AREA
SZA CLA
JMP I TPUT
JMS I (ERROR
25. /#Command is too long
TYR, 0
MNGSUB, 0
JMS I (SETLXR
JMS I (GETSPC
PUT "ER"
JMS I (TECMOV
JMS SETX
"T;"E
PUT "$YHXYHKI"
TAD DELIM
SNA
JMP F$
TAD (-",
SZA CLA
JMS I (ERROR
9. /#Illegal syntax
L$: CDF 0
ISZ LXR
TAD I LXR
CDF 10
AND (177 /GET RID OF HIGH ORDER BIT
SNA
JMP F$
JMS TPUT
JMP L$
F$: PUT "$MY" /MACRO GETS CALLED WITH POINTER PAST CHARS
JMS I (TECEND
JMP I MNGSUB
/SET DEFAULT EXTENSION
SETX, 0
TAD I SETX
DCA 1$
ISZ SETX
TAD I SETX
DCA 2$ /FALL THRU 2ND EXT
TAD NAME4
SNA CLA
TAD NAME1
SNA CLA
JMP I SETX
TAD I TYR /GET LAST CHAR (NO EXT)
TAD (-56 /WAS IT A DOT?
SNA CLA
JMP I SETX /YES
JMS I (TECPUT /NO, USE DEFAULT EXTENSION
".
1$: 0
2$: 0
0
TAD 1$
AND (77
BSW
DCA 1$
TAD 2$
AND (77
TAD 1$
DCA NAME4
JMP I SETX
LOVE, 0
TAD NAME1
TAD (-'LO
SZA CLA
JMP I LOVE
TAD NAME2
TAD (-'VE
SZA CLA
JMP I LOVE
TAD NAME3
SZA CLA
JMP I LOVE
CLA IAC /not WAR?
JMS I (LISPRT
MSGLST
JMP I LOVE
PAGE
.SBTTL CREATE COMMAND
CRSUB, 0
TAD I (MIFILE
SNA CLA /BETTER BE NO INPUT
TAD I (MOFILE /ANYTHING THERE?
SNA CLA
JMS I (ERROR /NO OUTPUT OR YES INPUT
9. /#Illegal syntax
JMS EDSUB /REMOVE BACK-ARROW AND REMEMBER CREATE LINE
JMP I CRSUB
.SBTTL EDIT COMMAND
EDSUB, 0
TAD I (ARLOC
DCA AR$
TAD AR$
CDF 0
SZA CLA /WE COULD KILL SOMETHING IN F0
DCA I AR$ /REPLACE ARROW BY NULL
CDF 10
CLA IAC CLL RAL /REMEMBER NEW COMMAND LINE
JMS I (EXSUB /REMEMBER IN CHANNEL #2
JMP I EDSUB
AR$: 0 /LOCATION OF BACK-ARROW IN COMMAND LINE
/0 IS NOW HARMLESS IN CASE NO ARROW
.SBTTL FOCAL COMMAND
FOSUB, 0
CLA STL IAC RTL /REMEMBER IN CHANNEL #6
JMS I (EXSUB
JMP I FOSUB
.SBTTL COPY, MOVE, AND DELETE COMMANDS
KILRT, 0
CLA STL IAC RTL /6
JMS I (LISPRT
MSGLST
JMP I KILRT
RENRT, 0
CLA CLL IAC RTL /4
JMS I (LISPRT
MSGLST
JMP I RENRT
MOVRT, 0
TAD (5
JMS I (LISPRT
MSGLST
JMP I MOVRT
.SBTTL VERSION COMMAND
VERTN, 0
JMS I (LISPRT
0 /READ OVERLAY
JMS I (RDMON /READ MONITOR
CDF 0
TAD I (2031 /GET PATCH LEVEL
SNA
TAD ("!
CDF 10
DCA I (VMES+17
CDF 0
TAD I (2000 /GET VERSION #
CDF 10
SPA
KK7600: 7600 /"0" MEANS OLD
TAD (260
DCA I (VMES+16
CDF 0
TAD I (OS78BIT
AND (200 / 78
SZA CLA / OR
TAD ("7-"/ / /8
TAD ("/
CDF 10
DCA I (VMES+2
/FALL INTO MULTI8 PART
SM8 /SKIP ON MULTI8
JMP N8$
TAD (240
DCA I (MMES-1 /HANG ON MULTI8 PART
CLA IAC
6770 /GIANT IOT #1
DCA V$
TAD V$
AND (77
TAD ("0 /TERMINAL NUMBER
DCA I (MMES+32
TAD V$
BSW
AND (77
TAD ("0 /BACKGROUND NUMBER
DCA I (MMES+52
N8$: JMS I (ERROR
26. /Version Message
V$: 0
.SBTTL TALK ROUTINE
TLKSUB, 0
SM8
JMS I (ERROR
27. /#Only under Multi8
CDF 0
CLA CLL IAC RTL /4
GIOT
BEGLN /PREPARE FUTURE
CLA
CDF 10
JMP I TLKSUB
PAGE