File: TECO.PA of Tape: OS8/OS8-V3D/al-5586c-sa-os8-ext-3
(Source file text)
/10 OS/8 TECO VERSION 5
/
/
/
/
/
/
/
/
/
/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.
/
/
/
/
/
/
/
/
/
/
/BROUGHT TO YOU BY: RUSS HAMM, O.M.S.I., AND RICHARD LARY (IN THAT ORDER)
/WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S
/PATCHES INCORPORATED BY S.R. ON 5-AUGUST-75 FOR OS/8 V3C:
/1. UPDATED VERSION # TO V4
/2. INCORPORATED PATCHES #S 1 & 2 (V302 AND V303)
/ PREVENTS \ FROM GOING OUTSIDE OF BUFFER
/ RESETS CFLAG TO PREVENT ARGUMENT ERROR EVERY 4096 TIMES IN LOOP
/ CHANGES FOR V5: -S.R.-
/3. ADDED OVERLAYS
/4. EXPANDED ERROR MESSAGES
/5. DOCUMENTED CORE LAYOUT
/6. ADDED "T, "S, "F, "U, AND "R
/7. FIXED EG BUG
/8. MADE DEFAULT ITERATION COUNT TRULY INFINITE
/9. ADDED N^T
/10. ADDED :=
/11. ADDED SOME SAFETY ERROR MESSAGES
/ (I) ERROR IF Y HAS A NUMERIC ARGUMENT
/ (II) ERROR IF TWO ARGUMENTS ARE SPECIFIED TO D
/12. REMOVE ^R (OBSOLETE COMMAND)
/13. REMOVE "A AND "B (AFTER AND BEFORE)
/14. ADDED 13-BIT ARITHMETIC
/15. MADE = AND \ GIVE SIGNED RESULTS (DECIMAL ONLY)
/16. ALLOW 13-BIT NUMERIC Q-REGISTERS.
/ THIS IS ACCOMPLISHED BY RESERVING THE HIGH ORDER BIT
/ OF THE LENGTH WORD. STRING PORTION OF Q-REGISTER
/ NOW RESTRICTED TO 2047 CHARACTERS. IT GETS CHECKED BY
/ ^U AND X. BELL RINGS WITHIN 12 CHARACTERS OF FILLING
/ UP COMMAND STRING Q-REGISTER.
/17. STORED LINK AS LOW ORDER BIT IN NLINK IN CASE WE EVER
/ WANT TO GO TO 24-BIT ARITHMETIC.
/18. ERROR ON A,B,C
/19. P DOESN'T CREATE FORM FEEDS
/20. ALLOW @ MODIFIER WITH ER, EW, EB.
/21. EK
/22. ^S FREEZE
/23. EGTEXT$
/24. GOT RID OF F_
/25. F IS ILLEGAL IF NOT FOLLOWED BY S OR N
/26. W IS NOW AN ILLEGAL COMMAND (EXCEPT ON -12)
/27. ADDED :G
/28. Y AND _ GIVE ERRORS IF DATA IS GOING TO BE LOST
/ (IF OUTPUT FILE IS OPEN AND BUFFER IS NOT EMPTY)
/29. CASE FLAGGING IMPLEMENTED
/30. "< AND "> ARE SYNONYMOUS WITH "L AND "G
/31. ^G<SPACE> AND ^G*
/32. SCOPE RUBOUTS
/33. == NOW PRINTS NUMBER IN OCTAL
/34. EUFLAG AND ETFLAG IMPLEMENTED
/35. CASE FLAGGING WORKS
/36. IMAGE MODE (ET BIT 11) APPLIES TO T, ^A, AND N^T
/ IT DOES NOT APPLY TO :G
/37. ERROR IF TRY TO DO AN EB TO A .BK FILE (IT DOES AN ER)
/38. VT AND FF ARE NOW LINE TERMINATORS
/39. BELL ECHOES AS ^G AS WELL AS RINGING BELL
/40. ^K IS AN ERROR
/41. REMOVED ^Z COMMAND
/42. CHANGED ^V TO EO
/43. CHANGED ^W TO W
/44. MEMORY RESIDENT OVERLAYS IF MORE THAN 12K
/45. LONG FORM ERROR MESSAGES ON 1EH
/46. ET FLAG 8'S BIT AFFECTS ECHOING OF ^T
/47. NEGATIVE OR 0 ITERATION SKIPS
/48. CTRL/N
/49. CTRL/C TRAP
/KNOWN BUGS
/1. LARGE T OR X AND ONLY 1 BLOCK LEFT IN OUT DEV
/2. ^S DOESN'T KEEP SCREEN ON
/3. FIX BATCH INTERRACTION
/4. MAKE VT AND FF SIMULATION INDEPENDENT OF TAB
DECIMAL
VERSN= 5 / VERSION NUMBER - CHANGE WITH EVERY EDIT
OCTAL / LAST EDIT 12-FEB-76
IN= 6200 /INPUT BUFFER AT 06200
OUT= 5200 /OUTPUT BUFFER AT 05200
ZMAX= 7640 /MAX 4000[10] CHARACTERS IN TEXT BUFFER
QMAX= 3720 /MAX 2000[10] Q-REGISTER CHARS IN 8K
Q12MAX= 5600 /MAX 2944[10] Q-REGISTER CHARS IN 12K
CHNSTR= 46 /38 CHARACTER STRING PASSED ON CHAIN
TWO= CLA CLL CML RTL
MTWO= CLA CLL CMA RAL
MTHREE= CLA CLL CMA RTL
AC3777= CLL STA RAR
SCPBIT= 7726
/THINGS WE WOULD LIKE TO ADD:
/:ER
/:EB
/NV
/@^A
/FR
/-S
/::S
/^EQ
/M,NS
/[Q
/]Q
/NON-EXACT SEARCH MODE
/*N
/ERFILESPEC/S FOR SUPERTECO
/^N
/CHECK FOR $ ON NI$
/CHECK INTO SEARCHES IN ITERATIONS
/ERR MSG ON EA, EP
/NV=(1-N)TNT
/^C TRAP
/:X
/THINGS FOR -11:
/^R
/3EH
/M,ND
/ET BIT 15 SHOULD BE LOWER
/ECHO OF NULL
/*****************************************
/ TECO ERROR MESSAGES:
/*****************************************
/ TECO ERROR MESSAGES CONSIST OF A QUESTION MARK AND THREE LETTERS
/ TYPING "?" IMMEDIATELY AFTER AN ERROR MESSAGE PRINTOUT PRINTS
/ THE CURRENT COMMAND LINE UP TO THE ERROR CHARACTER.
/1 ?ILL ILLEGAL COMMAND
/2 ?UTC INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF COMMAND STRING)
/3 ?IQN NON-ALPHANUMERIC Q-REGISTER NAME
/4 ?PDO PUSHDOWN OVERFLOW (MACROS & ITERATIONS NESTED TOO DEEPLY)
/5 ?MEM TEXT BUFFER OVERFLOW
/6 ?STL SEARCH STRING TOO LARGE ( >31 CHARS)
/7 ?ARG NUMBER MISSING BEFORE COMMA
/ OR TWO ARGUMENTS SPECIFIED TO D
/ OR 3 NUMERIC ARGUMENTS
/8 ?IFN ILLEGAL FILE NAME IN "ER","EW" OR "EB" COMMAND
/9 ?SNI SEMICOLON ON COMMAND LEVEL
/10 ?BNI ITERATION CLOSE (>) WITHOUT MATCHING OPEN (<)
/11 ?POP ATTEMPT TO MOVE POINTER OUTSIDE OF TEXT BUFFER
/12 ?QMO Q-REGISTER STORAGE OVERFLOW
/13 ?UTM INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF MACRO)
/14 ?OUT OUTPUT FILE TOO BIG OR OUTPUT PARITY ERROR
/15 ?INP PARITY ERROR ON INPUT FILE
/16 ?FER FILE ERROR: CAN MEAN EITHER
/ A) INPUT FILE NOT FOUND ON "ER" COMMAND
/ B) CANNOT ENTER OUTPUT FILE ON "EW" OR "EB" COMMAND
/ C) DEVICE SPECIFIED FOR FILE DOES NOT EXIST
/ D) "EB" COMMAND GIVEN ON NON-FILE-STRUCTURED DEVICE
/17 ?FUL OUTPUT COMMAND WOULD HAVE OVERFLOWED OUTPUT FILE
/ [PANIC MODE]
/18 ?NAY NUMERIC ARGUMENT SPECIFIED WITH Y COMMAND
/19 ?IEC E FOLLOWED BY AN ILLEGAL CHARACTER
/20 ?IQC " FOLLOWED BY AN ILLEGAL CHARACTER
/21 ?NAE NO NUMERIC ARGUMENT TO THE LEFT OF AN =
/22 ?NAU NO NUMERIC ARGUMENT TO THE LEFT OF A U
/23 ?NAQ NO NUMERIC ARGUMENT TO THE LEFT OF A "
/24 ?SRH FAILING SEARCH AT COMMAND LEVEL
/25 ?NAP NEGATIVE OR ZERO ARGUMENT TO P
/26 ?NAC NEGATIVE ARGUMENT TO COMMA
/27 ?NYI CASE SUPPORT NOT IMPL (USE W FOR WATCH)
/28 ?
/29 ?NAS NEGATIVE OR ZERO ARGUMENT WITH A SEARCH
/30 ?WLO WRITE LOCKED SYSTEM DEVICE
/31 ?IFC F FOLLOWED BY AN ILLEGAL CHARACTER
/32 ?YCA Y (OR _) COMMAND ABORTED BECAUSE DATA WOULD BE LOST
/33 ?CCL CCL NOT FOUND OR EG ARGUMENT TOO LONG
/34 ?XAB EXECUTION ABORTED BY ^C
/35 ?NYI CASE SUPPORT NOT IMPL (USE EO FOR VERSION)
/36 ?NFO ATTEMPT TO OUTPUT WITHOUT OPENING AN OUTPUT FILE
/ CORE LAYOUT AND OVERLAY STRUCTURE
/ BUFFER STRUCTURE:
/BUFFER 8K VERSION 12K VERSION
/INPUT BUFFER 06200-07200 25600-27600
/OUTPUT BUFFER 05200-06200 05200-07200
/Q-REG STORAGE OVER TEXT BFR 20000-25600
/ HANDLER LOCATIONS:
/HANDLER PDP-8 VERSION PDP-12 VERSION
/INPUT HANDLER 7200-7600 7200-7400
/OUTPUT HANDLER 4000-4400 7400-7600
/SIZE OF HNDLR 2-PAGES 1-PAGE
/DISPLAY CODE NONE 4000-4400
/ OVERLAY STRUCTURE
/ALL OVERLAYS ARE TWO PAGES LONG AND RESIDE IN CORE
/AT LOCATIONS 3200-3600 WHEN RUNNING. THE I-OVERLAY
/INITIALLY RESIDES IN THESE LOCATIONS.
/OVERLAY BLOCK INITIAL LOCATION CONTENTS
/ I-OVERLAY 40 3200-3600 ER,EW,EB
/ Q-OVERLAY 41 5600-6200 ", O, SKPSET
/ E-OVERLAY 42 6200-6600 ERROR MESSAGE PROCESSOR
/ X-OVERLAY 43 6600-7200 EX,EC,EG,EK,EF (EA,EI,EN,EP)
/ F-OVERLAY 44 7200-7600 ED,EH,EO,ES,ET,EU (EV)
IOVRLC=40
QOVRLC=41
EOVRLC=42
XOVRLC=43
FOVRLC=44
IOVRLY=3200
QOVRLY=3201
EOVRLY=3202
XOVRLY=3203
FOVRLY=3204
/EACH OVERLAY IS ASSIGNED A LOCATION AT THE BEGINNING OF PAGE 3200.
/IF THIS LOCATION IS 0 (AS IT ALWAYS IS), THEN THAT OVERLAY IS NOT
/IN CORE. IF IT IS NOT 0, THEN THIS LOCATION CONTAINS THE
/BLOCK NUMBER TO READ IN THAT OVERLAY.
/THUS EACH OVERLAY HAS POINTERS TO ALL THE OTHER OVERLAYS.
MEMLOC=2000
/IN 16K MACHINES, FIELD 3 IS USED TO HOLD OVERLAYS
/NAME BLOCK MEMORY
/I 40 2000
/Q 41 2400
/E 42 3000
/X 43 3400
/F 44 4000
/INITIAL MEMORY LAYOUT
/0000-3177 TECO
/3200-3577 OVERLAY AREA (INITIALLY I-OVERLAY)
/3600-3777 TECO
/4000-4377 PDP-12 DISPLAY ROUTINE
/4400-5177 TECO
/5200-5577 INITIALIZATION CODE
/5600-6177 Q-OVERLAY CODE
/6200-6577 E-OVERLAY CODE
/6600-7177 X-OVERLAY CODE
/7200-7577 F-OVERLAY CODE
/FIELD 1:
/4400-7377 EXTENDED ERROR MESSAGES
/ MOVES TO FIELD 3
/** TECO KLUDGES ** /7/27/73
/ONE OF THE REASONS WHY TECO GETS SO MANY OPERATIONS
/INTO SUCH A SMALL AMOUNT OF CORE IS THAT IT
/IS FULL OF *K*L*U*D*G*E*S*. THESE SHOULD BE KEPT IN MIND WHEN
/MODIFYING THE PROGRAM. SOME OF THEM ARE:
/ THE "SORT" ROUTINE COMPARE LIST MUST END WITH A NEGATIVE NUMBER.
/ USUALLY A FORTITUOUS JMS OR OPR INSTRUCTION IS USED
/ THE "SORT" JUMP LIST ENTRIES ARE TREATED AS JUMP ADDRESSES
/ IF THEY ARE POSITIVE AND SUBSTITUTE VALUES IF THEY ARE
/ NEGATIVE - THEREFORE ALL LOCS JUMPED TO MUST BE BELOW 4000
/ ANOTHER CONSEQUENCE IS THAT "QUOTST" CANNOT BE CALLED FROM
/ ABOVE 4000
/ THERE ARE OTHER LOCALIZED KLUDGES - THEY CAN GENERALLY
/ BE IDENTIFIED BY THE APPEARANCE OF A DOUBLE-ASTERISK IN THE
/ COMMENTS FIELD ALONG WITH A TERSE DESCRIPTIVE COMMENT
/ OS/8 EQUIVALENCES:
JSBITS= 7746 /JOB STATUS BITS - IN FIELD 0
OSHNDT= 7647 /OS/8 DEVICE HANDLER TABLE - IN FIELD 1
OSDCBT= 7760 /OS/8 DEVICE CONTROL TABLE - IN FIELD 1
CCLADR= 400 /CCL OVERLAY LOAD ADDRESS
CCLOVL= 67 /BLOCK OF CCL OVERLAY
CCLOST= 602 /CCL OVERLAY SECONDARY START ADDRESS
*0
NAME, ZBLOCK 4 /NAME BUILD BUFFER - MUST BE AT LOCATION 0
/LOCS 4,5&6 ARE RESERVED SO WE CAN USE OS/8 ODT
*10 /CONSTANTS & NON-INDIRECT TEMPS STORED IN AUTO-XRS!
QUOTE, 33 /QUOTE CHAR - SINGLE WORD SORT LIST
ERR01,
SERR, ERR /END OF LIST
INRSIZ, 2 /4 IF 12K MACHINE
NUMLNS, 3 /NUMBER OF LINES (+ AND -) TO DISPLAY ON VR12 SCOPE
DX, 7577 /DISPLAY XR
SXR, QPUT12-1/XR USED BY SEARCH PROCESSOR
INXR, ASR33-1 /XR USED TO UNPACK INPUT BUFFER
XR, ASR35-1 /WORK XR
NMT, 0 /USED AS NUMBER TEMP AND SEARCH FAIL FLAG
CFLG, 0 /COMMA FLAG
CLNF, 0 /COLON FLAG
TFLG, 0 /TRACE FLAG
NFLG, 0 /NUMBER FLAG
QFLG, 0 /QUOTED STRING FLAG
M, 0 /NUMBER ARGS
N, 0
NLINK, 0 /LINK AFTER ARITH OPERATIONS - TESTED BY "A AND "B
CHAR, 0 /CHARACTER BUFFER
ITRST, 0 /ITERATION FLAG
ITRCNT, 0 /ITERATION COUNT
MPDL, 0 /MACRO FLAG
SCHAR, 0 /LAST CHAR SORTED
FFFLAG, 0 /FORM FEED FLAG - 7777 IF FORM FEED SEEN ON THIS READ
REND, 0 /INPUT END-OF-FILE FLAG
SCANP, 0 /COMMAND LINE EXECUTION POINTER
OSCANP, 0 /BACKUP FOR SCANP
PDLP, PDLBEG /PUSH-DOWN-LIST POINTER
QCMND, 0 /COMM LINE OR MACRO POINTER
P, 0 /CURRENT PNTR TO TEXT BUFFER
ZZ, 0 /END OF TEXT BUFFER POINTER
Q, 0 /EXTRA BUFFER POINTERS
IFNZRO .-47 <_ERROR_>
R, 0
QP, 0 /Q REGISTER POINTER
QZ, CHNSTR /END OF Q-REG POINTER
Z7,
CTLBEL, 7
CACR, 15 /CR
CAHT, 11 /HT
CAAM, 33 /ALT MODE
CAFF, 14 /FF: END OF PAGE
13 /VT
CALF, 12 /LF
ERR07,
NERR, ERR /END OF LIST
RADIX, DRAD /RADIX TABLE POINTER - DRAD OR ORAD
MQ, 0
DVT1, 0
ODEV, 0 /OUTPUT DEVICE NUMBER
OUTHND, 0
INHND, 0
EBFLG, 0 /EDIT BACKUP FLAG
QNMBR, 0 /LAST Q-REG REFERENCED
QBASE, 0 /BASE OF CURRENT COMMAND LINE
QLENGT, 0 /LENGTH OF CURRENT COMMAND LINE
QPTR, 0 /POINTER TO Q-REGISTER CONTROL BLOCK
ICRCNT, 0 /INPUT DOUBLEWORD COUNTER
OCRCNT, 0 /OUTPUT "
OPTR2, 0 /OUTPUT BUFFER POINTER
INRCNT, 0 /NUMBER OF INPUT RECORDS LEFT
OCMDLN, 0 /LENGTH OF OLD COMMAND LINE
CDT, 0
KTYPE, TYPE /*ET SET TO PUTT IF NO CONVERSION
TEMPT, 0 /TEMP. GET RID OF WHEN FIND ROOM ON PAGE
MEMSIZ, 0 /HIGHEST MEMORY FIELD IN BITS 9-11
LASTC, 0 /LAST CHARACTER GOTTEN OUT OF COMMAND LINE
/NFLG: 0'ED BY COMMANDS WHICH EAT ARGUMENTS OR DON'T RETURN
/ VALUES; SUCH AS C,R,J,L,^A,X,$,',>,'U,G,O AND
/ NON-COLON MODIFIED SEARCHES
/ SET TO -1 TO INDICATE THATWWE'VE SEEN A NUMBER
/TECO PSEUDO-OPERATIONS
PUSH= JMS I .; PUSHXX
POP= JMS I .; POPXX /** MUST BE ONE MORE THAN "PUSH"
PUSHJ= JMS I .; PUSHJY
POPJ= JMP I .; POPJXX
PUSHL= JMS I .; PUSHLX
POPL= PUSHL /** POPL CALLED WITH POSITIVE AC
ERR= JMS I .;ERROR,ERRXX
SORT= JMS I .; SORTB
RESORT= JMP I .; SORTA2
SCAN= JMS I .; SGET
LISTEN= JMS I .; TYI
TYPE= JMS I .; TYPCTV
OUTPUT= JMS I .;OUTR, ERRXX /** MUST BE ONE MORE THAN "TYPE"
/PROBABLY NOT ANY MORE (19-JUN-77)
CRLF= JMS I .; TYCRLF
GETQ= JMS I .; GETQX
SKPSET= JMS I .; SETSKP
NCHK= ISZ NFLG /USED TO BE A SUBROUTINE CALL
CTCCHK= JMS I .; CHKCTC
BZCHK= JMS I .; CHKBZ
QCHK= JMS I .; CHKQF
QSKP= JMS I .; QOVER
QREF= JMS I .; QREFER
QSUM= JMS I .; QSUMR
QPUT= JMS I .; QPUTS
QUOTST= JMS I .; QTST
SETCMD= JMS I .; CMDSET
GETN= JMS I .; NGET
ADJQ= JMS I .; QADJ
MQLDVI= JMS I .; DVIMQL
UPPERC= JMS I .; CUPPER
SCANUP= JMS I .; SCUPPR
TSTSEP= JMS I .; SCHSRT
DISPLY= JMS I .; DSPLAY
NOTRCE= JMS I .; SAVTRA
ENTRCE= JMS I .; RESTRA
OVRLAY= JMS I .; OVERLY
GETNUM= JMS I .; NUMGET /GET 13 BIT NUMBER INTO L,AC
PUTT= JMS I .; TPUT
PAGE
/ENTER HERE TO USE AN ASR33 AS THE TELETYPE
TECO, ISZ I SPUT /IF CALLED BY "R" OR "RUN" - CHANGED TO TLS
TECO1, JMP I COMPAR /IF CALLED VIA "CHAIN" - CHANGED TO "JMP T0A"
TBEL, JMS COMPAR /HERE ON ^G - 2 ^G'S KILL ENTIRE COMMAND
T0, CRLF
T0A, TAD (PDLBEG
DCA PDLP /INITIALIZE PUSHDOWN LIST
T1, TAD PDLP
TAD (-PDLBEG
SZA CLA
ERR02, ERR /ERROR - PUSHDOWN LIST DID NOT BALANCE
TAD (45
QREF /SET UP POINTERS TO COMMAND LINE
TAD I [QPNTR
DCA OCMDLN /SAVE OLD COMMAND LINE LENGTH
/** SAVE ONLY IF < 20?
ADJQ /REDUCE COMMAND LINE LENGTH TO 0
CLL
PUSHJ
NRET /CLEAR NUMBER AND LAST OPERATOR
DCA CFLG
DCA MPDL /DELETE MACRO FLAG
DCA ITRST /ALSO ITERATION FLAG,
DCA CLNF /AND COLON FLAG
PUSHJ /KILL QUOTE FLAG
ZROSPN /KILL QUOTE AND NUMBER FLAGS AND SCAN POINTER
KCC /KILL ^O IF IN KEYBOARD BUFFER
DCA I (CHOOPS /KILL FATAL ERROR RETURN
TAD [52
SKP
ROCMND, JMS I (BACKUP /BACK UP AND GET LAST CHAR
TYPE
T2M1, DCA CHAR /KILL CHAR TO PREVENT SPURIOUS DOUBLE CHARACTERS
T2, LISTEN /BUILD COMMAND LINE
SORT
COMLST
COMTAB-COMLST
T2A, DCA CHAR
JMS SPUT /PUT INTO C.L. BUFFER
JMP T2 /GO GET ANOTHER
TCTLU, TAD SCHAR
TYPE /PRINT "^U"
TCTLUP, JMS I (BACKUP
TAD [-12 /CHECK FOR LF
SZA CLA
JMP TCTLUP /LOOP UNTIL LF
IAC
JMP I (TSP9
TCRLF, TAD CACR /CR IN COMM LINE
DCA CHAR
JMS SPUT /PUT INTO COMM LINE
TAD CALF /THEN PUT IN A LF
JMP T2A /AND GET SOME MORE
/COMMAND EXECUTION LOOP
TALTM, JMS COMPAR /2ND ALTM STARTS EXECUTION
CRLF /START COMM EXECUTION
CHTECO, TAD (45 /NUMBER OF INPUT COMMAND Q-REGISTER
SETCMD /SET UP THE INPUT LINE AS THE CURRENT COMMAND LINE
T6, SCANUP
T6A, DCA CHAR /SAVE COMMAND CHAR
TAD CHAR
TAD (CDSP /ADD BASE OF DISPATCH TABLE
DCA T7 /LOOK UP ENTRY IN
TAD I T7 /COMMAND DISPATCH TABLE
DCA T7 /CALL RECURSIVELY
CLL
PUSHJ
T7, 0 /CALL TO ROUTINE
CTCCHK /CHECK FOR ^C - ** AC MAY NOT BE 0 HERE **
CLA /CTCCHK LEAVES AC NON-ZERO
TAD NFLG
SPA CLA
JMP T6
DCA N /IF WE ARE NOT ENTERING A NUMBER
DCA NLINK /SET 13-BIT N TO 0
JMP T6 /KEEP INTERPRETING
TQMK, TAD I ERROR
SNA CLA /ERROR ROUTINE ENTRY POINT NON-ZERO?
RESORT /NO
STA /AN ERROR PRINTOUT
DCA QLENGT /SET QLENGT BIG SO WE CAN ACCESS ENTIRE LINE
NOTRCE /TURN TRACE OFF
SCAN
TYPE /PRINT OUT THE LINE WHICH CAUSED THE ERROR
ISZ I ERROR /UP TO THE ERROR CHAR ITSELF
JMP .-3
JMP T0 /RE-INITIALIZE
CHUA, POP /^ COMMAND - POP OFF RETURN ADDRESS
SCANUP /GET THE NEXT CHARACTER IN UPPER CASE
AND [77 /MAKE IT A CONTROL CHARACTER
JMP T6A /USE IT INSTEAD OF THE ^
COMPAR, TCINIT /LOOK FOR DOUBLED COMM LINE CHARS
TAD SCHAR /MOST RECENT
CIA
TAD CHAR /PREVIOUS
SZA CLA
RESORT /NOT THE SAME
JMS SPUT /PUT THE CHAR INTO THE COMMAND LINE AND ECHO IT
JMP I COMPAR /SAME-SPECIAL HANDLING
SPUT, JTECO /PUT CHAR INTO COMM LINE
TAD QZ
DCA QP
TAD CHAR
QPUT /STORE CHARACTER AWAY
TAD I [QPNTR
IAC
ADJQ /ADJUST COMMAND LINE REGISTER LENGTH
DCA I ERROR /CLEAR "ERROR JUST OCCURRED" FLAG
TAD CHAR
TYPE /TYPE THE INSERTED CHARACTER
TAD I [QPNTR
TAD CALF /12
SPA CLA
JMP EMERG /TYPE BELL IF WITHIN 12 CHARACTERS OF 2048
CLL
TAD QZ
TAD QLIMIT
SNL CLA /TYPE A BELL IF THE LINE IS
JMP I SPUT / WITHIN 12 CHARS OF OVERFLOW
EMERG, TAD Z7
TYPE
JMP I SPUT
QLIMIT, 12-QMAX
PAGE
/Q REGISTER PACK AND UNPACK
/THE Q-REGISTERS ARE STORED IN THE UPPER 4 BITS OF THE WORDS
/WHICH HAVE THE TEXT BUFFER CHARACTERS IN THEIR LOWER 8 BITS.
/THEREFORE EACH Q-REGISTER CHARACTER TAKES 2 WORDS.
QPUTS, 0 /STORE THROUGH POINTER "QP" AND BUMP POINTER
CLL RTL
RTL
DCA GETQX /SAVE CHARACTER
TAD QP
CLL RAL
DCA CHKCTC /COMPUTE CORE POINTER = 2*QP
CDF 10
TAD GETQX
JMS ST4BTS /STORE HIGH ORDER 4 BITS
ISZ CHKCTC
TAD GETQX
CLL RTL
RTL
JMS ST4BTS /STORE LOW ORDER 4 BITS
CDF 0
ISZ QP /BUMP POINTER
JMP I QPUTS
GETQX, 0
CLL RAL
DCA CHKCTC /COMPUTE CORE POINTER = 2*AC
CDF 10
TAD I CHKCTC
AND [7400 /FETCH HIGH ORDER
ISZ CHKCTC
DCA QPUTS
TAD I CHKCTC
AND [7400 /FETCH LOW ORDER
CLL RTR
RTR
TAD QPUTS /COMBINE TO FORM CHARACTER
RTR
RTR
CDF 0
JMP I GETQX
ST4BTS, 0
AND [7400
DCA POPXX
TAD I CHKCTC
AND [377
TAD POPXX
DCA I CHKCTC /STORE HIGH ORDER
JMP I ST4BTS
CHKCTC, 0 /SUBROUTINE TO CHECK FOR ^C IN KEYBOARD
CLA OSR /** AC MAY NOT BE 0 ON ENTRY
DCA QPUTS /GET LOCATION FROM SWITCH REGISTER
TAD I QPUTS
7421 /DISPLAY INDICATED LOCATION IN MQ
C7600, 7600 /JUST IN CASE THERE IS NO MQ
KSF
JMP I CHKCTC /NO CHAR IN KEYBOARD BUFFER - EXIT
KRS
AND [177 /KILL PARITY BIT
TAD [-20 /^P OUGHT TO GO AWAY
SZA
TAD CACR
SZA /^C?
JMP I CHKCTC /NO - RESUME WITH NON-ZERO AC
ERR34, ERR /^C, EXECUTION ABORTED
CTLC, TSF
JMP CTLC /WAIT FOR TELETYPE TO DIE DOWN
JMP I C7600 /RETURN TO OS/8
POPJXX, DCA GETQX /POPJ ROUTINE
POP
POPJXY, DCA POPXX
TAD GETQX
JMP I POPXX
/PUSH DOWN LIST ROUTINES
POPXX, 0 /POP ROUTINE
CLA CMA
TAD PDLP
DCA PDLP
TAD I PDLP
JMP I POPXX
PUSHXX, 0 /PUSH ROUTINE (DOESN'T AFFECT LINK)
DCA I PDLP
ISZ PDLP /BUMP PUSHDOWN POINTER
TAD PDLP /CHECK FOR EXACTLY FULL - THIS ALLOWS THE
TAD (-PDLEND
SNA CLA /** ERROR ROUTINE TO DO A PUSHJ
ERR04, ERR /FULL - REPORT IT
JMP I PUSHXX
PUSHJY, 0 /PUSHJ ROUTINE (DOESN'T AFFECT LINK)
DCA GETQX
IAC /** LINK SHOULD BE PRESERVED ON EXIT
TAD PUSHJY
PUSH
TAD I PUSHJY
JMP POPJXY
PUSHLX, 0 /PUSH AND CLEAR A LIST
CLL
SMA /PUSH LIST IF AC<0, POP IT IF >=0
CMA STL
DCA PUSHJY /SET COUNTER
RAL /** DEPENDS ON FACT THAT POP=PUSH+1 **
TAD PUSHYY
DCA PUSHYX /STORE EITHER A "PUSH" OR A "POP"
POP /SAVE RETURN POINTER
DCA CHKCTC
PUSHLP, TAD I PUSHLX
DCA GETQX
TAD I GETQX
PUSHYX, PUSH /PUSH OR POP
DCA I GETQX /IF PUSHYX=PUSH, THIS ZEROES THE PUSHED LOCATION
ISZ PUSHLX
ISZ PUSHJY
JMP PUSHLP
TAD CHKCTC /RESTORE RETURN POINTER
PUSHYY, PUSH
JMP I PUSHLX
TPUT, 0 /TELETYPE OUTPUT
DCA TEMPT
TPUTX, CTCCHK /CHECK FOR ^C OR ^P
TAD (3-17 /INHIBIT PRINTING AS LONG AS THERE
SNA /IS A ^O IN THE KEYBOARD BUFFER.
JMP I TPUT
TAD (17-23 /CHECK FOR ^S
SNA CLA
JMP TPUTX
TSF /WAIT FOR TELETYPE FLAG
TSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE
TAD TEMPT
TLS
CLA
JMP I TPUT
PAGE
/POINTER MOVING COMMANDS - C,R,J,L
CHRJ, DCA NFLG /COMMAND J
GETNUM /CAUSE NEG ARGUMENT TO GIVE A POP
JMP CLOQ
CHRR, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
CHR1, CML CIA /NEGATE 13-BIT NUMBER
SKP
CHRC, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
TAD P /OFFSET RELATIVE TO .
/
/ *** LINK NOT ALWAYS SET RIGHT
/
CLOQ, BZCHK /SEE IF IN RANGE B,Z
DCA P /IN RANGE
DNN3, CDF 0
POPJ
CHRL, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
CHRL1, CDF 10
SZL SNA
JMP LNEG
CIA
DCA CDT
CHRLP, TAD P
CIA
TAD ZZ
SNA CLA /IF WE ARE AT THE END OF THE BUFFER,
JMP DNN3 /RETURN
JMS I (CHLCMP /COMPARE CHARACTER AGAINST LINE FEED
ISZ P
JMP CHRLP /KEEP GOING UNTIL WE GET THERE OR OVERFLOW BUFFER
LNEG, TAD (-1
DCA CDT
CHRLM, CLA CMA CLL
TAD P
DCA P /MOVE POINTER BACKWARD 1
SNL
JMP I (CHRLI /OOPS - PAST THE BEGINNING OF THE BUFFER - RETURN
JMS I (CHLCMP /COMPARE CHARACTER AGAINST LINE FEED
JMP CHRLM /NOT SATISFIED YET - KEEP LOOPING
NUMGET, 0 /PUT 13-BIT NUMBER IN L,AC
TAD NLINK
CLL RAR
TAD N
JMP I NUMGET
/D COMMAND AND PART OF ADJUST ROUTINE
CHRD, ISZ CFLG /WAS THERE A COMMA?
SKP /NO
JMP NERR /YES, 2 ARGS TO D
GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
SNL /SIGN BIT OF 13-BIT NUMBER IS IN LINK
JMP PLUSND /+ND
CLL CIA
DCA CDT /-ND
TAD CDT
PUSHJ /DO (-)NC(+)ND
CHR1
TAD CDT
JMP PLUSND
ADJ, SNA /ADJUST BUFFER + OR - N CHARS
/TEST FOR NOTHING
POPJ /GO AWAY
STL /MOVE UP N CHARACTERS
TAD ZZ /ADD TO MAX CHARACTER
DCA R /NEW HIGHEST
TAD R /SEE IF TOO HIGH
TAD (-ZMAX
SNL SZA CLA /TWO PLACES FOR OVERFLOW THERE
ERR05, ERR
TAD ZZ
DCA Q
TAD R
DCA ZZ
CDF 10
UPNL, TAD Q
CIA
TAD P
SNA CLA /FINISHED?
JMP DNN3 /YES
CMA
TAD Q
DCA Q
CMA
TAD R
DCA R
TAD I Q /GET A CHAR
L12K1, AND [377 /JMP .+5 IF 12K
DCA CHLTMP
TAD I R /BE CAREFUL NOT TO
AND [7400 /DESTROY THE HIGH-
TAD CHLTMP /ORDER 4 BITS
J12K1= JMP .
DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD
JMP UPNL
/K COMMAND AND MORE OF ADJUST ROUTINE
CHRK, JMS I (NLINES /CONVERT LINES TO CHARS
DCA CDT
TAD M /SET POINTER
DCA P /LOWER ARG
TAD CDT
PLUSND, SNA
POPJ /IGNORE 0D
ADJ2, CLL
TAD P /MOVE DOWN N CHARACTERS
SZL
CLA CMA /DETECT GROSS OVERFLOWS
/** CHECK
BZCHK
DCA Q /N IN AC
TAD P
DCA R
CDF 10
DNN1, TAD ZZ
CIA
TAD Q
SNA CLA /FINISHED?
JMP DNN2
TAD I Q /GET A CHAR
L12K2, AND [377 /JMP .+5 IF 12K
DCA CHLTMP
TAD I R /BE CAREFUL NOT TO
AND [7400 /DESTROY THE HIGH-
TAD CHLTMP /ORDER 4 BITS
J12K2= JMP .
DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD
ISZ Q
ISZ R
JMP DNN1
DNN2, TAD R
DCA ZZ
JMP DNN3
CHLTMP, 0
/GO TO ADJ TO MOVE UP TEXT
/GOTO ADJ2 TO MOVE DOWN TEXT
/IN EITHER CASE, AC CONTAINS NUMBER OF CHARS TO MOVE (0-4095)
ERR27, ERR /^W
ERR35, ERR /^V
PAGE
/SEARCH SUBROUTINE - CALLED BY N, S, AND _ COMMANDS
SEARCH, 0
DCA REPFLG /AC MAY BE NON-0 TO ALLOW A REPLACE
GETN
SZL SNA
ERR29, ERR /NEG OR 0 ARG TO SEARCH
CIA
DCA CSN /GET NUMBER OF OCCURRANCES TO SEARCH FOR
QCHK /GET REPLACEMENT FOR ALTMODE, IF ANY
TAD (STABLE-1
DCA SXR /INITIALIZE XR
TAD [-40
DCA CSP
SGTLP, QUOTST /GET A CHARACTER FROM THE SEARCH STRING
JMP SCHQUO /OOPS- NO MORE
SORT /SEE IF ITS SPECIAL
SCHLST
SCHTAB-SCHLST
SSTCHR, DCA I SXR /STORE THE CHAR IN THE SEARCH BUFFER
ISZ CSP
JMP SGTLP /LOOP
ERR06, ERR /OOPS - SEARCH BUFFER FULL!
SCHQUO, TAD CSP
TAD [40 /A NULL SEARCH STRING MEANS USE THE
SZA CLA /PREV CONTENTS OF THE SEARCH BUFFER, ELSE
DCA I SXR /STORE TERMINATING 0 AND BEGIN THE SEARCH
CSST, TAD P
DCA CSP
JMP CSF1
SCHINV, TAD CSNCL /^N, INVERT SKIP SENSE
DCA CSWT
CSL, TAD I SXR /GET A CHAR FROM THE SEARCH BUFFER
SPA SNA
JMP SCCOMD /NEGATIVE CHARS AND 0 ARE SPECIAL
CIA
CDF 10
TAD I P
AND [377
CSWT1, CDF 0
CSWT, SZA CLA
JMP CSF /FAIL TO MATCH ON THIS CHARACTER
ISZ P
CSG, TAD CSZCL
DCA CSWT /RESTORE SEARCH TEST
TAD ZZ
CMA
TAD P
CSZCL, SZA CLA /CHECK FOR END OF BUFFER
JMP CSL /NO
DCA P
CSZ, DCA NMT
JMP I SEARCH
/SEARCH SUBROUTINE - CONTINUED
SCCOMD, DCA .+1 /SPECIAL CHARACTERS ARE JUMPS OR 0
HLT /0 FALLS THROUGH INTO TERMINATION CODE
ISZ CSN /GET NTH OCCURRENCE
JMP CSF /MORE TO GO
CMA
JMP CSZ /GOT IT
CSF, ISZ CSP /INDEX P
CSF1, TAD (STABLE-1
DCA SXR /INITIALIZE AUTO - INDEX
TAD CSP
DCA P
JMP CSG
/SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X
SCHTAB, JMP SCHINV /^N: ANYTHING BUT
SCHCTQ /^Q: LITERALLY
JMP SCHSEP /^S: ANY SEPARATOR
JMP CSWT1 /^X: ANYTHING
SCHCTQ, SCAN /GET THE NEXT CHARACTER
JMP SSTCHR /AND STORE IT IN PLACE OF THE ^Q
SCHSEP, CDF 10 /^S, LOOK FOR SEPARATOR
TAD I P
AND [377
TSTSEP /SHARED SORTING ROUTINE
SKP
CMA /SET AC = -1 IF NON-SEPARATOR
JMP CSWT1 /GO CHECK RESULTS
FN, DCA CNXT
STA
JMP CHRN1
/S,N AND _ COMMANDS (ALSO FS AND FN)
FS, STA /CHANGE S TO FS
CHRS, JMS SEARCH /S COMMAND - DO A SEARCH
CHKREP, ISZ REPFLG /WAS THERE A REPLACE SPECIFIED?
JMP CHKCLN /NO - CHECK FOR COLON
QSKP /COUNT UP STRING 2
TAD NMT
SMA CLA
JMP CHKCLN /FAILED, SET VALUE & EXIT
TAD CSP /FIGURE OUT OFFSET TO FAKE OUT "I" ROUTINE
CIA /SO THAT WE HAVE THE RIGHT INSERTION COUNT
TAD P /BUT THE SIZE OF THE HOLE WE NEED
DCA DVT1 /IS DECREASED BY THE LENGTH OF THE SEARCH STRING.
TAD CSP /RESET
DCA P /TEXT POINTER
PUSHJ /INSERT
CIL2 /STRING 2
CHKCLN, DCA REPFLG /CLEAR REPLACE FLAG
TAD NMT
PUSHJ /FORM NUMBER FROM "NMT"
NNEW13 /(APPLYING OPERATOR, IF NECESSARY)
ISZ CLNF /WAS THERE A COLON ON THIS SEARCH?
SKP /NO
JMP I [IREST /YES - GO AWAY REGARDLESS OF RESULTS
DCA CLNF /RESET COLON FLAG TO 0
ISZ N /DID WE SUCCEED?
JMP I (CFSI /NO - SIMULATE A SEMICOLON
DCA NFLG /YES - HOWEVER, NO COLON MEANS NO RESULT
JMP I [IREST
CHBA, CLA IAC /_ COMMAND
CHRN, DCA CNXT /N COMMAND - SET OUTPUT FLAG
CHRN1, JMS SEARCH /DO A SEARCH
TAD REND
CIA
TAD ZZ
CSNCL, SNA CLA /HAVE WE REACHED END-OF-FILE?
JMP CHKREP /YES - STOP AND ASSIGN VALUE
TAD NMT
SZA CLA /HAVE WE SUCCEEDED?
JMP CHKREP /YES - STOP AND ASSIGN VALUE
TAD CNXT
JMS I [NXTBUF /GET NEXT BUFFER
JMP CSST /KEEP SEARCHING - RETURN TO CHRN+2
CNXT, 0 /OUTPUT FLAG
CSP, 0 /TEMP P
CSN, 0
REPFLG, 0 /REPLACE FLAG (-1 MEANS REPLACE)
PAGE
/NUMBER PROCESSORS:
/COMMANDS B,H,Z,. AND DIGITS
NMBR, TAD CHAR /NUMBER FOUND IN COMMAND STRING
TAD [-60
NMBR2, DCA NMT
CLL
NCHK /CHECK NUMBER FLAG
JMP NNEW /NOT UP, NEW OPERAND
TAD DOPR
DCA NOPR /USE SAME OPERATOR AS FOR THE PREVIOUS DIGITS
TAD NP /MULTIPLY PREV DIGITS BY 10
CLL RTL
NMRBAS, TAD NP /REPLACED BY "NOP" FOR OCTAL
CLL RAL /** COULD CHECK FOR OVERFLOW IN THIS AREA
NNEW, TAD NMT
NCOM, DCA NP /CURRENT NUMBER
/ RAL
/ DCA NEWLNK
/ TAD NEWLNK /GET NEW LINK
/ CLL RAR /INTO LINK
NCOM2, TAD NP
NOPR, SKP /DISPATCH JUMP FOR OPERATOR
CML CIA
TAD NACC /CURRENT EXPRESSION VALUE
DCA N
RAL
TAD NACCLK /ADD IN OLD LINK
RAR
SKP CLA
NRET, DCA N
RAL
DCA NLINK /SAVE LINK FOR POSSIBLE COMPARISON TEST
TAD NOPR
DCA DOPR
TAD NULLOP
DCA NOPR /SET OPERATOR TO NULL OP
STA
JMP DCPOPJ /SET NUMBER FLAG AND EXIT
CCPR, STL CLA RTL /2
POPL
NOPR
NACC
NACCLK
GETNUM
JMP NCOM /COMBINE OLD NUMBER AND PARENTHESIZED RESULT
COPR, MTHREE
PUSHL
NACCLK
NACC
NOPR
DCA N
DCA NLINK
JMP CPLS /CLEAN OUT INSIDE PARENS
CDOT, TAD P /COMMAND .
/** COULD CAUSE ERROR IF NFLG SET
JMP NCOMCL
/NEWLNK, 0
/COMMANDS &,#,/,*,-,+,(,)
CAMP, MTWO /*K* LOGICAL AND **
CNBS, TAD (NIOR-NDIV /LOGICAL OR
CVIR, TAD (NDIV-NMPY /DIVISION
CAST, TAD (NMPY&177+5200-7400 /MULTIPLICATION
CMIN, TAD [7400-SKP /SUBTRACTION
CPLS, TAD (SKP /ADDITION
DCA NOPR /COMMON TO ALL NUMERIC OPERATORS
TAD N
DCA NACC
TAD NLINK
DCA NACCLK
DCA NP
DCPOPJ, DCA NFLG /CLEAR NUMBER FLAG
POPJ
NAND, AND NACC /BITWISE AND OF BINARY NUMBERS
JMP NRET /** KEEP THESE TWO OPNS TOGETHER
NIOR, CMA /BITWISE OR OF BINARY VALUES
AND NACC
TAD NP
NULLOP, JMP NRET
NACCLK, 0 /LINK OF EXPRESSION WITHOUT NP
NMPY, CIA /*** REALLY OUGHT TO IMPLEMENT 13-BIT MULTIPLY
DCA ND
TAD NACCLK
RAR /SET UP OLD LINK
TAD NACC
ISZ ND
JMP .-2
JMP NRET
NACC, 0 /VALUE OF EXPRESSION WITHOUT NP
NDIV, DCA ND
TAD NACC
MQLDVI
ND, 0
JMP NRET
/COMMANDS ^F,^^,^Z,^V, Q AND %, ^D, ^O
CTLF, CLA OSR SKP /^F COMMAND - VALUE OF CONSOLE SWITCHES
CTUA, SCAN /^^ COMMAND - VALUE OF NEXT CHAR IN COMMAND LINE
NCOMCL, CLL
JMP NCOM /GO INTO NUMBER PROCESSOR
/CTLZ, TAD QZ /COMMAND ^Z
/ JMP NCOM /RETURN NUMBER OF CHARACTERS IN ALL Q-REGS.
/CTLV, TAD (VERSN /^V COMMAND - RETURNS THE CURRENT VERSION NUMBER
/NCOM14, CLL
/ JMP NCOM
CTLD, TAD [4 /SET RADIX DECIMAL
CTLO, TAD (ORAD /SET RADIX OCTAL
DCA RADIX
TAD I RADIX
DCA NMRBAS /EITHER "NOP"(8) OR "TAD NP"(10)
POPJ
DOPR, 0 /PREVIOUS OPERATOR
NP, 0 /VALUE OF CURRENT NUMBER
SCPTAB, BBELL
BCR
BCR /TAB
EASYRO /ALT
BFF
BVT
BLF
CTLN, TAD REND
CMA
JMP I (NNEW13
CQSM, TAD TFLG
CMA /TRACE FLAG ALTERNATES BETWEEN 0 AND 7777
DCA TFLG
POPJ
FTAB, FN
FS
FLST, 116 /FN
123 /FS
CHRF, SCANUP /COMMAND F
SORT
FLST
FTAB-FLST
ERR31, ERR /BAD F COMMAND
CCLN, STA /: COMMAND - SET VALUE FLAG
DCA CLNF
POPJ /SO NEXT SEARCH WILL HAVE A NUMERIC VALUE
PAGE
/CURSOR RIGHT IS $C
/CURSOR UP IS $A
/ERASE LINE IS $K
BUGFLG, 0 /-1 MEANS MUST RETYPE LINE ON NEXT RUBOUT
BSP, 0
TAD TTY10
PUTT /TYPE BS, SPACE, BS
TAD TTY40
PUTT
TAD TTY10
PUTT
STA
TAD I (COLCT /FIX UP COLUMN COUNTER
DCA I (COLCT
JMP I BSP
SCOPY, JMS I (BACKUP /BACK UP ONE CHAR IN CMD LINE
TAD [-40 /LOOK AT CHAR WE BACKED OVER
SMA
JMP EASYRO /IT'S EASY TO RUB THIS ONE OUT
TAD [40 /RESTORE CHARACTER
SORT
CTLBEL
SCPTAB-CTLBEL
BBELL, CLA
JMS BSP /^X NEEDS TWO RUB OUTS
EASYRO, CLA
ISZ BUGFLG /MAYBE WE REALLY SHOULD REPRINT LINE
TTY10, SKP /NOT NECESSARY
JMP BCR /NECESSARY (PREVIOUS VERTICAL MOTION MAY
/HAVE SCROLLED OFF TOP OF SCREEN)
JMS BSP /RUB IT OUT
SCOPGO, DCA BUGFLG
JMP I (T2M1
BCR, JMS BELLSP /REPRINT LINE
JMS I SCAPE
113 /ERASE LINE
JMP SCOPGO
BLF, TAD CTLBEL /CURSOR UP 1
BFF, TAD (-4 /CURSOR UP 8
BVT, TAD (-4 /CURSOR UP 4
DCA BSP
JMS I (ESCAPE
101 /CURSOR UP
ISZ BSP
JMP .-3
TTY40, STA
JMP SCOPGO
TSTAR, DCA BCHAR
TSPACE, TAD CHAR /LOOK AT PREVIOUS CHARACTER
TAD (-7
SZA CLA /WAS IT ^G ?
RESORT /NO
STA /YES
TSP9, TAD I [QPNTR /REDUCE CMD LINE BY 1 CHAR
ADJQ /I.E. GET RID OF ^G
JMS BELLSP
JMP I (T2M1
BELLSP, 0
BLSP1, CRLF /TAD CACR
BLSP2, NOP /TYPE
TAD MQ
DCA SAVMQ
DCA MQ
TAD QZ /START FROM END OF COMMAND LINE
LFBLP, DCA QP /AND SEARCH FOR LF
STA
TAD MQ /COUNT HOW MANY
DCA MQ
STA
TAD QP
SPA
JMP LFSTAR /AT BEGIN OF CMD LINE
GETQ
TAD BCHAR /LOOK FOR LF
SNA CLA /IS IT LF?
JMP LFB /YES
STA /NO
TAD QP /BUMP BACK ONE MORE CHAR
JMP LFBLP
LFSTAR, CLA
TAD [52 /PRINT ANOTHER *
TYPE
LFB, PUSHJ
COLG4 /REPRINT LINE TO END OF CMD LINE
TAD SAVMQ /RESTORE MQ
DCA MQ
BLSP3, NOP /JMS I SCAPE
BLSP4, NOP /113
TAD [-12
DCA BCHAR /SET UP FOR NEXT TIME
KCC /CLEAR OUT ^O OR ^S
JMP I BELLSP
SAVMQ, 0
BCHAR, -12 /CHAR WE'RE SEARCHING BACKWARDS FOR
SCAPE, ESCAPE
SORTB, 0 /SORT AND BRANCH ROUTINE
DCA SCHAR /SAVE SORT CHAR
STA
TAD I SORTB /GET POINTER TO LIST
ISZ SORTB
DCA XR
SORTA1, TAD I XR /GET ITEM IN TEST LIST
SPA /END MARKED BY NEG VALUE
JMP SORTA2 /FELL OUT BOTTOM
CIA STL
TAD SCHAR
SZA CLA /COMPARE SORT CHAR
JMP SORTA1 /NOT IT.
TAD XR /GOT IT. NOW MAKE INDEX
TAD I SORTB /TO JUMP TABLE
DCA COUNT /THIS IS TABLE POINTER
TAD I COUNT /GET JUMP ADDRESS FROM TABLE
SPA /IF IT IS NEGATIVE,
JMP SORTA3 /ITS NOT A JUMP ADDRESS - ITS A VALUE
DCA COUNT
CLA CLL
JMP I COUNT
SORTA2, CLA CLL /FELL OUT BOTTOM
TAD SCHAR /CARRY CHARACTER BACK TO
SORTA3, ISZ SORTB
JMP I SORTB /DO SOMETHING ELSE
CSMC, SCANUP /GET NEXT CHARACTER IN UPPER CASE
AND [77 /MAKE IT A CONTROL CHARACTER
DCA SCHAR
JMP SORTA1 /SUBSTITUTE IT FOR THE UPARROW
COUNT, 0
PAGE
/COMMANDS P AND T
CHRP, JMS POKE /LOOK AHEAD ONE CHARACTER
UPPERC /BUT IN UPPERCASE
TAD (-127 /SEE IF IT'S "W"
DCA TEMPT /SAVE KNOWLEDGE AS FLAG
TAD TEMPT
SNA CLA
SCAN /PASS UP W
CLA /CLEAR W FROM AC
TAD CFLG
SPA CLA /IS THIS COMMAND M,NP?
JMP CHRW /YES - TREAT LIKE M,NPW
GETN /COMMAND P - GET # OF PAGES
SZL SNA
ERR25, ERR /NEG OR 0 ARG TO P
CIA
DCA CPCT
CPOA, PUSHJ
CPOC /DO N<HPY>
TAD TEMPT /IS NEXT CHARACTER W?
SNA CLA
JMP NOYANK /YES
/ TAD REND /IF WANT P TO CREATE FF'S
/ SZA CLA /WHEN NO MORE INPUT FILE
ISZ FFFLAG /NO, SAW FF?
JMP NOFF /NO
TAD CAFF /YES
OUTPUT /OUTPUT FF
NOFF, DCA ZZ /FORCE Y COMMAND TO WORK
PUSHJ
CHRY /WHOEVER THOUGHT OF THE PW COMMAND SHOULD BE SHOT
YANKY, ISZ CPCT
JMP CPOA
POPJ
CPCT, 0
POKE, 0 /RETURN NEXT CHARACTER (BY LOOKING AHEAD)
TAD QLENGT
CIA CLL
TAD SCANP
SZL CLA /MAKE SURE WE HAVEN'T RUN OFF END OF COMMAND LINE
JMP I POKE /RETURN 0 IF NO CHAR
TAD SCANP
TAD QBASE
GETQ
JMP I POKE /LEAVE CHAR IN AC
NOYANK, TAD CAFF /NPW OUTPUTS FFS
OUTPUT
JMP YANKY
CPOC, PUSHJ
CHRH
CHRW, TAD (OUTPUT
CHRT2, DCA CWOUT /W AND T COMMANDS - SAME THING, DIFFERENT DEVICES
JMS NLINES /CONVERT LINES TO CHARS
CWOA, CMA
DCA NLINES /SET CHARACTER COUNT
TAD NLINES
CIA
MQLDVI /COMPUTE HOW MANY WORDS THIS OUTPUT WILL USE
6 /(BY TAKING 2/3 OF THE NUMBER OF CHARACTERS,
CLL CML RTL / BU THAT'S SLOW SO WE TAKE 4/6 AND ROUND)
JMS I (FITS /DETERMINE WHETHER THE OUTPUT WILL FIT
ERR17, ERR /NO - TELL THE USER
CLA /CLEAR CRAP FROM AC
JMP CWOC
CWOB, CDF 10
TAD I M
AND [177
CDF 0
CWOUT, 0 /TYPE, OUTPUT, OR QPUT
ISZ M
CWOC, ISZ NLINES /DONE?
JMP CWOB /NO
POPJ
CHRT, TAD KTYPE
JMP CHRT2
/X COMMAND AND LINES-TO-CHARACTER CONVERTOR
CHRX, QREF /COMMAND X
JMS NLINES /CONVERT LINES TO CHARS
ADJQ /ADJUST Q-REGISTERS AND SET UP NEW LENGTH.
TAD (QPUT
DCA CWOUT /SET OUTPUT ROUTINE TO STORE INTO Q REG
TAD MQ /LOAD THE CHARACTER COUNT
JMP CWOA /GO TO TEXT OUTPUTTER
NLINES, 0 /CONVERT + OR - N LINES AROUND . TO CHARS M,N
ISZ CFLG /WAS THERE A COMMA?
SKP /NO
JMP MFROMN /YES - DON'T CONVERT LINES TO CHARS
TAD P
DCA M
DCA CFLG /V3C
PUSHJ /CHRL DOES A "GETN"
CHRL /TO GET THE DEFAULT VALUES OF N
TAD P
DCA N
TAD M
DCA P
MFROMN, DCA NFLG /CLEAR NFLG IN CASE COMMA FLAG WAS ON
CLL /M AND N ARE KNOWN TO BE 12-BITS LONG
/AND POSITIVE
TAD N
BZCHK /IS N OK?
CMA CLL /YES - COMPUTE N-M
TAD M /BY COMPUTING M-N-1
CMA /AND COMPLEMENTING IT
SNL /IS M>N?
JMP I NLINES /NO - RETURN N-M
TAD M /N-M+M=N NOW IN AC.
DCA CPCT /INTERCHANGE M AND N
TAD M
DCA N
TAD CPCT
DCA M
JMP MFROMN
/COMMANDS ; < AND >
CFSI, TAD ITRST
SNA CLA
ERR24, ERR /FAILING SEARCH NOT IN ITERATION
CSEM, OVRLAY
QOVRLY
CSEMO
/ ^A ROUTINE
CTLA, TAD KTYPE
CEXP, DCA WHERTO
TAD CHAR
DCA QUOTE /TERMINATING CHAR SAME AS COMMAND CHAR
DCA NFLG /KILL NUMBER IF PRESENT
CTLALP, QUOTST
JMP I [IREST
WHERTO, 0 /TYPE OR IGNORE THE CHARACTER
CLA
JMP CTLALP
PAGE
/COMMANDS A AND Y
CHRA, NCHK /COMMAND A
JMP CHAA
GETNUM
TAD P
DCA R
SZL
JMP I (ERR11 /ERROR IF POINTER OFF PAGE
CDF 10
TAD R
CMA CLL
TAD ZZ /RETURN 'POP' IF POINTER OUTSIDE RANGE [0,Z-1]
SNL CLA /OTHERWISE VALUE OF CHARACTER AT POINTER POSITION
JMP I (ERR11 /POP
TAD I R
AND [377
CDF 0
NCOM14, CLL
JMP I (NCOM
CHRY, TAD NFLG
SZA CLA
ERR18, ERR /NUMERIC ARGUMENT TO Y
TAD OUTR
CIA
TAD ERROR
SZA CLA
TAD ZZ
YSKP, SZA CLA /CHANGE TO SKP CLA TO NEVER ABORT Y COMMAND
ERR32, ERR /Y COMMAND ABORTED
DCA ZZ
DCA P /WIPE OUT THE BUFFER
CHAA, TAD (ZMAX-1
AND REND
CIA CLL
TAD ZZ /IF WE HAVE ALREADY SEEN THE INPUT EOF,
SZL CLA /OR IF WE'RE ALREADY FULL (OR NEARLY SO)
JMP APLF /GET OUT
DECGET, ISZ ICRCNT
JMP I2 /NO NEED TO READ
CLL
TAD INRSIZ
TAD INRCNT
STECO1, SNL /"SKP!CLA" FOR SUPERTECO
DCA INRCNT /UPDATE RECORD COUNT
LFTAB, CLL CML CMA RTR /IF WE OVERFLOWED THE END OF THE FILE, !
RTR /5 ENTRY TABLE: MUST BE - - - + + !
RTR /SHORTEN THE READ BY THE CORRECT AMOUNT !
TAD INCTLW / !
DCA INCTRL /SO THAT WE WILL NOT READ TOO FAR !
JMS I INHND
I3,
INCTRL, 0400
BUFIN, IN /6200 IF 8K, 5600 IF 12K
IBLK, 0
SMA CLA
SKP
JMP INER /IGNORE END-OF-FILE ERRORS, WE'LL SEE THE ^Z.
TAD IBLK
TAD INRSIZ /BUMP RECORD NUMBER BY THE MAXIMUM NUMBER
DCA IBLK /(IF WE READ SHORT ITS THE LAST ONE ANYWAY)
CLA CMA
TAD BUFIN
DCA INXR /SET UP INPUT XR
TAD INPCNT
DCA ICRCNT
MTHREE
DCA I3
I2, NOP /CDF 20 IF 12K
ISZ I3
JMP I1 /NORMAL CHARACTER
MTHREE /WEIRD CHARACTER-RESET SWITCH
DCA I3
MTWO
TAD INXR
DCA INXR /MOVE INPUT XR BACK TO BEGINNING OF DBLWORD
TAD I INXR
AND [7400
DCA FFFLAG /TEMP
TAD I INXR
AND [7400
CLL RTR
RTR
TAD FFFLAG
CLL RTR
RTR
SKP
I1, TAD I INXR
IC, NOP /CDF 0 IF 12K
AND [177 /MASK OFF GARBAGE
/INPUT CHARACTER IN AC
SZA
TAD (-177
SNA /IGNORE BLANK TAPE AND RUBOUTS
JMP DECGET
TAD (177-32
STECO2, SNA /"SKP" FOR SUPERTECO
JMP APFS /IT'S A ^Z
TAD (16
SNA
JMP APFF /ITS A FORM FEED
TAD CAFF /RESTORE CHAR
CDF 10
DCA MQ /SAVE CHAR
TAD I ZZ /PROTECT HIGH-
AND [7400 /ORDER BITS
TAD MQ /OF TARGET
DCA I ZZ /STORE CHAR IN BUFFER
TAD MQ
CDF 0
ISZ ZZ
TAD [-12
SNA CLA /IF THE CHAR IS A LINE FEED,
TAD (-310 /CHECK THAT THE BUFFER IS NOT NEARLY FULL
JMP CHAA
APFS, DCA REND /SIGNAL END OF FILE
SKP
APFF, STA
APLF, DCA FFFLAG /SET FORM FEED FLAG
POPJ
INER, DCA REND /INHIBIT FUTURE INPUTS
ERR15, ERR
INCTLW, 401 /1021 IF 12K MACHINE
INPCNT, 6400 /5000 IF 12K MACHINE
PAGE
/TELETYPE ROUTINES
TYPCTV, 0 /TELETYPE STUFFER
SORT
CTLBEL
CTLTAB-CTLBEL
DCA SCHAR /STORE (POSSIBLY TRANSLATED) CHAR
OUTCC, TAD SCHAR
ISZ COLCT /BUMP COLUMN COUNTER
AND [7740
SZA CLA /IS THE CHAR A CONTROL CHARACTER?
JMP NOCON /NO
TAD (136
PUTT /OUTPUT "^"
ISZ COLCT
TAD [100
OUTLF, TAD SCHAR
OUTLF1, PUTT
JMP I TYPCTV
COLCT, 0
OUTCR, DCA COLCT /RESET CHAR COUNT
JMP OUTLF
OUTVT, TAD [4
OUTFF, TAD [7770 /FORM FEED IS 8 LINE FEEDS, VERT TAB IS 4
DCA COLCT /*** BUG
ASR33, TAD CALF /SIMULATE FORMFEEDS AND VERT TABS WITH LINEFEEDS
JMP OUTCOM /*K* 8 LOCS AT ASR33 OVERLAYED BY ASR35 CODE
OUTHT, TAD COLCT /COLUMN COUNTER, MOD 8
AND [7
TAD [7770 /SIMULATE TABS WITH SPACES
DCA COLCT
40 /TAKE UP SPACE SO ASR-35 ROUTINE WILL JUST FIT
TAD .-1 /USE SPACES FOR TABS
OUTCOM, PUTT /PUT ONE OUT THE
ISZ COLCT /WINDOW
JMP I (TPUTX /STILL MORE INSIDE
JMP I TYPCTV
NOCON, TAD SCHAR
AND [100
EU1, SNA CLA /*EU SET TO CLA IF EUFLAG < 0 (NO CASE FLAGGING)
JMP OUTLF /NOT ALPHANUMERIC
EU2, NOP /*EU SET TO TAD [40 IF EUFLAG>0 (FLAG UPPER CASE)
TAD SCHAR
AND [40
SNA CLA
JMP OUTLF
TAD SQUO
PUTT
ISZ COLCT
TAD SCHAR
AND [137
JMP OUTLF1 /OUTPUT UPPER CASE VERSION
OUTBEL, TAD SCHAR
PUTT
JMP OUTCC
/ROUTINE TO MANIPULATE Q-REGISTER STORAGE
/*** ALLOW : TO MEAN APPEND TO Q-REGISTER
/APPLIES TO X AND ^U COMMANDS
/MAKE SURE CMD LINE AND ^S ZERO CLNF
QADJ, 0
SPA
JMP ERR12 /STRING TOO LONG FOR Q-REGISTER
DCA MQ /SAVE NEW LENGTH OF Q-REGISTER
QSUM /COMPUTE POINTER TO CURRENT Q-REGISTER
AC3777
AND I QPTR
TAD QP
DCA R
AC3777
AND I QPTR /GET ITS CURRENT LENGTH
CIA CLL
TAD MQ /COMPUTE DIFFERENCE
SNL /ADJUST Q-REGS
JMP QDNN /TO HOLD NEW STRING
SNA /CHECK FOR ZERO
JMP QADJDN /NOTHING TO DO
TAD QZ /MOVE Q-REGISTERS UP TO INSERT CHARS
DCA QP /(LINK IS 1 FROM PREVIOUS SNL)
TAD QP
TAD MQMAX /SEE IF OUT OF BOUNDS
SNL CLA /TWO PLACES TO TOGGLE LINK THERE
ERR12, ERR /GETTING TOO FULL
TAD QZ
DCA Q
TAD QP
DCA QZ
ISZ QP
QUPL, TAD Q
CIA
SQUO, TAD R /DOUBLES AS ASCII FOR '
SNA CLA
JMP QADJDN
CMA
TAD Q
DCA Q
MTWO
TAD QP
DCA QP
TAD Q
GETQ
QPUT
JMP QUPL
QDNN, TAD R /MOVE Q-REGS DOWN TO ABSORB CHARACTERS
DCA QP
QDNN1, TAD QZ
CIA
TAD R /-NUMBER OF CHARS TO MOVE
SNA CLA /DONE?
JMP QDNNF /YES
TAD R
GETQ
QPUT
ISZ R
JMP QDNN1 /LOOP AGAIN
QDNNF, TAD QP /SET NEW VALUE
DCA QZ /OF HIGHEST CHAR
QADJDN, STL CLA RAR /4000
AND I QPTR /SAVE HIGH ORDER PART
TAD MQ
DCA I QPTR /SAVE NEW LENGTH OF Q-REGISTER IN Q-REG TABLE
TAD QCMND /SET UP COMMAND LINE AGAIN
SETCMD /AS IT MAY HAVE BEEN SHUFFLED.
QSUM /RECOMPUTE POINTER TO BEGINNING OF NEW Q-REG
JMP I QADJ
MQMAX, -QMAX
QOVER, 0 /SUBROUTINE TO SKIP TO END OF STRING
QCHK /GET THE QUOTE CHARACTER (IF ANY)
TAD SCANP
DCA OSCANP /SAVE BACKUP SCAN POINTER
QOVERL, QUOTST
JMP I QOVER /FOUND AN ALTM OR EQUIVALENT - RETURN
JMP QOVERL /NOT END - SKIP ANOTHER CHAR
PAGE
/Q-REGISTER SUBROUTINES
QSUMR, 0 /COMPUTE POINTER TO Q-REG
SNA
TAD QNMBR /NORMALLY USES QNMBR, BUT CAN BE OVERRIDDEN BY AC
CIA
DCA QKNT
DCA QP
TAD (QARRAY /BASE ADDR OF Q-REG POINTERS
DCA QPTR
JMP QSUMB
QSUML, AC3777
AND I QPTR /ADD # OF CHARS IN LOWER REG
TAD QP
DCA QP
ISZ QPTR /SKIP VALUE WORD
ISZ QPTR /POINT TO NEXT Q-REG
QSUMB, ISZ QKNT /REACHED OUR Q-REGISTER YET?
JMP QSUML /NO - ADD IN ANOTHER
JMP I QSUMR
QKNT, 0
SGET, 0 /SCAN COMMAND LINE OR MACRO
SGET1, CLA /** CALLED WITH AC NON-ZERO **
TAD QLENGT
CIA CLL
TAD SCANP
SZL CLA /CHECK THAT WE ARE STILL INSIDE THE COMMAND LINE
JMP SGOVFL /NO - COMMAND DONE
TAD SCANP /GET CHARACTER POSITION IN LINE
TAD QBASE /ADD IT TO THE ADDRESS OF THE LINE
GETQ /AND GET THAT CHARACTER.
DCA LASTC
TAD TFLG
AND LASTC /IF THE TRACE FLAG IS ON,
SZA
TYPE /PRINT THE CHAR
TAD LASTC
ISZ SCANP /INCREMENT CHARACTER POINTER AFTER FETCH
JMP I SGET /RETURN
SGOVFL, TAD MPDL /"MPDL" IS THE PUSHDOWN POINTER ON ENTRY TO THIS
SNA /MACRO. IF IT IS 0, WE ARE NOT IN A MACRO
JMP I (T1 /SO RETURN TO THE USER
TAD PDLP /CHECK THAT THE ENDING POINTER IS THE SAME
IAC
SZA CLA /AS THE ENTRY ONE - OTHERWISE WE HAVE
ERR13, ERR /SCREWED UP SOMEHOW (EG WE ARE
POP / IN THE MIDDLE OF A COMMAND)
DCA SCANP
POP
DCA ITRST
POP /RESTORE THE PREVIOUS VALUES OF
DCA MPDL /MPDL, THE SCAN POINTER AND THE COMMAND LINE
POP /POINTER FROM THE PUSHDOWN LIST
SETCMD
JMP SGET1 /AND FETCH A CHARACTER FROM THE UPPER LEVEL.
CMDSET, 0 /SUBROUTINE TO SET UP COMMAND LINE POINTERS
DCA QCMND /STORE IN COMMAND LINE NUMBER
TAD QCMND
QSUM
TAD QP /GET FIRST LOCATION IN COMMAND LINE
DCA QBASE /AND STORE IN "QBASE"
AC3777
AND I QPTR
DCA QLENGT /STORE THE LINE LENGTH IN "QLENGT"
JMP I CMDSET /RETURN
QREFER, 0 /SET UP POINTERS FOR Q-REG REFERENCE
SZA
JMP QREFEX /AHA - WE ALREADY HAVE THE Q-REGISTER
SCANUP /GET Q-REGISTER IDENTIFIER
DCA QNMBR
TAD QNMBR
TSTSEP /TEST FOR ALPHANUMERIC (LOWER CASE LEGAL)
ERR03, ERR /OOPS - BAD Q-REGISTER REFERENCE
TAD QNMBR
TAD [7700
SPA /NUMERIC?
TAD Z7 /YES - FORCE NUMBERS UP TO ABUT LETTERS
TAD CALF /FORCE IDENTIFIER INTO THE RANGE 1-44 (OCTAL)
QREFEX, DCA QNMBR /STORE AWAY NUMBER FOR FURTHER REFERENCE
QSUM /COMPUTE QP AND QPTR
JMP I QREFER /RETURN
CDBQ, OVRLAY
QOVRLY /READ IN Q-OVERLAY
CDBQO
CHRO, OVRLAY /READ IN Q-OVERLAY
QOVRLY
CHROO
OVERLY, 0
TAD I OVERLY /GET LOCATION TO CHECK
ISZ OVERLY
DCA TMP
TAD I OVERLY
DCA OVERLY /SET RETURN ADDRESS
TAD I TMP /IS OUR OVERLAY IN CORE?
SNA
JMP I OVERLY /YES, BRANCH INTO IT
DCA TMP /NO, SET BLOCK TO READ IN
/** THE NEXT 5 WORDS ARE MODIFIED IF WE HAVE MORE THAN 12K
OVREAD, JMS I (7607 /CALL SYSTEM HANDLER
0200 /READ 2 PAGES
3200 /INTO 3200
TMP, 0 /FROM THIS BLOCK
HLT /ERROR READING OVERLAY
JMP I OVERLY /GO TO NEXT SPOT
CTLTAB, OUTBEL /BELL
OUTCR
POUTHT, OUTHT
4044 /$ WITH SIGN BIT ON
OUTFF
OUTVT
OUTLF
ALTTAB, 4033
4033 /ALTMODE WITH SIGN BIT ON
CATS, STA /@ COMMAND - FAKE OUT "IREST"
IREST, DCA QFLG /RESET QUOTED STRING FLAG
TAD CAAM
DCA QUOTE /RESET QUOTE CHAR TO ALTMODE
POPK, POPJ /RETURN
QTST, 0 /SUBROUTINE TO GET A CHAR AND TEST FOR ALTMODE
SCAN
SORT
QUOTE
QTST-QUOTE /RETURN IF QUOTE FOUND
ISZ QTST
JMP I QTST /SKIP-RETURN WITH AC INTACT IF NOT FOUND
/COMMANDS ^U AND E - ALSO ERROR ROUTINE
CTLU, OVRLAY
FOVRLY
CTLUO
PAGE
ERRXX, ERR30+1 /ENTRY POINT ALSO SERVES AS A FLAG FOR "TQMK"
KCC /CLEARS AC
CDF 0 /JUST IN CASE
TAD I ERRXX /GRAB SIGNAL '0' NOW
DCA ERRTMP /BEFORE OVERLAY MIGHT DESTROY IT
OVRLAY /GO TO ERROR OVERLAY
EOVRLY
ERRYY
ERRRET, TAD ERRTMP /GET THE LOCATION AFTER THE CALL
SNA CLA /IF IT'S ZERO AND WE WERE CHAINED TO,
CHOOPS, NOP /ITS A FATAL ERROR - JMP CTLC
FATALJ= JMP I (CTLC
CTRLP, TAD SCANP
CIA
DCA ERRXX /SET ERRXX TO CHAR POSITION OF ERROR CHAR.
KCC /ZAP KEYBOARD FLAG
JMP I (T0 /CONTINUE AS NORMAL UNLESS USER TYPES "?"
CHRE, SCANUP /COMMAND E
DCA TYI
TAD TYI
SORT
EFLST
EFTAB-EFLST
CLA
OVRLAY
FOVRLY
CHRED
ERRTMP, 0 /MUST BE INITIALLY 0
/COMMANDS I AND <TAB>
CHRI, NCHK /I COMMAND
JMP CIL1
TAD N /INSERT CHAR WHOSE VALUE IS N
JMS UPOC
/*** CHECK FOR $
POPJ
CTLI, DCA QFLG /CANNOT BE QUOTED
/ CLA CMA /FOR TAB INSERT
/ TAD SCANP
/ DCA SCANP /BACK UP SCAN POINTER BY ONE
/ /*** THIS IS A BUG
TAD CAHT /TAB
JMS UPOC
CIL1, QSKP /COUNT LENGTH OF INSERTION
DCA DVT1 /ZERO FUDGE USED BY FS COMMAND
CIL2, TAD OSCANP
TAD QBASE
DCA QP /SET UP POINTER TO INSERTION STRING
TAD SCANP
CIA CLL
TAD OSCANP
DCA MQ /STORE CHAR COUNT TO INSERT (-1)
TAD MQ
TAD DVT1 /ADD FS FUDGE
CMA
SNL /DID WE INSERT MORE THAN WE DELETED?
JMP EXPAND /YES - IGNORE SIGN BIT OF COUNT
CIA
PUSHJ
ADJ2 /COMPRESS OUT EXCESS DELETED STUFF
JMP CIL4
CIL3, TAD QP
GETQ /GET A CHAR
DCA TYI
JMS STOREC /STORE A CHARACTER
ISZ QP
CIL4, ISZ MQ
JMP CIL3 /OF INSERTION
JMP I [IREST
STOREC, 0 /STORE CHAR IN "TYI" INTO TEXT BUFFER AT P
CDF 10
TAD I P
AND [7400
TAD TYI
DCA I P
CDF 0
ISZ P
JMP I STOREC
/G COMMAND
CHRG, QREF /G COMMAND - GET Q-REGISTER NUMBER
DCA NFLG
AC3777
AND I QPTR /GET COUNT OF CHARS IN REGISTER
CMA
DCA MQ /SAVE AS TRANSFER COUNT
ISZ CLNF
SKP
JMP COLG4
DCA CLNF
AC3777
AND I QPTR
EXPAND, PUSHJ /COME HERE FROM INSERT LOGIC
ADJ /INCREASE TEXT BUFFER SIZE ( Q-REG LENGTH MAY
JMP CIL4 /BE NEGATIVE) AND GO TRANSFER THE CHARS
TYI, 0 /TELETYPE INPUT
TYI1, KSF /WAIT FOR THE KEYBOARD FLAG
KSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE
CTCCHK /CHECK FOR ^C
KRB /WATCH OUT - AC MAY NOT BE 0!
AND [177
SNA
JMP TYI1 /IGNORE NULL CHARS AND LEADER
SORT
ALTLST
ALTTAB-ALTLST /LOOK FOR NON-STANDARD ALTMODES
AND [177 /IN CASE WE RETURNED A NEGATIVE VALUE
JMP I TYI
UPOC, 0 /MOVE TEXT BUFFER UP ONE CHAR
AND [177
DCA TYI
CLA IAC
PUSHJ
ADJ
JMS STOREC /STORE CHAR IN THE HOLE WE MADE
JMP I UPOC
CUPPER, 0 /FORCE CHARACTER TO UPPER CASE
TAD [-100
SMA /IF ITS >100
AND (37 /REDUCE IT TO BE <140
TAD [100
JMP I CUPPER /RETURN
COLG3, TAD QP
GETQ /GET A CHAR
TYPE
ISZ QP
COLG4, ISZ MQ
JMP COLG3
POPJ
ESCAPE, 0
TAD CAAM /TYPE ESCAPE
PUTT
TAD I ESCAPE
PUTT /TYPE ARGUMENT
JMP I ESCAPE /OK TO RETURN TO ARGUMENT
PAGE
TSAVE, TAD I [QPNTR
SZA CLA /IF WE ARE NOT AT THE BEGINNING OF THE C.L.
RESORT /TREAT THIS LIKE ANY OTHER ^S
MTWO /DROP OFF THE TWO BELLS OR ALTMODES
TAD OCMDLN
ADJQ /SET COMMAND STRING LENGTH TO OLD VALUE
TAD L44
QREF /SET UP POINTERS TO Q-REG Z
ADJQ /KILL CONTENTS OF Q-REG Z
TAD I [QPNTR
DCA I (QPNTR-2
DCA I [QPNTR /DO A QUICK SHUFFLE OF Q-REG LENGTHS
JMP I (TCTLU
CHRQ, QREF /COMMAND Q
CLL
JMP CQOA
CPCS, QREF /COMMAND %
GETN
CQOA, ISZ QPTR /POINT TO VALUE WORD
TAD I QPTR /INCREMENT VALUE BY ARGUMENT
DCA I QPTR
/ADD LINKS
STA
TAD QPTR /GO BACK ONE
DCA QPTR2 /ALSO COMPL LINK
CML RAR
TAD I QPTR2
DCA I QPTR2
TAD I QPTR2
RAL
CLA
TAD I QPTR
JMP I (NCOM /MAKE A NUMBER
TYCRLF, 0 /TYPE A CR AND LF
TAD CACR /CR
XTYPE, TYPE
TAD CALF /LF
TYPE
JMP I TYCRLF /RETURN
QPTR2, 0
CHGT, OVRLAY
QOVRLY
CHGTO
CHLT, OVRLAY
QOVRLY
CHLTO
CCMA, NCHK /COMMAND ,
JMP NERR /NUMBER FLAG NOT SET
TAD NLINK
SZA CLA
ERR26, ERR /NEG ARGUMENT TO ,
ISZ CFLG
SKP
JMP NERR /3 NUMERIC ARGUMENTS
TAD N /MOVE N TO M
CCMA3, DCA M /ENTERED HERE BY "H" COMMAND
DCA N /AND CLEAR N
STA
DCA CFLG /SET COMMA FLAG
POPJ
/RETURNS 13-BIT RESULT IN AC,LINK
NGET, 0 /SUBROUTINE TO GET LAST NUMBER, WITH
NGET1, NCHK /DEFAULT VALUES OF +1 (NO NUMBER),
JMP NGET2 /OR -1 (JUST A MINUS SIGN)
GETNUM
JMP I NGET /DIGITS SEEN - RETURN THEM
NGET2, CLA CLL IAC /NO DIGITS SEEN
PUSHJ /MAKE BELIEVE WE SAW THE DIGIT "1"
NCOM /AND CREATE A NUMBER FROM IT (TAKING ANY
JMP NGET1 /OPERATORS INTO ACCOUNT) AND USE IT
BACKUP, 0
TAD I [QPNTR /SEE IF ANYTHING TO ERASE
SNA CLA
JMP I (T0 /NO, START ALL OVER
STA
TAD I [QPNTR /THEN THE CHARACTER COUNT
ADJQ /REDUCE THE LENGTH OF THE COMMAND REGISTER BY 1
TAD QZ
GETQ /GET THE CHARACTER WE RUBBED OUT
JMP I BACKUP
CHLCMP, 0 /COMPARISON SUBROUTINE
TAD I P /DATA FIELD IS 10
AND [377
CDF 0
SORT
CAFF
LFTAB-CAFF
SPA CLA /LINE TERMINATORS ARE CHANGED TO NEGATIVE NOS.
ISZ CDT /IS COUNT EXHAUSTED?
JMP CHLRET /NO
CHRLI, ISZ P
L44, 44
CDF 0
POPJ
CHRH, PUSHJ /COMMAND H
CCMA3 /SET M=0 AND COMMA FLAG ON AND FALL INTO "Z"
/** COULD CAUSE ERROR ON B AND H IF NFLG SET
CHRZ, TAD ZZ /COMMAND Z
CTLH, /^H COMMAND - TIME OF DAY - NOT IMPLEMENTED
CHRB, JMP I (NCOM14 /COMMAND B
CHLRET, CDF 10
JMP I CHLCMP
EFTAB, IOV
XOV
XOV
XOV
XOV
IOV
IOV
XOV
XOV, OVRLAY
XOVRLY
CHREX
IOV, OVRLAY
IOVRLY
CHRER
/COMMANDS = AND \ DISPATCHER TO OVERLAY
CEQL, OVRLAY
FOVRLY
CEQLO
CBSL, OVRLAY
FOVRLY
CBSLO
ZROSPN, DCA SCANP /RESET TO BEGINNING OF ITERATION
ZRON, DCA NFLG /KILL NUMBER FLAG
JMP I [IREST
PAGE
/ I/O-OVERLAY
/ IOVRLY XOVRLY FOVRLY
/ ER EF EU
/ EB EC ES
/ EW EX ET
/ EG EV
/ EH
/ EO
*3200
IOVRLY, 0
QOVRLC
EOVRLC
XOVRLC
FOVRLC
/SUBROUTINE TO DO LOOKUPS AND ENTERS (LINK CRITICAL ON ENTRY)
OPEN, 0 /CALLED WITH MONITOR CODE - 2 IN AC
DCA RSTSW /ENTER OR LOOKUP
SZL CLA /IF THIS IS THE OUTPUT SIDE OF AN "EB" COMMAND,
JMP DEVLOD /SKIP THE STATEMENT SCAN
QCHK
TAD DSKNAM /PACKED SIXBIT FOR 'DSK:'
DCA DEVC
TAD (72 /RESTORE :
NGOM1, DCA DEVLST+1
NGO, DCA NAME /CLEAR NAME
DCA NAME+1
DCA NAME+2
MTWO
DCA PERDSW
NAMCM1, DCA NAMCNT
NAMEC, QUOTST /GET CHAR AND TEST FOR ALTM
JMP DEVQOT /ALTM - END OF NAME
SORT /NO - CHECK SPECIAL CHARS
DEVLST /([,:,., AND SPACE
DEVTAB-DEVLST
TSTSEP /NO, SEE IF ALPHANUMERIC
ERR08, ERR /ILLEGAL CHAR
TAD NAMCNT
TAD [-10
SMA CLA /MORE THAN 6 CHARS?
JMP NAMEC /YES, IGNORE
TAD NAMCNT /NO, PACK IT
CLL RAR
DCA TEMP1 /*K* NOTE ASSUMPTION NAME STARTS AT LOC 0!
TAD SCHAR
UPPERC /** "UPPERC" ALWAYS COMPLEMENTS LINK
AND [77
SNL
JMP .+4
CLL RTL
RTL
RTL
TAD I TEMP1
DCA I TEMP1
ISZ NAMCNT
JMP NAMEC
PERD, ISZ PERDSW /FOUND A PERIOD
TAD NAME
SNA CLA /ERROR IF WE HAVE
JMP ERR08 /DOUBLE PERIODS OR NO FILE NAME
DCA DEVLST+1 /DEVICE NO LONGER LEGAL
DCA NAME+3 /ZERO EXTENSION OUT
TAD [6 /AND SET POINTER TO 6TH CHARACTER
JMP NAMCM1
COLON, TAD NAME+1
SNA /WE MUST PACK THE NAME INTO ONE WORD OURSELVES
JMP .+5 /BECAUSE IF "OPEN" IS CALLED FROM THE OUTPUT
TAD NAME /SIDE OF AN "EB" COMMAND, WE SKIP
SMA CLA /THE NAME COLLECTOR.(WITH GOOD REASON -
CLL CML RAR /THE USR OVERLAYS THE COMMAND LINE).
TAD NAME+1 /SINCE THE OS/8 "ASSIGN" CALL TO THE USR
TAD NAME /REPLACES THE 2ND NAME WORD WITH THE DEVICE
DCA DEVC /NUMBER, ALL NAME INFO MUST BE HELD IN WORD 1.
JMP NGOM1 /DEVICE NAME STORED - RESET FOR FILE NAME
DEVLST, 56 /.
72 /:
DSKNAM, 5723 /=0423+1300+4000 - SERVES AS LIST TERMINATOR
DEVQOT, ISZ PERDSW /IF WE NEVER SAW A PERIOD,
DCA NAME+3 /WIPE OUT THE EXTENSION
JMS I (GETUSR /BRING USR INTO CORE
DEVLOD, TAD I OPEN /MOVE HANDLER ADDRESS
DCA DEVHND
ISZ OPEN /AND BUMP POINTER
TWO
TAD RSTSW
DCA CODE /ENTER OR LOOKUP
CIF 10 /AND RESET TABLES
JMS I [200
13
RSTSW, 0 /DON'T ZAP OPEN FILES ON INPUT
DCA DEVNO /ZERO SECOND NAME WORD
CIF 10
JMS I [200
1 /ASSIGN HANDLER
DEVC, 0
DEVNO, 0
DEVHND, 0
JMP OPNERR /ERROR - KICK USR OUT FIRST
DCA STBLK
TAD RSTSW /GET LOOKUP-ENTER SWITCH
TAD NAME /IF NAME IS NULL AND THIS IS A LOOKUP,
SNA CLA
JMP OPSUCC /IT JUST SUCCEEDED
TAD DEVNO /DEVICE #
CIF 10
JMS I [200
CODE, 0 /ENTER OR LOOKUP
STBLK, 0 /FILLED WITH STARTING BLOCK
TEMP1,
FLN, 0 /FILLED WITH -LENGTH
/**** CHECK IF AC MUST = 0
JMP OPNERR /ERROR
OPSUCC, TAD DEVHND /HANDLER ADDRESS IN AC
JMP I OPEN
PERDSW, 7777 /FLIP FLOP FOR EXTENSION
NAMCNT, 0 /CHARACTER COUNT
/*** CHECK FOR : (SEE P.26) RETURN VALUE IF FNF, ALSO IF FOUND
OPNERR, TAD RSTSW /WE SHOULD ONLY KILL THE OUTPUT FILE
SNA CLA
JMP .+3 /IF THIS IS AN OUTPUT ERROR
EBERR, TAD ERROR
DCA OUTR
PUSHJ
PECDSM, ECDISM /DISMISS THE USR
ERR16, ERR
0 /*K* TELLS ERR RTN TO EXIT IF WE WERE CHAINED TO
PAGE
CHRER, TAD I (TYI
SORT
ERLST
ERTAB-ERLST
ERR /CAN'T HAPPEN
ERTAB, EBAK /EB
ROPEN /ER
WOPEN /EW
ERLST, 102 /EB
122 /ER
127 /EW
/FILE OPEN COMMMANDS:
EBAK, CLA CMA CLL /"EDIT BACKUP" COMMAND WITH LINK CLEAR
PUSHJ /USE 'ROPEN' TO SET POINTERS
ROPEN /WITHOUT KICKING OUT THE USR (AC=-1 ON ENTRY)
TAD I (DEVNO /DEVICE #
TAD (OSDCBT-1
DCA R
CDF 10
TAD I R /GET DEVICE CODE FROM DCB TABLE
CDF
SMA CLA /NEGATIVE IF FILE-STRUCTURED
JMP I (EBERR /YOU CAN'T DO THAT!
TAD NAME+3 /EXTENSION
TAD (-213
SNA
JMP I (EBERR /CAN'T EB A .BK FILE
TAD DOTBK /RESTORE EXTENSION
DCA R /SAVE IT
TAD DOTBK /.BK EXTENSION
DCA NAME+3
CIF 10
TAD I (DEVNO /DEVICE #
JMS I [200 /DELETE THE OLD BACKUP
4
NAME
0
DOTBK, 213 /WHO CARES IF IT'S NOT THERE?
TAD R /OLD EXTENSION
DCA NAME+3
CLA CLL CML IAC /SET EDIT BACKUP FLAG AND DO AN "ENTER"
/LINK MUST BE SET HERE FOR OPEN
WOPEN, DCA EBFLG /LINK NORMALLY 0 WHEN GOTTEN HERE
CLA IAC /OPEN OUTPUT FILE
JMS I (OPEN /ENTER CODE IN AC
OUHNDL, 4001 /HANDLER ADDRESS
DCA OUTHND /HANDLER ENTRY
TAD I (DEVNO
DCA ODEV /SAVE DEV #
DCA I (OCNT /CLEAR BLOCK COUNT
TAD I (FLN
DCA I (OMAXLN /MAXIMUM FILE LENGTH
TAD NAME
DCA I (OUNAM
TAD NAME+1
DCA I (OUNAM+1
TAD NAME+2
DCA I (OUNAM+2
TAD NAME+3
DCA I (OUNAM+3
TAD (DECPUT
DCA OUTR /ENABLE CHARACTER OUTPUT ROUTINE
TAD (ECDISM
DCA I (DECPUT /FAKE RETURN FROM CHAR I/O ROUTINE
TAD I (STBLK
JMP I (OSETP /SET UP BLOCK NUMBER AND POINTERS
/FILE OPEN ROUTINE
ROPEN, DCA QPTR /ENTERED WITH AC=-1 IF MONITOR IS TO BE KEPT
/ENTERED WITH LINK=0
JMS I (OPEN /LOOKUP CODE IN AC
INHNDL, 7201 /HANDLER ADDRESS
DCA INHND /SAVE HANDLER ENTRY
STA
DCA ICRCNT /POINTER
STA
DCA REND /CLEAR END-OF-FILE FLAG
TAD I (STBLK
DCA I (IBLK /FIRST BLOCK
TAD I (FLN
DCA INRCNT /SET UP INPUT FILE LENGTH
ISZ QPTR /SHOULD WE DISMISS THE MONITOR?
JMP I (ECDISM /YES - KICK THE USR OUT AND POPJ
JMP I [IREST /EXIT
DEVTAB, PERD /.
COLON /:
PAGE
NORMAL, TAD ODEV /CLOSE FILE
CIF 10
JMS I [200
4
OUNAM
OCNT, 0 /NUMBER OF BLOCKS
HLT
TAD ERROR /RESET OUTPUT SUBROUTINE POINTER
DCA OUTR /TO ERROR
ECDISM, CIF 10 /DISMISS OS/8 USR ROUTINE
JMS I [200
11 /KICK USR OUT
JMP I [IREST
/*** REALLY SHOULD BREAK UP INTO 2 ROUTINES
SCHSRT, 0 /SORT LETTERS AND NUMBERS
UPPERC /CONVERT TO UPPER CASE TO REDUCE CASES
CLL /THE LINK WILL ALTERNATE EACH TIME
TAD [-60 /WE ADD ONE OF OUR NEGATIVE CONSTANTS.
SMA /THE LINK AT THE END WILL TELL WHETHER
TAD [-12 /THE CHARACTER WAS ALPHANUMERIC
SMA /(I.E. BETWEEN 60-71,101-132 OR 140-172)
TAD M7 /OR A SEPARATOR CHARACTER.
SMA
TAD (-32
SZL CLA /WAS IT ALPHANUMERIC?
ISZ SCHSRT /YES
JMP I SCHSRT /SKIP RETURN IF ALPHANUMERIC
RT, 0 /ROUTINE TO PACK THIRD CHAR INTO OUTPUT BUFFER
CLL RTL
RTL
DCA DM /CALLED TWICE - FIRST TIME WITH CHAR IN AC,
TAD DM /SECOND TIME WITH "DM" IN AC
AND [7400
TAD I OPTR2
DCA I OPTR2
ISZ OPTR2
JMP I RT
DVIMQL, 0 /FAKE MQL DVI
DCA DVT1 /STORE DIVIDEND
DCA MQ /INITIALIZE QUOTIENT
DV1, TAD I DVIMQL /GET DIVISOR
CIA
CLL /SET UP TO TAKE IMMEDIATE EXIT ON ZERODIVIDE
TAD DVT1 /SUBTRACT DIVISOR FROM DIVIDEND
SNL /OVERFLOWED YET?
JMP DV7200 /YES
DCA DVT1 /NO - STORE IT BACK
ISZ MQ /BUMP QUOTIENT
JMP DV1 /AND LOOP
DV7200, CLA
TAD MQ
ISZ DVIMQL /SKIP PAST DIVISOR
JMP I DVIMQL /RETURN WITH QUOTIENT IN AC
/SEARCH STRING MODIFIERS:
SCHLST, 16 /^N - ANYTHING BUT
21 /^Q - LITERALLY
23 /^S - ANY SEPARATOR
30 /^X - ANYTHING
M7, -7
DECPUT, 0 /DEVICE INDEPENDENT I/O
TAD [200 /ADD ON PARITY BIT
ISZ O3 /3RD CHAR OF 3?
JMP O2 /NO
JMS RT /YES, SPECIAL HANDLING
TAD DM /TEMP STORAGE
JMS RT
SETO3, MTHREE /RESET SWITCH
DCA O3
ISZ OCRCNT /END OF BUFFER?
JMP I DECPUT /NO
JMS FITS /CHECK FOR OUTPUT OVERFLOW
JMP OERR /YUP
DCA OCNT /NO - UPDATE OUTPUT COUNT
JMS I OUTHND /OUTPUT THE BUFFER
OUCTRL, 4400
BUFOUT, OUT
OBLK, 0
JMP OERR
TAD OBLK
TAD INRSIZ /BUMP THE OUTPUT RECORD NUMBER BY THE MAXIMUM
OSETP, DCA OBLK /SINCE ALL WRITES EXCEPT THE LAST ARE MAXIMAL
TAD BUFOUT /BUFFER POINTERS
DCA OPTR1
TAD BUFOUT
DCA OPTR2
TAD OUTSIZ
DCA OCRCNT /DOUBLEWORD COUNT (7377 IF 8K, 6777 IF 12K)
JMP SETO3 /SET BYTE COUNTER AND RETURN
OERR, CLA
TAD ERROR
DCA OUTR /INHIBIT FUTURE OUTPUT
ERR14, ERR
O2, DCA I OPTR1 /NORMAL HANDLING
ISZ OPTR1 /BUMP POINTER
JMP I DECPUT
OPTR1, 0
OMAXLN, 0 /SIZE OF HOLE FOR OUTPUT
OUTSIZ, 7377 /6777
O3, 0
FITS, 0 /SUBROUTINE TO CHECK FOR OUTPUT OVERFLOW
TAD OPTR1 /** AC MAY CONTAIN FUDGE ON INPUT **
CIA
TAD BUFOUT /COMPUTE NUMBER OF WORDS IN BUFFER
AND [7400 /ROUND "UP" TO NEXT BUFFERLOAD
CIA /MAKE POSITIVE
CLL CML RAR
DCA OUCTRL /AND SAVE IT AS A BUFFER CONTROL WORD
TAD OUCTRL
CLL RAL
CLL RTL /ISOLATE THE BLOCK COUNT OF THE CONTROL WORD
RTL /IN THE LOW ORDER PART OF THE AC
RAL
TAD OCNT /ADD IT TO THE CURRENT OUTPUT COUNT
CLL CML
TAD OMAXLN /SEE THAT WE DIDN'T OVERFLOW
SNL SZA /THE ASSIGNED OUTPUT AREA
JMP I FITS /OOPS - WE DID - ERROR RETURN
CIA
TAD OMAXLN /SUBTRACT OFF THE LIMIT
CIA /TO ARRIVE AT THE UPDATED BLOCK COUNT
ISZ FITS
JMP I FITS /AND SKIP RETURN
OUNAM, ZBLOCK 4 /NAME OF OPEN OUTPUT FILE GOES HERE
PAGE
/DISPLAY ROUTINE FOR PDP-12 SCOPE
WASTE, 0 /** MUST BE AT MULTIPLE OF 2000
XPOS, 0 /PDP-12 BETA REGISTER 1
BETA2, 0 /PDP-12 BETA REGISTER 2
DSPLAY, 0 /TEXT DISPLAY ROUTINE FOR TECO
MTHREE /THIS ROUTINE DEPENDS ON THE FACT THAT THE
TAD DSPLAY /HIGH ORDER BITS OF THE X-COORD ARE IGNORED
DCA DX /BY THE VR12 HARDWARE
TAD I DX /GET THE SKIP
DCA DLPTST /PUT IT IN THE LOOP
TAD P
DCA DX
TAD NUMLNS
STL CIA /LOOK BACKWARD
PUSHJ /FOR BEGINNING OF DISPLAY AREA
CHRL1
D360, STA STL /=7360
TAD P
DCA DM
TAD DX
DCA P /RESTORE POSITION
TAD NUMLNS /NOW SCAN FORWARD
CLL IAC
PUSHJ /FOR THE END OF THE DISPLAY AREA
CHRL1
TAD P
CIA
TAD DM
DCA R /*K* THIS NUMBER MUST GO IN R -
TAD DX /THE ^W COMMAND NEEDS IT THERE
DCA P /RESTORE ORIGINAL P
DSETUP, TAD P
CIA
TAD DM
DCA DQ /SAVE COUNT OF CHARS TO CURSOR POSITION
TAD DM
DCA DX
TAD R
DCA DR
TAD D360
DCA YPOS
DISCR, TAD DISLF
SETXPS, DCA XPOS /SET X POSITION/COLUMN COUNTER
JMP DLPTST
/DISPLAY LOOP
DGETCH, CDF 10
TAD I DX
CDF 0 /GET THE CHARACTER FROM FIELD 1
AND [177 /AND OFF THE HIGH ORDER BITS
TAD (-33
SNA /CHANGE ALTMODES
TAD CAHT /TO DOLLAR SIGNS
TAD (-5
SMA SZA /IF NOT A CONTXRACTER
JMP DLOOP /DISPLAY IT AND KEEP GOING
SNA
JMP DBLANK /DO BLANKS FAST
TAD (40-15
SNA /CR?
JMP DISCR /YES - RESET X COORD
STL
TAD [4
SNA /TAB?
JMP DTABB
SNL
JMP DISLF /LINE FEED, VERTICAL TAB, OR FORM FEED
TAD (51 /ORDINARY CONTROL CHAR - RESTORE IT + 40
DCA WASTE /SAVE CHAR
JMS DISCHR /DISPLAY ^
TAD WASTE /NOW DISPLAY ALTERED CHAR
DLOOP, JMS DISCHR
DLPTST, HLT /EITHER KSF OR TSF OR "ISZ R"
SKP
JMP I DSPLAY /EXIT IMMEDIATELY IF TEST SKIPS
ISZ DQ /ARE WE AT THE CURRENT POINTER POSITION?
JMP TSTEDS /NO
TAD (-5
TAD XPOS
DCA XPOS /BACK UP X POSITION A HALF-CHARACTER
TAD DM20
TAD YPOS
6141 /ENTER LINC MODE
DM20, 1760 /DSC I
2000
1760 /DISPLAY A ^
2076
0002 /PDP
MTHREE /AND MOVE X POSITION BACK TO WHERE IT WAS
JMP DBLANK+1
TSTEDS, ISZ DR /ARE WE THROUGH?
JMP DGETCH /NO
JMP DSETUP /YES - START OVER
DTABB, TAD XPOS /DISPLAY TAB
CMA
AND Z7
DCA WASTE /GET NUMBER OF COLUMNS TO GO (-1)
TAD WASTE
CLL RTL
RAL
TAD WASTE /MULTIPLY BY 9
DBLANK, TAD CAHT /BUMP ONE MORE COLUMN
TAD XPOS
SZA /OVERFLOW?
JMP SETXPS /NO - SET XPOS AND CONTINUE
JMP LINOFL /YES - GO TO THE NEXT LINE
/SUBROUTINE TO DISPLAY A CHARACTER
DISCHR, DLPTST /*K* DISCHR MUST CONTAIN "DLPTST" WHEN WE
CLL RAL /ARE EXAMINING CHARACTERS **
TAD (DTABLE-1
DCA BETA2 /STORE ADDRESS OF TABLE ENTRY FOR CHAR -1
TAD YPOS
6141 /ENTER LINC MODE
1762 /DSC I 2
1762 /DSC I 2
0002 /RE-ENTER PDP-8 MODE
CLA
ISZ XPOS /BUMP THE X COORDINATE/COLUMN COUNTER
JMP I DISCHR /RETURN
LINOFL, TAD (7054 /INDENT ALL CONTINUATION LINES
DCA XPOS
DISLF, RAR /*K* RAR=7010 AC MAY HAVE A SMALL NUMBER
TAD YPOS /IN IT HERE - THATS OK AS LONG AS ITS SMALL,
TAD [-40 /SINCE ONLY THE HIGH 8 BITS OF YPOS COUNT.
DCA YPOS
JMP I DISCHR /*K* THIS ALWAYS RETURNS TO DLPTST **
YPOS= NAME /USE SOME FREE PAGE ZERO LOCATIONS
DR= NAME+1 /FOR OUR TEMPORARIES
DQ= NAME+2
DM= NAME+3
PAGE
DTABLE, 2000;2076; 7500;0000; 7000;0070; 7714;1477
5721;4671; 6661;4333; 5166;0526; 0000;0070
3600;0041; 4100;0036; 2050;0050; 0404;0437
0500;0006; 0404;0404; 0001;0000; 0601;4030
4536;3651; 2101;0177; 4523;2151; 4122;2651
2414;0477; 5172;0651; 1506;4225; 4443;6050
5126;2651; 5122;3651; 2200;0000; 4601;0000
1000;4224; 1212;1212; 2442;0010; 4020;2055
4077;5751; 4477;7744; 5177;2651; 4136;2241
4177;3641; 4577;4145; 4477;4044; 4136;2645
1077;7710; 7741;0041; 4142;4076; 1077;4324
0177;0301; 3077;7730; 3077;7706; 4177;7741
4477;3044; 4276;0376; 4477;3146; 5121;4651
4040;4077; 0177;7701; 0176;7402; 0677;7701
1463;6314; 0770;7007; 4543;6151; 4177;0000
3040;0106; 0000;7741; 2000;2076; 1604;0404
STABLE, ZBLOCK 40 /SEARCH BUFFER
CTLW, NCHK /^W COMMAND - IF THERE WAS A NUMBER BEFORE
JMP CTLW2 /THE ^W, SET THE NUMBER OF LINES TO DISPLAY
TAD N /EQUAL TO THAT NUMBER.
DCA NUMLNS
/DON'T WORRY ABOUT NEGATIVE N
CTLW2, ISZ R /FAKE OUT! (MUST BE BEFORE CALL TO DISPLY)
DISPLY /IN ANY CASE, GO THROUGH ONE DISPLAY CYCLE
POPJ /THEN RETURN
SAVTRA, 0 /SAVE TRACE MODE
TAD TFLG
DCA TFGTMP
DCA TFLG
JMP I SAVTRA /EXIT WITH TRACE OFF
RESTRA, 0 /RESTORE TRACE MODE
TAD TFGTMP
DCA TFLG
JMP I RESTRA
TFGTMP, 0
CHKQF, 0 /CHECK FOR EXPLICIT QUOTES
ISZ QFLG /QUOTE FLAG SET?
JMP .+3 /NO
SCAN /GET QUOTING CHAR
DCA QUOTE /PUT INTO SEARCH TABLE
DCA QFLG /ZAP QUOTE FLAG
JMP I CHKQF /RETURN
NXTBUF, 0
SZA CLA
JMP NOWRIT /READ-ONLY IF AC NOT 0 ON ENTRY
PUSHJ
CPOC /HP
DCA ZZ /FORCE Y TO WORK
ISZ FFFLAG /IF WE DIDN'T SEE A FORM FEED ON INPUT
JMP NOWRIT /DON'T OUTPUT ONE
TAD CAFF
OUTPUT
NOWRIT, PUSHJ
CHRY /READ NEW BUFFER
CTCCHK /CHECK FOR ^C AND ^P
CLA /*K* CTCCHK LEAVES AC NON-ZERO!
JMP I NXTBUF
GETUSR, 0 /ROUTINE TO LOCK THE USR INTO CORE
CDF 0
TAD ZZ /IF THE TEXT BUFFER IS EMPTY AND
SNA CLA /WE HAVE 12K, SO Q-REGS ARE IN FIELD 2,
NWRUSR, NOP /(CHANGED BY INIT CODE TO "TAD [4" IF 12K)
STL RTR /THEN WE SHOULD NOT SAVE CORE ON A USR CALL.
DCA I (JSBITS /THIS STORES A 2000 OR A 2001
CIF 10
JMS I [7700 /OK - NOW LOAD THE USR IN
10
JMP I GETUSR
/E COMMAND MODIFIERS
EFLST, 102 /EB I
103 /EC X
106 /EF X
107 /EG X
113 /EK X
122 /ER I
127 /EW I
130 /EX I
CHRU, QREF /COMMAND U
NCHK
ERR22, ERR /U MUST BE PRECEDED BY A NUMBER
TAD NLINK
CLL RTR
DCA NLINK
AC3777
AND I QPTR
TAD NLINK
DCA I QPTR
ISZ QPTR
TAD N
DCA I QPTR
POPJ
/RADIX TABLES:
ORAD, NOP
1000
100
10
DRAD, NP&177+1200 /"TAD NP"
1750
144
12
/DISPATCH TABLE FOR COMMAND INPUT
COMTAB, TBEL /^G
TCRLF /CR
RUBY, ROCMND /RUBOUT
TCTLU /^U
TALTM /ALTMODE
TQMK /?
TSAVE /^S
TSTAR /*
TSPACE /SPACE
EDFLAG, 0 /MUST BE KEPT TOGETHER
EHFLAG, 0
EOFLAG, VERSN
ESFLAG, 0
ETFLAG, 0
EUFLAG, 0
/CXFLAG, 0
PAGE
/COMMAND M
/AND Q-REGISTER STORAGE
COMLST, 7 /^G, COMMAND LINE EDIT LIST
15 /CR, INSERT CR & LF
177 /RUBOUT
25 /^U - RUB OUT LINE
33 /^[, ALT MODE
77 /?
23 /^S - SAVE OLD COMMAND LINE IN Q-REG Z
52 /*
40 /SPACE
CHRM, QREF /COMMAND M
TAD M4 /4 ITEMS PUSHED TO
PUSHL /SAVE CURRENT MACRO STATE
QCMND
MPDL
ITRST /SO THE "O" COMMAND WILL WORK IN MACROS
SCANP /ZEROED BY "PUSHL"
TAD PDLP /MUST CHECK PDL AT END OF MACRO
CIA
DCA MPDL
TAD QNMBR /Q-REGISTER TO EXECUTE
SETCMD /SET COMMAND LINE TO THIS Q-REG
POPJ /LEAVE NUMBER FLAG ALONE AND EXIT
CHKBZ, 0 /SEE THAT B .LE. C(AC) .LE. ZZ
SZL
JMP ERR11 /POP
CIA /ENTERED WITH LINK SET CORRECTLY
TAD ZZ
SNL /13-BIT ARITHMETIC
ERR11, ERR /C(AC)>ZZ
CIA
TAD ZZ /RESTORE ORIGINAL AC
JMP I CHKBZ
ALTLST, 175 /ALT MODE
176 /ANOTHER ALTMODE
M4, -4
SCUPPR, 0 /SCAN AND CONVERT TO UPPER CASE
SCAN
UPPERC
JMP I SCUPPR /THAT'S ALL?
/Q-REGISTER STORAGE - EACH Q-REGISTER TAKES 2 WORDS.
/WD 1 CONTAINS THE LENGTH OF THE CHARACTER PART OF THE REGISTER (IF ANY)
/WD 2 CONTAINS THE VALUE OF THE NUMERIC PART OF THE REGISTER (IF ANY)
QARRAY, ZBLOCK 110 /36 Q-REGISTERS * 2 WORDS/REGISTER = 72 WORDS
QPNTR, CHNSTR /FAKE Q-REGISTER FOR INPUT LINE - LENGTH ONLY.
CTLT, NCHK
JMP CTLT2 /NO ARG
TAD N
ET1, TYPE /TYPE CHAR REPRESENTED BY ARGUMENT
POPJ
CTLT2, LISTEN /^T COMMAND - VALUE OF NEXT CHAR FROM TTY
ET8, TYPE /*ET ECHO THE CHARACTER
TAD SCHAR /GET THE CHARACTER
JMP I (NCOM14 /JUMP INTO NUMBER PROCESSOR
CTLE, TAD FFFLAG /^E COMMAND - RETURNS FORM FEED FLAG
NNEW13, CLL
SPA
STL /EXTEND SIGN BIT TO LINK
JMP I (NCOM /RETURN -1 IF F.F., 0 OTHERWISE
PAGE
*5000
/COMMAND DISPATCH TABLE ** ALLOW EVEN/ODD FOR NOVICE SUBSET?
CDSP, POPK;CTLA;SERR;CTLC;CTLD;CTLE;CTLF;CTLC /0-7
CTLH;CTLI;POPK;SERR;POPK;POPK;CTLN;CTLO /10-17
T0;SERR;SERR;SERR;CTLT;CTLU;ERR35;ERR27 /20-27
SERR;SERR;SERR;ZRON;SERR;SERR;CTUA;SERR /30-37
POPK;CEXP;CDBQ;CNBS;SERR;CPCS;CAMP;ZRON /40-47
COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR /50-57
NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR /60-67
NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM /70-77
CATS;CHRA;CHRB;CHRC;CHRD;CHRE;CHRF;CHRG /100-107
CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO /110-117
CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;SERR;SERR /120-127
CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA /130-137
/END OF DISPATCH TABLE
PDLBEG, ZBLOCK 11 /BEGINNING OF PUSHDOWN LIST
QPUT12, ZBLOCK 16 /ROUTINES INSERTED LATER - USED IN
ASR35, ZBLOCK 10 /INITIALIZATION, OVERLAYED BY PUSHDOWN LIST
PDLEND, 0 /END OF PUSHDOWN LIST
PAGE
*5200
/ INITIALIZATION SECTION
/ ENTER HERE AT 5200 TO MODIFY TECO TO USE A MODEL 35 TELETYPE
/ SORRY - NO CURRENT PAGE LITERALS
TECO35, ISZ JTECO /IF CALLED VIA "R" OR "RUN"
TAD I XR /MOVE ASR-35 PATCH (WHICH OUTPUTS TABS AND
DCA I INXR / FORM FEEDS) OVER PRINT ROUTINE
ISZ ASRCNT
JMP .-3
TAD YOUTHTX
DCA I YPOUTHT
TAD [TECO
DCA I Y7745 /CHANGE STARTING ADDRESS IN CASE WE'RE RESTARTED
/AND FALL INTO INITIALIZATION ROUTINE
TCINIT, TLS /INITIALIZATION ROUTINE - INITIALIZE THE TTY
TAD .-1
DCA I [TECO
TAD YT0A /"JMP T0A"
DCA I PTECO1 /CHANGE THE ENTRY AT 200 SO WE'RE NOT CALLED AGAIN
CLA STL
6141 /ENTER LINC MODE (MAYBE)
4 /ESF - SET SMALL CHARACTERS FOR SCOPE
0261 /ROL I 1 - ROTATE LINK INTO AC11
0002 /BACK TO PDP-8 MODE
SNA CLA /AC NON-ZERO IF WE ARE A PDP-12
JMP NOTA12 /NO, JUST AN ORDINARY 8
TAD YPDP12
JMS CHANGE /TRADE OFF TWO PAGE HANDLERS FOR A SCOPE
NOTA12, TAD I Y7777
AND COR70
SZA
JMP SOFCOR
COR0, CDF 0 /NEEDED FOR PDP-8L
TAD CORSIZ /GET FIELD TO TEST
RTL
RAL
AND COR70 /MASK USEFUL BITS
TAD COREX
DCA .+1 /SET UP CDF TO FIELD
COR1, CDF /N /N IS FIELD TO TEST
TAD I CORLOC /SAVE CURRENT CONTENTS
COR2, NOP /HACK FOR PDP-8!
DCA COR1
TAD COR2 /7000 IS A "GOOD" PATTERN
DCA I CORLOC
COR70, 70 /HACK FOR PDP-8, NOP
TAD I CORLOC /TRY TO READ BACK 7000
CORX, 7400 /HACK FOR PDP-8, NOP
TAD CORX /GUARD AGAINST WRAP-AROUND
TAD CORV /TAD (1400
SZA CLA
JMP COREX /NON-EXISTENT FIELD EXIT
TAD COR1 /RESTORE CONTENTS DESTROYED
DCA I CORLOC
ISZ CORSIZ /TRY NEXT HIGHER FIELD
JMP COR0
COREX, CDF 0 /LEAVE WITH DATA FIELD 0
STA
TAD CORSIZ /HIGHEST EXISTING FIELD
COR999, DCA MEMSIZ
TAD MEMSIZ
SNA CLA
JMP JTECOM /8K
TAD YM7 /MORE THAN 8K
JMS I YMOVE
CDF 0
QPUT12-1
CDF 0
QPUTS-1
TAD YM7
JMS I YMOVE
CDF 0
QPUT12+7-1
CDF 0
GETQX-1
TAD YTWLVEK
JMS CHANGE /AND CHANGE A WHOLE MESS OF LOCATIONS
JTECOM, JMS I YOVINIT /WRITE OUT OVERLAYS
CDF 10
TAD I YSCPBIT
CDF 0
AND [200
SNA CLA
JMP JTECO
TAD YSCOPE
JMS CHANGE
JTECO, JMP I .+1 /INCREMENTED IF WE WERE'NT CHAINED TO
CHINIL
PTECO1, TECO1
CORLOC, CORX /ADDRESS TO TEST IN EACH FIELD
CORV, 1400 /7000+7400+1400=0
CORSIZ, 1 /CURRENT FIELD TO TEST
SOFCOR, CLL RAR
RTR
JMP COR999
/CHAINED INIT CODE - MOVE 17600 INTO Q-REGISTER SPACE
CHINIL, CDF 10
TAD I DX /GET A COMMAND LINE CHAR
CDF 0
QPUT
ISZ INICT
JMP CHINIL
TAD YFATALJ /SET UP THE FATAL ERROR EXIT
DCA I YCHOOPS /IN THE ERROR ROUTINE
JMP I YCHTECO
INICT, -CHNSTR
ASRCNT,
CHANGE, -10 /ROUTINE TO CHANGE SPECIFIC LOCATIONS
DCA XR /STORE TABLE POINTER
CHANGL, TAD I XR /GET LOCATION
SNA
JMP I CHANGE /END OF LIST - RETURN
DCA TEMPT
TAD I XR /GET CONTENTS
DCA I TEMPT /ZAP!
JMP CHANGL
/CHECK FOR OS/8 SCOPE BIT, IF ON, PATCH TECO
/ALSO SEND ESC SEQ TO TERMINAL TO SEE IF VT05 OR VT5X.
YOUTHTX, OUTHTX
YPOUTHT,POUTHT
Y7745, 7745
Y7777, 7777
YM7, -7
YMOVE, MOVE
YOVINIT,OVINIT
YSCPBIT,SCPBIT
YFATALJ,FATALJ
YCHOOPS,CHOOPS
YCHTECO,CHTECO
YPDP12, PDP12-1
YTWLVEK,TWLVEK-1
YSCOPE, SCOPE-1
YT0A, T0A&177+5200
/FLOW INTO NEXT PAGE
SCOPE, RUBY; SCOPY /MAKE SCOPE RUBOUTS WORK
BLSP1; TAD CACR /MAKE BELL SPACE WORK
BLSP2; TYPE /AND MORE RUBOUTS
BLSP3; SCAPE&177+4600 /JMS I (ESCAPE
BLSP4; 113 /MORE BELL SPACE
EUFLAG; -1 /SET EU TO -1
EU1; CLA
EU2; TAD [40
0
/LOCATIONS TO CHANGE MUST BE CHANGED IN OVERLAY IMAGE
/BEFORE OVERLAY IS WRITTEN OUT
/LOCATIONS TO CHANGE IF WE HAVE 12K OF CORE
TWLVEK, INRSIZ; 4 /INPUT BUFFER GROWS TO 4 BLOCKS LONG
INCTLW; 1021 /AND LIVES IN FIELD 2
INPCNT; 5000
I2; CDF 20
IC; CDF 0 /THIS WAS A NOP TO SPEED UP RTS-8 OPERATION
L12K1; J12K1 /SPEED UP TEXT MOVE ROUTINES,
L12K2; J12K2 /SINCE Q-REGISTERS DON'T SIT ON TOP OF TEXT.
OUTSIZ; 6777 /OUTPUT BUFFER TAKES OVER OLD INPUT BUFFER SPACE
BUFIN; 5600
NWRUSR; TAD [4 /LET USR BE CALLED WITHOUT SAVING CORE
MQMAX; -Q12MAX /ALLOW MORE Q-REGISTER STORAGE
QLIMIT; 12-Q12MAX
0
/LOCATIONS TO CHANGE IF WE'RE RUNNING ON A PDP-12
PDP12, KSFWT; DISPLY /FIX KEYBOARD AND PRINTER WAITS
TSFWT; DISPLY /SO THEY DISPLAY WHILE WAITING
CDSP+127;CTLW /ENABLE W COMMAND
INHNDL; 7200 /ONE PAGE INPUT HANDLER ONLY
OUHNDL; 7400 /DITTO OUTPUT HANDLER
/VALUE MUST BE 0 INITIALLY TO END LIST
OVINIT, 0 /WRITE OUT OVERLAYS
/IF MORE THAN 12K, MOVE OVERLAYS TO FIELD 3
MTHREE
TAD MEMSIZ
SPA CLA
JMP L16K /LESS THAN 16K
TAD [-400
JMS MOVE
CDF 0
3200-1
CDF 30
MEMLOC-1
TAD M2000
JMS MOVE
CDF 0
5600-1
CDF 30
MEMLOC+400-1
TAD M5
JMS MOVE
CDF 10
NEWERR-1
CDF 0
OVREAD-1
/ TAD (COREAD-COREND-1
TAD M3000
JMS MOVE
CDF 10
4400-1 / COREAD-1
CDF 30
4400-1
JMP G16K
L16K, JMS I (7607
4200
3200 /WRITE OUT I/O-OVERLAY
IOVRLC
JMP OVERR /ERROR WRITING OVERLAY
M3000, JMS I (7607
5400 /4 OVERLAYS
5600 /WRITE OUT Q-OVERLAY AND E-OVERLAY
QOVRLC
JMP OVERR /ERROR WRITING OUT OVERLAY
G16K, DCA I (ERRXX
JMP I OVINIT /RETURN
OVERR, TAD [-400 /SWAP IN ERROR OVERLAY FROM CORE AND MAKE SURE
JMS MOVE /WE RETURN TO MONITOR
CDF 0
6200-1
CDF 0
3200-1
/ DCA I (ERRTMP /SET FATAL SWITCH
TAD (FATALJ
DCA I (CHOOPS
ERR30, JMP I (ERRYY /CALL ERROR MESSAGE PROCESSOR
M2000, -2000
M5, -5
MOVE, 0
DCA MQ
TAD I MOVE
DCA MOVEL
ISZ MOVE
TAD I MOVE
DCA INXR
ISZ MOVE
TAD I MOVE
DCA MOVEC
ISZ MOVE
TAD I MOVE
DCA XR
ISZ MOVE
MOVEL, HLT
TAD I INXR
MOVEC, HLT
DCA I XR
CDF 0
ISZ MQ
JMP MOVEL
JMP I MOVE
/ROUTINES TO BE (POSSIBLY) SWAPPED INTO TECO
*QPUT12
RELOC QPUTS
QPUTS, 0 /12K Q-REGISTER PUT ROUTINE
AND [377
CDF 20
DCA I QP
CDF 0
ISZ QP
JMP I QPUTS
RELOC GETQX
GETQX, 0 /12K Q-REGISTER GET ROUTINE
DCA CHKCTC
CDF 20
TAD I CHKCTC
CDF 0
AND [377
JMP I GETQX
RELOC ASR33
JMP OUTCMX / FORM FEED/VERT. TAB - USE 8/4 FILLERS
OUTHTX, TAD COLCT /GET COLUMN COUNTER
RTR
RAR
CLA CMA RAL /OUTPUT 2 FILLERS IF MORE THAN 4 CHARS TO TAB
DCA COLCT /OTHERWISE 1 (COLCT IS A MODULO 8 COUNTER)
OUTCMX, TAD SCHAR /GET CONTROL CHAR TO TYPE
PUTT /AND TYPE IT - WE WILL NOW FILL WITH NULLS
RELOC
PAGE
/ Q-OVERLAY
*5600
RELOC 3200
IOVRLC
QOVRLY, 0
EOVRLC
XOVRLC
FOVRLC
/O COMMAND
CHROO, TAD SCANP /O COMMAND
DCA COOQ /SAVE CURRENT SCAN POINTER
DCA NFLG
/??? DCA QFLG /QUOTED "O" COMMAND NOT ALLOWED
QSKP /CHECK THAT THERE IS REALLY A STRING HERE
/BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS
/FROM THIS STRING IN THE SEARCH LOOP.
TAD ITRST /"O" ONLY SCANS FROM THE BEGINNING OF THE
DCA SCANP /CURRENT ITERATION LOOP.
/(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN)
SKPSET
CS41, 41 /SEARCH FOR !
TAD CS41
DCA QUOTE /SET QUOTE CHAR TO !
TAD COOQ
TAD QBASE
DCA QP /SET UP PTR TO ACCESS GOTO STRING
COOC, TAD QP
GETQ /GET CHAR FROM GOTO STRING
CIA
DCA MQ /SAVE IT
QUOTST /GET CHAR FROM LABEL
JMP COOB /LABEL EXHAUSTED
TAD MQ
SZA CLA /MATCH?
JMP CSMQ /NO - REJOIN SEARCH ROUTINE FOR ANOTHER !
ISZ QP
JMP COOC
COOB, TAD MQ
TAD CAAM /IS GOTO STRING EXHAUSTED TOO?
SZA CLA
JMP CSMQ+1 /NO - REJOIN ! SEARCH ROUTINE
ENTRCE /RE-ENABLE TRACE
JMP I [IREST
COOQ, 0
/ROUTINE TO SKIP COMMANDS UP TO A CHARACTER
SETSKP, 0 /SET UP TO SKIP COMMANDS
TAD I SETSKP
DCA SKPLST /CHAR TO TRAP ON
NOTRCE /DISABLE TRACE MODE
CSML1, DCA BRACKS /INITIALIZE BRACKET LEVEL
CSML, SCANUP /GET A COMMAND CHAR
SORT
SKPLST
SKPTAB-SKPLST
JMP CSML /NOTHING SPECIAL - KEEP GOING
CSMD, SCAN /CLEAR OUT MODIFIER
JMP CSML
CSMU, SCAN /SKIP ^U COMMAND
SKP CLA /GET RID OF Q-REG NUMBER
CSMFS, QSKP /FS COMMAND - SKIP FIRST STRING
CSMQ, QSKP /SKIP OVER A QUOTED STRING
CSMQ1, PUSHJ
IREST /FIX UP QUOTE CHAR
JMP CSML /KEEP GOING
CSMY, TAD SCHAR /SKIP ROUTINE FOR ^A AND !
DCA QUOTE /WE MUST SCAN UNTIL WE FIND
JMP CSMQ /A COPY OF THE COMMAND CHARACTER.
/SORT LIST FOR " COMMAND
CNDLST, 103 /C
107 /G
116 /N
114 /L
105 /E
124 /T
123 /S
106 /F
125 /U
122 /R
74 /<
76 />
CSME, SCANUP /FOUND E COMMAND
SORT
ESKLST /LOOK FOR ER & EW & EG
ESKTAB-ESKLST /USE CSMQ TO SKIP
JMP CSML /NO STRING
CSMF, SCAN /F COMMAND - BETTER BE FOLLOWED BY S,N, OR _
CLA
JMP CSMFS /SCAN OFF TWO STRINGS
CSMI, ISZ BRACKS /INCREMENT BRACKET LEVEL
JMP CSML
CSMO, STA
TAD BRACKS /DECREMENT BRACKET LEVEL
SPA
JMS I (POPITR /IF WE EXIT <> POP OFF ITERATION VALUES
JMP CSML1
SKPRTN, TAD BRACKS /WE HAVE FOUND THE DESIRED CHARACTER
SZA CLA /BUT IF THE BRACKET LEVEL IS NON-ZERO,
JMP I XSORTA1 /WE CANNOT ACCEPT IT - KEEP SORTING
JMP I SETSKP /EVERYTHING IS OK - RETURN
BRACKS, 0
/SORT LIST FOR SKIPPING OVER COMMANDS
SKPLST, 0 /TRAP CHAR
41 /!
76 />
74 /<
42 /"
136 /^
100 /@
1 /^A
11 /TAB
25 /^U
36 /^^
105 /E
106 /F
111 /I
116 /N
117 /O
123 /S
137 /_
121 /Q
125 /U
130 /X
107 /G
115 /M
45 /%
/ SKIP LIST FOR E'S
ESKLST, 122 /R
127 /W
102 /B
107 /G
CSMA, STA /LIST TERMINATOR
JMP CSMQ1 /FOUND @ - SET QUOTE FLAG AND CONTINUE
XSORTA1,SORTA1
PAGE
/DISPATCH TABLE FOR SKIPPING OVER COMMANDS:
SKPTAB, SKPRTN /DESIRED CHARACTER - RETURN
CSMY /!
CSMO />
CSMI /<
CNDI /"
CSMC /^
CSMA /@
CSMY /^A
CSMQ /TAB
CSMU /^U
CSMD /^^
CSME /E
CSMF /F
ESKTAB, CSMQ /I OR ER
CSMQ /N OR EW
CSMQ /O OR EB
CSMQ /S OR EG
CSMQ /_
CSMD /Q
CSMD /U
CSMD /X
CSMD /G
CSMD /M
CSMD /%
SEMO, SKPSET /PLOD THRU
76 /LOOKING FOR >
ENTRCE /IT'S THE RIGHT ONE, TURN TRACE BACK ON
JMP I ZCGSG
ZCGSG, CGSG
CNDTAB, TSTSEP /LEGAL CONSTITUENT OF SYMBOL FOR ASSEMBLER
SZL SNA CLA /GT 0
SNA CLA /NE 0
SNL CLA /LT 0
SZA CLA /EQ 0
SNL CLA /TRUE
SNL CLA /SUCCESSFUL
SZA CLA /FALSE
SZA CLA /UNSUCCESSFUL
TSTSEP /ALPHANUMERIC
SNL CLA /<
SZL SNA CLA />
/THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL
/COMMANDS " AND '
CDBQO, NCHK /COMMAND "
ERR23, ERR /NO NUMBER TO TEST
SCANUP
SORT
CNDLST
CNDTAB-CNDLST
SMA /CHECK THAT CHAR WAS TRANSLATED
ERR20, ERR /NO - NO SUCH TEST
DCA SKIP /STORE TEST INSTRUCTION
GETNUM /PERFORM THE TEST
SKIP, HLT /TEST SKIPS IF TRUE
SKP CLA
POPJ /CONDITION SATISFIED
STA /NOT SATISFIED
DCA SKIP /BEGINNING SKIPPING COMMANDS
SKPSET /CALL SKIPPING ROUTINE
47 /FIND A '
ISZ SKIP /FOUND A '
RESORT /NEED ANOTHER: BACK TO CSML
ENTRCE /RE-ENABLE TRACE
JMP I [IREST /COMMAND ' NO ACTION TO TAKE
CNDI, SCAN /HIT ANOTHER "
STA /SO SKIP MATCHING '
TAD SKIP
DCA SKIP
RESORT /GO BACK TO CSML
/COMMANDS ; AND >
CSEMO, TAD ITRST /COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH
SNA CLA
ERR09, ERR /IF NOT IN ITERATION
CSEM2, TAD NLINK
SNA CLA
NCHK
JMP I (ZRON /NO NUMBER - IGNORE IT, WE DID IT ALREADY
JMP SEMO /SEARCH FOR >
CHGTO, TAD ITRCNT
SNA CLA
JMP CGTC /0 MEANS INFINITY
ISZ ITRCNT /LOOK FOR COUNT EXHAUSTED
JMP CGTC /NO, CONTINUE
CGSG, JMS POPITR /POP UP OLD ITERATION PARAMETERS
JMP I [IREST
CGTC, TAD ITRST
SNA
ERR10, ERR /IF NOT IN ITERATION
JMP I (ZROSPN /BACK TO ROOT
POPITR, 0
CLA IAC /** AC NOT NECESSARILY 0 ON ENTRY
POPL
ITRCNT
ITRST
JMP I POPITR
CHLTO, MTWO /COMMAND <
PUSHL
ITRST
ITRCNT
TAD NFLG
SNA CLA /WAS A NUMBER SPECIFIED?
JMP INF /NO, ASSUME INFINITY
TAD NLINK
SNA CLA
TAD N
SNA
JMP SEMO /0 OR NEGATIVE MEANS SKIP ITERATION
CIA /MAKE NEGATIVE
INF, DCA ITRCNT /SET UP TERMINATION
TAD SCANP /SAVE CURRENT SCAN PNTR
DCA ITRST /ALWAYS .GE. 1 IN ITERATION
DCA NFLG /CLEAR NUMBER FLAG
POPJ
/SHOULD WE TREAT 0<> SPECIAL?
PAGE
RELOC
/ ERROR-OVERLAY
*6200
RELOC 3200
IOVRLC
QOVRLC
EOVRLY, 0
XOVRLC
FOVRLC
ERRYY, DCA N
TAD (ERLIST-1
DCA XR
ERLOOP, ISZ N /BUMP ERROR NUMBER
TAD I XR
SZA /END OF LIST?
TAD I (ERRXX /NO - CHECK FOR MATCH
Z40, SZA CLA /FOUND WHAT WE WANTED?
JMP ERLOOP /NO - KEEP LOOKING
TAD N
CLL RAL /MULTIPLY BY 2
TAD (ERBASE-2
DCA PTR
TAD I PTR /GET FIRST WORD OF ERR MSG
SPA CLA
JMP CTCT /^C TRAP
ERL2, TAD [77
TYPE
TAD I PTR
RTR
RTR
RTR
JMS I (SIXTYP /TYPE LEFT CHARACTER
TAD I PTR
JMS I (SIXTYP /TYPE RIGHT CHARACTER
ISZ PTR
TAD I PTR
RTR
RTR
RTR
JMS I (SIXTYP /TYPE 3RD CHARACTER
CLA IAC
AND I (EHFLAG
SZA CLA
JMP I (ERRRET
MTHREE
TAD MEMSIZ
SPA CLA
JMP I (ERRRET /NO LONG ERROR MESSAGE UNLESS 16K OOR MORE
TAD Z40 /TYPE EXTENDED ERROR MESSAGE
TYPE
TAD Z40
TYPE
/ TAD Z40
/ TYPE
TAD N
TAD (XERBAS-1
DCA PTR /GET PTR TO PTR TO ERROR MSG
CDF 30
TAD I PTR /GET PTR TO ERROR MESSAGE
DCA PTR
XLUP, TAD I PTR
CDF 0
SNA
JMP I (ERRRET
SPA
JMS NEGCHR /NEGATIVE CHAR IS FLAG FOR ERRONEOUS CHARACTER
PUTT
ISZ PTR
CDF 30
JMP XLUP
CTCT, KRS /CTRL/C ERROR MESSAGE
AND [177 /ISOLATE ^C OR ^P INTO 7-BIT
TYPE /READ CTRL/C FROM BUFFER
CRLF /ECHO IT AND CR LF
TAD I [QPNTR
SZA CLA
JMP ERL2 /PRINT XAB ERROR MESSAGE
/ MTHREE
/ TAD CHAR /LOOK AT PREVIOUS CHARACTER
/ SZA CLA
/ JMP I (ERRRET /ONE ^C DO NOTHING
JMP I (CTLC /TWO ^C'S, ABORT
NEGCHR, 0
CLA
TAD LASTC
SORT
CACR
ERPTAB-CACR
SPA
DCA LASTC /SAVE $ FOR ALTMODE
CLA
TAD (""
PUTT
TAD LASTC
AND [7740
SNA CLA
JMS WOW /USE CARRET FORM FOR CONTROL CHARS
TAD LASTC /AC MAY BE NON-0
PUTT
TAD (""
JMP I NEGCHR
WOW, 0
TAD ("^
PUTT
TAD [100
JMP I WOW
SPY, TAD LASTC
TAD (-11+CNVTAB
DCA WOW
TAD ("<
PUTT
TAD I WOW
RTR
RTR
RTR
JMS I (SIXTYP
TAD I WOW
JMS I (SIXTYP
TAD (">
JMP I NEGCHR
PTR, 0
PAGE
SIXTYP, 0
AND [137 /IGNORE SIGN BIT OF BYTE
TAD [40
AND [77
TAD [40
PUTT
JMP I SIXTYP
ERLIST, -ERR01-1 /LIST OF POINTERS TO ALL POSSIBLE
-ERR02-1 /CALLS TO THE ERROR ROUTINE.
-ERR03-1
-ERR04-1
-ERR05-1
-ERR06-1
-ERR07-1
-ERR08-1
-ERR09-1
-ERR10-1
-ERR11-1
-ERR12-1
-ERR13-1
-ERR14-1
-ERR15-1
-ERR16-1
-ERR17-1
-ERR18-1
-ERR19-1
-ERR20-1
-ERR21-1
-ERR22-1
-ERR23-1
-ERR24-1
-ERR25-1
-ERR26-1
-ERR27-1
ERR28, -ERR28-1
-ERR29-1
-ERR30-1
-ERR31-1
-ERR32-1
-ERR33-1
-ERR34-1
-ERR35-1
0 /ERROR 36 - UNLABELED ERROR - NAMELY "JMS I OUTR"
/** MUST BE LAST ERROR MESSAGE
ERBASE, TEXT /ILL/ /1 ILLEGAL COMMAND
TEXT /UTC/ /2 UNTERMINATED COMMAND
TEXT /IQN/ /3 ILLEGAL Q-REGISTER NAME
TEXT /PDO/ /4 INTERNAL PUSH DOWN OVERFLOW (RECURSION)
TEXT /MEM/ /5 MEMORY OVERFLOW
TEXT /STL/ /6 SEARCH STRING TOO LONG
TEXT /ARG/ /7 ARGUMENT ERROR
TEXT /IFN/ /8 ILLEGAL FILE NAME
TEXT /SNI/ /9 SEMICOLON NOT IN ITERATION
TEXT /BNI/ /10 CLOSE BRACKET NOT IN ITERATION
TEXT /POP/ /11 POINTER OFF PAGE
TEXT /QMO/ /12 Q-REGISTER MEMORY OVERFLOW
TEXT /UTM/ /13 UNTERMINATED MACRO
TEXT /OUT/ /14 OUTPUT ERROR
TEXT /INP/ /15 INPUT ERROR
TEXT /FER/ /16 FILE ERROR
TEXT /FUL/ /17 OUTPUT COMMAND WOULD HAVE OVERFLOWED
TEXT /NAY/ /18 NEGATIVE ARGUMENT TO Y
TEXT /IEC/ /19 ILLEGAL E CHARACTER
TEXT /IQC/ /20 ILLEGAL " CHARACTER
TEXT /NAE/ /21 NO ARGUMENT BEFORE =
TEXT /NAU/ /22 NO ARGUMENT BEFORE U
TEXT /NAQ/ /23 NO ARGUMENT BEFORE "
TEXT /SRH/ /24 FAILING SEARCH
TEXT /NAP/ /25. NEGATIVE OR 0 ARGUMENT TO P
TEXT /NAC/ /26. NEGATIVE ARGUMENT TO ,
TEXT /NYI/ /27. ^W NOT IMPLEMENTED
TEXT /DMY/ /28. NOT USED
TEXT /NAS/ /29. NEGATIVE OR 0 COUNT TO SEARCH
TEXT /WLO/ /30. CAN'T WRITE OUT ERROR MESSAGE OVERLAY
TEXT /IFC/ /31. ILLEGAL F CHARACTER
TEXT /YCA/ /32. Y COMMAND ABORTED
TEXT /CCL/ /33. CCL NOT FOUND OR EG TOO BIG
/ TEXT /XAB/ /34. EXECUTION ABORTED BY ^C
7001;0200
TEXT /NYI/ /35. ^V NOT IMPLEMENTED
TEXT /NFO/ /36. NO FILE FOR OUTPUT
CNVTAB, TEXT /HTLFVTFFCR/
*.-1
ERPTAB, SPY /CR
SPY /HT
4044 /$
SPY /FF
SPY /VT
SPY /LF
PAGE
RELOC
/ X-OVERLAY
*6600
RELOC 3200
IOVRLC
QOVRLC
EOVRLC
XOVRLY, 0
FOVRLC
CHREX, TAD I (TYI
SORT
XLIS
XTAB-XLIS
ERR /CAN'T HAPPEN
XLIS, 103 /EC
106 /EF
107 /EG
113 /EK
130 /EX
/"EX" AND "EC" COMMANDS
EXIT, PUSHJ /"EX" COMMAND
EXITC /CLOSE OUT THE FILES
JMP I (CTLC /AND GO AWAY
EXITC, TAD OUTR /"EC" COMMAND
CIA /CHECK FOR OPEN OUTPUT FILE
TAD ERROR
SNA CLA
POPJ /NOPE, EXIT ALREADY
EXLOOP, JMS I [NXTBUF /GET NEXT BUFFER
TAD REND
CIA
TAD ZZ /CHECK FOR END-OF-FILE AND
SZA CLA /TEXT BUFFER EMPTY
JMP EXLOOP /NOT YET
/ENDFILE PROCESSOR
ENDFIL, TAD OCRCNT
CMA /REDUCE THE OUTPUT DOUBLEWORD COUNT
AND [177 /TO REFLECT ONLY THOSE WORDS REMAINING
CMA /UNTIL THE NEXT BLOCK BOUNDARY
DCA OCRCNT
TAD (7200 /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 [200
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 (213 /CHANGE EXTENSION TO .BK
DCA I TY
TAD I Z7 /DIRECTORY BLOCK IT CAME FROM
AND Z7
DCA ACI
CDF 0
JMS I OUTHND
4210 /WRITE IT BACK OUT
1400
ACI, 0
JMP .-4 /ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
JMP I (NORMAL
XTAB, EXITC /EC
ENDFIL /EF
EXITGO /EG
EKILL /EK
EXIT /EX
EKILL, TAD ERROR
DCA OUTR
POPJ
PAGE
EXITGO, PUSHJ /DO AN EC TO CLOSE OUT FILE
EXITC
QCHK /ALLOW @
DCA STOCD /MAKE REUSABLE IN CASE .START
TAD (7600
DCA CDPTR
TAD (-47 /47 ENTRIES IN CD TABLE
DCA EGCNT
EG1, QUOTST
JMP EG2
TAD [200 /TURN ON PARITY BIT FOR OS/8
JMS STOCD
JMP EG1
STOCD, 0
ISZ EGCNT
SKP
ERR33, ERR /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
CLA IAC /SYS
CIF 10
JMS I [200
2 /LOOKUP
ARG1, CCLNAM
0
JMP CCLERR
TAD (2001
DCA I (JSBITS /KEEP USR IN CORE
TAD ARG1
DCA CHNBLK
CIF 10
JMS I [200
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
RELOC
/ F-OVERLAY
*7200
RELOC 3200
IOVRLC
QOVRLC
EOVRLC
XOVRLC
FOVRLY, 0
CHRED, TAD I (TYI
SORT
DLIS
DTAB2-DLIS /CHECK FOR LEGALITY
ERR19, ERR /BAD CHAR AFTER E
DTOK, TAD I (TYI
SORT
DLIS
DTAB-DLIS
DCA XXFLAG
NCHK /ANY ARGUMENT?
JMP XXNO /NO, RETURN VALUE
TAD N /YES
DCA I XXFLAG /SET NEW VALUE
TAD XXFLAG
TAD (-EDFLAG+XXSUBS
DCA XXSUB
TAD I XXSUB
DCA XXSUB
JMS I XXSUB /CALL IT
POPJ /RETURN
XXNO, TAD I XXFLAG /GET VALUE
JMP I (NNEW13 /MAKE NEW 13-BIT VALUE
DLIS, 104 /ED
110 /EH
117 /EO
123 /ES
124 /ET
125 /EU
DTAB, EDFLAG /MUST BE NEGATIVE
EHFLAG /TO CAUSE SUBSTITUTION
EOFLAG
ESFLAG
ETFLAG
EUFLAG
XXFLAG, 0 /POINTS TO FLAG IN MEMORY ABOVE 4000
DTAB2, DTOK
DTOK
DTOK
DTOK
DTOK
DTOK
XXSUB, 0
/ MASK;SKIP;LOC;VALUE IF SKIPS;VALUE IF NO SKIP
EUSUB, 0
JMS FIXUP
7777; SMA CLA; EU1; CLA; SNA CLA
7777; SPA SNA CLA; EU2; TAD [40;NOP
0
JMP I EUSUB
ETSUB, 0
JMS FIXUP
1; SNA CLA; KTYPE; PUTT; TYPE
1; SNA CLA; ET1; PUTT; TYPE
10; SNA CLA; ET8; CLA; TYPE
0
JMP I ETSUB
LOC, 0
MASK, 0
FIXUP, 0
FIXLUP, TAD I FIXUP
SNA
JMP I FIXUP /DONE, RETURN TO 0
DCA MASK /SAVE MASK
ISZ FIXUP
TAD I FIXUP
DCA SKIPY /SAVE SKIP CONDITION
ISZ FIXUP
TAD I FIXUP
DCA LOC /SAVE LOC TO CHANGE
ISZ FIXUP
TAD I XXFLAG /LOOK AT FLAG
AND MASK /'AND' WITH MASK
SKIPY, HLT
JMP SKPF
TAD I FIXUP
DCA I LOC
ISZ FIXUP
SKPT, ISZ FIXUP
JMP FIXLUP
SKPF, ISZ FIXUP
TAD I FIXUP
DCA I LOC
JMP SKPT
CTLUO, QREF /COMMAND ^U
QSKP /COUNT UP STRING
TAD OSCANP
CMA
TAD SCANP /LENGTH OF STRING
/
/ *** PROHIBIT STRING > 2047 CHARS
/
ADJQ /ADJUST Q-REGISTERS AND SET NEW LENGTH
TAD OSCANP /RESET SCAN POINTER
DCA SCANP
DCA NFLG
NOTRCE
CCUB, QUOTST
JMP CTLUND
QPUT
JMP CCUB
CTLUND, ENTRCE
JMP I [IREST
PAGE
/NUMERICAL OUTPUT ROUTINE
ZEROD, 0
DCA ZERFLG /INITIALIZE "LEADING ZEROS" FLAG
TAD I ZEROD
ISZ ZEROD
DCA OUTDEV /SAVE OUTPUT ROUTINE ADDRESS
TAD NLINK /POS OR NEGATIVE?
SNA CLA
JMP ZER2 /POSITIVE
TAD RADIX
TAD (-ORAD
SNA CLA
JMP PUTSGN /OCTAL
TAD N /DECIMAL
CIA
DCA N /NEGATE
SKP
PUTSGN, TAD ["1-"-
TAD ("-
JMS I OUTDEV /OUTPUT MINUS SIGN
ZER2, MTHREE
DCA ZCOUNT /ITERATION COUNT
TAD RADIX
DCA RXR
ZDIGIT, ISZ RXR
TAD I RXR
DCA DIV1 /GET DIVISOR
TAD N
MQLDVI /DIVIDE BY A POWER OF THE BASE
DIV1, 0
TAD ZERFLG
SNA
JMP LZ /IGNORE LEADING ZEROS
TAD (60
JMS I OUTDEV
STL RAR
DCA ZERFLG /SET LEADING ZEROS FLAG
LZ, TAD DVT1 /GET REMAINDER
DCA N
ISZ ZCOUNT /GO AROUND AGAIN?
JMP ZDIGIT /WHY NOT?
TAD N
TAD (60
JMS I OUTDEV /OUTPUT LAST DIGIT NO MATTER WHAT
JMP I ZEROD
OUTDEV, 0 /WHERE WE'RE SENDING THE DIGITS
ZERFLG, 0
ZCOUNT, 0
RXR, 0
/COMMANDS = AND \
/COMMANDS = AND \ - NUMERICAL OUTPUT
CEQLO, NCHK /COMMAND =
ERR21, ERR /NO NUMBER
TAD RADIX
DCA RADTMP
JMS I (POKE /LOOK AHEAD ONE CHARACTER
TAD (-75 /CHECK FOR = SIGN
SZA CLA
JMP SETRAD /SINGLE =
SCAN /DOUBLE = (PASS UP SECOND ONE)
SKP CLA /CLEAR AC
SETRAD, TAD [4
TAD (ORAD
DCA RADIX /SET OCTAL RADIX TEMPORARILY
JMS ZEROD
TPUT
TAD RADTMP
DCA RADIX /RESTORE ORIGINAL RADIX
ISZ CLNF /: SEEN?
CRLF /NO, END WITH CRLF
DCA CLNF
POPJ
CBSLO, NCHK /COMMAND \
JMP CBSN
JMS ZEROD
UPOC
POPJ
RADTMP, 0
CBSN, PUSHJ
NMBR2 /INITIALIZE RESULT TO 0
JMS PTCH
TAD I P
AND [377 /GET CURRENT CHARACTER
CDF 0
TAD (-55 /CHECK FOR MINUS SIGN
SZA
JMP .+3 /NOT MINUS
PUSHJ
CMIN /RECORD MINUS SIGN
CIA
CLL RTR
SNA CLA /CHECK FOR PLUS SIGN
CBSNP, ISZ P /BUMP POINTER PAST SIGN
JMS PTCH
TAD I P /GET A CHAR
AND [377
CDF 0
TAD (-72
CLL
TAD CALF
SNL /IS IT A DIGIT?
POPJ /NO
PUSHJ
NMBR2 /YES - ACCUMULATE IT
JMP CBSNP /AND LOOP
PTCH, 0
TAD P /V3C
STL CIA /CHECK FOR END OF BUFFER
TAD ZZ
SZL SNA CLA
POPJ
CDF 10
JMP I PTCH
XXSUBS, EDSUB
EHSUB
EOSUB
ESSUB
ETSUB
EUSUB
/ CXSUB
/CXSUB,
EDSUB,
EHSUB,
ESSUB,
EOSUB, 0
JMP I EOSUB
PAGE
RELOC
FIELD 1
*4400
XERBAS, XER1
XER2
XER3
XER4
XER5
XER6
XER7
XER8
XER9
XER10
XER11
XER12
XER13
XER14
XER15
XER16
XER17
XER18
XER19
XER20
XER21
XER22
XER23
XER24
XER25
XER26
XER27
XER28
XER29
XER30
XER31
XER32
XER33
XER34
XER35
XER36
XER1,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"o;"m;"m;"a;"n;"d;" ;4000;0
XER2,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"C;"o;"m;"m;"a;"n;"d;0
XER3,
"I;"l;"l;"e;"g;"a;"l;" ;"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"N;"a;"m;"e;" ;4000;0
XER4,
"I;"n;"t;"e;"r;"n;"a;"l;" ;"P;"u;"s;"h;" ;"D;"o;"w;"n;" ;"O;"v;"e;"r
"f;"l;"o;"w;0
XER5,
"S;"t;"o;"r;"a;"g;"e;" ;"C;"a;"p;"a;"c;"i;"t;"y;" ;"E;"x;"c;"e;"e;"d;"e;"d;0
XER6,
"S;"e;"a;"r;"c;"h;" ;"S;"t;"r;"i;"n;"g;" ;"t;"o;"o;" ;"L;"o;"n;"g;0
XER7,
"I;"m;"p;"r;"o;"p;"e;"r;" ;"A;"r;"g;"u;"m;"e;"n;"t;"s;0
XER8,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"i;"n;" ;"F;"i;"l;"e;"n;"a;"m;"e;0
XER9,
";;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER10,
">;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER11,
"A;"t;"t;"e;"m;"p;"t;" ;"t;"o;" ;"M;"o;"v;"e;" ;"P;"o;"i;"n;"t;"e;"r
" ;"O;"f;"f;" ;"P;"a;"g;"e;0
XER12,
"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"M;"e;"m;"o;"r;"y;" ;"O;"v;"e;"r;"f;"l;"o;"w;0
XER13,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"M;"a;"c;"r;"o;0
XER14,
"O;"u;"t;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER15,
"I;"n;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER16,
"F;"i;"l;"e;" ;"E;"r;"r;"o;"r;0
XER17,
"O;"u;"t;"p;"u;"t;" ;"C;"o;"m;"m;"a;"n;"d;" ;"w;"o;"u;"l;"d;" ;"h;"a;"v;"e
" ;"O;"v;"e;"r;"f;"l;"o;"w;"e;"d;0
XER18,
"N;"u;"m;"e;"r;"i;"c;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"Y;0
XER19,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"E;0
XER20,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"";0
XER21,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"=;0
XER22,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"U;0
XER23,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"q;"u;"o;"t;"e;0
XER24,
"S;"e;"a;"r;"c;"h;" ;"f;"a;"i;"l;"e;"d;0
XER25,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o
" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"P;0
XER26,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;",;0
XER27,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t
" ;"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
"[;"u;"s;"e;" ;"W;" ;"f;"o;"r;" ;"W;"a;"t;"c;"h;" ;"C;"o;"m;"m;"a;"n;"d;"];0
/XER28,
/"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;"
/"I;"t;"e;"r;"a;"t;"i;"o;"n;" ;"C;"o;"u;"n;"t;0
XER28,
0
XER29,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;"
"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"S;0
XER30,
"C;"a;"n;"n;"o;"t;" ;"W;"r;"i;"t;"e;" ;"O;"u;"t;" ;"E;"r;"r;"o;"r
" ;"M;"e;"s;"s;"a;"g;"e;" ;"O;"v;"e;"r;"l;"a;"y;0
XER31,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"F;0
XER32,
"Y;" ;"C;"o;"m;"m;"a;"n;"d;" ;"A;"b;"o;"r;"t;"e;"d;0
XER33,
"C;"C;"L;".;"S;"V;" ;"n;"o;"t;" ;"f;"o;"u;"n;"d;" ;"o;"r;"
"E;"G;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;"o;" ;"b;"i;"g;0
XER34,
"E;"x;"e;"c;"u;"t;"i;"o;"n;" ;"a;"b;"o;"r;"t;"e;"d;0
XER35,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t;"
"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
"[;"u;"s;"e;" ;"E;"O;" ;"f;"o;"r
" ;"V;"e;"r;"s;"i;"o;"n;" ;"n;"u;"m;"b;"e;"r;"];0
XER36,
"N;"o;" ;"F;"i;"l;"e;" ;"f;"o;"r;" ;"O;"u;"t;"p;"u;"t;0
PAGE
COREAD, 0
ISZ COREAD
TAD I COREAD /GET BLOCK #
AND CO7
CLL RTR
RTR
RAR /MULTIPLY BY 400
TAD KMEM
DCA FLO
TAD M400
DCA FLCNT
TAD K3200
DCA FTO
FLOO, CDF 30
TAD I FLO
CDF 0
DCA I FTO
ISZ FLO
ISZ FTO
ISZ FLCNT
JMP FLOO
ISZ COREAD
CIF CDF 0
JMP I COREAD
FLCNT, 0
CO7, 7
M400, -400
K3200, 3200
KMEM, MEMLOC
FLO, 0
FTO, 0
COREND=.
NEWERR, RELOC OVREAD
CIF 30 /NEW CODE TO READ OVERLAY
JMS I .+1 /MUST BE 5 LOCS LONG
COREAD
TMP, 0 /BLOCK #
NOP
RELOC
PAGE