File: CCL.MA of Tape: OS8/OS8-V40/v40-6
(Source file text)
/5 MACREL VERSION OF CCL FOR OS/8 V40 / / / / / / / / / /COPYRIGHT (C) 1978 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. / / / / / / / / / / .GLOBAL OUTLIM,OUTSW,COLSET .GLOBAL LOSUB,EXSUB,BLK,IOERR .GLOBAL LOOK,MONRES .GLOBAL SETLPT,SETPTP,SETTTY .GLOBAL DEFILE .GLOBAL YAT,ZOW,BATCH,FLAG,RDMON,REGO,REMD,CHAIN .GLOBAL DECODE,SCAN,LBEGIN .GLOBAL MOVE,TWAIT,NAMPTR .GLOBAL SAVL,DONB,FUDG,ARLOC .GLOBAL ERROR,LEAVE,FATALFLG .EXTERNAL RESHND,RESNUM,ENTRY .EXTERNAL LPTDEV,TTYDEV,PTPDEV .EXTERNAL SWAPER .EXTERNAL SEMI .EXTERNAL TABLES,YBATCH .EXTERNAL AT,PTBL,VERTN,NOCCL .EXTERNAL SETDEV,RECALL .EXTERNAL CD,CDNORM,CCER1,REMEM .EXTERNAL PRINT,PRWD,TYPE .EXTERNAL LISPRT,ERRLST,MSGLST .EXTERNAL CCSUB,OVLSTR /CCL STARTING ADDRESS: 12000 /STARTING ADDRESS: 12001 /CHAIN STARTING ADDRESS:12002 .INCLUDE OUT:CCLDEF.MA /*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY. /USE OF SEMICOLONS WITH CCL VERSION I OR LATER /REQUIRES BATCH VERSION 7 OR LATER. /USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER /MEMORY ALLOCATION: /0 0000-0777 KBM /0 1000-1777 COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK] /0 2000-2777 LINE BUFFER EXTENSION /0 3000-3177 PRE-EXTENSION @ BUFFER /0 3200-3577 @ BUFFER /0 4000-4377 REM-LINES /0 4400-4777 INPUT HANDLER FOR CD / ALSO, SEMICOLON BUFFER /0 5000-5777 LONGWORD TABLE /0 6000-7277 MORE TABLES /0 7300-7577 SWITCH POINTER TABLE /VERSION 1A CHANGES: /56. FIXED BUG RE NULL INDIRECT CMD FILE /57. FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM /58. PRINT "OS78" FOR VERSION NAME IF APPLICABLE /59. ADDED -N AND -D AND REWROTE LOGIC A BIT /60. HELP COMMAND NOW USES HELP.SV /61. SET COMMAND NOW USES SET.SV /62. 'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD /63. ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH) /64. ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE) /65. ADDED DUPLICATE COMMAND (USES RXCOPY) /V1B CHANGES: /66. MODIFIED FORMAT OF MAIN TABLE /67. GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT / FILE (EVEN IF NON-FS) /68. PRINT KBM VERSION # /69. ADDED TERMINATE COMMAND /V1F CHANGE: /70. DUPL CALLS RXCOPY IN SPECIAL MODE /V1G CHANGES: /71. SOURCE CODE IS NOW MACREL /72 LINKER OVERLAYS ADDED /73. = ALLOWED IN ADDITION TO _ AND < (IF NOT FOLLOWED BY A DIGIT) /74. /C:NNNN ALLOWED FOR NUMERIC ARGUMENT IN ADDITION TO = /75. HOOKS FOR MULTIPLE CHARACTER SWITCHES ADDED /76. SWITCHES MAY NO LONGER BE EMBEDDED IN A FILENAME /77. KNOWN BUG IF SAY MAKE # /78 A+B IS IDENTICAL TO A-NB,B /79. KNOWN BUG THAT /A-L USES A /80. TEMPORARILY REMOVED SEMICOLON STUFF / FORMAT OF CCL TABLE /ENTRY PURPOSE / TABLE WIDTH=7 (BUT VARIES) /0 FLAG WORD /BIT MEANING IF ON /0 PERFORM CD (IF 0, OMIT ENTRIES 1-6) /1 DON'T PERMIT SPOOLING /2 ALLOW .LS, .NB, .MP SWITCHES /3 ADD _ TO END OF COMMAND STRING /4 SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON) /6-8 SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1) / 0 MEANS NONE. 7 RESERVED FOR SPECIAL USE. /10 CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME /11 WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1) /1 PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES. / IF PTS TO 0, NONE. IF PTS TO 5200, USE SPECIAL MODE. /2-4 DEFAULT SWITCHES TO BE OR'ED INTO THOSE / EXPLICITLY GIVEN. /5 ADDRESS OF SUBROUTINE TO BE CALLED / AFTER C.D. HAS BEEN DONE. 0 IF NONE. /6 PTR TO FILENAME OF PROGRAM / TO BE CHAINED TO. 0 IF NONE. .ASECT CCL *2000 .VERSION CCLNUM&77^100+<CCLVER&77> FIELD 1 START, IAC /START FROM MONITOR IAC /START FROM .RUN COMMAND TAD (JMP I WHICH+1 /START WHEN CHAINED TO DCA WHICH CDF 0 /DO INIT FOR ALL MODES TAD I (MREAD-1 DCA CCLHND /WHICH HANDLER ENTRY POINT? TAD I (SBLOCK DCA CCLDEV /GET HANDLER NUMBER TAD I (SOFSET TAD (1+1+5 /SKIP CCB, *400 AND FIELD 1 DCA CCLREM /GET BLOCK OF REST DCA XFERV /SET UP FOR OVERLAY DRIVER TAD (SWAPER DCA XFERV+1 WHICH, JMP I .+1 MONCHN MONFIX .+1 TAD I (CCLINC /IS CCL IN CORE? SZA CLA JMP CCLIN /YES: DON'T READ CDF 10 CIF 0 JMS I CCLHND 1300 /READ 11 MORE PAGES REST CCLREM, 0 JMP ERR2 CCLIN, JMS I (TWAIT CDF 0 TAD I (KMNTRY /REALLY 'VNO' BUT WE KNOW IT IS AT 400 TAD (-CCLTAB /DO VERSION #'S AGREE? SZA CLA JMP I (BADVNO CDF 10 DCA DONB STA DCA OUTSW TAD (1-MIFILE DCA OUTLIM TAD ("@ JMS I (CSRCH JMS I (AT TAD ("; JMS I (CSRCH JMS I (SEMI STA DCA I (REMD /ALLOW RECURSIVE U'S CDF 0 TAD I (ENTRY /GET ENTRY # TAD (PTBL /GET ADDRESS OF PTR TO START OF ENTRY DCA PTR CDF TABLES TAD I PTR /GET PTR TO START OF ENTRY CDF 10 DCA PTR TAD PTR DCA BASPTR JMP I (GO BASPTR, 0 ERR2, CIF CDF 0 JMP I (NOCCL MONCHN, TAD (1000 /4 BLOCKS JMS I (LODKBM TAD (-44 JMS I (MOVE /ASSUME COMMAND LINE IS IN CDF 10 /17600-17643 MOFILE CDF 0 BEGLN /MOVE TO OS/8 LINE BUFFER CIF CDF 0 JMP I (KEYMON+1 /START KM KBMGO, STA DCA BASPTR /SET SWITCH FOR KBM RESTART TAD (400 /4 BLOCKS (WITH NEXT) REGO, TAD (400 /2 BLOCKS (BUFFER STAYS) JMS I (LODKBM STA DCA I (7700 /USR IS IN CORE CIF CDF 0 STA DCA I (CCLINC /CCL IS IN CORE! TAD (MSOVL2 DCA I (OV /RESTORE FOR DATE CMD WITH ARGS ISZ BASPTR JMP I (KEYMON+1 JMP I (KMNTRY .START START+1,1 OUTSW, -1 /-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE OUTLIM, 1-MIFILE DONB, 0 /USED AS A FLAG JMP I DONB PAGE /THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT /IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0 /IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1 /IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC. DECODE, 0 TAD (-"9-1 /MIGHT BE CALLED WITH ANY DF CLL TAD ("9+1-"0 SZL JMP YES$ TAD ("0-"Z-1 CLL CML TAD ("Z-"A+1 SNL YES$: ISZ DECODE JMP I DECODE SETLPT, 0 /COULD BE ONCE ONLY TAD (LPTDEV JMS I (SETDEV JMP I SETLPT SETTTY, 0 TAD (TTYDEV JMS I (SETDEV JMP I SETTTY SETPTP, 0 TAD (PTPDEV JMS I (SETDEV JMP I SETPTP LBEGIN, 0 /PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT SCAN, 0 TAD (BEGLN-1 DCA XR JMS BLSCAN /IGNORE INITIAL SPACES SKP 1$: JMS I (CGET /GET CHAR THRU XR SNA JMP 3$ JMS DECODE SKP CLA JMP 1$ STA TAD XR DCA XR JMS BLSCAN 3$: DCA DELIM STA TAD XR DCA LBEGIN JMP I SCAN BLSCAN, 0 JMS I (CGET TAD (-240 SNA JMP BLSCAN+1 TAD (240-211 /ALLOW TABS SNA JMP BLSCAN+1 TAD (211 JMP I BLSCAN /LEAVE CHAR IN AC GO, JMS SCAN /ADVANCE SCAN UNTIL AFTER SPACES GO2, CDF TABLES TAD I PTR /GET FLAG CDF 10 DCA FLAG /SAVE IT TAD DELIM SNA CLA /IS TYPED LINE EMPTY AFTER KEYWORD? TAD FLAG /AND IS SPECIAL REMEMBERING BITS ON? CLL RTR RAR /AND HAS GOD WILLED US TO REMEMBER? AND (7 /AND ARE THE ZODIAK SIGNS FAVORABLE? SNA JMP I (NORM /NO TAD REMD /YES, GET REM-LINE (SUBTRACT 1) DCA REMD CDF 0 TAD I (BEGLN CDF 10 DCA SETLPT JMS I (RECALL /RECALL LINE REMD, -1 /-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE DCA DEPN /SAVE DEPENDENT INFO TAD SETLPT SZA CLA /EG COMMAND? JMP I (NORM /NO ISZ DELIM /YES TAD DEPN DCA PTR /RESET PTR FROM CMD DEPENDENT WORD JMP GO2 LODKBM, 0 /AC= # OF PAGES * 100 CDF 10 CIF 0 DCA .+2 JMS I (SHNDLR /READ IN KBM 1000 /4 BLOCKS 0 /0-1777 7 /BLOCK 7 ON SYS: HLT /NO WAY TO RECOVER (EVEN 7605 DOES THIS) JMP I LODKBM DEPN, 0 /REM LINE DEPENDENT INFORMATION FLAG, 0 /MAIN TABLE FLAG (CD ETC.) PAGE PSPOOL, SPOOLIT /HARMLESS FOR SET TTY COL NORM, DCA DEFILE TAD I (FLAG L7700, SMA CLA JMP CHAINN /SKIP ENTRIES IF NO CD ISZ PTR /POINT TO DEFAULT INPUT EXTENSION CDF TABLES TAD I PTR /GET DEFAULT INPUT EXTENSION PTR CDF 10 DCA DEFALT /SAVE IT TAD (MPARAM-2 DCA XR TAD I (FLAG CDF 0 TAD I (AMFLAG /COMBINE ALTMODE BITS CDF 10 RAR /IN POSITION 11 CLA RAR /PUT NEW ALTMODE BIT ALONE IN BIT 0 DCA I XR /STORE AWAY IN C.D. OPTION TABLE DCA I XR /V3D ZERO OPTION WORDS DCA I XR DCA I XR DCA I XR /ZERO L.O. = L$: ISZ PTR CDF TABLES TAD I PTR SNA JMP 2$ DCA NTEMP ISZ PTR TAD I PTR /GET VALUE CDF 10 TAD I NTEMP DCA I NTEMP /STORE IN SPECIFIED LOCATION JMP L$ 2$: CDF 10 TAD I (FLAG AND (400 SZA CLA JMS I (INSARR /INSERT BACK ARROW IF FLAG BIT SET JMS I (CD /PERFORM COMMAND DECODE IF FLAG BIT 0 SET TAD I (FLAG RAL SMA CLA /IS SPOOLING PROHIBITED? JMS I PSPOOL /NO CHAINN, ISZ PTR /POINT TO AFTER CD SUBR CDF TABLES TAD I PTR /GET SUBR ADDRESS CDF 10 JMS I (JMSUB TAD DEFILE SZA /IS THERE A FILENAME SET TO CHAIN TO? JMP ZOW /YES ISZ PTR /NO, POINT TO FILENAME CDF TABLES TAD I PTR CDF 10 SNA JMP I (LEAVE /NO FILE TO CHAIN TO ZOW, DCA NMPTR TAD (YBATCH /CHECK FOR BATCH.SV CIA TAD NMPTR SNA CLA JMP BATSYS /YES, IS BATCH TAD CCLDEV /ON 'CCL' DEVICE JMS LOOK /LOOKUP FILE NMPTR, 0 JMP I (CCER1 /NOT FOUND TAD CCLHND /ONLY KBM V40!!!! CHAIN, JMS I (USR /CHAIN TO IT 6 /CHAIN BLK, 0 DEFILE, 0 /PTR TO FILENAME TO CHAIN TO BATSYS, TAD NMPTR /BATCH M U S T COME FROM SYS: DCA .+2 JMS LOOK 0 JMP I (CCER1 JMP CHAIN /LOOK, LOOKS UP FILE ON DEVICE . POINTER IS IN ARG1 / ARG2 IS ERROR RETURN IF NOT FOUND /DEVICE NUMBER IS IN AC. IF 0, USE SYS: LOOK, 0 SNA IAC DCA DEV TAD I LOOK /GET PTR TO FILE NAME IN FIELD 0 DCA HISFIL TAD HISFIL AND L7700 SNA CLA JMP FLD1 /PTR LT 100 MEANS IN FIELD 1 TAD (-3 JMS I (MOVE /MOVE IT UP CDF 0 HISFIL, 0 CDF 10 PFILDMY,FILDMY TAD PFILDMY SETN, DCA NAMPTR /STORE AWAY PTR TO FILENAME TAD ('SV DCA FILDMY+3 ISZ LOOK /POINT TO ERROR RETURN TAD DEV /GET DEVICE NUMBER JMS I (USR 2 /LOOKUP NTEMP, NAMPTR, 0 0 JMP I LOOK /TAKE ERROR RETURN IF NOT FOUND TAD NAMPTR /STORE STARTING BLOCK # IN 'BLK' DCA BLK ISZ LOOK /POINT TO NORMAL RETURN JMP I LOOK /RETURN FLD1, TAD HISFIL JMP SETN DEV, 0 PAGE TEMP, 0 LOSUB, 0 CLA IAC /LOAD,LINK: CHANNEL #1 JMS EXSUB JMP I LOSUB EXSUB, 0 DCA EX$ /AC CARRIES REMEMBRANCE CHANNEL TAD I (BASPTR /PUSH PTR BACK TO BEGIN OF ENTRIES JMS I (REMEM /REMEMBER THIS IN DEPENDENT WORD EX$: 0 /NORMALLY CHANNEL #0 FOR COMPILE CLASS JMP I EXSUB JMSUB, 0 SNA JMP I JMSUB DCA TEMP TAD (OVLSTR CLL CIA TAD TEMP /CHECK IF SUB IS IN OVERLAY RANGE SZL CLA JMS I (CCSUB /LOAD OVERLAY ONLY IF NEEDED JMS I TEMP JMP I JMSUB SPOOLIT,0 JMS I (BATCH /IS BATCH RUNNING? JMP I SPOOLIT /NO DCA CB /YES CDF 0 TAD I DEFALT TAD (-5200 SNA TAD I DEFALT /LEAVE 5200 IN AC IF SPECIAL MODE CDF 10 CB, HLT /CIF TO FIELD OF BATCH JMS I (BATSPL /ALLOW BATCH TO SPOOL STUFF JMP I SPOOLIT / TAD (-# OF LOCS TO MOVE / JMS MOVE / FROM CDF / FROM LOC / TO CDF / TO LOC MOVE, 0 DCA T TAD I MOVE /GET FROM CDF DCA FRCDF ISZ MOVE STA TAD I MOVE /GET FROM LOC-1 DCA XR ISZ MOVE TAD I MOVE /GET TO CDF DCA TOCDF ISZ MOVE STA TAD I MOVE /GET TO LOC-1 DCA XR2 ISZ MOVE /POINT TO RETURN TAD T SNA CLA JMP I MOVE /V1A IGNORE 0 MOVE FRCDF, HLT TAD I XR TOCDF, HLT DCA I XR2 ISZ T JMP FRCDF CDF 10 JMP I MOVE INSARR, 0 JMS I (CSRCH /SEARCH NULL STA TAD XR DCA XR TAD ("< CDF 0 DCA I XR DCA I XR CDF 10 STA TAD XR DCA ARLOC /REMEMBER WHERE WE INSERTED A "_" JMP I INSARR ARLOC, 0 /FOR REMOVING BACK-ARROW 'EDIT' BADVNO, TAD ('#V JMS I (PRWD CDF 0 TAD I (400 JMS I (TYPE JMS I (LISPRT /MSG 0 MSGLST JMS I (VERTN JMP I (LEAVE /GO AWAY COLSET, 0 JMS I (SETTTY TAD I (MPARAM+3 SNA TAD I (MMISC /NEW F1 RESIDENT BITS KM V40!!!! AND (7 DCA I (MPARAM+3 JMP I COLSET IOERR, JMS I (ERROR 0. PAGE CSRCH, 0 DCA S$ TAD (BEGLN-1 DCA XR 1$: JMS CGET CIA TAD S$ SNA JMP I CSRCH /FOUND IT (ALSO END) CIA TAD S$ SZA CLA /AT END? JMP 1$ ISZ CSRCH JMP I CSRCH /YES SECOND RETURN S$: 0 CGET, 0 CLA CDF 0 TAD I XR CDF 10 TAD (-340 SMA TAD (-40 /CONVERT LC TO UC TAD (340 JMP I CGET SAVL, 0 YAT, 0 TAD SAVL /'YAT' IS JMS'ED TO SNA CLA /BY INITIAL @ COMMAND JMP LEAVE /DO NOTHING IF NO @ GOT EXPANDED (NULL LINE) JMP I (REGO ERROR, 0 CLA CDF 10 TAD I ERROR /GET ERROR NUMBER JMS I (LISPRT ERRLST LEAVE, JMS I (TWAIT TAD FATALF SNA CLA JMP I (KBMGO FATALF, 0 /CIF CDF BATCH FIELD IF WANT TO ABORT JMP I (BATERR /SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC BATCH, 0 CDF 0 TAD I (BATCCL CDF 10 DCA BWORD TAD BWORD RTL SNL CLA /IS BATCH RUNNING? JMP I BATCH /NO TAD BWORD /YES AND (70 /ISOLATE FIELD OF BATCH TAD (CIF /FORM CIF TO THE HIGHEST FIELD ISZ BATCH /AND TAKE SKIP RETURN WITH IT IN AC JMP I BATCH TWAIT, 0 DCA ERROR JMS BATCH JMP TW$ /BATCH NOT RUNNING CLA /WE'RE RUNNING UNDER BATCH JMP I TWAIT TW$: TSF SKP /WAIT FOR THINGS TO QUIET DOWN JMP I TWAIT 400 /WASTE SOME TIME 400 400 ISZ ERROR JMP TW$ JMP I TWAIT /CAN'T WAIT TOO LONG BWORD, FUDG, 0 JMS I (CDNORM /INIT CD NORMAL MODE DCA I (OUTSW TAD I (OUTLIM /LOAD HANDLER CIA DCA CLXR JMP I FUDG PAGE MONFIX, JMS RDMON CDF 0 TAD I (TESBUF TAD (-SHNDLR SNA CLA JMP CCER3 /ALWAYS WRITE OUT CCL BLOCK CLL TAD CCLHND /NOW TEST IF RESIDENT TAD (-SHNDLR SNL CLA JMP RESERR /NON-RESIDENT HANDLERS TEND TO DISAPPEAR TAD CCLHND /GOT ENTRY POINT FROM 'RUN' DCA I (RESHND /STORE IN CCLBLK TAD CCLDEV /GOT NUMBER FROM MONITOR RUN DCA I (RESNUM /STORE ALSO IN CCLBLK CDF 10 CIF 0 JMS I (SHNDLR 4200 /WRITE 1 RECORD FROM FIELD 0 400 /LOCATIONS 400-777 CCLBLK /INTO THE SYSTEM'S CCL BLOCK JMP I (IOERR CDF 0 TAD I (TESBUF+CCLSW TAD (-PRQMRK SNA JMP OK$ TAD (PRQMRK-GETCCL SZA CLA JMP CCER3 OK$: TAD (GETCCL DCA I (TESBUF+CCLSW STA DCA I (TESBUF+DEASADR /DELETE DEASSIGN CLA STL RAR /WRITE MONITOR JMS RDMON CIF CDF 0 JMP I (MONLOD RDMON, 0 /WITH AC=4000 ALSO WRITE MONITOR CDF 10 CIF 0 TAD (400 DCA .+2 JMS I (SHNDLR 0400 /READ/WRITE 2 RECORDS TESBUF /IN BUFFER AT 02000 7 /BLOCK 7,10 JMP I (IOERR JMP I RDMON MONRES, 0 JMS RDMON CDF 0 TAD (PRQMRK DCA I (TESBUF+CCLSW TAD (-405 DCA I (TESBUF+DEASADR CLA STL RAR JMS RDMON JMP I MONRES CCER3, JMS I (ERROR 23. RESERR, JMS I (PRINT RESBAD CIF CDF 0 JMP I (MONLOD .ENABLE ASCII RESBAD, .IF NDF GERMAN < TEXT /#Device not resident!/> .IF DF GERMAN < TEXT /#Geraet nicht resident!/> .ENABLE SIXBIT PAGE