File: CCLSUB.MA of Tape: OS8/OS8-Latest/new-9
(Source file text)
/CCL SUBROUTINES 1 FOR KBM V40
/
/
/
/
/
/
/ CCL SIMPLE COMMAND SUBROUTINES
/ VERSION=4B
.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,TTSUB
.GLOBAL SQSUB,KILRT,RENRT,MOVRT
.NOLIST
.INCLUDE OUT:CCLDEF
.LIST
.SBTTL UA,UB,UC COMMANDS
.RSECT CCLSUB
FIELD 1
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 SQUISH COMMAND
SQSUB, 0
TAD I (MOFILE+1
TAD I (MIFILE+1
SZA CLA
SQER$: JMS I (ERROR /DON'T ALLOW FILES
24. /#Error in command
TAD I (MOFILE
SZA CLA
JMP I SQSUB
TAD I (MIFILE
SNA
JMP SQER$ /NO DEV: NO GOOD
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
TAD I (MPARAM
AND (20 /HUSH ?
SZA CLA
JMP I SQSUB /YES, NO MESSAGE
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
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
TAD LXR
DCA SAVLXR
JMS I (CHKSUP
JMS I (GETSPC
PUT "$ER"
JMP TECLV
TECNORM,PUT "EB"
TECLV, JMS TECMOV
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
.SBTTL BASIC COMMAND
BASUB, 0
TAD (200 /SET /Q SWITCH
DCA I (MPARAM+1
JMP I BASUB
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, RENAME, AND DELETE COMMANDS
KILRT, 0
CLA STL IAC RTL /MESSAGE #6
JMS KRMHSH
JMP I KILRT
RENRT, 0
CLA CLL IAC RTL /MESSAGE #4
JMS KRMHSH
JMP I RENRT
MOVRT, 0
TAD (5 /MESSAGE #5
JMS KRMHSH
JMP I MOVRT
KRMHSH, 0
DCA KRMNM$
TAD I (MPARAM
AND (20 /PICK OUT /H FOR HUSH
SNA CLA
JMP KRMND$ /NO HUSH
CLA CLL CMA RAL /7776
AND I (MPARAM
DCA I (MPARAM /TAKE OUT /L
JMP I KRMHSH
KRMNM$: 0
KRMND$: TAD KRMNM$
JMS I (LISPRT
MSGLST
JMP I KRMHSH
.SBTTL TTL TECO.TEC LOAD
TTSUB, 0 /MOVE TT COMMAND STRING
TAD (-200 /TO TECO INPUT BUFFER
DCA T /128 CHARS
TAD (BEGLN-1
DCA XR2
TAD (7400-1
DCA XR
TL$: CDF 0
TAD I XR2
CDF 10
AND (177
DCA I XR
ISZ T
JMP TL$
DCA I (MOFILE /SET FLAG FOR TECO.TEC
TAD (7400 /AND CONTINUATION POINTER
DCA I (MOFILE+1
JMP I TTSUB /THAT WAS EASY