.TITLE TRACE
/
/ 24 MAR 75 (PDH) BEGIN DEBUGGING
/ 12 MAR 75 - PAUL HENDERSON - BEGIN TYPING ON WITS
/
/ PROGRAM TO TRACE A PROGRAM, SIMULATING ALL INSTRUCTIONS.
/ IT WILL NOT PERFORM CORRECTLY IF WE TRY TO SIMULATE
/ XCT A
/ A CAL
/
IDX=ISZ / INDEX POINTER - SKIP NOT EXPECTED
AUTO16=16
LP=-12
TTO=-3
BUFSIZ=70 / SIZE OF IMAGE BUFFER
/
.IODEV LP,TTO
/
TRACE .INIT TTO,1,EXIT+1 / ABORT TIDILY ON ^P
.INIT LP,1,EXIT+1
.ENTER LP,NAME / IN CASE BULK STORAGE
LAW -1
DAC LNCNT / MUST BEGIN WITH HEADING
LAC (LSTIMG
DAC LSTPNT / DON'T SCRAMBLE WITH 1ST CR
JMS WRITE / GET TRACE OUTPUT STARTED
B1 NOP / FOR DDT BREAKPOINT
/
/ RETURN HERE TO GET NEW OPCODE
/
GETOP LAC PC
DAC IPC / SAVE PC IN 'IMMEDIATE PC'
JMS DIGITS / OUTPUT PC
IDX LSTPNT / SINGLE SPACE
/
/ XCT RETURNS HERE TO FETCH ITS INTENDED TARGET
/
XCTOP LAC* IPC
JMS DIGITS / INSTRUCTION
IDX LSTPNT / ANOTHER SPACE
LAC* IPC
LRS 16
AND (17 / GET OPCODE
TAD (JMP OPCODE
DAC .+1
XX / DISPATCH TO APPROPRIATE SIMULATION
OPCODE JMP .CAL
JMP .DAC
JMP .JMS
JMP .DZM
JMP .LAC
JMP .XOR
JMP .ADD
JMP .TAD
JMP .XCT
JMP .ISZ
JMP .AND
JMP .SAD
JMP .JMP
JMP .EAE
JMP .IOT
JMP .OPR
/
/ THE ASSUMPTION HERE IS THAT 'CAL' WILL NEVER BE
/ INVOKED BY 'XCT'
/
.CAL JMS SIXTO7
.SIXBT 'CAL'
LAC* IPC
AND (37777
JMS DIGITS / OUTPUT .DAT SLOT & SUB-FUNCTION
IDX PC / THIS IS THE WAY 'XCT' WOULD
LAC* PC / CAUSE IT TO HAPPEN
AND (17 / GET FUNCTION CODE
TAD (JMP CALDSP+1
DAC CALDSP
CLA
CALDSP XX
JMP IOPS0 / 0=ILLEGAL 'CAL' FUNCTION
JMP ARGS4 / 1=.INIT
JMP ARGS3 / 2=.FSTAT, .DLETE, .RENAM
JMP ARGS3 / 3=.SEEK
JMP ARGS3 / 4=.ENTER
JMP ARGS2 / 5=.CLEAR
JMP ARGS2 / 6=.CLOSE
JMP ARGS2 / 7=.MTAPE
JMP ARGS4 / 10=.READ
JMP ARGS4 / 11=.WRITE
JMP IOWAIT / 12=.WAIT, .WAITR
JMP ARGS5 / 13=.TRAN
JMP ARGS3 / 14=.TIMER
JMP EXIT / 15=.EXIT
JMP IOPS0 / 16=ILLEGAL 'CAL' FUNCTION
JMP IOPS0 / 17=ILLEGAL 'CAL' FUNCTION
/
ARGS5 LAW -1
ARGS4 TAD (-1
ARGS3 TAD (-1
ARGS2 TAD (-1
DAC ARGCNT / SAVE NUMBER OF ARGUMENTS TO LIST
/
GETCAL JMS WRITE / WRITE OUT PREVIOUS ARGUMENT
LAC (LSTIMG+13
DAC LSTPNT / START AT 'OPCODE' COLUMN
LAC* PC / GET ARGUMENT
IDX PC
JMS DIGITS
ISZ ARGCNT
JMP GETCAL
/
/ 'CAL' IS THE ONLY INSTRUCTION THAT IS ALLOWED TO EXECUTE NORMALLY.
/ HOWEVER, WE MUST INTERCEPT IT AFTER ITS COMPLETION.
/
LAC (RESTORE-1 / PREPARE TO INTERCEPT INSTRUCTION
DAC* (AUTO16 / STREAM AFTER 'CAL'
LAC* PC
DAC SAVE1 / SAVE NEXT INSTRUCTION
LAC PC
DAC ADDR1 / SAVE ADDRESS IT CAME FROM
LAC (JMS* AUTO16
DAC* ADDR1 / REPLACE WITH JMS TO 'RESTORE'
JMP* IPC / NOW EXECUTE THE 'CAL' NORMALLY.
/
/ CONTROL RETURNS HERE AFTER 'CAL'
/
RESTORE XX
JMS PUTACL / OUTPUT LINK & AC IN CASE OF '.OPER'
JMS WRITE
LAW -1 / MUST BACK UP PC TO ACCOUNT FOR
TAD RESTORE / REPLACED INSTRUCTION
AND (77777
DAC PC / NEW 15-BIT VALUE OF PC
LAC SAVE1
DAC* ADDR1 / RESTORE REPLACED INSTRUCTIONS
LAC SAVE2 / .WAITR RETURN, IF PRESENT
DAC* ADDR2
LAC (SAVE2 / DON'T RESTORE NEXT TIME UNLESS
DAC ADDR2 / WE HAVE ANOTHER '.WAITR'
JMP GETOP / NOW RE-ENTER TRACE LOOP
/
IOWAIT LAC* IPC
AND (1000 / .WAIT OR .WAITR?
SNA
JMP ARGS2 / .WAIT
LAC IPC
TAD (2 / .WAITR
DAC ADDR2
LAC* ADDR2
DAC ADDR2 / .WAITR BRANCH ADDRESS
LAC* ADDR2
DAC SAVE2 / SAVE CONTENTS AT BRANCH TRANSFER POIN
LAC (JMS* AUTO16 / CATCH THIS ONE TOO, IN CASE I/O BUSY
DAC* ADDR2
CLA
JMP ARGS3
/
IOPS0 JMS WRITE / OUTPUT INFORMATION TO DATE
LAC (LSTIMG+13
DAC LSTPNT / COLUMN OF OPCODES
LAC* PC / GET OFFENDING FUNCTION CODE
JMS DIGITS
JMS WRITE / WRITE IT OUT
.WRITE LP,2,IPS0,0 / 'ILLEGAL CAL FUNCTION'
JMP CLOSLP
/
EXIT JMS WRITE / OUTPUT WAITING INFORMATION
.WRITE LP,2,XIT,0 / ' .EXIT ENCOUNTERED'
CLOSLP .CLOSE LP
.EXIT
/
ARGCNT;SAVE1;ADDR1;SAVE2;ADDR2 SAVE2
IPS0 IP-.*400+2; 0
.ASCII <11>'ILLEGAL CAL FUNCTION'<15> ;IP=.
XIT XT-.*400+2; 0
.ASCII <11>'.EXIT ENCOUNTERED'<15> ;XT=.
/
.DAC JMS SIXTO7
.SIXBT 'DAC'
JMS SETMB / SET 'MB' TO CORRECT ADDRESS
DAC* MB / PERFORM INTENT OF INSTRUCTION
JMP IDXPC
/
.JMS JMS SIXTO7
.SIXBT 'JMS'
JMS SETMB
LAC PC
XOR (200000 / EXTENDED MEMORY BIT
DAC* MB / STORE RETURN ADDRESS
IDX* MB / RETURN MUST POINT TO CORRECT PLACE
LAC MB
DAC PC / MB BECOMES THE NEW PC
JMP IDXPC
/
.DZM JMS SIXTO7
.SIXBT 'DZM'
JMS SETMB
DZM* MB
JMP IDXPC
/
.LAC JMS SIXTO7
.SIXBT 'LAC'
JMS SETMB
LAC* MB
JMP LINKAC
/
.XOR JMS SIXTO7
.SIXBT 'XOR'
JMS SETMB
XOR* MB
JMP LINKAC
/
.ADD JMS SIXTO7
.SIXBT 'ADD'
JMS SETMB
ADD* MB
JMP LINKAC
/
.TAD JMS SIXTO7
.SIXBT 'TAD'
JMS SETMB
TAD* MB
JMP LINKAC
/
.XCT JMS SIXTO7
.SIXBT 'XCT'
JMS SETMB
JMS WRITE
LAC (LSTIMG+7 / SKIP PAST THE 'PC' COLUMN
DAC LSTPNT
LAW 52 / '*'
DAC LSTIMG+5 / INDICATE 'XCT' CONTINUATION
LAC MB
DAC IPC / MB BECOMES THE INTERIM PC
JMP XCTOP / NOW PROCEED WITH MODIFIED PC
/
.ISZ JMS SIXTO7
.SIXBT 'ISZ'
JMS SETMB
ISZ* MB
SKP
IDX PC / INDEX SOFTWARE PC IF SKIP
JMP IDXPC
/
.AND JMS SIXTO7
.SIXBT 'AND'
JMS SETMB
AND* MB
JMP LINKAC
/
.SAD JMS SIXTO7
.SIXBT 'SAD'
JMS SETMB
SAD* MB
SKP
IDX PC
JMP LINKAC / WE WANT TO SEE THE VALU OF THE AC
/
.JMP JMS SIXTO7
.SIXBT 'JMP'
JMS SETMB
JMS WRITE
LAC MB / EFFECTIVE ADDRESS BECOMES
DAC PC / THE NEW PC
JMP GETOP
/
.EAE JMS SIXTO7
.SIXBT 'EAE'
LAC (NOP / ASSUME SINGLE-WORD INSTRUCTIO
DAC EAEOP+1
LAC* IPC / GET EAE INSTRUCTION
DAC EAEOP / IT WILL BE EXECUTED DIRECTLY
JMS DIGITS
LAC EAEOP
AND (700 / GET EAE COMMAND
SAD (100 / IS IT MULTIPLY?
SKP
SAD (300 / OR DIVIDE?
SKP
JMP NOTMDV / NEITHER MULTIPLY NOR DIVIDE
/
IDX IPC
IDX PC / 2-WORD INSTRUCTION. INDEX PC
LAW 50 / '('
DAC* LSTPNT
IDX LSTPNT
LAC* IPC / GET OPERAND FOR MULT OR DIVIDE
DAC EAEOP+1 / PUT IN EXPECTED PLACE
JMS DIGITS / LET US SEE WHAT IT WAS
LAW 51 / ')'
DAC* LSTPNT
JMP GETMQ
/
NOTMDV LAC SC / GET PREVIOUS VALUE OF STEP COUNTER
XOR (77
TAD (640402 / THIS METHOD OF RESTORING THE
AND (640477 / STEP COUNTER IS IN THE PDP-9 HANDBOOK
DAC .+1 / BUT IS ALLEGEDLY WRONG.
XX
GETMQ LAC MQ / RESTORE MQ
LMQ
JMS GETACL / RESTORE LINK & AC
EAEOP XX / EAE INSTRUCTION INSERTED HERE
NOP / 'NOP' OR EAE OPERAND
DAC AC / TEMPORARY STORE
LACQ
DAC MQ / SAVE MQ
LACS
DAC SC / SAVE STEP COUNTER
LAC AC / RETRIEVE AC FOR 'PUTACL'
JMS PUTACL / SAVE & OUTPUT LINK & AC
IDX LSTPNT / SINGLE SPACE
LAC MQ
JMS DIGITS / OUTPUT MQ
JMP IDXPC
/
.IOT JMS SIXTO7
.SIXBT 'IOT'
LAC* IPC / GET INSTRUCTION
AND (37777 / REMOVE OPCODE
JMS DIGITS
JMP OPRGET / NOW GO TO COMMON CODE EXECUTION
/
.OPR LAC* IPC / GET INSTRUCTION
AND (37777 / IGNORE OP CODE
SZA
JMP CKOPR
JMS SIXTO7
.SIXBT 'NOP'
JMP OPRGET
/
CKOPR LAC* IPC
ALSS 4 / SHIFT OUT OPCODE
CKLAW SMA!RAL
JMP CKCLA
JMS SIXTO7
.SIXBT 'LAW'
LAC* IPC
AND (17777 / GET IMMEDIATE DATA
JMS DIGITS
JMP OPRGET / NOW GO AND EXECUTE IT
/
CKCLA SMA!RAL
JMP CKCLL
JMS SIXTO7
.SIXBT 'CLA'
CKCLL SMA!RAL
JMP CKRT
JMS SIXTO7
.SIXBT 'CLL'
CKRT DAC MB / MB NOT USED FOR THIS INSTRUCTION, SO
SMA / IT MAY BE USED FOR TEMPORARY STORAGE
JMP CKRAR / INSTRUCTION IS NOT DOUBLE ROTATE
CKRTR LAC* IPC / ROTATE RIGHT?
AND (20
SNA
JMP CKRTL
JMS SIXTO7
.SIXBT 'RTR'
CKRTL LAC* IPC
AND (10 / ROTATE LEFT?
SNA
JMP CKSKP
JMS SIXTO7
.SIXBT 'RTL'
JMP CKSKP
/
CKRAR LAC* IPC / CHECK FOR SINGLE ROTATE
AND (20
SNA / ROTATE RIGHT?
JMP CKRAL
JMS SIXTO7
.SIXBT 'RAR'
CKRAL LAC* IPC
AND (10
SNA / ROTATE LEFT?
JMP CKSKP
JMS SIXTO7
.SIXBT 'RAL'
/
CKSKP LAC* IPC / GET INSTRUCTION AGAIN
AND (1700 / SAVE ONLY 'CONDITION' BITS
SAD (1000 / IS IT 'SKP'
SKP / YES.
JMP SKPEND
JMS SIXTO7
.SIXBT 'SKP'
SKPEND LAC MB / RETRIEVE INSTRUCTION
RAL / NO LONGER WISH TO CHECK BIT 7
ANDOR SMA!RAL / CHECK FOR 'AND OF' OR 'OR OF'
JMP OROF
ANDOF SMA!RAL / CHECK FOR 'SZL', 'SNA', 'SPA'
JMP CKSNA
JMS SIXTO7
.SIXBT 'SZL'
CKSNA SMA!RAL
JMP CKSPA
JMS SIXTO7
.SIXBT 'SNA'
CKSPA SMA!RAL
JMP CKHLT
JMS SIXTO7
.SIXBT 'SPA'
JMP CKHLT
/
OROF SMA!RAL / CHECK FOR 'SNL', 'SZA', 'SMA'
JMP CKSZA
JMS SIXTO7
.SIXBT 'SNL'
CKSZA SMA!RAL
JMP CKSMA
JMS SIXTO7
.SIXBT 'SZA'
CKSMA SMA!RAL
JMP CKHLT
JMS SIXTO7
.SIXBT 'SMA'
/
CKHLT SMA!RTL
JMP CKOAS
JMS SIXTO7
.SIXBT 'HLT'
CKOAS RAL / HAVE TO GET PAST ROTATE BITS
SMA!RAL
JMP CKCML
JMS SIXTO7
.SIXBT 'OAS'
CKCML SMA!RAL
JMP CKCMA
JMS SIXTO7
.SIXBT 'CML'
CKCMA SMA
JMP CKBUFR
JMS SIXTO7
.SIXBT 'CMA'
/
/ WE HAVE NOW REACHED THE END OF THE OPERATE INSTRUCTION DECODING.
/ CHECK TO SEE IF WE HAVE ENOUGH ROOM ON THIS LINE FOR THE LINK & AC.
/
CKBUFR LAC LSTPNT
CMA
TAD (LSTIMG+41 / DO WE HAVE ROOM?
SPA
JMS WRITE / LINK AND AC WILL APPEAR ON NEXT LINE
/
OPRGET JMS GETACL / RESTORE LINK & AC TO SIMULATED VALUES
XCT* IPC / EXECUTE THE INSTRUCTION (IOT OR OPR)
SKP
IDX PC / INCREMENT PC IF INSTRUCTION SKIPS
/
LINKAC JMS PUTACL / STORE AND OUTPUT LINK & AC
IDXPC JMS WRITE / OUTPUT BUFFER
IDX PC / INCREMENT PC TO NEXT INSTRUCTION
JMP GETOP / GO AND GET NEXT INSTRUCTION
/
/ SUBROUTINE TO RESOTRE SIMULATION VALUES OF AC & LINK.
/
GETACL XX
LAC LINK / RESTORE LINK
RAR
LAC AC / RESTORE AC
JMP* GETACL
/
/ SUBROUTINE TO SAVE UPDATED VALUES OF LINK & AC, AND ALSO PUT THEM
/ INTO THE OUTPUT IMAGE BUFFER.
/
PUTACL XX
DAC AC / SAVE AC
CLA!RAL
DAC LINK / SAVE LINK
XOR (60 / CONVERT TO ASCII
DAC LSTIMG+41 / AND PUT IT IN BUFFER
LAC (LSTIMG+43 / ALWAYS PUT LINK & AC AT THIS POINT
DAC LSTPNT
LAC AC / GET AC
JMS DIGITS / PUT ASCII INTO BUFFER
JMP* PUTACL
/
LINK;AC;MQ;SC
PC;IPC;MB;DEFER
/
/ SUBROUTINE TO CONVERT NUMBER TO IMAGE ASCII.
/ ENTER WITH NUMBER IN AC, USE CURRENT VALUE OF 'LSTPNT'
/
DIGITS XX
JMS LEAD0 / ALWAYS SET 'LEADING ZERO' FLAG
LEAD0 XX
LMQ
LAW -5
DAC DIGCNT / DO 5 DIGITS IN LOOP
NXTDIG LLSS!1000 3 / GET DIGIT
SZA
JMP STORE / STORE NON-ZERO DIGITS
LAC LEAD0
SZA
JMP IDXPNT / LEADING ZEROS CONVERTED TO SPACE
STORE DZM LEAD0 / NO LEADING ZEROS AFTER DIGIT OUTPUT
XOR (60 / CONVERT TO ASCII
DAC* LSTPNT
IDXPNT IDX LSTPNT
ISZ DIGCNT
JMP NXTDIG
LLSS!1000 3
XOR (60 / LAST DIGIT OUTPUT AS DIGIT
DAC* LSTPNT
IDX LSTPNT
JMP* DIGITS
/
DIGCNT
/
/ SUBROUTINE TO CONVERT 6-BIT PACKED ASCII TO 7-BIT IMAGE ASCII.
/ THE PACKED 6-BIT IS IN THE LOCATION FOLLOWING THE SUBROUTINE
/ CALL AND THE 7-BIT IMAGE ASCII IS OUTPUT VIA 'LSTPNT'.
/ THE CONTENTS OF THE AC AT ENTRY ARE SAVED AND RESTORED AT EXIT.
/
SIXTO7 XX
DAC AC627 / SAVE AC
LAW -3 / 3 CHARACTERS IN 6-BIT WORD
DAC CHRCNT
LAC* SIXTO7 / GET CHARACTERS
IDX SIXTO7 / INDEX TO CORRECT RETURN ADDRESS
LMQ
SIXNXT LLSS!1000 6 / SHIFT IN 1 CHARACTER
LLSS 14 / WE DECIDE THE CORRECT TYPE OF BIT TO
SMA!CLL / ADD ON FOR 7TH BIT
STL
LRS 14 / CONVERT TO 7-BITS
DAC* LSTPNT
IDX LSTPNT
ISZ CHRCNT
JMP SIXNXT
IDX LSTPNT / LEAVE SPACE AFTER OPCODE
LAC AC627 / RESTORE AC
JMP* SIXTO7
/
CHRCNT;AC627
/
/ SUBROUTINE TO SET THE SIMULATED MB TO THE CORRECT VALUE. THE VALUES
/ ARE ALSO INSERTED INTO THE LISTING BUFFER.
/
SETMB XX
LAC* IPC
AND (20000
DAC DEFER / SET 'DEFER' FLAG, IF INDICATED
LAC* IPC
AND (17777 / GET 13-BIT ADDRESS FROM INSTRUCTION
DAC MB
LAC IPC
AND (60000 / GET BANK BITS FROM PC
XOR MB
STORMB DAC MB / NOW HAVE 15-BIT INSTRUCTION ADDRESS
JMS DIGITS
LAW 50 / '('
DAC* LSTPNT
IDX LSTPNT
LAC* MB / CONTENTS OF ADDRESSED MEMORY
JMS DIGITS
LAW 51 / ')'
DAC* LSTPNT
IDX LSTPNT
LAC DEFER / DO WE HAVE TO PERFORM AN ADDITIONAL
SNA / FETCH CYCLE?
JMP DIRECT / NOT AT THIS POINT. PROCEED
/
/ WE HAVE AN INDIRECT MEMORY REFERENCE. WE MUST CHECK TO SEE IF
/ IT IS AN AUTO-INDEX REFERENCE, AND TAKE APPROPRIATE ACTION, IF SO.
/
LAC MB
AND (17777 / GET 13-BIT ADDRESS
TAD (-10
SPA / IS ADDRESS < 10 ?
JMP NOAUTO / YES. NOT AUTO-INDEX.
TAD (10-17 / ADDRESS > 10
SMA!SZA / IS ADDRESS < 17 ?
JMP NOAUTO
/
/ WE HAVE AN AUTO-INDEX REFERENCE. SIMULATE IT PROPERLY.
/
TAD (17 / RESTORE CORRECT ADDRESS.
DAC MB / IT ALWAYS REFERENCES BANK 0
IDX* MB / INDEX AUTO_INDEX. IT SHOULDN'T SKIP
NOP / BUT IT MIGHT
LAW 40
DAC LSTIMG+31 / CHANGE BANK BITS AND
DAC LSTIMG+32 / LEADING ZEROS TO SPACES
DAC LSTIMG+33
DAC LSTIMG+34
/
NOAUTO LAW 52 / '*'
DAC LSTIMG+21 / INDICATE INDIRECT INSTRUCTION
JMS WRITE / OUTPUT INFO TO DATE
LAC (LSTIMG+22
DAC LSTPNT / RESUME IN 'INSTRUCTION' COLUMN
DZM DEFER / CLEAR 'DEFER' FLAG
LAC* MB
AND (77777 / ONLY 15 BITS IN ADDRESS
JMP STORMB / AND RETURN TO LOOP
/
DIRECT JMS GETACL / SET LINK & AC TO EXPECTED PROG STATE
JMP* SETMB
/
/ SUBROUTINE TO OUTPUT THE CURRENT IMAGE BUFFER, THEN RE-INITIALIZE IT
/ TO ALL SPACES.
/
WRITE XX
LAW 15 / CR
DAC* LSTPNT / APPEND CARRIAGE RETURN TO LINE
LAC (LSTIMG
DAC PCK+1 / POINTER FOR PACK
DAC LSTPNT / AND BUFFER INITIALIZATION
LAC (LSTBUF+2
DAC PCK+2
.WAIT LP / WAIT FOR ANY PREVIOUS I/O
PCK JMS PACK
0; 0
SMA
JMP PCK
TAD (LSTBUF
CMA
TAD PCK+2 / (PCK+2) - ( (LSTBUF)
ALSS 10
XOR (2
DAC LSTBUF
.WRITE LP,2,LSTBUF,0 / WRITE OUT THE LINE
LAW -BUFSIZ
DAC LSTCNT
LAW 40 / INITIALIZE IMAGE BUFFER TO SPACES
DAC* LSTPNT
IDX LSTPNT
ISZ LSTCNT
JMP .-3
LAC (LSTIMG / RESET IMAGE BUFFER POINTER
DAC LSTPNT
ISZ LNCNT / HAVE WE OUTPUT A FULL PAGE YET?
JMP* WRITE / NOT YET
LAW -62 / YES. RESET LINES-PER-PAGE COUNTER
DAC LNCNT
.WRITE LP,2,HEAD,0 / WRITE NEW COLUMN HEADER INFO
.WRITE LP,2,SPACE,0 / BLANK LINE
JMP* WRITE
/
LSTIMG .BLOCK BUFSIZ
LSTBUF .BLOCK BUFSIZ+4/5*2+2 / MAGIC FORMULA TO CREATE CORRECT SIZE
NAME .SIXBT 'PROG@@TRC'
LSTPNT;LSTCNT;LNCNT
HEAD HD-.*400+2; 0
.ASCII <14>' PC'<11>'INSTR OP ADDR CON'
.ASCII <11>' L AC MQ'<15> ;HD=.
SPACE 2002; 0
.ASCII ' '<15>
.TITLE ASCII PACK-UNPACK SUBROUTINE
/
/ CALLING SEQUENCE
/
/ JMS* PACK (OR UNPACK)
/ .DSA ADDRESS OF INPUT CHARACTERS
/ .DSA ADDRESS OF OUTPUT CHARACTERS
/
/THE ADDRESSES ARE INCREMENTED BY THE PROPER AMOUNT TO POINT TO THE
/WORDS IN THE BUFFER. WHEN CARRIAGE RETURN OR ALT MODE IS ENCOUNTERED,
/THE AC IS SET TO -1 (.TRUE.) ON EXIT FROM THE SUBROUTINE. HENCE,
/NORMAL CALLING SEQUENCE WOULD BE:
/
/ JMS* PACK (OR UNPACK)
/ .DSA ADDRESS IN
/ .DSA ADDRESS OUT
/ SMA
/ JMP .-4
/
/ .GLOBL PACK,UNPACK
/
PACK XX
LAC* PACK
DAC IN
TAD (5
DAC* PACK
ISZ PACK
LAC* PACK
DAC OUT
TAD (2
DAC* PACK
ISZ PACK /POINT TO RETURN
LAW -5 /SET A COUNTER TO PROCESS
DAC COUNT /5 CHARACTERS
CLL /CLEAR LINK TO PREVENT CONFUSION TO EAE
NEXT LAC* IN
JMS END /CHECK FOR END OF LINE
DAC END /HANDY PLACE TO STORE TEMPORARILY
LAC TWO
LMQ
LAC ONE /LOAD TWO WORDS
LLS 7
DAC ONE /STORE SHIFTED LEFT HALF
LAC END
OMQ /ADD IN NEW CHARACTER
DAC TWO /STORE NEW RIGHT HALF
ISZ IN /POINT TO NEXT CHARACTER
ISZ COUNT /5 CHARACTERS YET?
JMP NEXT /NO
LAC TWO /YES
RCL
DAC TWO /MUST SHIFT EXTRA PLACE ON PACK
LAC ONE
RAL
DAC* OUT /RETURN PACKED PAIR TO USER
ISZ OUT
LAC TWO
DAC* OUT
LAC LNEND /EXIT WITH END OF LINE FLAG
DZM LNEND /IN AC
JMP* PACK
/
/
IN;OUT;COUNT;LNEND
/
ONE;TWO
/
END XX
AND (177
SAD (15 /CHECK FOR CARRIAGE RETURN
SKP
SAD (175 /AND ALT MODE
SKP
JMP* END /GO AWAY IF NEITHER
LMQ /SAVE CHARACTER TEMPORARILY
LAW -1 /SET END-OF-LINE FLAG TO
DAC LNEND /.TRUE. (-1) IF FOUND
LACQ
JMP* END
.END