File CCL.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/56	CCL  FOR  OS/8 V3D
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/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.
/
/
/
/
/
/
/
/
/
/

MOFILE=7600 MIFILE=7617 MPARAM=7643 XR2=15 XR=16 TXR=17 AMFLAG=17 T=20 TT=21 DEF=22 NAME1=23 NAME2=24 NAME3=25 NAME4=26 NMBASE=27 DEV1=30 DEV2=31 DELIM=32 DEFALT=33 /POINTS TO DEFAULT EXTENSION LIST LXR=34 CLXR=35 PTR=36 DATWD=7666 BATERR=7000 /JMP HERE TO ABORT BATCH BATOUT=7400 /JMS HERE TO PRINT ON BATCH LOG BATSPL=7200 /JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC OS78BIT=7771 BEGLN=1000 /CCL STARTING ADDRESS: 12000 /STARTING ADDRESS: 12001 /CHAIN STARTING ADDRESS:12002 / JOB STATUS WORD = 2003 /************************************************** / / SAVING CCL / / .LOAD CCL / .SAVE SYS CCL;12001=2103 / .R CCL / /************************************************** CCLSW=435 DEASADR=427 PRQMRK=1357 GETCCL=1362 OV=1375 MSOVL2=55 CCLBLK=67 /BLOCK ON SYS: USED BY CCL CCLTAB="G /MUST BE UPDATED IF TABLES CHANGE CCLNUM="1 CCLVER="F /CCL VERSION # /*** 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 HNDLR=4400 BFR=5000 /MEMORY ALLOCATION: /0 4400-4777 INPUT HANDLER FOR CD / ALSO, SEMICOLON BUFFER /0 5000-5177 PRE-EXTENSION @ BUFFER /0 5200-5577 @ BUFFER /0 1000-1777 /COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK] /0 2000-2777 /LINE BUFFER EXTENSION
/ CHANGES SINCE FIELD RELEASE VERSION: /1. RECURSIVE 'U' BUG FIXED /2. INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED /3. BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED /4. .SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE /5. COMPARE PASSES ALTMODE /6. TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP /7. BUG RE PASSING DEFAULT * FIXED /8. .LS FORM OF .CREF COMMAND REMOVED /9. BUG CONCERNING PROCESSOR SWITCHES FIXED /10. CCL SWITCH ALLOWED AFTER =N OPTION /11. BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED /12. EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT /13. 'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY /14. 'BAD CCL SWITCH' MESSAGE ADDED /15. CCL EDIT # CHANGED TO CCL VERSION # /16. .EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES /17. MUNG PTR: NOW WORKS /18. FIXED BUG RE MUNG <CR> /19. FIXED BUG RE CD FOR FILE > 2047 BLKS /20. FIXED BUG RE MAKE PTR: /VERSION B FIXES: /21. ALLOWED 'EDIT' TO COPY FILE EXTENSION /22. FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE /23. FIXED DATE PROBLEM /24. ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED /VERSION C FIXES: /25. FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT /26. ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE / AS IN DEVICE (IF NONE SPECIFIED) /27. ADDED MORE SYNTAX CHECKING TO ZERO COMMAND /VERSION D CHANGES: /28. ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' . /VERSION E CHANGES: (IN-HOUSE ONLY VERSION) /29. WARNING MSG IF SQUISH SYS: UNDER BATCH /30. ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS < /31. ADDED HOOKS FOR ; TO BE READY FOR V4 /32. FIX BUG RE CMD STARTING WITH SPACES /CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C): /33. FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC /34. INCORPORATED ALL PREVIOUS EDITS /35. ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED) /36. FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1: /37. CORRECTED SPELLING OF SUPERSEDING /38. ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS] /VERSION G CHANGES: /39. FIXED BUG WITH HELP COMMAND /40. FIXED BUG CONCERNING EDIT DEV:_FILE /VERSION H CHANGES: /41. ADDED MAC AND LINK COMMANDS /42. ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS /43. ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS /44. ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING /45. ALLOWED @ AT BEGINNING OF LINE /46. MOVED MOST OF 'DETCOR' TO FIELD 0 /47. WAIT ROUTINE NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC /48. ALLOWED EXEC .BI TO USE BATCH /49. TENTATIVELY ADDED SEMICOLON STUFF /50. PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH /VERSION I CHANGES: /51. FIRMED UP SEMICOLON STUFF /VERSION J CHANGES: /52. DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS: /53. -L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME /VERSION K CHANGES: /54. DATE NOW HANDLES DATE/78 ALGORITHM /55. TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG /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
/ 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. / FIELD 0 /1000-1777 LINE BUFFER /2000-2777 LINE BUFFER EXTENSION /4000-4377 REM-LINES /4400-4777 HANDLER /5000-5577 BUFFER /6000-7577 MORE CCL (7 PAGES) REST=6000
FIELD 1 *2000 FAKBM=404 /PLACE TO FAKE OUT KBM START, JMP .+3 /START FROM MONITOR JMP (CCLBLC /START FROM .RUN COMMAND /THIS LITERAL IS AT END OF PAGE JMP MONCHN /START WHEN CHAINED TO CLA CDF 0 /READ IN REST OF CCL TAD I (CCLBLC /GET BLOCK OF START CDF 10 TAD CCLREM DCA CCLREM /GET BLOCK OF REST CIF 0 JMS I (7607 700 /READ 7 MORE PAGES REST CCLREM, 1+14+1 /SKIP CCB AND *400 STUFF JMP ERR2 JMS TWAIT CDF 0 TAD I LVNO CDF 10 TAD (-CCLTAB /DO VERSION #'S AGREE? SZA CLA JMP BADVNO PREGO, JMS I (AT STA DCA I (REMD /ALLOW RECURSIVE U'S CDF 0 TAD I KENTRY /GET ENTRY # KCIDF, CIF CDF 10 TAD (PTBL /GET ADDRESS OF PTR TO START OF ENTRY DCA PTR TAD I PTR /GET PTR TO START OF ENTRY DCA PTR JMP I (GOO MONCHN, KCIF, CIF 0 JMS I (7607 /READ IN KBM 1000 /4 BLOCKS 0 /0-1777 7 /BLOCK 7 ON SYS: HLT /NO WAY TO RECOVER (EVEN 7605 DOES THIS) TAD (-44 JMS I (MOVE /ASSUME COMMAND LINE IS IN CDF 10 /17600-17643 7600 CDF 0 1000 /MOVE TO OS/8 LINE BUFFER CIF CDF 0 YAT, JMP I KFAKBM /@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO') TAD I (ASSIGN /'YAT' IS JMS'ED TO SNA CLA /BY INITIAL @ COMMAND JMP I (LEAVE /DO NOTHING IF NO @ GOT EXPANDED (NULL LINE) REGO, CIF 0 JMS I (7607 200 /READ ONE BLOCK 400 /400-777 10 /RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY HLT JMP I (FAKE /REGO, TAD KCIDF / CDF 0 / DCA I (RETCIF /ALLOW 'FINDIT' TO RETURN TO FIELD 1 / CIF CDF 0 / STA / DCA I (HALF / DCA I (ENTRY / TAD (KEYWRD / DCA I (KPTR / JMS I (FINDIT /LOOK UP KEYWORD / SMA CLA / JMP PREGO /FOUND IT /CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD / ERRCMD
ERR2, CIF CDF 0 JMP I (NOCCL BADVNO, JMS I (PRINT BADVMS JMS I (VERTN JMP I (LEAVE /GO AWAY
/TEST END OF TABLE USRSUB, 0 TAD I (REMD SMA CLA JMP REGO /REMEMBERED A NEW LINE TAD I (FLAG /WANT TO AND (70 CLL RTR RAR TAD (-1 /IN THIS REM-LINE DCA UREM JMS I (FOREVER /NO DATE JMS I (REMEM UREM, 0 JMP I USRSUB
TWAIT, 0 DCA WFL 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 LVNO, AND I 0 /WASTE SOME TIME KFAKBM, AND I 4 KENTRY, 600 ISZ WFL JMP TW JMP I TWAIT /CAN'T WAIT TOO LONG WFL, 0 /SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC BATCH, 0 CDF 0 TAD I (7777 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 KCIF /FORM CIF TO THE HIGHEST FIELD ISZ BATCH /AND TAKE SKIP RETURN WITH IT IN AC JMP I BATCH
BWORD, 0 PAGE
/WE FALL INTO THIS FROM LITERAL ON PREVIOUS PAGE MONFIX, JMS I (RDMON CDF 0 TAD I ZERO TAD (-7607 SNA CLA JMP I PCCER3 /ALWAYS WRITE OUT CCL BLOCK CDF 10 CIF 0 JMS I L7607 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 (2000+CCLSW TAD (-PRQMRK SNA JMP MONOK TAD (PRQMRK-GETCCL SZA CLA JMP I PCCER3 / CIF CDF 0 / JMP I L7605 MONOK, TAD (GETCCL DCA I (2000+CCLSW STA DCA I (2000+DEASADR /DELETE DEASSIGN JMS WRMON JMS I (LOOK YFORT /LOOK FOR FORT.SV TAD (YF4-YFORT /NOT FOUND, USE F4 TAD (YFORT /FOUND USE IT DCA I (FORTE TAD I (FORTE TAD (-YFORT SZA CLA TAD (YLOAD-YLOADER /F4 TAD (YLOADER DCA I (LOADE JMP I (WRITFT /UNKLUTZ
L200, WRMON, 200 CDF 10 CIF 0 JMS I L7607 4200 L2400, 2400 10 JMP I (IOERR JMP I WRMON
MONRES, 0 JMS I (RDMON CDF 0 TAD (PRQMRK DCA I (2000+CCLSW TAD (-405 DCA I (2000+DEASADR JMS WRMON JMP I MONRES L7605, SETLPT, 7605 /COULD BE ONCE ONLY TAD KLPTDEV JMS SETDEV JMP I SETLPT L7607, 7607 M7607, SETTTY, -7607 TAD KTTYDEV JMS SETDEV JMP I SETTTY PCCER3, SETPTP, CCER3 TAD (PTPDEV JMS SETDEV JMP I SETPTP ZERO, /STAYS 0 FOR A WHILE SETDEV, 0 /V1A ARG NOW IN AC DCA DEVPTR CLL STA RAL /-2 JMS I (MOVE CDF 0 DEVPTR, LOC78 CDF 10 DVNM1 JMS I (SETOUT JMP I SETDEV P4, SETDEV KLPTDEV,LPTDEV P5, SETDEV KTTYDEV,TTYDEV
FAKE, CIF CDF 0 TAD (MSOVL2 DCA I (OV /RESTORE LOC SO DATE CMD W ARGS WILL WORK JMP I (FAKBM PTCH, CDF 0 DCA I (VLOC TAD I (OS78BIT AND (200 / 78 SZA CLA / OR TAD (1000 / /8 TAD (5770 DCA I DEVPTR CDF 10 JMS I (PRMESG VMES PAGE
COLWRD /NEEDED BY SET GO, JMS I (SCAN /ADVANCE SCAN UNTIL AFTER SPACES GO2, TAD I PTR /GET FLAG 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 NORM /NO TAD REMD /YES, GET REM-LINE (SUBTRACT 1) DCA REMD CDF 0 TAD I (BEGLN CDF 10 DCA NMPTR JMS I (RECALL /RECALL LINE REMD, -1 /-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE DCA DEPN /SAVE DEPENDENT INFO TAD NMPTR SZA CLA /EG COMMAND? JMP NORM /NO ISZ DELIM /YES TAD DEPN DCA PTR /RESET PTR FROM CMD DEPENDENT WORD JMP GO2
NORM, TAD FLAG L7700, SMA CLA JMP CHAINN /SKIP ENTRIES IF NO CD ISZ PTR /POINT TO DEFAULT INPUT EXTENSION TAD I PTR /GET DEFAULT INPUT EXTENSION PTR DCA DEFALT /SAVE IT TAD (7641 DCA XR TAD FLAG JMS I (GAMFLG 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. = STOLUP, ISZ PTR TAD I PTR SNA JMP STODON DCA NTEMP ISZ PTR TAD I PTR /GET VALUE DCA I NTEMP /STORE IN SPECIFIED LOCATION JMP STOLUP STODON, TAD 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 CHAI, TAD FLAG RAL SMA CLA /IS SPOOLING PROHIBITED? JMS I (SPOOLIT /NO CHAINN, ISZ PTR /POINT TO AFTER CD SUBR TAD I PTR /GET SUBR ADDRESS JMS I (JMSUB TAD I (DEFILE SZA /IS THERE A FILENAME SET TO CHAIN TO? JMP ZOW /YES ISZ PTR /NO, POINT TO FILENAME TAD I PTR SNA JMP I (LEAVE /NO FILE TO CHAIN TO ZOW, DCA NMPTR JMS LOOK /LOOKUP FILE NMPTR, 0 JMP I (CCER1 /NOT FOUND CHAIN, JMS I (200 /CHAIN TO IT 6 /CHAIN DEPN, /REM LINE DEPENDENT INFO BLK, 0 / -----
/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 ISZ LOOK /POINT TO ERROR RETURN TAD DEV /GET DEVICE NUMBER JMS I (200 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
FLAG, 0 DEV, 0 FLD1, TAD HISFIL JMP SETN PAGE
XEXE, 5033; EXTEXE; 7643;40;0; EXSUB; YPAL8 /EXECUTE MUST BE FIRST FOR TECO EG XBAC, 0; TRMSUB; YCAMP /BACKSPACE (OR TERMINATE) /MUST BE 2ND FOR OS78 XBAS, 0; BASUB; YBASIC /BASIC XDUPL, 4001; STAR; 0; 0; YRXCOP /DUPLIC XBOO, 0; 0; YBOOT /BOOT XCCL, 0; MONRES; 0 /CCL XCOMPA, 4001; EXTNUL; 0; SETTTY; YSRCCOM /COMPARE XCOMPI, 5033; EXTCOM; 0; EXSUB; YPAL8 /COM XCOP, 4001; STAR; 7643;1;0; MOVRT; YFOTP /COPY XCOR, 0; DETCOR; 0 /MEMORY XCREA, 4400; EXTNUL; 0; CRSUB; YEDIT /CREATE XCREF, 4002; EXTCF; 7643;1000;0; 0; YPAL8 /CREF XDAT, 0; DATE; 0 /DATE XDEL, 4001; STAR; 7643;401;0; KILRT; YFOTP /DELETE XDEA, 0; DEASSIG;0 /DEASSIGN XDIR, 4001; STAR; 7646;COLWRD,0;0;SETTTY; YDIRECT /DIRECT XEDI, 5220; EXTNUL; 0; EDSUB; YEDIT /EDIT XEOF, 0; 0; YCAMP /EOF XHEL, 4001; STAR; 7644;20;0; SETTTY; YHELP /HELP XLINK, 5033; EXTLI; 0; EXSUB; YLINK /LINK XMAC, 5033; EXTMA; 0; EXSUB; YMACREL /MAC XLIS, 4001; STAR; 7644;10;0; SETLPT; YFOTP /LIST XLOA, 5031; EXTLO; 0; EXSUB; YABSLDR /LOAD XMAK, 0; MAKSUB; YTECO /MAKE XMAP, 4001; EXTBN; 0; SETTTY; YBITMAP /MAP XMUN, 0; MNGSUB; YTECO /MUNG XPAL, 5033; EXTPA; 0; EXSUB; YPAL8 /PAL XPRI, 4000; STAR; 0; SETLPT; YLPTSPL /PRINT XPUN, 4001; EXTNUL; 0; SETPTP; YPIP /PUNCH XREN, 4001; STAR; 7643;1;7644;100;0;RENRT;YFOTP /RENAME XRES, 4001; EXTSY; 0; SETTTY; YRESORC /RESOURCES XREW, 0; 0; YCAMP /REWIND XSET, 0; 0; YSET /SET XSKI, 0; 0; YCAMP /SKIP XSQU, 4001; EXTNUL; 7644;40;0; SQSUB; YPIP /SQUISH XSUB, 4000; EXTBI; 0; 0; YBATCH /SUBMIT XTEC, 10; TECSUB; YTECO /TECO XTYP, 4001; STAR; 7644;10;0; SETTTY; YFOTP /TYPE XUNL, 0; 0; YCAMP /UNLOAD XUA, 40; USRSUB; 0 /UA XUB, 50; USRSUB; 0 /UB XUC, 60; USRSUB; 0 /UC XVER, 0; VERTN; 0 /VERSION XZER, 4401; EXTNUL; 7645;2000;0; ZERSUB; YPIP /ZERO XAT, 0; YAT; 0 /@ ZBLOCK 13 GAMFLG, 0 CDF 0 TAD I PAMFLAG /COMBINE ALTMODE BITS CDF 10 RAR /IN POSITION 11 CLA RAR /PUT NEW ALTMODE BIT ALONE IN BIT 0 JMP I GAMFLG PAMFLAG,AMFLAG
TRMSUB, 0 CDF 0 TAD I POS78 CDF 10 AND R200 SNA CLA JMP I TRMSUB /BACKSPACE, NOT TERMINATE 6073 6002 CLA /JUST IN CASE WE'RE NOT ON A VT-78 JMS I PPRM BADEV POS78, OS78BIT R200, 200 PPRM, PRMESG
PTBL, XEXE XBAC XBAS XDUPL XBOO XCCL XCOMPA XCOMPI XCOP XCOR XCREA XCREF XDAT XDEL XDEA XDIR XEDI XEOF XHEL XLINK XMAC XLIS XLOA XMAK XMAP XMUN XPAL XPRI XPUN XREN XRES XREW XSET XSKI XSQU XSUB XTEC XTYP XUNL XUA XUB XUC XVER XZER XAT ZBLOCK 4
STAR, 5200; 0 0; 0 EXTSY, 2331; 0 0; 0 EXTBI, 0211; 0 0; 0 EXTCF, 2001; COMPA /EXTLS, 1423; COMLS 0; COMPA EXTMA, 1501; COMMA 0; COMMA EXTPA, 2001; COMPA 0; COMPA EXTBN, 0216; 0 0; COMBN /EXTHL, 1014; 0 / 0; 0 EXTNUL, 0; 0 EXTLO, 0216; COMBN /BN 2214; COMRL /RL EXTLI, 2202; COMRB /RB 0; 0 EXTCM, 0315; 0 0; 0
EXTEXE, 2001; COMPA /PA 0624; COMFT /FT 0201; COMBA /BA 1501; COMMA /MA 0216; COMBN /BN 2214; COMRL /RL 2201; COMRA /RA 2302; COMSB /SB 2202; COMRB /RB 1404; COMLD /LD V3C 0211; COMBI /BI 0; 0 ZBLOCK 4 EXTCOM, 2001; COMPA /PA 0624; COMFT /FT 1501; COMMA /MA 0201; COMBA /BA 2201; COMRA /RA 2302; COMSB /SB 0; 0 ZBLOCK 4 IFZERO .&7600-3200 <PAGE>
COMBN, 0 JMS USUAL 0216 YABSLDR JMP I COMBN COMRL, 0 JMS USUAL 2214 LOADE, YLOAD /MAY BECOME YLOADER JMP I COMRL COMPA, 0 JMS USUAL 2001 YPAL8 JMP I COMPA COMFT, 0 JMS USUAL 0624 FORTE, YF4 /COULD BE CHANGED TO YFORT BY .R CCL JMP I COMFT COMBA, 0 JMS USUAL 0201 YBCOMP JMP I COMBA COMRA, 0 JMS USUAL 2201 YRALF JMP I COMRA
COMSB, 0 JMS USUAL 2302 YSABR JMP I COMSB COMRB, 0 JMS USUAL 2202 YLINK JMP I COMRB COMMA, 0 JMS USUAL 1501 YMACREL JMP I COMMA COMBI, 0 JMS USUAL 0211 YBATCH JMP I COMBI COMLD, 0 JMS USUAL 1404 YFRTS JMP I COMLD
DEFILE, 0 /PTR TO FILENAME TO CHAIN TO /COMLS, 0 / TAD I (EXTLS / DCA SETEXT / TAD (YCREF / DCA DEFILE / ISZ I (DONB /CREF FOO.LS MAKES NO BINARY / JMP I COMLS RDMON, 0 CDF 10 CIF 0 CLA JMS I (7607 0400 /READ 2 RECORD 2000 /LOCATION 2000 FIELD 0 7 /BLOCK 7,10 JMP I (IOERR JMP I RDMON USUAL, 0 TAD I USUAL DCA SETEXT ISZ USUAL TAD I USUAL DCA DEFILE ISZ USUAL JMP I USUAL
UNKN, 0 TAD SETEXT SZA TAD T /NEG OF SWITCH REQUEST SZA CLA JMP I (CCERA /CAN'T HAVE 2ND DEFAULT EXTENSION TAD T CIA DCA SETEXT /SET DEFAULT EXTENSION TAD DEFALT /SEE IF IT'S IN COMMAND'S SEARCH LIST DCA DEF TAD SETEXT JMS I (EXTLUK SNA CLA /DID WE FIND IT? JMP I (CDER4 /NO ISZ DEF /YES / TAD I (JMSUB /ALLOW RECURSIVE CALL / DCA HOLD TAD I DEF JMS I (JMSUB /CALL ITS SUBR / TAD HOLD /V1A RECURSIVE CALL NO LONGER THREATENS / DCA I (JMSUB JMP I UNKN SETEXT, 0 /EXT WHICH HAS BEEN SET BY A CCL SWITCH SEMERR, TAD (SEMSG-1 DCA UNKN TAD I UNKN DCA .+2 JMS I (PRMESG SEMSG1
WRITFT, JMS I (LOOK YCCL JMP I (IOERR /CCL.SV NOT FOUND TAD I (BLK TAD (4 /*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB DCA FBLK CDF 10 CIF 0 JMS I (7607 4210 /WRITE 1 RECORD FROM FIELD 1 3400 /LOCS 3400-3777 FBLK, 0 JMP I (IOERR CIF CDF 0 JMP I (7605 PAGE
CD, 0 JMS I (200 13 /RESET ALL HANDLERS JMS I (CDINIT BEGGRP, TAD OUTSW SNA CLA TAD I (BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS TAD (MOFILE-1 DCA CLXR JMS I (GETSPC JMS I (ASSIGN TAD OUTSW SNA CLA TAD I (LIMDIF /DIFF BETWWEN END OF OUTPUT & INPUT AREAS TAD I (OUTLIM /END OF OUTPUT AREA TAD CLXR SMA CLA JMP I (CDER1 JMS I (CCLSWT TAD OUTSW SNA CLA LKUPSW, JMP INFILE /ZEROED IF IN "SPECIAL DECODE" MODE TAD I (DVICE JMS PCLXR TAD NAME1 JMS PCLXR TAD NAME2 JMS PCLXR TAD NAME3 JMS PCLXR TAD NAME4 JMP LSTPUT INFILE, JMS I (LOOKUP JMS PCLXR /STORE LENGTH AND DEV NUMBER TAD I (LNAME /GET BLOCK LSTPUT, JMS PCLXR TAD OUTSW SNA CLA TAD I (FLAG CLL RTL SPA CLA /FEATURE ENABLED? TAD LKUPSW SNA CLA JMP DLOOK /IN SPECIAL MODE OR ON OUTPUT SIDE TAD DONB SZA CLA JMP NBS TAD (7600 /V1A NOW TAKES ARG IN AC JMS I (NMOVE /MOVE NAME TO OUTPUT FILE NAMES JMP DLOOK
NBS, DCA DONB /ZERO 1ST OUTPUT FILE TAD (7577 DCA XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 DCA I XR2 DLOOK, STA DCA I (DVFLAG TAD DELIM SNA JMP I CD TAD (-"[ SNA JMP I (OLENGT TAD ("[-", SNA JMP I (FILLP /**** JUMPING INTO ROUTINE (IS THIS A BUG?) TAD (",-"< SNA JMP BKAROW TAD ("<-"= SZA CLA JMP I (CDER2 /BAD CHAR / THIS STUFF WOULD ALLOW = AS WELL AS < AND _ /*** HAVE TO FIX 'BKA' ROUTINE / JMS I (GLXR / JMS I (DECODE / STL / STA /LINK=0 MEANS LETTER / TAD LXR /NOW LINK=1 MEANS LETTER / DCA LXR / SZL / JMP BKAROW DCA I (NUMFUJ JMS I (NUMBER DCA I (MPARAM+3 CLA CLL CML RAR AND I (MPARAM-1 /PRESERVE ALTMODE TAD I (HIORD DCA I (MPARAM-1 JMS I (CCLSWT JMP DLOOK BKAROW, ISZ OUTSW JMP I (CDER2 /TWO BACK-ARROWS TAD LXR /GET PTR TO ARROW DCA I (ARLOC /SAVE IT ('EDIT' MIGHT NEED IT) JMP BEGGRP PCLXR, 0 ISZ CLXR DCA I CLXR JMP I PCLXR
DONB, 0 /ENTRY PT USED AS FLAG JMP I DONB OUTSW, -1 /-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE P6, SETDEV TVDEV PAGE
NUMBER, 0 SZA CLA TAD (NUM&177+1200-SKP TAD (SKP DCA NUMADD/SET NUMADD TO EITHER "SKP" OR "TAD NUM" DCA HIORD NUMLP, DCA NUM JMS I (GCH ISZ NUMKNT SKP JMP EONUM2 CMA TAD NUMFUJ TAD ("8 /TEST INPUT CHARACTER FOR RANGE CLL CMA /0-7 IF NUMFUJ=0 TAD (10 /0-9 IF NUMFUJ=2 TAD NUMFUJ SNL JMP EONUM DCA T CLA CLL CMA RTL DCA DELIM TAD NUM ROTLP, CLL RAL DCA NUMX TAD HIORD RAL NUMSKP, SPA /MODIFIED BY # JMP I (CDER5 DCA HIORD TAD NUMX ISZ DELIM JMP ROTLP NUMADD, TAD NUM /SKP IF OCTAL TAD NUM TAD T JMP NUMLP EONUM, TAD ("0 EONUM2, DCA DELIM TAD NUMKNT SPA CLA JMP I (CDER5 /FEWER THAN CORRECT NUMBER OF DIGITS TAD NUM JMP I NUMBER NUM, 0 NUMFUJ, 0 NUMKNT, 0 /SET TO -N-1 TO FORCE N DIGITS HIORD, 0
ASSIGN, 0 TAD CLXR AND I (DVFLAG TAD I (OUTLIM SMA SZA CLA /CHECK FOR OUTPUT OR FIRST INPUT JMP ASNORM /IF DEVICE WAS SPECIFIC, /OR IF WE ARE ON THE INPUT SIDE, /PROCEED NORMALLY TAD NAME1 SNA CLA JMP ASGNST TAD DFLTNM+1 DCA DEV2 TAD DFLTNM DCA DEV1 ASNORM, TAD DEV1 DCA AS+1 TAD DEV2 DCA AS+2 TAD I (OUTSW SNA CLA /DON'T LOAD HANDLER /IF WE ARE ON OUTPUT SIDE OF "_" TAD NAME1 SPKLG1, SNA CLA /OR THERE IS NO FILE NAME TO LOOK UP TAD GETHND /GETHND=11 NORMALLY, /0 IF IN "SPECIAL DECODE" MODE IAC DCA AS TAD (HNDLR+1 /ALLOW TWO PAGE HANDLERS DCA ASADR CIF 10 JMS I (200 NUMX, AS, 0 0 0 ASADR, HNDLR+1 JMP I (CDER0 TAD AS+2 ASGNST, DCA I (DVICE JMP I ASSIGN
DFLTNM, DEVICE DSK GETHND, 11 /1+11=12 (1=FETCH, 12=INQUIRE) LOVE, 0 TAD NAME1 TAD (-1417 SZA CLA JMP I LOVE TAD NAME2 TAD (-2605 SZA CLA JMP I LOVE TAD NAME3 TAD NAME4 SZA CLA JMP I LOVE JMS I (PRINT LOVMES JMP I LOVE FILDMY, FILENAME DUMMY.SV SEMSG, SEMSG1 SEMSG2 SEMSG3 SEMSG4 PAGE
/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR /RETURNS WITH DELIMETER IN AC /GIVES ERROR MESSAGE IF NAME IS BAD TN, /DON'T CALL CCLSWT FROM GNAME UNLESS THIS IS MOVED GNAME, 0 DCA NAME1 DCA NAME2 DCA NAME3 DCA NAME4 TAD (NAME1 DCA NMBASE CLA CMA DCA PERDSW DCA NAMECT JMS I (GCH TAD (-"# SNA JMP NUMCON TAD ("# SKP GTNMLP, JMS I (GCH DCA DELIM TAD DELIM TAD (-"? SZA TAD ("?-"* SNA STARSW, JMP I (CDER6 /"JMP STARNM" /IF "SPECIAL DECODE" MODE TAD ("*-". SNA CLA JMP PERIOD TAD DELIM JMS I (DECODE JMP LV STARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY TAD DELIM AND (77 DCA DELIM TAD NAMECT TAD (-6 SMA CLA JMP GTNMLP TAD NAMECT CLL RAR TAD NMBASE DCA TT TAD DELIM SNL JMS I (ROTL TAD I TT DCA I TT ISZ NAMECT JMP GTNMLP PERIOD, TAD NAME1 SZA CLA ISZ PERDSW JMP I (CDER7 /NULL NAME OR DOUBLE EXTENSION ISZ NMBASE TAD (4 DCA NAMECT JMP GTNMLP
CCLSWT, 0 TAD DELIM TAD (-"- SZA CLA JMP I CCLSWT TAD I (OUTSW SZA CLA JMP I (CDER4 /CCL EXT ON OUTPUT FILE TAD (SWTCHS DCA DEF JMS GETL JMP I (CDER44 /NON-ALPHANUMERIC CCL SWITCH JMS I (ROTL DCA TN JMS GETL JMP XLK2 /ONE CHAR CCL SWITCH TAD TN DCA TN JMS GETL XLK2, SKP CLA /2 CHAR CCL SWITCH JMP I (CDER44 /3 CHAR CCL-SWITCH TAD TN JMS I (EXTLUK CLA ISZ DEF TAD I DEF DCA GETL /GET PTR TO ARGUMENT PAIR TAD I GETL /GET SUBROUTINE DCA PERDSW ISZ GETL TAD I GETL /GET ARGUMENT JMS I PERDSW /CALL SUBR, ARG IN AC JMP CCLSWT+1
GETL, 0 JMS I (GCH DCA DELIM TAD DELIM JMS I (DECODE JMP I GETL /NON-ALPHANUM IN CCL SWITCH CLA TAD DELIM AND (77 ISZ GETL JMP I GETL NUMCON, JMS I (NUMC LV, CLA TAD DELIM JMP I GNAME PERDSW, 0 NAMECT, 0 PAGE
LOOKUP, 0 DCA LNAME TAD NAME1 SNA CLA JMP LKUPST TAD I (PERDSW TAD NAME4 SNA CLA CLA IAC /FORCE NAMERM NON-0 IF . AND NO EXT TAD NAME4 DCA NAMERM /REMEMBER TYPED EXTENSION TAD DEFALT DCA DEF TAD I (SETEXT SNA /HAS AN EXTENSION BEEN SET? TAD NAMERM /NO SNA /DOES FILE HAVE EXTENSION? JMP EXT2 /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS JMS EXTLUK /LOOK FOR EXTENSION SNA CLA /DID WE FIND IT? JMP EXT3 /NO, FORCE NULL EXTENSION TO MATCH EXT2, TAD I DEF IAC SNA CLA JMP NEXTEXT /IGNORE -1'S TAD NAMERM SZA CLA JMP EXT3 TAD I DEF DCA NAME4 /SET NEW EXTENSION EXT3, TAD (NAME1 DCA LNAME TAD I (AS+2 JMS I (200 2 LNAME, 0 /NAME1 LENGTH, 0 JMP LFAILD ISZ DEF /POINT TO FOLLOW-UP SUBROUTINE TAD I DEF JMS JMSUB /CALL IT TAD LENGTH CLL TAD (400 SNL CLACON, 7600 /CLA CLL RTL RTL AND (7760 LKUPST, TAD DVICE JMP I LOOKUP
LFAILD, TAD NAMERM SNA CLA /WAS THERE AN EXPLICIT EXTENSION? TAD I DEF /NO - WAS THERE A DEFAULT EXTENSION? SNA CLA JMP I (CDER3 /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION NEXTEXT,ISZ DEF /NO EXPLICIT EXT AND YES DEFAULT EXT ISZ DEF /POINT TO NEXT POSSIBLE DEFAULT EXTENSION JMP EXT2 /AND TRY FOR IT NAMERM, 0 DVICE, 0 EXTLUK, 0 CIA DCA T XLUK, TAD I DEF SNA /AT NULL? JMP I EXTLUK /YES TAD T /NO SNA CLA /MATCH? JMP MAT /YES ISZ DEF /NO ISZ DEF /POINT TO NEXT ENTRY JMP XLUK /TRY AGAIN MAT, TAD I DEF /RETURN WITH IT IN AC JMP I EXTLUK TS, ZERSUB, 0 TAD I (7601 SNA CLA /WAS FILENAME SPECIFIED ON ZERO CMD? TAD I CLACON /OR WAS NO OUT DEVICE SPECIFIED? SNA CLA JMP I (CDER2 /YES... ERROR JMP I ZERSUB /NO, OKAY.
IOERR, JMS I (PRMESG SYSER EXSUB, 0 TAD BASPTR /PUSH PTR BACK TO BEGIN OF ENTRIES JMS I (REMEM /REMEMBER THIS IN DEPENDENT WORD 2 JMP I EXSUB JMSUB, 0 SNA JMP I JMSUB DCA TS JMS I TS JMP I JMSUB
SPOOLIT,0 JMS I (BATCH /IS BATCH RUNNING? JMP I SPOOLIT /NO DCA CB /YES TAD I DEFALT TAD (-5200 SNA CLA TAD I DEFALT /LEAVE 5200 IN AC IF SPECIAL MODE CB, HLT /CIF TO FIELD OF BATCH JMS I (BATSPL /ALLOW BATCH TO SPOOL STUFF JMP I SPOOLIT GOO, TAD PTR BASPTR, DCA BASPTR JMP I (GO PAGE
SLSHCH, 0 DCA DELIM TAD (MPARAM-1 DCA T TAD DELIM JMS DECODE JMP CDER8 SZL TAD (32 CMA STL /THE FOLLOWING TURNS /ON THE CORRECT OPTION BIT DCA TT SLSHLP, SZL ISZ T RAR SNL ISZ TT JMP SLSHLP DCA TT TAD TT CMA AND I T TAD TT DCA I T JMP I SLSHCH /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 DCDYES TAD ("0-"Z-1 CLL CML TAD ("Z-"A+1 SNL DCDYES, ISZ DECODE JMP I DECODE CDER8, CLA JMS I (PRMESG BADOPT
ZEROCD, 0 TAD (-42 /AC MAY BE NON-0 DCA T TAD (MOFILE-1 DCA XR DCA I XR /ZERO THE COMMAND DECODER OUTPUT AREA ISZ T JMP .-2 JMP I ZEROCD GCH, 0 JMS GLXR TAD (-240 SNA JMP GCH+1 TAD (240-"/ SNA JMP SLASH TAD ("/-"( SNA JMP OPENP TAD ("( JMP I GCH SLASH, JMS GLXR JMS SLSHCH /*** CAN'T PUT /A:VAL HERE BECAUSE GCH AINT RECURSIVE JMP GCH+1 OPENP, JMS GLXR TAD (-") SNA JMP GCH+1 TAD (") JMS SLSHCH JMP OPENP GLXR, 0 CDF 0 ISZ LXR TAD I LXR CDF 10 JMP I GLXR
OLENGT, TAD I (OUTSW AND NAME1 /[N] IS ONLY LEGAL /ON THE OUTPUT SIDE OF THE "_" SNA CLA /AND ONLY AFTER A FILE NAME JMP I (CDER2 TAD (-4 TAD CLXR DCA NMBASE CLA CLL CML RTL DCA I (NUMFUJ /SET "NUMBER" TO ACCEPT /DIGITS 8 AND 9 STA /ALLOW DECIMAL JMS I (NUMBER CLL RTL RTL AND (7760 TAD I NMBASE DCA I NMBASE CDF 0 TAD DELIM TAD (-"] /IS THERE A CLOSING BRACKET? SNA /IF NOT, /"DLOOK" ROUTINE WILL DETECT IT JMS GCH DCA DELIM JMP I (DLOOK
BASUB, 0 TAD (200 /SET /Q SWITCH DCA I (MPARAM+1 JMP I BASUB PAGE
PRMESG, 0 CLA TAD I PRMESG DCA .+2 JMS PRINT HLT LEAVE, JMS I (TWAIT /V3D TCF CIF CDF 0 TAD FATALFLG SNA CLA JMP I (7605 FATALFLG,0 /CIF CDF BATCH FIELD IF WANT TO ABORT JMP I (BATERR PRWD, 0 DCA T TAD T TTY212, RTR RTR RTR JMS PCHAR TAD T JMS PCHAR JMP I PRWD PCHAR, 0 AND (77 SNA JMP I PCHAR /IGNORE NULLS TAD (240 AND (77 TAD (240 /CAN'T USE 'TTY240' JMS TYPE JMP I PCHAR PRNAME, 0 TAD NAME1 JMS PRWD TAD NAME2 JMS PRWD TAD NAME3 JMS PRWD TAD NAME4 SNA CLA JMP I PRNAME TAD (256 JMS PCHAR TAD NAME4 JMS PRWD JMP I PRNAME
TYPE, 0 DCA TE2 JMS I (BATCH JMP TTYOUT DCA CIFB CIFB, HLT /REPLACED BY CIF BATCH FIELD TAD TE2 JMS I (BATOUT TAD TE2 TAD (-"# TTY240, SZA CLA JMP I TYPE TAD CIFB IAC /CONVERT CIF TO CIF CDF DCA FATALFLG JMP I TYPE TTYOUT, TAD TE2 TAD (-"# /DON'T TYPE #'S SNA CLA JMP I TYPE TAD T7600 KRS TAD (-7603 SNA JMP LEAVE TAD (203-217 SNA CLA JMP I TYPE TAD TE2 TJUMP, JMP .+3 TSF JMP .-1 TLS T7600, 7600 TAD (7000 DCA TJUMP JMP I TYPE
PRINT, 0 DCA CRLF /AC NON-0 MEANS DON'T CRLF TAD I PRINT ISZ PRINT DCA TE PRINTP, CDF 0 TAD I TE CDF 10 JMS PRWD CDF 0 TAD I TE CDF 10 ISZ TE AND (77 SZA CLA JMP PRINTP TAD CRLF SNA CLA JMS CRLF JMP I PRINT TE, 0 TE2, 0
CRLF, 0 TAD (215 JMS TYPE TAD TTY212 JMS TYPE JMP I CRLF CDER2, JMS PRMESG BADSYN P1, NMOVE 7605 PAGE
CCERB, JMS I (PRMESG BADSW CDER1, JMS I (PRMESG TOOMAN CDER5, JMS I (PRMESG BADNUM CCER1, TAD I (NAMPTR DCA NMX TAD (-4 JMS I (MOVE CDF 10 NMX, 0 CDF 10 NAME1 CDER3, TAD (4300 JMS I (PRWD /# JMS I (PRNAME JMS I (PRMESG NF CCER2, TAD I (DVNM1 DCA DEV1 TAD I (DVNM2 DCA DEV2 CDER0, TAD DEV1 SNA CLA JMP I (CDER2 /B DOES NOT EXIST TAD (4300 /# JMS I (PRWD TAD DEV1 JMS I (PRWD TAD DEV2 JMS I (PRWD JMS I (PRMESG DNE
KILRT, 0 JMS I (PRINT KILMES JMP I KILRT RENRT, 0 JMS I (PRINT RENMES JMP I RENRT MOVRT, 0 JMS I (PRINT MOVMES JMP I MOVRT SWTCHS, 1423; P1 /LS 1602; P2 /NB 1520; P3 /MP 1400; P4 /L 2400; P5 /T 2300; P6 /S 2000; P7 /P 0400; P8 /D 1600; P9 /N 0000; P10 /UNKNOWN ZBLOCK 2 /PATCH ROOM FOR USER P2, DONB 0 P3, NMOVE 7612 P7, SETDEV PTPDEV P9, SETDEV NULDEV P10, UNKN 0
SCAN, 0 TAD (BEGLN DCA T CDF 0 JMS BLSCAN /IGNORE INITIAL SPACES JMP CHK NOBLUP, CLA ISZ T TAD I T CHK, SNA JMP ENDOFB JMS I (DECODE SKP CLA JMP NOBLUP JMS BLSCAN ENDOFB, DCA DELIM STA TAD T CDF 10 DCA I (LBEGIN JMP I SCAN BLSCAN, 0 TAD I T TAD (-240 SZA JMP BL2 ISZ T JMP BLSCAN+1 BL2, TAD (240 JMP I BLSCAN /LEAVE CHAR IN AC PAGE
ALTMODE=233 SETPA, 0 JMS I (SETX "P;"A /KEEP HERE TO MAKE EASY TO PATCH JMP I SETPA MAKSUB, 0 TAD DELIM SNA CLA JMP CMDERR /DON'T ALLOW MAKE <CR> JMS SETLXR JMS I (GETSPC JMS I (LOVE JMS TECPUT "E;"W;0 JMS TECMOV JMS SETPA JMS TECPUT ALTMODE;0 JMS I (CHKSUP JMS I (REMEM 0 JMP I MAKSUB SETLXR, 0 TAD I (LBEGIN DCA LXR TAD (MOFILE-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 NAME1 / SNA CLA / JMP I (CDER2 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 17600 TECMOV, 0 TAD SAVLXR DCA XR2 TAD SAVLXR CMA TAD LXR SNA CLA JMP I (CDER2 /NO FILE SPEC TECL, CDF 0 TAD I XR2 CDF 10 JMS I (TPUT TAD XR2 CMA TAD LXR SNA CLA JMP I TECMOV JMP TECL
TECSUB, 0 JMS SETLXR JMS I (GETSPC TAD DELIM SNA JMP TECNORM TAD (-"< /ALLOW "_" AS WELL AS "<" SNA JMP EXTEN TAD ("<-"_ SZA CLA JMP I (CDER2 EXTEN, CDF 0 DCA I LXR /CHANGE < TO 0 CDF 10 JMS TECPUT "E;"W;0 JMS TECMOV JMS SETPA TAD LXR DCA SAVLXR JMS I (CHKSUP JMS I (GETSPC JMS TECPUT ALTMODE;"E;"R;0 JMS TECMOV JMS SETPA JMS TECPUT ALTMODE;"Y;0 JMP TECLV
TECNORM,JMS TECPUT "E;"B;0 JMS TECMOV JMS SETPA JMS TECPUT ALTMODE;"Y;0 TECLV, JMS I (REMEM 0 JMP I TECSUB SAVLXR, 0 CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD ERRCMD PAGE
TPUT, 0 AND (177 /TECO LIKES 7-BIT ISZ TYR DCA I TYR TAD TYR TAD (-7646 /CHECK FOR OVERFLOW OF CD AREA SZA CLA JMP I TPUT CDER9, JMS I (PRMESG TOOLNG MNGSUB, 0 JMS I (SETLXR JMS I (GETSPC JMS I (TECPUT "E;"R;0 JMS I (TECMOV JMS SETX "T;"E EXTOK, JMS I (TECPUT ALTMODE;"Y;"H;"X;"Y;"H;"K;"I;0 TAD DELIM SNA JMP IFIN TAD (-", SZA CLA JMP I (CDER2 G, STL CLA RAR /PREVENT 'GCH' FROM HANDLING SPACE AND / JMS I (GCH AND (177 /GET RID OF HIGH ORDER BIT SNA JMP IFIN JMS TPUT JMP G IFIN, JMS I (TECPUT ALTMODE;"M;"Y;0 /MACRO GETS CALLED WITH POINTER PAST CHARS JMP I MNGSUB TYR, 0
/SET DEFAULT EXTENSION SETX, 0 TAD I SETX DCA C1 ISZ SETX TAD I SETX DCA C2 /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 ". C1, 0 C2, 0 0 TAD C1 AND (77 JMS I (ROTL DCA C1 TAD C2 AND (77 TAD C1 DCA NAME4 JMP I SETX CCERA, JMS I (PRMESG CONTRA
CRSUB, 0 TAD I (7617 SNA CLA /BETTER BE NO INPUT TAD I (7600 /ANYTHING THERE? SNA CLA JMP I (CDER2 /NO OUTPUT OR YES INPUT JMS EDSUB /REMOVE BACK-ARROW AND REMEMBER CREATE LINE JMP I CRSUB EDSUB, 0 CDF 0 DCA I ARLOC /REPLACE ARROW BY NULL CDF 10 JMS I (REMEM /REMEMBER NEW COMMAND LINE 1 JMP I EDSUB ARLOC, . /LOCATION OF BACK-ARROW IN COMMAND LINE /'.' IS HARMLESS PTR IN CASE NO ARROW CCER3, CDF 10 JMS I (PRMESG BADMON CDER4, CLA JMS I (PRMESG BADSW CDER44, CLA JMS I (PRMESG BADSW2 CDER7, JMS I (PRMESG BADX CDER6, JMS I (PRMESG BADSTR PAGE
INSARR, 0 TAD (BEGLN DCA XR CDF 0 TAD I XR SZA CLA JMP .-2 STA TAD XR DCA XR TAD ("< DCA I XR DCA I XR CDF 10 STA TAD XR DCA I (ARLOC /REMEMBER WHERE WE INSERTED A "_" JMP I INSARR BKA, 0 TAD I (LBEGIN DCA CLXR GG, CDF 0 ISZ CLXR TAD I CLXR CDF 10 SNA JMP NOBKAR TAD (-"< SNA JMP I BKA TAD ("<-"_ SZA CLA JMP GG TAD ("< CDF 0 DCA I CLXR CDF 10 JMP I BKA NOBKAR, ISZ BKA JMP I BKA
AT, 0 CIF CDF 0 JMS I (SEMI ATMORE, TAD (BEGLN-1 DCA LXR ATLOOP, JMS I (GLXR SNA JMP I AT TAD (-300 SZA CLA JMP ATLOOP TAD LXR DCA I (SAVL JMS I (FUDG JMS I (GETSPC JMS I (ASSIGN DCA I (SETEXT TAD (EXTCM DCA DEFALT JMS I (LOOKUP SZA CLA /V3C TAD I (ASADR SNA JMP I (ATERR /IF NO FILESPEC AFTER @, ERROR DCA T TAD I (LNAME /GET BLOCK NUMBER DCA BLN CIF 0 JMS I T 200 /READ 2 PAGES NWB, BFR+200 /INTO BUFFER COUNT, BLN, 0 /FROM THIS BLOCK JMP I (ATERR / I/O ERROR TAD (-200 DCA COUNT TAD (BFR-1 DCA XR TAD NWB DCA T CDF 0 ALP, TAD I T JMS I (P CLL RTR RTR DCA BKA ISZ T TAD I T JMS I (P CLL RTL RTL RAL TAD BKA JMS I (P CLA ISZ T ISZ COUNT JMP ALP JMP I (ATOVER /ATFIN, TAD LXR / TAD (-BEGLN / SZA CLA / JMP I AT /LEAVE / JMP I (LEAVE /LEAVE BECAUSE LINE NOW EMPTY PAGE
P, 0 AND (177 SNA JMP CTZ /END AT 0 OR ^Z TAD (-32 SNA JMP CTZ TAD (32-16 /IGNORE CR,LF,FF,VT CLL TAD (16-12 SZL JMP POGO TAD (212 /FORCE 8-BIT DCA I XR POGO, CLA TAD I T AND (7400 JMP I P
CTZ, CDF 10 TAD LXR DCA ATEND STA TAD LXR DCA LXR /INCASE @ GOES TO EOL JMS I (GLXR /SEARCH FOR EOL SZA CLA JMP .-2 TAD LXR CMA TAD ATEND DCA ENDLEN TAD XR CMA TAD (BFR /GET LENGTH OF INSERTED STUFF DCA NEWLEN CDF 0 TAD I ATEND /GET NEXT CHAR AFTER FILESPEC CDF 10 /V3C TAD (-"' SZA CLA /IS IT AN APOSTROPHE? JMP .+3 /NO ISZ ENDLEN /YES ISZ ATEND /MAKE IT GO AWAY TAD ENDLEN JMS I (MOVE /MOVE REST OF LINE UP CDF 0 ATEND, 0 /FIRST CHAR POSITION AFTER @ SPEC CDF 0 BEGLN+1000 TAD NEWLEN /IF 0, 'MOVE' WILL IGNORE IT JMS I (MOVE /MOVE IN NEW STUFF CDF 0 BFR CDF 0 SAVL, 0 /POINTS TO @ TAD NEWLEN CIA TAD SAVL DCA NEWEND CLL TAD NEWEND TAD (-BEGLN-1000 SZL CLA JMP ATOVER TAD ENDLEN JMS I (MOVE /MOVE BACK END CDF 0 BEGLN+1000 CDF 0 NEWEND, 0 /FIRST POSITION AFTER NEW STUFF JMP I (ATMORE /LOOK FOR MORE
ATOVER, JMS I (PRMESG OVFLOW GETMP, ENDLEN, 0 /- NO. OF CHARS AT END INCLUDING 0 NUMC, 0 TAD (SKP DCA I (NUMSKP TAD (-11 DCA I (NUMKNT JMS I (NUMBER DCA NAME2 TAD I (HIORD DCA NAME1 STA TAD LXR DCA LXR TAD (-11 DCA I (NUMKNT JMS I (NUMBER DCA NAME4 TAD I (HIORD DCA NAME3 TAD (SPA DCA I (NUMSKP JMP I NUMC
NEWLEN, /- NO. OF CHARS BEING INSERTED GETYR, 0 AND (7 DCA GETMP CDF 0 TAD I (7777 CDF 10 CLL RTR RTR AND (30 TAD GETMP JMP I GETYR PAGE
/ 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 TMP1, TOCDF, HLT DCA I XR2 ISZ T JMP FRCDF CDF 10 JMP I MOVE
DETCOR, 0 CIF 0 JMP I (CORE JMP I DETCOR BADCOR, JMS I (PRINT NOCORE GOEQ, CIF CDF 0 JMP I (COREQ ABSCOR, JMS I (PRINT CORMES JMP I DETCOR WRSCOR, JMS I (PRINT BATCOR JMP GOEQ SCRM, JMS I (PRINT SCRMES JMP I DETCOR
SQSUB, 0 TAD I K7600 SZA CLA JMP I SQSUB TAD I (7617 DCA I K7600 JMS I (BATCH /IS BATCH RUNNING? JMP I SQSUB /NO K7600, 7600 /YES (CLEAR AC) TAD I K7600 TAD (7647-1 /POINT INTO DEVICE HANDLER RESIDENCY TABLE DCA TMP1 TAD I TMP1 /GET HANDLER STARTING ADDRESS TAD (-7607 SZA CLA /IS SQUISHED DEVICE SYS:? JMP I SQSUB /NO JMS I (PRINT SQWARN /YES, WARN USER JMP I SQSUB
SETOUT, 0 TAD I (FLAG RTR SZL CLA TAD (5 TAD K7600 DCA OLOC TAD I OLOC SZA CLA JMP I SETOUT /HE'S SPECIFIED SOMETHING JMS I (200 12 /INQUIRE DVNM1, 0 DVNM2, 0 0 JMP I (CCER2 /NO SUCH DEVICE TAD DVNM2 DCA I OLOC TAD OLOC AND (5 SNA CLA /USING 2ND OUT DEV? JMP I SETOUT /NO ISZ OLOC /YES TAD (-4 JMS MOVE CDF 10 NAME1 CDF 10 OLOC, 7600 /INITIALLY 7600 OR 7605 JMP I SETOUT
ENGOA, TAD (-5 JMS I (ZEROCD CDF 0 TAD I (BLKNO CDF 10 DCA I (7620 CLA IAC DCA I (7617 /'CCBTCH' IS ON SYS: TAD (20 / /T OPTION DCA I (7644 TAD (20 / ALSO /H (HUSH) OPTION DCA I (7643 TAD (YBATCH JMP I (ZOW /CHAIN TO BATCH PAGE
DATE, 0 TAD I (DATWD SNA JMP NODATE DCA DATEM TAD DATEM CLL RTL RTL RAL AND (17 DCA TM1 TAD TM1 TAD (MONLST-1 DCA TM2 CDF 0 TAD I TM2 CDF 10 DCA MONP TAD DATEM JMS I (GETYR /V3D DATE/78 ALGORITHM DCA TM2 TAD TM2 TAD (106 /70. CIF CDF 0 JMS I (OTODY DCA YEAR TAD DATEM CLL RTR RAR AND (37 DCA DATEM TAD DATEM CIF CDF 0 JMS I (OTODY DCA DAY CDF 0 STL CLA RTL /2 TAD TM2 CLL RTR SNL SMA JMP LEAP ISZ I (JAN ISZ I (FEB LEAP, AND (37 TAD TM2 TAD (3 TAD DATEM DCA DATEM TAD TM1 TAD (JAN-1 DCA TM1 TAD I TM1 CDF 10 TAD DATEM DIV7, CLL TAD (-7 SZL JMP DIV7 TAD (7 TAD (WEEKLST DCA TM2 CDF 0 TAD I TM2 CDF 10 DCA WKP STA /DON'T CRLF JMS I (PRINT WKP, 0 STA JMS I (PRINT DAYDAY STA JMS I (PRINT MONP, 0 STL CLA RAR JMS I (PRWD /SPACE TAD DAY JMS I (PRWD STA JMS I (PRINT COM19 TAD YEAR JMS I (PRWD JMS I (CRLF JMS I (LOOK /LOOKUP SYS:DATE.SV YDATE JMP I DATE /DO NOTHING IF IT'S NOT THERE JMP I (CHAIN /CHAIN TO IT, IF IT'S THERE
NODATE, JMS I (PRMESG NONE DT, 0 TM2, 0 DATEM, 0 DAY, 0 YEAR, 0
SETDSK, 0 TAD DSKDEV SZA JMP I SETDSK JMS I (200 12 /INQUIRE 5723 /PACKED ENCODING FOR 'DSK:' DSKDEV, 0 /SET TO DEVICE NUMBER 0 TM1, HLT /NO 'DSK' ! TAD DSKDEV JMP I SETDSK PAGE
/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL /SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE. /THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT: /4000-4037 REM-LINE 0 /4040-4177 REM-LINE 1 /4100-4137 REM-LINE 2 /4140-4177 REM-LINE 3 /4200-4237 REM-LINE 4 /4240-4277 REM-LINE 5 /4300-4337 REM-LINE 6 /4340-4377 REM-LINE 7 /EACH REM-LINE HAS THE FOLLOWING FORMAT: /WORD 0: IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE /WORD 1: DATE LINE WAS REMEMBERED /WORD 2: COMMAND DEPENDENT INFORMATION /WORD 3: RESERVED FOR FUTURE EXPANSION /WORDS 4-37 COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES / PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0. /ROUTINES: / TAD (DEP / JMS REMEM / N /REMEMBERS CURRENT LINE IN REM-LINE N. AC IS LINE DEPENDENT INFORMATION. /IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK. / JMS RECALL / N /RECALLS REM-LINE N INTO BUFFER /IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8. /UPON RETURN, LINE-DEPENDENT INFO IS IN AC. /IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1 /0 USED BY TECO, MAKE COMMANDS /1 USED BY EDIT, CREATE COMMANDS /2 USED BY COMPILE, EXECUTE COMMANDS & PAL. / DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE /3 USED BY 'UA' COMMAND /4 USED BY UB /5 USED BY UC / JMS FOREVER /CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
REMSPACE=4000 REMBLOCK=65 REMEM, 0 DCA DEP TAD I (REMD SMA CLA JMP I REMEM /DON'T REMEMBER IF JUST RECALLED JMS I (RDREM JMP I (MEMBIG TAD I REMEM ISZ REMEM CLL RTL RTL RAL /MULTIPLY BY 40 TAD (REMSPACE DCA LPTR TAD (1234 CDF 0 DCA I LPTR CDF 10 ISZ LPTR FORVR, TAD I (DATWD /REPLACED BY CMA IF WANT NO DATE JMS LPUT /STORE DATE TAD DEP JMS LPUT /STORE DEPENDENT INFO JMS LPUT /RESERVED JMS I (SCAN /GO PAST KEYWORD AND BLANKS TAD I (LBEGIN DCA XR RELUP, JMS I (GETF JMP LZER JMS I (ROTL DCA TML JMS I (GETF JMP RZER TAD TML JMS LPUT JMP RELUP RZER, TAD TML LZER, JMS LPUT JMS I (WRREM JMP I (MEMBIG REMGO, JMP I REMEM
DEP, 0 LPTR, 0 /PTS TO REM-LINE TML, 0 /TEMP /PUT INTO REM-LINE LPUT, 0 DCA TML TAD LPTR AND (37 SNA CLA JMP I (MEMBIG TAD TML CDF 0 DCA I LPTR CDF 10 ISZ LPTR JMP I LPUT FOREVER,0 TAD LCMA DCA FORVR JMP I FOREVER /NON-ZERO MEANS SET DATE TO -1
RECALL, 0 JMS I (RDREM JMP I (REMERR TAD I RECALL ISZ RECALL JMS I (ROTL RAR TAD (REMSPACE DCA LPTR JMS LGET TAD (-1234 SZA CLA JMP I (REMER2 JMS LGET SNA JMP I (REMER2 LCMA, CMA SNA JMP FOREV IAC TAD I (DATWD /SAME DAY? SZA CLA JMP I (REMER2 FOREV, JMS LGET DCA DEP JMS LGET /IGNORE RESERVED WORD CLA TAD (BEGLN-1 DCA XR TAD (BEGLN-1 DCA I (LBEGIN RECLUP, JMS LGET DCA TML TAD TML JMS I (ROTL RAL JMS I (PUTF JMP RECLV TAD TML JMS I (PUTF JMP RECLV JMP RECLUP RECLV, TAD DEP JMP I RECALL
LGET, 0 CDF 0 TAD I LPTR CDF 10 ISZ LPTR JMP I LGET PAGE
PUTF, 0 AND (77 SNA JMP PUTZ ISZ PUTF TAD (240 AND (77 TAD (240 PUTZ, CDF 0 DCA I XR CDF 10 JMP I PUTF CHKSUP, 0 JMS 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) JMS I (PRINT SUP JMP I CHKSUP REMERR, JMS I (PRMESG REMBAD REMER2, JMS I (PRMESG BADREM
MEMBIG, CLA JMS I (PRINT MEMWARN JMP I (REMGO RDREM, 0 CIF 0 JMS I (7607 200 /READ 2 PAGES INTO FIELD 0 4000 /LOCATION 4000 REMBLOCK SKP CLA ISZ RDREM JMP I RDREM WRREM, 0 CIF 0 JMS I (7607 4200 /WRITE 2 PAGES FROM FIELD 0 4000 /LOCATION 4000 REMBLOCK SKP CLA ISZ WRREM JMP I WRREM FUDG, 0 DCA I (OUTSW /LOAD HANDLER TAD I (OUTLIM CIA DCA CLXR JMP I FUDG
K8, 0 TAD (1716 JMS I (PRWD TAD (1431 JMS I (PRWD CIF CDF 0 JMP I K8 ROTL, 0 CLL RTL RTL RTL JMP I ROTL /GET FROM INPUT LINE VIA XR GETF, 0 CDF 0 TAD I XR CDF 10 SZA ISZ GETF AND (77 JMP I GETF
/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR) /PUTTING RESULT IN DEV1,DEV2, NAME1-4. /IT GIVES A FATAL ERRORR MESSAGE IF BAD. GETSPC, 0 STA DCA DVFLAG DCA DEV1 FILLP1, DCA DEV2 FILLP, JMS I (GNAME TAD (-": /AC CONTAINED DELIM SNA CLA JMP DEVNAM DCA I (NUMC JMP I GETSPC DEVNAM, CLA IAC TAD I (PERDSW TAD I (NUMC SZA CLA JMP CDERA /. OR # IN DEVICE NAME TAD NAME1 DCA DEV1 ISZ DVFLAG JMP CDERA /CATCHES A:B: TAD NAME2 JMP FILLP1 DVFLAG, 0
CDERA, JMS I (PRMESG BADEV ATERR, CDF 10 CLA JMS I (PRMESG ATIO PAGE
CDINIT, 0 TAD I DEFALT TAD (-5200 SZA CLA /IS THIS A REQUEST FOR A /"SPECIAL DECODE"? JMP CDCONT /NO TAD ALTLIM DCA OUTLIM /YES, SET UP THE PROPER LOCATIONS TAD ALTDF1 DCA LIMDIF /TO GET 1 OUTPUT AND 5 INPUT FILES TAD ALTDF2 DCA BEGDIF /ALL OF WHICH ARE /5-WORD <DEVICE,NAME> ENTRIES DCA I PLKUPS TAD STARJM DCA I PSTARS /AND ALLOW * /AS A FILE OR EXTENSION NAME TAD CCLA /STOPS FETCHES IN SPECIAL MODE DCA I PSPKG1 /NO HANDLER FETCHES NECESSARY EITHER /SINCE NO LOOKUPS CDCONT, JMS I (BKA STA DCA I (OUTSW JMS I (ZEROCD TAD LBEGIN DCA LXR JMP I CDINIT /CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE ALTLIM, 1-MOFILE-5 ALTDF1, MOFILE+5-MPARAM+5 ALTDF2, 5 PLKUPS, LKUPSW PSTARS, STARSW PSPKG1, SPKLG1 BEGDIF, MIFILE-MOFILE LIMDIF, MIFILE-MPARAM+2 OUTLIM, 1-MIFILE LBEGIN, 0 /PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT
NMOVE, 0 DCA PT1 /V1A ARG IN AC TAD I (FLAG RTL SMA CLA /FEATURE ENABLED? JMP I (CCERB /NO TAD I (OUTSW SZA CLA JMP I (CCERB /ON OUTPUT SIDE TAD I CCLA /V3C SNA CLA /DON'T CHANGE OUT DEV IF SPECIFIED TAD I (FLAG /LOOK AT 'COPY EXT' BIT AND (200 SNA CLA JMP NMXXX /IT WASN'T SET TAD I (7617 /GET FIRST INPUT DEVICE AND (17 /ISOLATE DEVICE BITS DCA I CCLA /FORCE THIS TO BE FIRST OUTPUT DEVICE NMXXX, TAD I PT1 SNA JMS I (SETDSK /CHANGE TO 'IAC' TO ALWAYS USE SYS: DCA I PT1 /SET DEVICE TO SYS IF NONE ISZ PT1 TAD I PT1 /WAS THERE A SPECIFICATION THERE? SZA CLA JMP I NMOVE /YES, DO NOTHING TAD I (FLAG AND (200 /GET 'COPY EXTENSION' BIT L7740, SMA SZA CLA /'SMA' IS UNNECESSARY STA /COPY 4 WORDS IF BIT 4 WAS ON TAD (-3 /OTHERWISE ONLY COPY 3 WORDS JMS I (MOVE CDF 10 NAME1 CDF 10 TEM, PT1, 0 JMP I NMOVE P8, SETDEV DMPDEV
VERTN, 0 JMS I (RDMON /READ MONITOR CDF 0 TAD I (2031 /GET PATCH LEVEL SNA TAD ("! AND (77 DCA TEM TAD I (2000 /GET VERSION # CDF 10 SPA CCLA, 7600 /"0" MEANS OLD TAD (60 JMS I (ROTL TAD TEM JMP I (PTCH
/ALLOW DEASSIGN FOO ? DEASSIGN,0 TAD L7740 DCA XR TAD (-17 DCA T DCA I XR ISZ T JMP .-2 CDF 0 TAD I (7746 AND (6777 TAD (1000 DCA I (7746 CDF 10 JMP I DEASSIGN
STARJM, RELOC STARNM /DUMP LITERALS AT LAST POSSIBLE MOMENT JMP STARNM RELOC PAGE ZBLOCK 7600-.
/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD /CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT. /FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE /OS/8 CORE-IMAGE FORMAT. /FOR VERSION OF THE MONITOR BEFORE LEVEL A, /THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS /OR IT READS OVER 7600. /BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF /INTO FIELD 0. 400-777 IS IGNORED BY SKIPPING A BLOCK, /THEN THER REST OF CCL (7 PAGES) IS READ IN. FIELD 0 *400 /IT LOADS OVER THE SAVE, DATE OVERLAY /AND STARTS AT LOCATION 600 /KEYWORD TABLE IN 400- /CONSISTS OF COMMANDS 2 CHARS PER LOCATION /IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL) /SEPARATED FROM EACH OTHER BY 6-BIT 00'S. /EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU /NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX /BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED /BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
VNO, CCLTAB KEYWRD, 0530 /EX ECUT 4543 6564 0002 /BA CKSP OR TER MIN 0143 5363 6000 0201 /BAS IC 2351 4300 0425 /DU PLICATE 6054 5143 4164 4500 0217 /BO OT 5764 0003 /CCL 0314 0003 /COMPA R 1715 2001 6200 0317 /COM PIL 1560 5154 0003 /COP Y 1720 7100 1505 /MEM ORY 1557 6271 0003 /CREA TE 2205 0164 4500 0322 /CREF 0506 0004 /DA TE 0164 4500 0405 /DEL ETE 1445 6445 0004 /DE A 0541 0004 /DIR ECT 1122 4543 6400 0504 /ED IT 5164 0005 /EO F 1746 0010 /HE LP 0554 6000 1411 /LIN K 1653 0015 /MAC R 0103 6200 1411 /LI ST 6364 0014 /LO AD 1741 4400 1501 /MAK E 1345 0015 /MAP 0120 0015 /MUNG 2516 0700 2001 /PAL 1400 2022 /PRI NT 1156 6400 2025 /PU NCH 5643 5000 2205 /REN AME 1641 5545 0022 /RES 0523 0022 /REW IND 0527 5156 4400 2305 /SET 2400 2313 /SK IP 5160 0023 /SQ UISH 2165 5163 5000 2325 /SU BMIT 4255 5164 0024 /TE CO 0543 5700 2431 /TY PE 6045 0025 /UN LOAD 1654 5741 4400 2501 /UA 0025 /UB 0200 2503 /UC 0026 /VE R 0562 0032 /ZERO 0522 1700 4000 /@ ZBLOCK 600-.
IFDEF XYZMCR < THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE: HKGYJ2SR0,.KHXAHKMA TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL. ** NO EDITING ** HKHXYHXN0UO0UB0UN !CHLP!^TULQL-32"EOBLANK'QL-13"EOCR'QL-26"EOEND' !CHLP0!QL&63+QBUT QT/8UXQX+48IQT-(8*QX)+48I QL"NZJ.UZGNQLIQZJXNK%N' %O&1"NOCHLP' QN-3"LZUH'I OCHLP !BLANK! 32UBZJ.UZGNQLIQZJXNK%NOCHLP !CR!  QHJ /GNZJXN0UN0UB0ULOCHLP0 !END!I00  >
*600 JSBITS=7746 SYSTEM=22 PRMES=330 ERRET=33 /THESE ARE LOCATIONS FROM OS/8 MONITOR /RUNS IN FIELD 0 ONLY. ENTRY, 0 /INITIALLY 0 MEANS 'EX' COMMAND LINPTR, JMP ENTREE /OS/8 JUMPS HERE (ACTUALLY TO 600) TEMM, TEKLDG, ISZ CCLNHR /TECO 'EG' JUMPS HERE DCA I (BEGLN /ZERO COMMAND LINE JMP TEGO /FIRST WE DISABLE CALLS TO MONITOR ENTREE, TAD (7605 DCA ERRET TAD SYSTEM DCA MYSYS JMS FINDIT SPA CLA /WAS IT A LEGAL COMMAND? JMP I (PRQMRK /NO TEGO, TAD (6003 /YES DCA I (JSBITS CIF 10 JMS I MYSYS /CALL USR AND LOCK IN CORE 10 CLA IAC CIF 10 JMS I (200 2 CCLBLC, CCLSV CCLEN, 0 CCLNHR, JMP NOCCL /ISZ'ED IF KBM NOT IN MEMORY CLA IAC TAD CCLBLC DCA CCLRDB JMS I (7607 CCLCCW, 2711 /READ 27 PAGES OF CCL.SV CCLSTR, 2000 MYSYS, CCLRDB, 7700 /INITIALLY POINTS TO USR JMP NOCCL CIF CDF 10 JMP I CCLSTR
CCLSV, FILENAME CCL.SV NOCCL, CLA SKP JMP I (7605 /GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND JMS I (PRMES /PRINT ERROR MESSAGE OTHERWISE TEXT /NO CCL!/ 0
/FINDS IF INPUT LINE STARTS WITH A COMMAND /LEAVES ENTRY # IN AC, -1 IF NOT FOUND /ENTRIES START AT ENTRY 0. /CALLABLE FROM ANY FIELD FINDIT, 0 MORE, TAD (BEGLN-1 DCA LINPTR ISZ LINPTR TAD I LINPTR TAD (-240 SNA CLA JMP .-4 JMS GETKAR JMP ENDOFT /NO MATCH JMP INTO FNLUP, TAD I LINPTR TAD (-301 STL TAD (-32 SNL CLA JMP NOLET /NOT A LETTER JMS GETKAR JMP MATCH INTO, CIA TAD I LINPTR AND (37 /5-BIT ASCII ISZ LINPTR SNA CLA /DO THEY MATCH? JMP FNLUP /YES NOMT, JMS GETKAR SKP JMP .-2 /SCAN TO NEXT ENTRY ISZ ENTRY JMP MORE NOLET, JMS GETKAR JMP MATCH CLA ISZ SIGNIF JMP NOMT MATCH, TAD ENTRY SKP ENDOFT, STA RETCIF, CDF 0 /RETURN TO CALLING FIELD (MAY BE OVERLAID) JMP I FINDIT KPTR, KEYWRD
HALF, -1 /0 MEANS LEFT HALF SIGNIF, 0 /1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT /GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC /SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT /TAKES RETURN 1 IF CHAR IS 0 /TAKES RETURN 2 OTHERWISE GETKAR, 0 ISZ HALF JMP RTHALF TAD I KPTR RTR RTR RTR JMP INSIDE RTHALF, STA DCA HALF TAD I KPTR ISZ KPTR INSIDE, AND (77 DCA TEMM TAD TEMM AND X40 X40, SZA CLA STA DCA SIGNIF TAD TEMM SZA ISZ GETKAR AND (37 JMP I GETKAR PAGE
*REST CORLOC, CORX CORV, 1400 CORSIZ, 1 CORE, CDF 0 TAD CORSIZ CLL RTL RAL AND COR70 TAD COREX DCA .+1 COR1, CDF TAD I CORLOC COR2, NOP DCA COR1 TAD COR2 DCA I CORLOC COR70, 70 TAD I CORLOC CORX, 7400 TAD CORX TAD CORV SZA CLA JMP COREX TAD COR1 DCA I CORLOC ISZ CORSIZ JMP CORE COREX, CDF 0 TAD CORSIZ CLL RTL TAD (-10 JMP I (DETC2 /GO TO NEXT PAGE
MONLST, MON1 MON2 MON3 MON4 MON5 MON6 MON7 MON8 MON9 MON10 MON11 MON12
MON1, TEXT /JANUARY/ MON2, TEXT /FEBRUARY/ MON3, TEXT /MARCH/ MON4, TEXT /APRIL/ MON5, TEXT /MAY/ MON6, TEXT /JUNE/ MON7, TEXT /JULY/ MON8, TEXT /AUGUST/ MON9, TEXT /SEPTEMBER/ MON10, TEXT /OCTOBER/ MON11, TEXT /NOVEMBER/ MON12, TEXT /DECEMBER/
COM19, TEXT /, 19/ WEEKLST,DAY1 DAY2 DAY3 DAY4 DAY5 DAY6 DAY7 DAY1, TEXT /SATUR/ DAY2, TEXT /SUN/ DAY3, TEXT /MON/ DAY4, TEXT /TUES/ DAY5, TEXT /WEDNES/ DAY6, TEXT /THURS/ DAY7, TEXT /FRI/ BADMON, TEXT /#BAD MONITOR/ PAGE
HISIZ, 0 /HIGHEST MEMORY BANK NEWCOR, 0 /PROPOSED NEW MEMORY BANK DETC2, SNA JMS KEIGHT TAD (-30 SNA JMS K32 TAD (40 JMS OTOD DCA I (CORMES CDF 10 TAD I (LBEGIN DCA XRL CDF 0 STA TAD I (CORSIZ DCA HISIZ ISZ XRL TAD I XRL /GET NEXT CHAR SNA JMP COREQ /NOT SETTING CORE SIZE TAD (-260 DCA NEWCOR TAD NEWCOR AND (7770 SZA CLA JMP DETER /TRIED TO SET CORE SIZE GT 7 TAD NEWCOR CIA TAD HISIZ SPA CLA JMP BADKOR /TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE TAD I (7777 RTL /BATCH BIT TO LINK SZL CLA JMP WRSKOR /CAN'T CHANGE CORE SIZE UNDER BATCH TAD NEWCOR CLL RTL RAL DCA NEWCOR TAD I (7777 AND (7707 TAD NEWCOR DCA I (7777 COREQ, TAD I (7777 AND (70 SNA JMP ABSKOR TAD (10 CLL RAR JMS OTOD DCA I (SCRMES TAD I (SCRMES CIA TAD I (CORMES ABSKOR, CIF CDF 10 SNA CLA JMP I (ABSCOR /DON'T PRINT SOFT IF = REAL JMP I (SCRM BADKOR, CIF CDF 10 JMP I (BADCOR WRSKOR, CIF CDF 10 JMP I (WRSCOR DETER, CIF CDF 10 JMP I (CMDERR KEIGHT, 0 CIF CDF 10 JMS I (K8 JMP I KEIGHT XRL, 0
OTOD, 0 DCA TTX DCA TX TAD TTX TAD (-12 ISZ TX SMA JMP .-3 TAD (72 DCA CORETM STA TAD TX SNA TAD (40-60 TAD (60 CLL RTL RTL RTL TAD CORETM JMP I OTOD TX, 0 TTX, 0 CORETM, K32, 0 TAD (4100 DCA I (CORMES+5 JMP I K32
OTODY, 0 JMS OTOD CIF CDF 10 JMP I OTODY PAGE
ERRCMD, TEXT /#ERROR IN COMMAND/ BADVMS, TEXT /#CCL 3X OVERLAY AND MONITOR INCOMPATIBLE/ AAAA=. *BADVMS+3 CCLTAB&77^100+40 *AAAA
LOVMES, TEXT /NOT WAR?/ KILMES, TEXT /FILES DELETED:/ RENMES, TEXT /FILES RENAMED:/ MOVMES, TEXT /FILES COPIED:/ SCRMES, TEXT \00K/\ *.-1 CORMES, TEXT /00K MEMORY/ DAYDAY, TEXT /DAY /
NOCORE, TEXT /# NOT ENOUGH MEMORY/ BATCOR, TEXT /#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/ JAN, 0 FEB, 3 4;0;2;5;0;3;6;1;4;6
SUP, TEXT /%SUPERSEDING/ MEMWARN,TEXT /%CAN'T REMEMBER/ SQWARN, TEXT /%BATCH SQUISHING SYS:!/ SYSER, TEXT \#I/O ERROR ON SYS:\ BADSYN, TEXT /#ILLEGAL SYNTAX/ TOOMAN, TEXT /#TOO MANY FILES/ NF, TEXT / NOT FOUND/ DNE, TEXT / DOES NOT EXIST/ SEMSG1, TEXT /? ENTER ERROR/ SEMSG2, TEXT \?I/O ERROR\ SEMSG3, TEXT /?DEVICE FULL/ SEMSG4, TEXT /?CLOSE ERROR/
ATIO, TEXT /#BAD FILENAME OR ERROR READING INDIRECT FILE/ OVFLOW, TEXT /#COMMAND LINE OVERFLOW/ BADNUM, TEXT /#BAD NUMBER/ BADSTR, TEXT /#ILLEGAL * OR ?/
BADX, TEXT /#BAD EXTENSION/ BADOPT, TEXT /#BAD SWITCH OPTION/ TOOLNG, TEXT /#COMMAND TOO LONG/ REMBAD, TEXT \#I/O ERROR TRYING TO RECALL\
BADSW, TEXT /#SWITCH NOT ALLOWED HERE/ BADSW2, TEXT /#BAD CCL SWITCH/ NONE, TEXT /NONE/ BADREM, TEXT /#BAD RECOLLECTION/ BADEV, TEXT /#BAD DEVICE/ CONTRA, TEXT /#CONTRADICTORY SWITCHES/
VMES, TEXT \OS/8 - KBM V3A - CCL V1A\ LOC78=VMES+1 VLOC=VMES+6 *.-2 CV=CCLVER&77 CCLNUM&77^100+CV *.+1
YEDIT, FILENAME EDIT.SV *.-1 YBOOT, FILENAME BOOT.SV *.-1 YFORT, FILENAME FORT.SV *.-1 YF4, FILENAME F4.SV *.-1 YBITMAP,FILENAME BITMAP.SV *.-1 YSRCCOM,FILENAME SRCCOM.SV *.-1 YBCOMP, FILENAME BCOMP.SV *.-1 YPAL8, FILENAME PAL8.SV *.-1 YFOTP, FILENAME FOTP.SV *.-1 /YCREF, FILENAME CREF.SV / *.-1 YDIRECT,FILENAME DIRECT.SV *.-1
YPIP, FILENAME PIP.SV *.-1 YABSLDR,FILENAME ABSLDR.SV *.-1 YLOADER,FILENAME LOADER.SV *.-1 YLOAD, FILENAME LOAD.SV *.-1 YTECO, FILENAME TECO.SV *.-1 YLPTSPL,FILENAME LPTSPL.SV *.-1 YCAMP, FILENAME CAMP.SV *.-1 YSET, FILENAME SET.SV *.-1 YBASIC, FILENAME BASIC.SV *.-1 YRXCOP, FILENAME RXCOPY.SV *.-1 YRESORC,FILENAME RESORC.SV *.-1 YBATCH, FILENAME BATCH.SV *.-1 YRALF, FILENAME RALF.SV *.-1 YSABR, FILENAME SABR.SV *.-1 YFRTS, FILENAME FRTS.SV *.-1 YDATE, FILENAME DATE.SV *.-1 YCCL, FILENAME CCL.SV *.-1 YHELP, FILENAME HELP.SV *.-1 YMACREL,FILENAME MACREL.SV *.-1 YLINK, FILENAME LINK.SV *.-1
BATHED, "$;"J;"O;"B;215;212;".;0 BATAIL, ".;"R;240;"F;"O;"T;"P;215;212 "*;"S;"Y;"S;":;"C;"C;"B;"T;"C;"H;".;"T;"M;"/;"D;"$;215;212 "$;"E;"N;"D;215;212;32;0 TEMNAM, FILENAME CCBTCH.TM
LPTDEV, DEVICE LPT TVDEV, DEVICE TV TTYDEV, DEVICE TTY PTPDEV, DEVICE PTP DMPDEV, DEVICE DUMP NULDEV, DEVICE NULL
BATBUF=4400 /LOCATION OF ONE BLOCK BATCH TEMP BUFFER USR=200 GLINE=1200 /LOCATION FROM KBM CTRLCK=1241 /LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C BATPTR, BATBUF-1 LCHAR, 0 SEMGO, CIF CDF 10 JMP I SEMI SEMI, 0 TAD (BEGLN-1 DCA XR SEMLUP, TAD I XR SNA JMP SEMGO /NO SEMICOLONS TAD (-"; SZA CLA JMP SEMLUP CIF 10 CLA IAC /SYS JMS I (USR 3 /ENTER BLKNO, TEMNAM BLKLEN, 0 /NEG OF LENGTH JMP SEMER1 /ENTER ERROR TAD BLKNO DCA BATBLK TAD (BEGLN-1 DCA XR TAD (7600 DCA I (CTRLCK /FORCE ^C TO GLINE TO GO TO 7600 JMS BATLST BATHED S2, TAD I XR SNA JMP LINEND DCA LCHAR /SAVE CHAR TAD LCHAR TAD (-"; SNA CLA JMP GOTSEM TAD LCHAR S3, JMS BATPUT JMP S2
LINEND, TAD LCHAR TAD (-"; /LOOK AT LAST CHAR SZA CLA /WAS IT SEMICOLON? JMP BATEND /NO, END OF TEMP BATCH STREAM JMS I (GLINE /YES, READ NEW LINE FROM KEYBOARD /**** WHAT IF WE'RE RUNNING UNDER BATCH **** TAD (BEGLN-1 DCA XR JMP S2 GOTSEM, JMS KRLF TAD (". JMP S3 KRLF, 0 TAD (215 JMS BATPUT TAD (212 JMS BATPUT JMP I KRLF BATPUT, 0 ISZ BATPTR DCA I BATPTR TAD BATPTR TAD (-BATBUF-377 SNA CLA JMS BATWRIT /WRITE OUT BUFFER IF FULL JMP I BATPUT
BATWRIT,0 JMS I (7607 4200 /WRITE 1 BLOCK BATBUF BATBLK, 0 JMP SEMER2 / I/O ERROR ISZ BATBLK /POINT TO NEXT BLOCK ISZ BATLEN /BUMP LENGTH ISZ BLKLEN SKP JMP SEMER3 /DEVICE FULL TAD (BATBUF-1 DCA BATPTR JMP I BATWRIT BATEND, JMS KRLF JMS BATLST BATAIL JMS BATWRIT CIF 10 CLA IAC /SYS JMS I (USR 4 /CLOSE TEMNAM BATLEN, 0 /LENGTH OF TEMPORARY FILE JMP SEMER4 /CLOSE ERROR CIF CDF 10 JMP I (ENGOA
BATLST, 0 TAD I BATLST DCA BTPT ISZ BATLST BTLP, TAD I BTPT SNA JMP I BATLST JMS BATPUT ISZ BTPT JMP BTLP BTPT, 0 SEMER4, IAC /CLOSE ERROR SEMER3, IAC /DEVICE FULL SEMER2, IAC / I/O ERROR SEMER1, IAC /ENTER ERROR CIF CDF 10 JMP I (SEMERR PAGE
FIELD 1 *2001 $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search