Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/subusm.mac
There are no other files named subusm.mac in the archive.
;[toed.xkl.com]DXX:<KLAD.SOURCES>SUBUSM.MAC.2, 18-Apr-96 17:20:59, Edit by GORIN
;change $CPTYP. Old code used an indeterminate form of BLT
SUBTTL *CONTRL* MAIN SUBROUTINE PACKAGE CONTROL
S
;*SPECIAL SUBPROGRAM LINKAGES
S
LOC 440
JRST DIAGNOS
JRST DDT
JRST DIAMON
JRST REINIT
LOC 27775
DDTLNK: 10000 ;DDT LINKAGE
MODLNK: MODCHK ;OPERATIONAL MODE CHECK LINKAGE
SUBLNK: SUBINI ;SUBROUTINE LINKAGE
LOC 1000 ;RESET THE PC AFTER "FIXED" @ 30,000
S
;*INITIALIZE THE SUBROUTINE PACKAGE
S
START: JRST $SBSRT ;START SUBROUTINE BY ITSELF
REINIT: JRST $REINI ;REINIT SUBROUTINE
SUBINI: JRST $PGMIN ;SUBROUTINE INIT ROUTINE
MODCHK: JRST $MODCK ;OPERATIONAL MODE CHECK LINKAGE
0
SUBRTN: SIXBIT/SUBRTN/ ;"SUBRTN" IDENTIFICATION WORD
SUBVER: MCNVER,,DECVER ;"SUBRTN" VERSION INFORMATION
$TTYSPD:-1 ;MONITOR TTY SPEED
NOEXEC: HALT . ;PROGRAM NOT CODED FOR EXEC MODE
PLERR: HALT . ;FATAL PUSH LIST POINTER ERROR
PLERR1: HALT . ;INITIAL PUSH LIST POINTER ERROR
MUOERR: HALT . ;MUUO WITH LUUO HANDLER WIPED OUT
DTEBER: HALT . ;DTE20 INTERRUPT WITHOUT DOORBELL
DTECER: HALT . ;DTE20 CLOCK INTERRUPT WITHOUT FLAG SET
CPIERR: HALT . ;CPU INITIALIZATION ERROR
EOPERR: HALT . ;END OF PROGRAM ERROR
LUOERR: HALT . ;INTERRUPT WITH LUUO HANDLER WIPED OUT
S
;*SPECIAL SUBROUTINE ONLY INITIALIZATION
S
$SBSRT: MOVEI 1
MOVEM ITRCNT ;ALLOW ONLY ONE PASS
MOVEI DIAMON
MOVEM RETURN
SETOM MAPNEW ;FULL 4096K MAPPING
PGMINT
JRST BEGEND
$REINI: SETZM $ONETM ;FOR NOW
SETZM PASCNT
SETZM ERRTLS
JRST BEGIN
STARTA: JRST BEGEND
PGMNAM: ASCIZ %
DECSYSTEM DIAGNOSTIC USER SUBROUTINE'S
%
S
;*CONTRL* SUBROUTINE PACKAGE INITIALIZATION
S
$PGMIN: MOVEM 0,$$PAC0
SETOM USER
JSP 0,.+1 ;LOAD FLAGS INTO AC0
TLNN 0,USERF ;USER MODE ?
HALT . ;EXEC MODE
SETZM MONTYP
MOVE [112,,11]
GETTAB ;GET MONITOR TYPE ID
CAM
CAIN 40000 ;TOPS20 ?
SETOM MONTYP ;YES
S
;*INITIALIZE PROCESSOR FLAGS AND PUSH LIST
S
$PGMN1: HLRZ JOBSA ;RESET JOB FIRST FREE TO
MOVEM JOBFF ;END OF LOW SEGMENT
SKIPN MONTYP
CALLI 0 ;TOPS10 RESET
SKIPE MONTYP
RESET ;CLEAR USER I/O
JRST 2,@.+1 ;CLEAR PC FLAGS
0,,.+1
MOVE CONSW
MOVEM $SVCSW# ;SAVE PREVIOUS SWITCHES
SETZM CONSW# ;CLEAR SWITCH REGISTER
SETZM $SWFLG# ;DISALLOW SWITCHES TILL INITED
MOVE [JRST $DDTENT] ;SETUP DDT START
MOVEM DDTSRT ;DDT IF LOADED, EOPUUO IF NOT
MOVE [JRST PSHERR]
MOVEM $PSHER ;INIT FOR UNDERFLOW
MOVE P,PLIST ;INIT PUSH POINTER
MOVEI 0,$PSHER
PUSH P,0 ;SET ERR FOR EXCESSIVE POP'S
PUSH P,0
S
;*INITIALIZE SUBROUTINES
S
PGINGO: GO $CPUTP ;DETERMINE CPU TYPE (KS/KL/KI/KA)
GO $UUOIN ;INIT UUO TRAP TRANSFER LOCATION
GO $PNTIN ;INIT PRINT SUBROUTINE
GO $TYPIN ;INIT TTY INPUT SUBROUTINE
GO $SWTIN ;INIT SWITCH INPUT SUBROUTINE
GO $ITRIN ;INIT INTERRUPT SUBROUTINE
SKIPE $MMAP ;MEMORY ROUTINES ?
GO $MEMMP ;MAP MEMORY
SETOM $ONETM ;SET ONE TIME FLAG
SETZM SCOPE ;INIT ERROR SCOPE LOOP
SETZM ERRPC ;INIT ERROR PC
JRST @$$PAC0#
S
;* -- THIS ROUTINE IS USED TO DETERMINE THE PROPER OPERATIONAL
;*MODE FOR A DIAGNOSTIC JUST LOADED. IT WILL CHECK WHETHER OR NOT
;*IT IS IN USER MODE OR EXEC MODE. AND THEN WILL CHECK TO SEE WHAT
;*MODE HAS BEEN SELECTED FOR THIS TEST TO RUN IN. THIS MODE IS SELECTED
;*AT ASSEMBLY TIME.
S
$MODCK: JSP 0,.+1 ;GET FLAG CONDITIONS
TLNE 0,USERF ;IN USER MODE ?
JRST $UCK ;YES
$ECK: SETOM ITRCNT ;EXEC, RUN FOREVER
SETZM MONCTL ;NOT HERE IF UNDER MONITOR CONTROL
SETOM MONFLG ;SET TO NORMAL OPERATION
SKIPE MONTEN ;LOADED BY "DIAMON" ?
JRST .+3 ;YES, RETURN TO "DIAMON" UPON COMPLETION
MOVEI BEGIN ;SET UP RETURN IN CASE WE EVER COUNT OUT
MOVEM RETURN ;FOR THE RETURN ADDRESS
SKIPE $EMODE ;EXEC MODE ALLOWED?
JRST $START ;YES - CONTINUE
HALT NOEXEC ;THIS PROGRAM NOT CODED FOR EXEC MODE OPERATION!
$UCK: SKIPE $UMODE ;USER MODE ALLOWED?
JRST $START ;YES - CONTINUE
$NOUSR: MOVE [112,,11]
GETTAB
CAM
CAIN 40000
JRST $NOU20
OUTSTR [ASCIZ/
EXEC ONLY
/]
OUTSTR @$PNAME
JRST @RETURN
$NOU20: HRROI 1,[ASCIZ/
EXEC ONLY
/]
PSOUT
HRROI 1,@$PNAME ;PRINT THE NAME OF THIS FILE
PSOUT
JRST @RETURN ;LEAVE FOR EVER
SUBTTL *CONTRL* UUO HANDLING SUBROUTINE
S
;*UUO INITIALIZATION
S
$UUOIN: MOVE [GO $UORTN] ;BRING IN UUORTN ENTRY INSTR.
MOVEM JOB41 ;SETUP UUO TRAP AT JOB41
MOVE [JRST $UOERX]
MOVEM $UUOER ;SET UUO ERROR IN "FIXED"
SETZM $UPLER#
RTN ;EXIT
S
;*THIS ROUTINE FIELDS ALL TRAPPED UUO'S AND SELECTS BETWEEN SUBROUTINE
;*PACKAGE UUO'S (037), TEST ERROR UUO'S (034, 035 & 036), AND DIAGNOSTIC
;*PROGRAM SEGMENT UUO'S (001 - 033).
;*AC0 IS SAVED ON THE STACK INITIALLY
S
$UORTN: SKIPE $$UUO ;IF NON-ZERO, XCT USERS UUO INTERCEPT
XCT $$UUO
TLNN P,777000
JRST $UOPLE ;CHECK THAT P LOOKS LIKE A P POINTER
TRNE P,747000
JRST $UOPLE
PUT AC0 ;SAVE AC0 ON PUSH LIST
HRRZ AC0,P ;VERIFY THAT THE PUSH POINTER
CAIG AC0,PLIST ;IS STILL OK
JRST $UOPLE ;OUT OF RANGE
CAIL AC0,PLISTE
JRST $UOPLE
HLRZ AC0,P ;GET CONTROL COUNT
CAIG AC0,777577
JRST $UOPLE ;OUT OF RANGE
CAIL AC0,777777
JRST $UOPLE
MOVE AC0,JOBUUO ;GET THE UUO
LSH AC0,-^D27 ;ISOLATE INSTRUCTION FIELD FOR UUO (RT 27 PLACES)
CAILE AC0,33 ;IS IT 33 OR LESS? (LOW)
JRST $SUBUO ;DECODE 34 - 37 @ $SUBUO
$USRUO: MOVE AC0,-1(P) ;GET USRPC + 1 (AC0 IS ALSO ON THE STACK)
SUBI 1 ; - 1
MOVEM $SVUPC ;SAVE FOR USER UUO ROUTINE (IF NEEDED)
MOVE AC0,JOBUUO ;GET UUO FROM LOCATION 40 IN JDA
MOVEM $SVUUO ;SAVE FOR USER UUO ROUTINE
GET AC0
XCT UUORTN ;EXECUTE USERS ROUTINE IF SUPPLIED
PUT AC0
MOVE AC0,$SVUUO
LSH AC0,-^D27 ;RIGHT SHIFT FOR INDEX INTO UUO TABLE
PUT 1
LSHC 0,-1
ADDI UUODIS ;ADD USER UUO TABLE START TO THE UUO
$XUUO: TLNN 1,400000
HRRZ @0 ;EVEN UUO
TLNE 1,400000
HLRZ @0 ;ODD UUO
GET 1
EXCH AC0,(P) ;PUT ADR ON STACK, AC0 BACK IN AC0
RTN ;SPECIAL XFER TO ROUTINE USING ADR ON STACK
$SUBUO: SUBI AC0,34 ;NORMALIZE TO MAKE LOWEST UUO = 0
ADDI AC0,TABLE0 ;ADDR OF TABLE + NORM. UUO (0-3)
JRST @0 ;SELECT THE CORRECT ERROR UUO VIA TABLE
TABLE0: JRST %REPT ;UUO = 34 ......................REPEAT
JRST %ERLP ;UUO = 35 ...........LOOP ON THE ERROR
JRST %ERUUO ;UUO = 36 .REPORT THE ERROR CONDITIONS
JRST $UUO37 ;UUO = 37 .......DECODE SUBROUTINE UUO
S
;*UUO ERROR EXIT ROUTINE
S
SALL
GET AC0 ;POP OFF AC0 (KA MUUO'S)
$UOERX: PUT JOBUUO ;SAVE BAD UUO WHILE PRINTING VIA AC0 (P + 1)
PMSG <^ILLEGAL UUO^UUO]]FLAGS] PC^>
GET AC0 ;GET BAD UUO FROM THE STACK (P - 1)
PNTHW ;PRINT IT
PSP ;PRINT SPACE
GET AC0 ;GET FLAGS & UUO PC + 1 FROM STACK (P - 1)
SUBI AC0,1 ;SUBTRACT 1
PNTHW ;PRINT FLAGS & UUO PC
PCRL ;PRINT C/R & L/F
XCT $UORTX ;EXECUTE USERS UUO EXIT, IF PROV
FATAL
$UOPLE: SKIPE $UPLER ;FIRST TIME ?
HALT PLERR ;NO, FATAL HALT THEN
SETOM $UPLER
MOVEM P,$PDOVP# ;SAVE "P"
MOVE P,PLIST
CAME P,[PLIST-PLISTE,,PLIST]
HALT PLERR1 ;INITIAL POINTER BAD
MOVEI $PSHER
PUSH P,0
PMSGF <^*****^UUO PLIST ERR P=>
MOVE $PDOVP
PNTHWF
FATAL
LALL
S
;*DECODE ROUTINE FOR SUBROUTINE UUO'S (037)
S
$UUO37: HRRZ JOBUUO ;GET CALLING UUO
JUMPE $PNTIT ;PRINT UUO
CAIN 0,1
JRST $PNTIF ;PRINT FORCED UUO
TRNE 777600
JRST $EG177 ;PRINT MESSAGE UUO
CAIL 5
JRST $EG4 ;PRINT CHAR IMMEDIATE UUO
PUT 1
MOVE 1,JOBUUO
LSH 1,-^D23 ;EXTRACT UUO AC FIELD
ANDI 1,17
LSH 0,4 ;POSITION E FIELD
IOR 0,1 ;COMBINE E & AC FIELD
LSHC 0,-1 ;SET ODD/EVEN
ADDI $UOTAB-20 ;COMPUTE TABLE ENTRY OFFSET
JRST $XUUO
$UOTAB: ;E FIELD = 2
$PTSXF,,$PNTSX
$PNTCF,,$PNTCW
$DRPDV,,$PNTNM
$MODDV,,$MODDP
$MSEG,,$SWTCH
$MPADR,,$MZRO
$MPCNK,,$MPSET
$PMAP,,$PNTMG
;E FIELD = 3
$YESNO,,$OPTLK
$TPOCT,,$NOYES
$TPCNV,,$TPDEC
$TALTM,,$TTLK
$TTYIN,,$TISIX
$UOERX,,$TPCLR
$PSIXF,,$PSIX
$POCSF,,$POCS
;E FIELD = 4
$CINVAL,,$MEMMP
$CWRTB,,$CFLUSH
$FSELECT,,$MTROP
$FRD36,,$FREAD
$UOERX,,$FRD8
$CLOCK,,$END
$FATAL,,$ERHLT
$UOERX,,$EOP
$EG4: MOVE JOBUUO ;IMMEDIATE CHARACTER PRINT
CAMN [PFORCE] ;"PFORCE" CALL ?
JRST $EGX1 ;YES
TLNE (1B12)
JRST [PNTCHF
JRST $EGX]
PNTCHR
JRST $EGX
$EG177: MOVE JOBUUO ;IMMEDIATE MESSAGE PRINT
TLNE (4B12)
JRST [PSIXLF
JRST $EGX]
TLNE (2B12)
JRST [PSIXL
JRST $EGX]
TLNE (1B12)
JRST [PNTALF
JRST $EGX]
PNTAL
$EGX: GET 0
RTN
$EGX1: GO $PCLRO ;CLEAR CONTROL O & INPUT BUFFER
JRST $EGX
$CFLUSH:
$CINVAL:
$CLOCK:
$CWRTB:
$MPCNK:
$MPSET:
$MTROP:
$PNTMG:
RTN ;NON-USER MODE UUO'S
SUBTTL *CONTRL* PDP-10 DIAGNOSTIC ERROR HANDLER
S
;*THE DIAGNOSTIC ERROR HANDLER IS A SUBROUTINE CAPABLE OF REPORTING
;*A STANDARD BUT FLEXIBLE FORMAT OF TEST DATA AND DIAGNOSTIC
;*INFORMATION. THE ERROR HANDLER ALSO INTERPRETS AND CONTROLS TEST
;*SWITCHES SUCH AS TYPEOUT SUPPRESSION, CONTINUE/HALT OR LOOP ON
;*ERROR, AND BELL ON ERROR.
;*ERROR LOOPING ROUTINE
;*EITHER CONTINUES IN-LINE
;*OR TRANSFERS TO E FIELD OF UUO
;*CHECKS PC OF ERROR TO DETERMINE LOOPING
S
%ERLP: SETZM %ERFLG#
MOVE AC0,JOBUUO ;GET AC FIELD OF UUO
LSH AC0,-^D23
ANDI AC0,17
CAIN AC0,2
JRST %ERLP2 ; 2 = LOOP IF ANY ERROR
CAIN AC0,1
JRST %ERLP1 ; 1 = LOOP IF PC'S MATCH
CAIN AC0,0
JRST %ERLP0 ; 0 = PC'S, REPT, REPT1 & ERROR
GET AC0
JRST $UOERX
%ERLP0: SETOM %ERFLG
CAMN REPT,%RP ;ARE REPEAT COUNTS SAME AS ERROR ?
CAME REPT1,%RP1 ;(AT RIGHT PLACE IN TEST LOOPS ?)
JRST %ERX1 ;NO, CONTINUE IN LINE
%ERLP1: HRRZ AC0,-1(P) ;GET PC OF LOOP CALL FROM STACK
SUBI AC0,2 ;LESS 2
CAME AC0,ERRPC ;NOW EQUAL TO PC OF ERROR CALL ?
JRST %ERX1 ;NO, CONTINUE IN LINE
%ERLP2: GO $SWTCH ;READ SWITCHES INTO AC0
TLNN LOOPER ;LOOP ON ERROR ?
SETZM SCOPE ;NO ..........CLEAR LOOP CONTROL
SKIPL SCOPE ;YES ...WAS THERE AN ERROR ?
JRST %ERX1 ;NO, CONTINUE IN LINE
%ERX: GET AC0 ;RESTORE AC0
SUB P,[1,,1] ;CORRECT PUSH LIST POINTER FOR NO "RTN"
JRST @JOBUUO ;TRANSFER TO E FIELD OF UUO
%ERX1: GET AC0 ;RESTORE AC0
RTN
S
;*REPEAT LOOP ROUTINE
;*EITHER CONTINUES IN-LINE
;*OR TRANSFERS TO E FIELD OF UUO
S
%REPT: SOSLE REPTU# ;REPEAT TEST SECTION ?
JRST %ERX ;YES, E FIELD OF UUO IS RETURN
JRST %ERX1 ;NO, CONTINUE IN LINE
S
;*COMMON ERROR HANDLER AC SAVE/RESTORE
S
%EACS: MOVEM 0,%AC0#
MOVEM 1,%AC1#
MOVEM 2,%AC2#
MOVEM 3,%AC3#
RTN
%EACR: MOVE 0,%AC0
%EACR1: MOVE 1,%AC1
MOVE 2,%AC2
MOVE 3,%AC3
RTN
;*ERROR REPORTING ROUTINE
S
%ERUUO: MOVE LUUO
MOVEM %LUUO#
SETOM SCOPE
GET AC0
SKIPE %ERHI1 ;ANY USERS INSTRUCTION ?
XCT %ERHI1 ;YES, DO USERS ROUTINE
GO %EACS ;SAVE AC0 - AC3
SETZM %CORFLG#
SETZM %ACTFL#
AOS ERRTLS ;INCREMENT ERROR TOTALS
GO $SWTCH
HRRZ 3,(P) ;GET <ADDRESS> OF ERROR CALL FROM STACK
SUBI 3,1
CAME 3,ERRPC ;SKIP IF SAME ERROR
JRST %ERPNT
SKIPN %ERFLG
JRST .+4 ;DON'T CHECK REPEAT COUNTS
CAMN REPT,%RP
CAME REPT1,%RP1
JRST %ERPNT ;DIFFERENT, PRINT ERROR
TLNN PALERS ;PRINT ALL ERRORS ?
JRST %ERSW1 ;THIS ERROR ALREADY REPORTED ONCE.
;*BYPASS ERROR REPORT IF NOPNT SWITCH IS SET
S
%ERPNT: MOVEM REPT,%RP# ;SAVE REPEAT COUNTS
MOVEM REPT1,%RP1#
MOVEM 3,ERRPC ;SAVE ERROR CALL ADDRESS
TLNE 0,NOPNT
JRST %ERSW1
PFORCE ;OVERRIDE CONTROL O
SETZM %ERCNT#
SKIPGE MONCTL ;DIAG MON OR SYS EXER ?
JRST %ERPRA ;YES, GO PRINT TITLE
SALL
%ERPRB: SKIPN PASCNT
JRST .+4 ;DON'T PRINT PASS COUNTER ON FIRST PASS
PMSG <^TEST PASS COUNT = >
MOVE 0,PASCNT
PNTDEC ;PRINT TEST PASS COUNTER
PMSG <^PC= >
MOVEI 0,(3)
PNT6 ;PRINT PC OF ERROR CALL.
PMSG <^SWITCHES = >
MOVE CONSW
PNTHW ;PRINT SWITCHES AT ERROR
GO %EACR
SKIPE %ERHI3 ;IF NON-ZERO, XCT USERS ROUTINE
XCT %ERHI3
HRRZ 3,@ERRPC ;GET "E FIELD" OF ERROR CALL
MOVE 0,CONSW ;AC3 HAS THE ERROR CALL ADDR IN IT
TLNE TXTINH ;TEXT INHIBITED ?
JRST %ERPR2 ;YES
MOVEI 0,SIXBTZ <^ERROR IN >
HLRZ 1,(3) ;GET NAME OF FAILING TEST
JUMPE 1,%ERPR1 ;JUMP IF NO TEST NAME
PSIXL ;*DEFINE T=0 TO INHIBIT TEST NAME
MOVE 0,1
PSIXL ;REPORT NAME OF FAILING TEST
MOVEI 0,SIXBTZ < - >
JRST .+2
%ERPR1: MOVEI 0,SIXBTZ <^>
HRRZ 1,(3) ;GET ADDRESS OF FUNCTION MSG
MOVE 1,(1) ;GET MESSAGE
CAMN 1,[SIXBIT\_\] ;BLANK MESSAGE ?
JRST %ERPR2 ;JUMP IF NO FUNCTION CALLED OUT.
PSIXL
HRRZ 0,(3) ;GET MESSAGE ADDRESS AGAIN
PSIXL ;REPORT FUNCTION BEING TESTED.
%ERPR2: SETOM %DISCR# ;SET 'DISCREPANCY FLAG'.
LALL
;*GET X (AC FIELD) FROM ERROR UUO. PASS X ARGUMENT ONTO $PRINT.
S
SALL
%ERP2B: MOVE %LUUO
ROT 0,15 ;GET THE X ARGUEMENT
ANDI 0,17
JUMPN 0,.+2 ;PRINT 12 OCTAL DIGITS IF X=0
MOVEI 0,14
CAILE 0,14 ;MAKE SURE THAT X IS A LEGAL ARGUMENT
FATAL ;PROGRAM CALL ERROR
LSH 0,^D<35-12> ;PUT X IN AC FIELD
ADD 0,[PNTA] ;PRINT THE X ARGUEMENT
MOVEM 0,%ERIN2
MOVEI 0,SIXBTZ <^CORRECT: >
HLRZ 2,1(3) ;GET ADDRESS OF EXPECTED TEST RESULTS
JUMPN 2,.+3
SETZM %DISCR ;NO 'CORRECT RESULT' TYPEOUT
JRST %ERPR3
SETOM %CORFLG
CAILE 2,3 ;ARE TEST RESULTS IN AC THAT HAS BEEN SAVED?
JRST %ERP2A
CAIN 2,1 ;AC1?
MOVE 1,%AC1
CAIN 2,2 ;AC2?
MOVE 1,%AC2
CAIN 2,3 ;AC3?
MOVE 1,%AC3
JRST .+2
%ERP2A: MOVE 1,(2)
LALL
;*AC1 NOW CONTAINS THE CORRECT TEST RESULTS.
S
SALL
PSIXL ;CORRECT RESULTS.
MOVE 0,1
JSR %ERIN1 ;REPORT CORRECT DATA
MOVEM 1,%COREC# ;SAVE CORRECT DATA
%ERPR3: MOVEI 0,SIXBTZ <^ACTUAL: >
HRRZ 2,1(3) ;GET ADDRESS OF ACTUAL TEST RESULTS.
JUMPN 2,.+3
SETZM %DISCR ;NO 'ACTUAL RESULT' TYPEOUT.
JRST %ERPR4
SETOM %ACTFL
CAILE 2,3 ;ARE ACTUAL TEST RESULTS IN AC THAT IS SAVED?
JRST %ERP3A
CAIN 2,1 ;AC1?
MOVE 1,%AC1
CAIN 2,2 ;AC2?
MOVE 1,%AC2
CAIN 2,3 ;AC3?
MOVE 1,%AC3
JRST .+2
%ERP3A: MOVE 1,(2)
LALL
;*AC1 CONTAINS THE ACTUAL TEST RESULTS.
S
SALL
PSIXL ;ACTUAL RESULTS
MOVE 0,1
JSR %ERIN1 ;REPORT ACTUAL DATA
MOVEM 1,%ACTUL# ;SAVE ACTUAL DATA
%ERPR4: MOVEI 0,SIXBTZ <^DISCREP: >
SKIPN %DISCR ;REPORT DATA DISCREPANCY IF BOTH CORRECT AND
JRST %ERPR5 ;ACTUAL DATA REPORTED.
MOVE 1,%COREC
XOR 1,%ACTUL ;XOR CORRECT & ACTUAL DATA
PSIXL
MOVE 0,1
JSR %ERIN1 ;REPORT DISC BETWEEN COR & ACT
MOVEM 1,%DISCR ;SAVE DISCREPANCY DATA
LALL
;*PICK UP AND REPORT DIAGNOSTIC COMMENT IF ANY.
S
%ERPR5: MOVE 0,CONSW
TLNE TXTINH ;TEXT INHIBITED ?
JRST %ERPR6 ;YES
HLRZ 1,2(3) ;GET ADDRESS OF ASCIZ TEXT.
MOVE 1,(1) ;GET MESSAGE
CAMN 1,[SIXBIT\_\] ;BLANK MESSAGE ?
JRST %ERPR6 ;EXIT FROM ERROR PRINT IF NO DIAGNOSTIC TEXT.
PCRL
HLRZ 0,2(3) ;GET MESSAGE ADDRESS AGAIN
PSIXL
%ERPR6: PCRL
HRRZ 0,2(3) ;GET ADDRESS OF ADDITIONAL ERROR PRINT ROUTINE
GO %EACR1
MOVEM 0,%ERXTR#
JUMPE 0,%ERMORE ;JUMP IF NONE
MOVE 0,CONSW
TLNE 0,TXTINH ;TEXT INHIBITED ?
JRST %ERMORE ;YES, NO ADDITIONAL PRINT
MOVE 0,%AC0
GO @%ERXTR ;XFER TO PRINT ROUTINE, RETURN TO ERMORE
MOVEM 0,%AC0
%ERMORE:MOVE 0,%AC0
XCT ERMORE ;TO ADD ROUTINE PLACE XFR AT ERMORE
;IN "FIXED"
GO %EACS
GO $PNTMG ;IF KI10, PRINT MARGINS
GO $SWTCH
;*EXAMINE DATA SWITCHES (OR SOFTWARE SWITCHES IF USER MODE).
S
%ERSW1: GO $TALTM ;ALTMODE CHECK
JRST .+4 ;NONE
MOVEI .+3 ;SAVE ADDRESS FOR CONTINUE
MOVEM JOBOPC
JRST @ALTMGO ;PERFORM TRANSFER
MOVE 3,CONSW
TLNN 3,ERSTOP ;IS 'HALT ON ERROR' SWITCH SET, (SWITCH ERSTOP)
JRST %ERSW2 ;NO
;*EXECUTE HALT IF SWITCH ERSTOP SET.
S
%ERS1A: GO %EACR ;RESTORE AC'S
JRST $ERHLT ;USE SUBROUTINE ERROR HALT
%ERPRA: SKIPN %ERFST# ;PRINT PROGRAM NAME
PNTNM
SETOM %ERFST
JRST %ERPRB
;*EXAMINE LOOPER SWITCH AND SCOPE LOOP ON ERROR IF SET.
S
%ERSW2: TLNN 3,LOOPER
SETZM SCOPE ;CLEAR SCOPE LOOP CONTROL
AOS 1,%ERCNT ;INCREMENT ERROR COUNT
;*RING TTY BELL IF DING SWITCH IS SET.
S
%ERSW3: TLNE 3,DING
PBELL
;*RETURN TO ERROR CALL ADDRESS+1
S
%EXCAL: GO %EACR1
SKIPL MONCTL ;UNDER DIAGNOSTIC MONITOR ?
JRST %EXCL1 ;NO, CONTINUE PROGRAM
MOVE 0,ERRTLS ;YES
CAIL 0,5 ;PRINTED ALLOWED ERRORS ?
JRST $BEND2 ;END OF PROGRAM
%EXCL1: MOVE 0,%AC0
SKIPE %ERHI2 ;ANY USERS INSTRUCTION ?
XCT %ERHI2 ;YES, DO USERS ROUTINE
RTN ;CONTINUE PROGRAM
SUBTTL PROCESSOR TYPE DETERMINATION
S
$CPUTP: SETZM CYCL60
SETZM SM10
SETZM KLFLG
SETZM KAIFLG
$CPKL: SETZ 1, ;source 0, dest 0
BLT 1,0 ;copy 1 word from 0 to 0
SKIPN 1 ;if KL10, BLT will change AC1
JRST $CPKAI
SETOM KLFLG ;KL10 - SET FLAG
$CPINI: SKIPN MONTYP
JRST .+5 ;TOPS-10
MOVE 1,[SIXBIT/APRID/]
SYSGT ;GET SERIAL NUMBER
MOVE 0,1
JRST .+4
MOVE 0,[20,,11]
GETTAB
SETZ 0,
MOVEM 0,$$SNX# ;SAVE IT
SKIPN KLFLG
RTN
CAILE 0,^D4096 ;IS THIS A KS10 ?
SETOM SM10 ;YES, SERIAL # GT 4096.
RTN
$CPKAI: SETOM KAIFLG
MOVNI 0,1
AOBJN 0,.+1
SKIPE
SETZM KAIFLG ;KA10
JRST $CPINI
SUBTTL "DIAMON" FILE SELECTION & READ
S
$FSELECT:PUT 0
SETZM $FSELF#
MOVE 0,[1,,POWER+1] ;SAVE ACS
BLT POWER+16
GET 0
SKIPN FSELNK ;ANY FILE SELECT LINK ?
JRST $FSEL1 ;NO
GO @FSELNK ;TRANSFER TO "DIAMON"
JRST $FSEL2 ;ERROR RTN, AC0 HAS CODE
SETOM $FSELF ;FOUND, SET FILE SELECTED FLAG
AOS (P) ;SKIP RETURN
$FSEL2: PUT 0
MOVS 0,[1,,POWER+1] ;RESTORE ACS
BLT 16
GET 0
RTN
$FSEL1: SETZM 0 ;NO "DIAMON" CAPABILTY
JRST $FSEL2
;*"DIAMON" FILE READ
S
$FRD8: MOVEI 0,1 ;SET FLAG FOR 8BIT READ
JRST .+4
$FRD36: SETO ;SET FLAG FOR 36 BIT READ
JRST .+2
$FREAD: SETZ ;SET FLAG FOR 7 BIT ASCII READ
PUT 0
SKIPN $FSELF ;WAS ANY FILE SELECTED ?
FATAL ;NO
SKIPN FRDLNK ;ANY FILE READ LINK ?
FATAL ;NO
MOVE 0,[1,,POWER+1] ;SAVE ACS
BLT POWER+16
GET 0 ;GET FORMAT FLAG
GO @FRDLNK ;TRANSFER TO "DIAMON"
JRST $FSEL2 ;EOF
JRST $FSEL2-1 ;OK, SKIP RETURN
SUBTTL PROGRAM HALTS
;*SUBROUTINE ERROR HALT
S
SALL
$ERHLT: PNTNM ;PRINT PROGRAM NAME
PMSGF <ERROR HALT AT >
GET $ERH0
PUT 0
MOVE AC0,$ERH0# ;LOAD HALT LOC WITH USRPC + 1 FOR RESTART
SOS ;SUBTRACT ONE FOR USRPC OF ERROR
PNT6F ;PRINT USRPC FORCED
PCRLF
SKIPL MONCTL ;UNDER MONITOR CONTROL ?
JRST $ERHL4 ;NO..HALT AT USRPC WHERE UUO OCCURRED
$ERHL1: GO $SWTCH ;READ SWITCHES INTO AC0
TLNE 0,ERSTOP ;HALT ON ERROR SWITCH SET ?
JRST $ERHL4 ;YES...HALT
$ERHL3: GET AC0 ;RESTORE THE STACK (P - 1)
JRST $BEND2 ;END OF PROGRAM
$ERHL4: GET AC0
SKIPE MONTYP
JRST .+3
EXIT 1,
JRST @$ERH0
HALTF ;RETURN TO MONITOR
JRST @$ERH0 ;IF CONTINUED
LALL
;*FATAL PROGRAM ERROR HALT
S
SALL
$FATAL: PNTNM
PMSGF <FATAL PROGRAM ERROR AT >
MOVE AC0,(P) ;RETRIEVE USRPC + 1 FROM THE STACK
SOS ;- 1
PNT6F ;PRINT IT
PCRLF
SKIPL MONCTL ;EXEC - DIAGNOSTIC MONITOR ?
JRST $FATL1 ;NO, END OF PROGRAM
GO $SWTCH ;YES ... READ SWITCHES
TLNN ERSTOP ;STOP ON ERROR ?
JRST $BEND2 ;NO, END OF PROGRAM
$FATL1:
$DDTENT:PUT 0
MOVE AC0,DDT+1 ;GET DDT ID
CAME AC0,[ASCII/DDT/]
JRST $BEND2 ;NOT LOADED, END PROGRAM
GET 0
JRST @DDTLNK ;DDT LOADED, GO TO IT
LALL
SUBTTL PROGRAM NAME PRINTER
;*PRINT PROGRAM NAME IF NOT STAND-ALONE OR USER MODE
S
SALL
$PNTNM: SKIPL MONCTL ;DIAG MON / SYS EXR ?
JRST $PNM2 ;NO
PNTMSG @$PNAME ;PRINT PROGRAM NAME
PMSG <VERSION >
HLRZ JOBVER
PNTOCS ;PRINT MCN LEVEL
PNTCI "."
HRRZ JOBVER
PNTOCS ;PRINT DEC VERSION
PMSG <, SV=>
HLRZ SUBVER
PNTOCS ;PRINT "SUBRTN" MCN LEVEL
PNTCI "."
HRRZ SUBVER
PNTOCS ;PRINT "SUBRTN" DEC VERSION
SKIPN MONTYP
PMSG <, TOPS-10>
SKIPE MONTYP
PMSG <, TOPS-20>
SKIPE KLFLG
JRST [SKIPE SM10
JRST [PMSG <, KS10>
JRST $PNM3]
PMSG <, KL10>
JRST $PNM3]
SKIPN KAIFLG
JRST [PMSG <, KA10>
JRST $PNM3]
PMSG <, KI10>
$PNM3: SKIPN $$SNX ;ANY SERIAL NUMBER ?
JRST $PNM2 ;NO
PMSG <, CPU#=>
MOVE $$SNX
PNTDEC ;PRINT SERIAL NUMBER
$PNM2: PCRL
RTN ;EXIT
SUBTTL *SUBRTN* INTERRUPT HANDLING ROUTINES
LALL
;*PUSH DOWN LIST EXCESSIVE POPJ ROUTINE
S
SALL
PSHERR: PMSGF <^*****^PLIST UFLOW^>
FATAL ;PRINT LOCATION AND EXIT
LALL
S
;*INTERRUPT ROUTINE INITIALIZATION
S
SALL
$ITRIN: SKIPE MONTYP
JRST .+6
MOVEI ITRUSR ;TOPS10, SETUP USER APR TRAPPING
MOVEM JOBAPR
MOVEI PDLOVU!MPVU!NXMU!PARU
APRENB ;ENABLE PROCESSOR TRAPS
RTN
MOVEI 1,.FHSLF ;CURRENT PROCESS
MOVE 2,[LEVTAB,,CHNTAB]
SIR ;SPECIFY INTERRUPT TABLES
EIR ;ENABLE SYSTEM
MOVE 2,[1B1+1B<.ICPOV>+1B<.ICILI>+1B<.ICIRD>+1B<.ICIWR>]
AIC ;ACTIVATE CHANNELS
MOVE 1,[.TICCG,,1]
ATI ;ASSIGN CTRL/G TO CHANNEL 1
RTN
LALL
;*INTERRUPT TABLES
S
SALL
LEVTAB: 0 ;LEVEL TABLE
PC2
0
PC2: 0
CHNTAB: 0 ;CHANNEL TABLE
2,,CNTRLG ;CHANNEL 1 IS CTRL/G
REPEAT ^D7,<0> ;CHANNEL 2-8 NOT USED
2,,PDLINT ;CHANNEL 9 IS PDL
REPEAT ^D5,<0> ;CHANNEL 10-14 NOT USED
2,,IININT ;CHANNEL 15 IS ILLEGAL INST
2,,IMRINT ;CHANNEL 16 IS ILLEGAL MEMORY READ
2,,IMWINT ;CHANNEL 17 IS ILLEGAL MEMORY WRITE
REPEAT ^D18,<0> ;CHANNEL 18-35 NOT USED
LALL
;*TOPS20 CONTROL G ROUTINE
S
SALL
CNTRLG: MOVEM 0,$CGAC0#
TLNN P,777000 ;CHECK THAT P IS "SUBUSR'S" P
JRST CNTRG1 ;NO
TRNE P,747000
JRST CNTRG1
HRRZ 0,P
CAIG 0,PLIST
JRST CNTRG1
CAIL 0,PLISTE
JRST CNTRG1
HLRZ 0,P
CAIG 0,777577
JRST CNTRG1
CAIL 0,777777
JRST CNTRG1
SKIPE $$TAX1
XCT $$TAX1 ;EXECUTE USER ROUTINE IF SUPPLIED
GO $SW0 ;DO SWITCHES
SKIPE $$TAX2
XCT $$TAX2 ;EXECUTE USER ROUTINE IF SUPPLIED
DEBRK ;DISMISS INTERRUPT
CNTRG1: MOVE 0,$CGAC0
DEBRK
LALL
;*TOPS20 INTERRUPT PROCESSOR
S
SALL
PDLINT: MOVEM 0,$ACC0
MOVEI $PDOVU ;SETUP TRANSFER
$$INT: EXCH PC2
MOVEM ITRCH1 ;SAVE TRAPPED ADDRESS
DEBRK ;DISMISS INTERRUPT
IININT: MOVEM 0,$ACC0
MOVEI $IIN
JRST $$INT
IMRINT: MOVEM 0,$ACC0
MOVEI $IMR
JRST $$INT
IMWINT: MOVEM 0,$ACC0
MOVEI $IMW
JRST $$INT
$PDOVU: MOVEM P,$PDOVP#
MOVE P,PLIST ;RESET POINTER
MOVEI 0,$PSHER
PUSH P,0
PMSG <^*****^PLIST OVERFLOW P=>
MOVE 0,$PDOVP
PNTHW
SETZ
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
$IIN: PMSG <^*****^ILLEGAL INSTRUCTION >
MOVE ITRCH1
SOS
MOVE @0
PNTHW ;PRINT OFFENDING INSTRUCTION
SETZ
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
$IMR: MOVEI SIXBTZ <^ILLEGAL MEMORY READ>
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
$IMW: MOVEI SIXBTZ <^ILLEGAL MEMORY WRITE>
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
LALL
;*TOPS10 USER INTERRUPT HANDLER
S
SALL
ITRUSR: MOVEM $ACC0
MOVE JOBTPC
MOVEM ITRCH1 ;SAVE TRAPPED ADDRESS
MOVE JOBCNI ;GET CAUSE
TRNE PARU
$UPAR: JRST $PAREX ;PARITY ERROR
TRNE PDLOVU
$UPDL: JRST $PDOVU ;PUSHDOWN OVERFLOW
TRNE MPVU
$UMPV: JRST $MPVU ;MEMORY PROTECTION VIOLATION
TRNE NXMU
$UNXM: JRST $NXMU ;NON-X-MEMORY
MOVEI SIXBTZ <^UNKNOWN INTERRUPT>
JRST $ITR1A
$MPVU: MOVEI SIXBTZ <^MEMORY PROT>
JRST $ITR1A
$NXMU: MOVEI SIXBTZ <^NON-X-MEMORY>
JRST $ITR1A
$PAREX: MOVE $ACC0
XCT $PARER ;EXECUTE USERS ROUTINE IF SUPPLIED
MOVEI SIXBTZ <^MEMORY PARITY>
JRST $ITR1A
LALL
;*COMMON INTERRUPT HANDLERS
;*PRINT CAUSE AND OTHER PERTINENT INFO
S
SALL
$ITR1A: PUT 0
PFORCE
GET 0
$ITR1B: SKIPE 0
PSIXL ;PRINT CAUSE
PMSG <^FLAGS PC PROG^>
MOVE ITRCH1
PNTHW ;PRINT FLAGS, PC
PSP
HRRZ 0,(P)
PNT6 ;PRINT LAST PUSHJ ENTRY
PCRL
MOVE 0,$ACC0
XCT $ITRX1 ;EXECUTE USER ROUTINE, IF SUPPLIED
FATAL
LALL
SUBTTL *SUBRTN* END OF PASS/END OF PROGRAM ROUTINES
LALL
;*END OF PASS ROUTINE
S
SALL
$END: AOS PASCNT ;INCREMENT PASS COUNTER
SOS ITRCNT
SETZM SCOPE
SETZM ERRPC
GO $SWTCH
TLNE ABORT ;ABORT AT END OF PASS ?
JRST $END2 ;YES
SKIPN ITRCNT
$END1: JRST $END3 ;SKIP RETURN, COMPLETED ALL ITERATIONS
RTN ;NON - SKIP , KEEP RUNNING
$END2: PMSGF <END PASS >
MOVE PASCNT ;PRINT END OF PASS COUNT
PNTDCF
PNTCIF "."
PCRLF
$END3: AOS (P)
RTN
LALL
;*END OF PROGRAM ROUTINE
S
$EOP: SKIPE MONTEN ;USER, LOADED BY ITSELF ?
JRST @RETURN ;NO, RETURN TO LOADER
SKIPN MONTYP
EXIT
HALTF ;YES, EXIT
JRST BEGIN
SUBTTL *SUBRTN* MEMORY MANAGMENT ROUTINES
S
;*THESE ROUTINES PERFORM CORE MAPPING AND PRINTING AS WELL AS MEMORY
;*ZEROING AND ADDRESS TRANSLATION FOR PAGING OR DIRECT ADDRESS MODES
;* $MPCNK (MAPCNK) ACTUAL MEMORY CHUNK MAPPER
;* $MPSET (MAPSET) SETS UP PAGE MAP FOR KI10
;* $MSEG (MEMSEG) SET UP SEGMENTS FROM CHUNKS IN PAGE MAP
;* $MZRO (MEMZRO) ZERO'S THE MAPPED MEMORY
;* $MPADR (MAPADR) VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
S
$MEMMP: SETZM MEMSIZ ;USER MEMORY STARTS AT 0
HRRZ JOBREL ;GET HIGHEST REL ADDRESS
MOVEM MEMSIZ+1 ;SAVE AS MEMORY SIZE
SETOM MEMSIZ+2 ;FLAG END OF MEMSIZ TABLE
SETZM MAPNEW ;CLEAR 4096K MAPPING FLAG
JRST $PMAP ;GO PRINT MAP
S
;*MEMSEG, ARGUMENTS 0-10: SETUP CORRESPONDING CHUNK FROM MEMSIZ TABLE
;* 11-37 RETURN 0, MAXIMUM OF 8 CHUNKS IN 256K
;* USER MODE, 1-37 ALWAYS RETURNS 0
;* GT 37 - RETURNS MEMORY AT PHYSICAL ADDRESS
;*RETURNED IN AC0:
;* 0 - NO MEMORY AVAILABLE
;* START ADDRESS,,END ADDRESS
;*RETURNS +1
S
$MSEG: MOVEM 1,$ACMP5# ;AC1 = TEMP STORAGE POINTER
MOVEM 2,$ACMP6# ;AC2 = MAP STORAGE POINTER
MOVEM 3,$ACMP7# ;AC3 = CHUNK START ADR
MOVEM 4,$ACMP8# ;AC4 = CHUNK END ADR
MOVEM 5,$ACMP9# ;AC5 = PAGE COUNTER
SETZB 5,$MNCON# ;SAVED AC1 - AC5
TLNE 0,777760 ;VALID ARGUMENT ?
FATAL ;NO
JUMPE 0,$MSKA ;USER MODE, SEGMENT 0 ONLY
CAIL 0,40 ;IF 1-37, NO MEMORY
JRST $MSKAP ;PHY, DO DIRECT PHYSICAL
$MSEG3: MOVE 0,5 ;AC0 = RESULTS (SEE TITLE BLOCK)
MOVE 1,$ACMP5 ;RESTORE AC'S
MOVE 2,$ACMP6
MOVE 3,$ACMP7
MOVE 4,$ACMP8
MOVE 5,$ACMP9
RTN
;*PHYSICAL CORE ASSIGNMENT
S
$MSKAP: CAILE 0,777000 ;REQUEST FOR OVER 256K ?
JRST $MSEG3 ;YES, NO MEMORY
$MSEGP: MOVE 1,0
TRZ 1,777 ;MAKE PHYSICAL EVEN PAGE
SETZ 4,
MOVE MEMSIZ(4) ;GET START ADDRESS
JUMPL $MSEG3 ;IF END OF TABLE, NO CORE ..EXIT
CAMGE 1,0 ;PHY = OR GT START ?
JRST $MSEG3 ;NO, NO CORE ...EXIT
MOVE MEMSIZ+1(4) ;GET END ADDRESS
ADDI 4,2
CAML 1,0 ;PHY GT END ?
JRST .-7 ;YES, TRY NEXT CHUNK
MOVE 5,0 ;1= PHY ADR, 0= END ADR
HRL 5,1 ; START ADR,,END ADR
JRST $MSEG3 ;EXIT
$MSKA: MOVE 1,0
LSH 1,1 ;DOUBLE, 2 ENTRIES PER
MOVE 0,MEMSIZ(1) ;GET START ADDRESS
JUMPL 0,$MSEG3 ;NO MEMORY ...EXIT
MOVE 2,MEMSIZ+1(1) ;GET END ADDRESS
JUMPE 2,$MSEG3 ;NO MEMORY ...EXIT
JUMPN 0,.+2 ;IF START ADDRESS IS 0
MOVE 0,MEMLOW ;USE 'MEMLOW'
CAMG 2,0 ;END GREATER THAN START ?
FATAL ;NO ...ABORT
MOVE 5,2 ;SETUP START ADR,,END ADR
HRL 5,0
JRST $MSEG3 ;EXIT
S
;*MEMZRO, ZERO'S MEMORY FROM MEMLOW UP TO MAXIMUM
;*MAPNEW = 0 DIRECT MEMORY ZERO
S
$MZRO: MOVEM 1,$MZROB# ;SAVE AC1 & AC2
MOVEM 2,$MZROC#
$MZRO2: SETZ 2, ;DIRECT MEMORY ZERO
MOVE 0,MEMLOW ;START ADDRESS
CAML 0,MEMSIZ+1
JRST $MZROX
JRST .+3
$MZRO3: MOVE 0,MEMSIZ(2) ;SEGMENT START ADDRESS
JUMPL 0,$MZROX ;DONE
SETZM @0
HRLS ;CREATE BLT POINTER
ADDI 1
BLT 0,@MEMSIZ+1(2) ;ZERO DIRECT
ADDI 2,2
JRST $MZRO3 ;DO NEXT SEGMENT
$MZROX: MOVE 2,$MZROC ;RESTORE AC'S
MOVE 1,$MZROB
RTN ;EXIT
S
;*MAPADR, VIRTUAL ADDRESS IN AC0, PHYSICAL ADDRESS RETURNED IN AC0
;*SKIP RETURN IS NORMAL, NON-SKIP RETURN IS KI10 PAGE INACCESSIBLE
S
$MPADR: MOVEM 1,$MPAC0#
HRRZ 1,0
CAIG 1,17 ;ACCUMULATOR ADDRESS ?
JRST $MPAD3-1 ;YES
MOVE CONSW
SKIPN PVPAGI
TLNN INHPAG
JRST .+2
JRST $MPAD2 ;PAGING INHIBITED
SKIPE KLFLG ;KL10 ?
JRST $MPADL ;YES
SKIPN KAIFLG ;KA10 ?
JRST $MPAD2 ;YES
$MPAD6: MAP 0,(1) ;KI10, GET RELOCATION DATA
TRNE 0,400000 ;PAGE FAILURE ?
JRST $MPAD4 ;YES, SEE IF VALID ANYWAY
$MPAD5: TRZ 0,760000 ;CLEAR P,W,S, NO MATCH BITS
LSH 0,^D9 ;HI-ORDER 13 FROM MAP
ANDI 1,777 ;LO-ORDER 9 FROM VIRTUAL
OR 0,1 ;COMBINE
$MPAD7: AOS (P) ;SKIP RETURN
$MPAD3: MOVE 1,$MPAC0
RTN
$MPAD4: TRNE 0,20000 ;PAGE FAILURE, ALSO NO MATCH ?
JRST $MPAD3 ;YES, ERROR
JRST $MPAD5 ;MATCH (RELOCATION VALID)
$MPAD2: MOVE 0,1 ;KA10
HRROI 1
CALLI 41 ;GETTAB - RELOCATION TABLE
SETZ ;ERROR
HRRZ ;RELOCATION ONLY
ADD 0,1 ;RELOC + VIRTUAL = PHYSICAL
JRST $MPAD7
$MPADL: MOVE 0,1 ;MAP ILLEGAL ON KL10
JRST $MPAD7 ;SO VIRTUAL GIVEN BACK
;*MAPPNT, PRINT MEMORY MAP
S
SALL
$PMAP: SETZ 4,
SKIPL MONCTL ;UNDER DIAGNOSTIC MONITOR ?
JRST $PMAP3 ;NO
JRST $PMAP1 ;YES
$PMAP3: SKIPN $ONETM ;FIRST TIME ?
SETO 4, ;YES, SET FLAG FOR PRINTING
$PMAP1: JUMPE 4,$PMAPL-1 ;NO
PMSG <^MEMORY MAP =^FROM TO SIZE/K>
PCRL
SETZB 3,5
$PMAPL: JUMPE 4,.+6
MOVE MEMSIZ(3)
PNTADR ;PRINT START ADDRESS
MOVE MEMSIZ+1(3)
PNTADR ;PRINT END ADDRESS
PNTCI " "
MOVE MEMSIZ+1(3)
ADDI 0,1
SUB MEMSIZ(3)
IDIVI ^D1024
ADD 5,0
JUMPE 4,$PMAP4
$PMAP7: PNTDEC ;PRINT DECIMAL SIZE
$PMAP4: MOVEM 5,MEMTOT ;SAVE TOTAL # OF K
HRRZ JOBFF ;SETUP LOWEST USABLE
ADDI 1000 ;MEMORY ADDRESS
TRZ 777 ;EVEN BREAK ABOVE JOBFF
MOVEM MEMLOW
JUMPE 4,$PMAP6 ;RETURN
PCRL
$PMAP6: RTN ;EXIT
LALL
SUBTTL *SUBRTN* DEVICE CODE CHANGE SUBROUTINE
S
$MODDV: GO $SWTCH ;LOAD SWITCHES INTO AC0
TLNN 0,MODDVC ;DEVICE CODE CHANGE SELECTED ?
RTN ;NO, DON'T DO IT
$MODD0: MOVEM 1,$MODDB# ;SAVE AC'S
MOVEM 2,$MODDC#
MOVEM 3,$MODDD#
;*ASK WHETHER CHANGES ARE DESIRED & IF SO; ASK FOR OLD AND NEW DEV CODE
S
SALL
$MODD1: PMSGF <^CHANGE DEVICE CODES,>
GO $YESNO ;AFFIRMATIVE ?
JRST $MODDX ;NO/NO MORE CHANGES, EXIT
$MODD3: PMSGF <OLD DEVICE CODE - >
JSP 3,$MODD2 ;GET OLD DEVICE CODE
JRST .-2 ;NO RESPONSE ...ASK AGAIN
MOVEM 0,$MDVCO# ;SAVE THE OLD CODE
$MODD4: PMSGF <NEW DEVICE CODE - >
JSP 3,$MODD2 ;GET NEW DEVICE CODE
JRST .-2 ;NO RESPONSE ...ASK AGAIN
MOVEM 0,$MDVCN# ;SAVE THE NEW CODE
$MODD5: PMSGF <CHANGING FROM >
MOVE 1,$MDVCO ;GET OLD CODE
JSP 3,$MDSRC ;GET THAT CODE OUT OF LIST
$MODD6: PMSGF < TO >
MOVE 1,$MDVCN ;GET NEW CODE
JSP 3,$MDSRC ;GET THAT CODE OUT OF LIST (
PCRLF
$MODD7: PMSGF <VALID CHANGE,>
GO $YESNO ;AFFIRMATIVE ?
JRST $MODD1 ;NO ...START OVER )
GO $MODD8 ;YES ...CHANGE THE LIST
JRST $MODD1
LALL
;*CHANGE THE DEVICE CODE LIST
S
$MODD8: MOVE 2,$MODVL
SUB 2,$MODVU
HRLZ 2,2
HRR 2,$MODVL
MOVE 1,$MDVCN
LDB 0,[POINT 10,(2),9] ;GET IOT & DEVICE CODE
CAMN 0,$MDVCO ;IS IT REQUESTED ONE ?
DPB 1,[POINT 10,(2),9] ;YES, MAKE THE CHANGE
AOBJN 2,.-3
RTN
;*INPUT OLD CODE AND CHECK FOR VALIDITY
S
$MODD2: GO $TPOCT ;INPUT THE OLD CODE
JRST @3 ;NO RESPONSE, RETURN + 1 )
$MODD9: TRNE 0,3 ;MUST END IN 0 OR 4
JRST $MODER ;ERROR! ASK AGAIN
CAIG 0,774 ;IS DEVICE CODE IN PROPER RANGE
CAIGE 0,14
JRST $MODER ;ERROR, 14 TO 774 ONLY
CAIN 0,120 ;CTY MAY NOT CHANGE!
JRST $MODER ;ASK AGAIN
TRO 0,7000 ;INSERT IOT CODE
LSH 0,-2 ;POSITION
AOS 3 ;RETURN + 2
JRST @3 ;RETURN
;*GET THE OLD/NEW CODE FROM DEVICE CODE LIST
S
SALL
$MDSRC: LSH 1,2 ;POSITION FOR COMPARE
TRZ 1,7000 ;MASK IOT
MOVE 2,[-$MDEND,,$MDLST]
LDB [POINT 9,(2),35] ;EXTRACT CODE FROM LIST
CAMN 0,1 ;IS THIS THE ONE?
JRST $MDSR2 ;YES! ...PRINT IT & EXIT
AOBJN 2,.-3 ;NOT YET ...GET NEXT
MOVE 0,1
PNT3F
$MDSR1: JRST @3 ;RETURN
$MDSR2: MOVE 0,(2)
TRZ 0,777 ;MASK CODE
PNTSXF ;PRINT IT
JRST $MDSR1 ;EXIT
$MODER: PMSGF <^DEV CODE ERR, 14-774 ONLY^>
JRST $MODD3 ;ASK WHICH ONE TO CHANGE AGAIN
$MODDX: MOVE 3,$MODDD ;RESTORE AC'S
MOVE 2,$MODDC
MOVE 1,$MODDB
RTN ;EXIT
LALL
;*DEVICE CODE CHANGE SUBROUTINE BY PROGRAM
;* AC0 = [OLD,,NEW]
S
$MODDP: LSH AC0,-2 ;RIGHT JUSTIFY
OR AC0,[1600,,1600] ;INSERT IOT CODE
HLRZM $MDVCO ;SETUP OLD CODE
HRRZM $MDVCN ;SETUP NEW CODE
MOVEM 1,$MODDB
MOVEM 2,$MODDC
MOVEM 3,$MODDD
GO $MODD8 ;CHANGE CODES
JRST $MODDX ;EXIT
SUBTTL *SUBRTN* CONSOLE DATA SWITCH INPUT SUBROUTINE
S
;*INPUT CONSOLE SWITCHES IN EXEC MODE OR IN
;*USER MODE IF NON-TTY SWITCH CONTROL
S
$SWTCH: SKIPE $$TOGGLE ;SWITCHES PREVENTED ?
JRST $SWU2 ;YES, USE C(CONSW)
SKIPN $SWFLG ;BEEN INITED ?
JRST $SWU1 ;NO, USE SAVED SWITCHES
SKIPE $USWTF ;TTY SWITCH CONTROL ?
JRST $SWU1 ;YES, USE SAVED SWITCHES
JRST $SWUSR ;USER MODE
$SWCH1: SKIPGE MONCTL ;MONITR CONTROL ?
HRR 0,MONCTL ;YES, USE PRESTORED RH SWITCHES
MOVEM 0,CONSW ;SAVE
RTN ;EXIT
$SWUSR: SETZ ;KL'S DON'T HAVE SWITCHES
SKIPN MONTYP
CALLI 20 ;TOPS10 SWITCH CALL
MOVEM AC0,CONSW
$SWU1: MOVE 0,CONSW
JRST $SWCH1
$SWU2: MOVE 0,CONSW
RTN
;*SWITCH INITIALIZATION ROUTINE
S
SALL
$SWTIN: SETZM $USWTF# ;CLEAR TTY CONTROL FLAG
SETZM $SWONCE#
GO $SW0 ;INIT SWITCH ROUTINE
$SWIN1: SETOM $SWONCE
SETOM $SWFLG ;SET INITED FLAG
GO $SWTCH ;READ CONSOLE SWITCHES
TLNE PNTLPT ;PRINT ON LPT/LOGICAL DEVICE ?
GO $PNTNM+2 ;YES ...PRINT PROGRAM NAME
MOVE CONSW
TLNE CHAIN ;IN CHAIN MODE ?
RTN ;YES, DON'T PRINT FOLLOWING
SKIPGE MONCTL
RTN ;DIAGNOSTIC MONITOR
SKIPE $$TOGGLE
JRST .+5
PMSGF <^SWITCHES = >
MOVE CONSW ;GET THE SAVED SWITCHES
PNTHWF ;PRINT PRESENT SWITCH SETTINGS
PCRLF
RTN ;EXIT
LALL
;*SWITCH INITIALIZATION ROUTINE
S
SALL
$SW0: PUT 0
SKIPE $$TOGGLE ;SWITCHES PREVENTED ?
JRST $SW9+2 ;YES, USE C(CONSW)
SKIPGE MONCTL ;DIAGNOSTIC MONITOR MODE ?
JRST $SW10 ;YES
SKIPN $SWONCE ;INITIALIZATION ?
JRST $SW11 ;YES
$SW12: PMSGF <^SWITCHES = >
MOVE CONSW
PNTHWF
$SW1: PMSGF <^TTY SWITCH CONTROL ? - 0,S, Y OR N <CR> - >
GO $OPTLK ;INPUT THE ANSWER
JRST $SW1 ;NO CHARACTER RETURNED, ASK AGAIN
CAIN 0,15
JRST $SWERR ;1ST CHAR CR, ERROR
LSH 0,7 ;POSITION 1ST CHAR
MOVEM $SW#
GO $OPTLK ;INPUT THE CR
JRST $SW1 ;NO CHAR, ASK AGAIN
OR 0,$SW
CAIN 0,14015 ;"0" (CR) ?
JRST $SW6 ;YES-USE ALL SWITCHES = 0
CAIN 0,24615 ;"S" (CR) ?
JRST $SW9 ;YES-USE SAVED SWITCHES
CAIN 0,26215 ;"Y" (CR) ?
JRST $SW2 ;YES-USE TTY INPUT SWITCHES
CAIN 0,23415 ;"N" (CR) ?
JRST $SW7 ;YES-READ CONSOLE SWITCHES & RETURN
$SWERR: GO $TPCLR ;CLEAR INPUT
JRST $SW1 ;ASK AGAIN
$SW6: SETZM 0
JRST $SW4
$SW2: PMSGF <^LH SWITCHES <# OR ?> - >
GO $TPOCT ;INPUT 6 OCTALS
JRST $SW13 ;ERROR .....TRY AGAIN
HRLZM 0,$SW# ;MOVE LH WORD TO SW
$SW3: PMSGF <RH SWITCHES <# OR ?> - >
GO $TPOCT ;INPUT 6 OCTALS
JRST $SW14 ;ERROR .....TRY AGAIN
HLL 0,$SW ;GET LH SWITCHES
$SW4: MOVEM 0,CONSW ;SAVE SWITCHES IN CONSW
$SW5: SETOM $USWTF ;SET TTY INPUT SWITCH FLAG
$SW8: GET 0
RTN
$SW7: SETZM $USWTF ;N, USE REAL SWITCHES
JRST $SW8
$SW9: SKIPE $SWONCE ;S, USE SAME AS BEFORE ON "DING" REQUEST
JRST $SW8
MOVE $SVCSW ;ON INITIALIZATION USE PREVIOUS SWITCHES
JRST $SW4
$SW10: MOVE 0,DIASWS ;GET DIAMON SWITCHES
JRST $SW4
$SW11: MOVE 0,$SVCSW ;IF SAVED SW'S ARE ZERO
JUMPE 0,$SW1 ;DON'T PRINT THEM
MOVEM 0,CONSW
JRST $SW12
$SW13: CAIE "?" ;QMARK ?
JRST $SW2 ;NO, ERROR
MOVEI SWTAB
GO $SWXX ;PROMPT FOR SWITCHES
JRST $SW3-1
$SW14: CAIE "?" ;QMARK ?
JRST $SW3 ;NO, ERROR
MOVE SWPTAB ;GET ADDRESS OF USERS TABLE
JUMPE $SW3 ;IF NONE, ERROR
GO $SWXX ;PROMPT FOR SWITCHES
JRST $SW4-1
;*PROMPT FOR SWITCHES
$SWXX: PUT 1
PUT 2
PUT 3
MOVE 1,0 ;PUT SWITCH PROMPT TABLE ADDRESS IN 1
HRLI 1,-^D18 ;18 SWITCHES
MOVEI 2,400000
SETZ 3,
PCRLF
$SWXX1: MOVE (1) ;GET SIXBIT PROMPT
JUMPE 0,$SWXX2 ;IF BLANK, NO PROMPT
PNTSXF
PNTCIF 11 ;PRINT A TAB
GO $SWZZ ;GET SWITCH ANSWER
JRST $SWXX1-1 ;ERROR
JRST $SWXX3 ;CONTROL Z
JRST $SWXX4 ;UPARROW
OR 3,2 ;YES, OR SWITCH BIT IN
;NO, LEAVE SWITCH BIT CLEAR
$SWXX2: LSH 2,-1 ;POSITION TO NEXT SWITCH
AOBJN 1,$SWXX1
$SWXX3: PCRLF
MOVE 0,3 ;RETURN SWITCHES IN 0
GET 3
GET 2
GET 1
RTN
SWTAB: SIXBIT/ABORT/
SIXBIT/RSTART/
SIXBIT/TOTALS/
SIXBIT/NOPNT/
SIXBIT/PNTLPT/
SIXBIT/DING/
SIXBIT/LOOPER/
SIXBIT/ERSTOP/
SIXBIT/PALERS/
SIXBIT/RELIAB/
SIXBIT/TXTINH/
0
SIXBIT/MODDVC/
0
SIXBIT/OPRSEL/
SIXBIT/CHAIN/
0
0
;*PROCESS PROMPT
;* CONTROL Z, ENDS PROMPTING
;* UPARROW, BACK UP ONE PROMPT
;* Y, SET SWITCH
;* N, DON'T SET SWITCH
;* CR, DON'T SET SWITCH
$SWXX4: CAIN 2,400000 ;BACKED UP ALL THE WAY ?
JRST .+5 ;YES
LSH 2,1 ;BACKUP SWITCH BIT
SUB 1,[1,,1] ;BACKUP SWITCH TABLE POINTER
SKIPN (1) ;THIS POSITION BLANK ?
JRST .-5 ;YES, BACK UP ANOTHER
JRST $SWXX1-1
$SWZZ: PNTMSF [ASCIZ/- Y,N,^ <CR> OR ^Z - /]
GO $OPTLK
RTN ;NO RESPONSE
CAIN "Z"-100
JRST $SWZZ1 ;^Z, DONE
CAIN "^"
JRST $SWZZ2 ;^, BACKUP
CAIN 15
JRST $SWZZ4 ;CR, SAME AS NO
CAIE "Y" ;Y, SET SWITCH BIT
CAIN "N" ;N, DON'T SET SWITCH BIT
JRST .+2
RTN ;NEITHER, ERROR
LSH 0,7
MOVEM $SWYYY#
GO $OPTLK ;GET CR
RTN ;NO RESPONSE
OR 0,$SWYYY
CAIN 0,26215
JRST $SWZZ3 ;Y <CR>
CAIN 0,23415
JRST $SWZZ4 ;N <CR>
RTN ;ERROR
$SWZZ4: AOS (P) ;NO
$SWZZ3: AOS (P) ;YES
$SWZZ2: AOS (P) ;UPARROW
$SWZZ1: AOS (P) ;CONTROL Z
RTN
LALL
SUBTTL *SUBRTN* TELETYPE INPUT ROUTINES
S
;*CARRIAGE RETURN OR COMMA TERMINATES OCTAL, DECIMAL, OR CONVERT TYPE-IN.
;*CHARACTER OR NUMBER RETURNED IN AC0.
;*CALL SEQUENCE IS AS FOLLOWS:
;* NAME
;* NO/ERROR RESPONSE RETURN (+ 1)
;* NORMAL RESPONSE RETURN (+ 2)
;*$OPTLK = INPUT ANY CHARACTER
;*$YESNO = ASK QUESTION, CORRECT RESPONSE Y
;*$NOYES = ASK QUESTION, CORRECT RESPONSE N
;*$TPOCT = INPUT UP TO 12 OCTALS
;*$TPDEC = INPUT UP TO 11 DECIMALS
;*$TPCNV = INPUT UP TO 9 CONVERT'S
;*$TTLK = KEYBOARD CHECK, INPUT ANY CHARACTER (NO WAIT)
;*$TALTM = KEYBOARD, ALT-MODE CHECK
;*$TISIX = INPUT UP TO 6 SIXBIT CHARACTERS
S
;*TELETYPE INPUT INITIALIZATION
S
$TYPIN: SETZM INUPTR ;CLEAR INPUT POINTER
RTN ;NO TYPE-IN AVAILABLE
S
;*CHECKS FOR ANY KEY STRUCK, RETURNS IMMEDIATELY
;*RETURNS +1 IF NO TYPEIN, RETURNS +2 IF CHAR TYPED
S
$TTLK: SETZ AC0,
SKIPGE MONCTL ;NO CHECK IF "MONITOR"
RTN
SKIPE MONTYP
JRST .+4
INCHRS $TTCHR ;TOPS10 INPUT CHAR AND SKIP
RTN ;NONE AVAILABLE
JRST $HEAR4 ;GO PROCESS
PUT 1
PUT 2
MOVEI 1,.PRIIN
SIBE ;ANY INPUT AVAILABLE ?
JRST .+4 ;YES
GET 2
GET 1
RTN
PBIN ;GET INPUT CHAR
MOVEM 1,$TTCHR
GET 2
GET 1
JRST $HEAR4 ;CHAR TYPED, GO PROCESS
S
;*TELETYPE IMAGE MODE INPUT
;*PROVIDES UNBUFFERED MODE INPUT
;*WAITS FOREVER, RETURN WITH CHAR UPPER CASED & ECHOED
S
$TTYIN: SKIPE MONTYP
JRST .+3
INCHRW ;TOPS10 INPUT CHAR AND WAIT
JRST .+5
PUT 1
PBIN
MOVEM 1,$TTCHR
GET 1
GO $HEAR4 ;PROCESS IT
JRST .-1
RTN
$OPTLK: MOVEM 4,$TACB4#
GO $HEAR
JRST .-1
AOS (P)
MOVEI 4,1
MOVEM 4,$TWCNT ;INDICATE NO TIMEOUT
MOVE 4,$TACB4
RTN
S
;*TELETYPE ALT-MODE CHECK ROUTINE
S
$TALTM: GO $TTLK
RTN ;NO TYPE-IN ...EXIT
$TALT2: CAIE 175
CAIN 176
JRST $TALT1 ;ALT-MODE WAS TYPED
CAIE 33
JRST .+2 ;NO ALT-MODE
$TALT1: JRST CPOPJ1 ;ALT-MODE, RETURN +2
CAIE 007 ;IS CHAR A BELL ?
RTN
SKIPE $$TAX1
XCT $$TAX1 ;XCT USERS PRE-ROUTINE
GO $SW0 ;YES, DING FOR SWITCH CONTROL
SKIPE $$TAX2
XCT $$TAX2 ;XCT USERS POST-ROUTINE
RTN
S
;*TELETYPE INPUT CHARACTER
S
$HEAR: SKIPE MONTYP
JRST .+3
INCHWL $TTCHR ;TOPS10 INPUT CHAR LINE MODE
JRST $HEAR4
SKIPN INUPTR ;ANY INPUT POINTER ?
JRST .+5 ;NO, INPUT CLEARED
ILDB 0,INUPTR ;GET CHAR FROM STORE
JUMPE 0,.+3 ;USED IT ALL, GET NEW INPUT
MOVEM 0,$TTCHR ;SAVE IT
JRST $HEAR4 ;GO PROCESS
PUT 1
PUT 2
PUT 3
MOVE 1,[POINT 7,D$ISTR]
MOVEM 1,INUPTR# ;SETUP INPUT POINTER
MOVE 2,[RD%BRK!RD%TOP!^D132]
SETZ 3,
RDTTY ;GET TTY INPUT FROM MONITOR
JRST T20ERR
GET 3
GET 2
GET 1
JRST $HEAR ;NOW GO PROCESS
$TPCLR: PUT 1
SETZM INUPTR ;CLEAR INPUT POINTER
MOVEI 1,.PRIIN
SKIPN MONTYP
CLRBFI ;TOPS10 CLEAR BUFFER
SKIPE MONTYP
CFIBF ;ERROR, CLEAR TYPE-IN BUFFER
GET 1
RTN
S
;*CHARACTER PROCESSING ROUTINE FOR INPUT
;*CHARACTER RETURNED IN AC0 IS UPPER CASE
;*ACTUAL CHARACTER IS IN $TTCHR
S
$HEAR4: MOVE 0,$TTCHR ;GET ACTUAL CHARACTER
ANDI 0,177 ;CLEAR PARITY BIT
CAIL 0,"A"+40 ;CONVERT TO UPPER CASE
CAILE 0,"Z"+40
JRST .+2
SUBI 0,40
MOVEM 0,$CHRIN# ;SAVE CHARACTER
CAIE 0,15 ;IS IT CR ?
JRST $HEAR3 ;NO
SETZM $CARCT ;CLEAR CHARACTER COUNTER
SKIPN MONTYP
INCHRW ;TOPS10 FLUSH LF
SKIPE MONTYP
IBP INUPTR ;GET RID OF LF
MOVE 0,CONSW
TLNN 0,PNTLPT ;LPT/LOGICAL DEVICE OUTPUT ?
JRST $HEAR2 ;NO
PCRL ;YES-ADD CRLF
$HEAR2: MOVE 0,$CHRIN ;PUT INPUT CHAR IN AC0
AOS (P) ;SKIP RETURN +2
RTN ;NORMAL RETURN +1
$HEAR3: CAIN 0,04
JRST $DDTENT ;CONTROL D, GO TO DDT
MOVE 0,CONSW ;GET DATA SWITCHES
TLNN 0,PNTLPT ;PRINT ON LPT?
JRST $HEAR2 ;NO-EXIT
MOVE 0,$CHRIN ;YES
PNTCHR ;SEND CHAR TO LPT/LOGICAL DEV
JRST $HEAR2 ;EXIT
SUBTTL *SUBRTN* TELETYPE YES/NO TYPE-IN ROUTINE
S
;*ACCEPTS Y OR N
;*FOR YESNO, Y IS SKIP RETURN, N OR NO RESPONSE IS DIRECT RETURN
;*FOR NOYES, N IS SKIP RETURN, Y OR NO RESPONSE IS DIRECT RETURN
;*'Y OR N <CR> - ' ASKED UPON ENTRY
S
$NOYES: MOVEI 0,1 ;INIT FOR N ANSWER
JRST .+2
$YESNO: MOVEI 0,0 ;INIT FOR Y ANSWER
MOVEM 1,$TACC1# ;SAVE AC'S
MOVEM 2,$TACC2#
MOVE 2,0
$YN1: PMSGF < Y OR N <CR> - >
GO $OPTLK
JRST $YN2 ;NO RESPONSE
CAIE 0,"Y" ;IS IT A 'Y' ?
CAIN 0,"N" ;OR AN 'N' ?
JRST .+2 ;YES
JRST $YN3 ;NEITHER, ERROR
MOVE 1,0
LSH 1,7 ;POSITION 1ST CHAR
GO $OPTLK
JRST $YN2 ;NO RESPONSE
OR 1,0 ;MERGE 2ND CHAR
CAMN 1,$YN4(2) ;COMPARE FOR REQUESTED
JRST .+4 ;YES, RETURN +2
CAMN 1,$YN4+1(2) ;COMPARE FOR OPPOSITE
JRST .+3 ;YES, RETURN +1
JRST $YN3 ;ERROR, REPEAT
AOS (P) ;YES, RETURN +2
$YN2: MOVE 2,$TACC2 ;RESTORE AC2
MOVE 0,1
MOVE 1,$TACC1 ;RESTORE AC1
RTN ;RETURN +1
$YN3: PCRLF
GO $TPCLR ;CLEAR INPUT
JRST $YN1
$YN4: EXP 26215 ;'Y' (CR)
EXP 23415 ;'N' (CR)
EXP 26215 ;'Y' (CR)
SUBTTL *SUBRTN* TELETYPE OCTAL-DECIMAL-CONVERT TYPE-IN ROUTINE
S
;*ACCEPTS 0 TO 12 OCTALS, 0 TO 11 DECIMALS, 0 TO 9 CONVERT CHARACTERS
;*NUMBER RETURNED IN AC0.
S
$TPCNV: MOVEI AC0,2 ;SET INDEX TO CONVERT
JRST $TPCV1
$TPDEC: MOVEI AC0,1 ;SET INDEX TO DECIMAL
JRST $TPCV1
$TPOCT: MOVEI AC0,0 ;SET INDEX TO OCTAL
$TPCV1: MOVEM 1,$TACD1# ;SAVE AC'S 1-3
MOVEM 2,$TACD2#
MOVEM 3,$TACD3#
MOVE 3,0 ;LOAD AC3 WITH THE INDEX
SETZB 1,2 ;CLEAR DATA REG, CHAR COUNTER
SETZM $TYPNB# ;CLEAR ERR NUMBER
SETZM $NEGF# ;CLEAR NEGATE FLAG
SETZM $CNVD# ;CLEAR DECIMAL CONVERT FLAG
SETZM TTNBRF ;CLEAR DIGIT TYPED FLAG
;*INPUT AND COMPUTE NUMBER
S
$TYPLP: GO $OPTLK
JRST $TPERR ;NO RESPONSE, GO TO ERROR EXIT
CAIN 0,"-" ;IS IT MINUS ?
JRST $NEGX ;YES
CAIN 0,"." ;IS IT PERIOD ?
JRST $CNVX ;YES
CAIN 0,15 ;IS IT CR ?
JRST $TPEXT ;YES
CAIN 0,"," ;IS IT COMMA ?
JRST $TPEXT ;YES
CAIL 0,"0" ;A VALID DIGIT ?
XCT $TPCK(3) ;YES
JRST $TPERR ;NO ...ERROR EXIT
$TYPL1: SETOM TTNBRF ;SET DIGIT TYPED FLAG
AOS 2 ;INCREMENT CHARACTER COUNTER
XCT $TPMUL(3) ;MULT BY OCTAL/DECIMAL BASE, SHIFT CONVERT
SUBI 60 ;ADD IN NEW CHAR
ADD 1,0
JRST $TYPLP ;REPEAT TILL CR OR COMMA
;*CHECK FOR PROPER AMOUNT OF CHARACTERS
S
$TPEXT: XCT $TPNBR(3) ;PROPER NUMBER OF CHARACTERS
JRST $TPERR ;NO ...ERROR EXIT
CAIN 3,2 ;CONVERT ? (INDEX = 2)
JRST $CNVX1 ;YES
;NO, EXIT
$TPEX1: MOVE 3,$TACD3 ;RESTORE AC'S 3 & 2
MOVE 2,$TACD2
MOVE 0,1 ;PUT NUMBER IN AC0
SKIPE $NEGF ;NEGATE ?
MOVN 0,1 ;YES
MOVE 1,$TACD1 ;RESTORE AC1
AOS (P) ;RETURN +2
RTN ;RETURN +1
$TPERR: MOVEM 1,$TYPNB ;SAVE NUMBER - ERROR EXIT
MOVE 3,$TACD3 ;RESTORE AC'S
MOVE 2,$TACD2
MOVE 1,$TACD1
RTN ;ERROR EXIT )
;*NUMBER COMPUTING CONSTANTS
S
$TPCK: CAILE 0,"7" ;OCTAL NUMBER CHECK
CAILE 0,"9" ;DECIMAL NUMBER CHECK
CAILE 0,"9" ;CONVERT NUMBER CHECK
$TPMUL: LSH 1,3 ;OCTAL BASE SHIFT
IMULI 1,^D10 ;DECIMAL BASE MULTIPLIER
LSH 1,4 ;CONVERT SHIFT
$TPNBR: CAILE 2,^D12 ;ACCEPT UP TO 12 OCTALS
CAILE 2,^D11 ;ACCEPT UP TO 11 DECIMALS
CAILE 2,^D9 ;ACCEPT UP TO 9 CONVERT
$NEGX: SKIPE 2 ;1ST CHAR ?
JRST $TPERR ;NO, ERROR EXIT )
SETOM $NEGF ;YES, SET NEGATE FLAG
JRST $TYPLP ;GET NEXT CHAR
$CNVX: CAIE 3,2 ;PERIOD, IN CONVERT ?
JRST $TPERR ;NO, ERROR EXIT )
SETOM $CNVD ;YES, SET DECIMAL FLAG
JRST $TYPLP ;GET NEXT CHAR
;*CONVERT CONVERSION ROUTINE
S
$CNVX1: MOVEI 2,^D9 ;NINE DIGITS
SETZM 0
SKIPE $CNVD ;OCTAL OR DECIMAL ?
JRST $CNVX2 ;DECIMAL
TDNE 1,[421042104210] ;OCTAL
JRST $TPERR ;OCTAL ERROR, 8 OR 9 INPUT
LSH 1,1 ;SQUEEZE OUT 4TH BIT
LSHC 0,3 ;COMPACT INTO OCTAL
SOJN 2,.-2 ;COMPLETED ?
MOVE 1,0 ;YES
JRST $TPEX1 ;RETURN
$CNVX2: SETZM 3 ;DECIMAL
SETZM 0
IMULI 3,^D10 ;MULTIPLY BY DECIMAL BASE
LSHC 0,4 ;UNPACK NEXT DIGIT
ADD 3,0 ;ADD IN
SOJN 2,.-4 ;COMPLETED ?
MOVE 1,3 ;YES
JRST $TPEX1 ;RETURN )
SUBTTL *SUBRTN* TELETYPE SIXBIT INPUT ROUTINE
S
;*INPUTS UP TO SIX CHARACTERS, TERMINATES WITH A CR OR COMMA.
;*SIXBIT WORD RETURNED IN AC0
S
$TISIX: MOVEM 1,$TSX1# ;SAVE AC'S
MOVEM 2,$TSX2#
MOVE 2,[POINT 6,1]
MOVEI 1,0
$TSXB1: GO $OPTLK
JRST $TSXB3 ;NO RESPONSE, RTN + 1
CAIN 0,15
JRST $TSXB2 ;CR, TERMINATE, RTN + 2
CAIN 0,","
JRST $TSXB2 ;COMMA, TERMINATE, RTN + 2
CAIL 0,"0"
CAILE 0,"Z"
JRST $TSXB3 ;ERROR, RTN + 1
CAILE 0,"9"
CAIL 0,"A"
JRST $TSXB4 ;ALPHA-NUMERIC
JRST $TSXB3 ;ERROR, RTN + 1
$TSXB4: TRC 0,40 ;CONVERT TO SIX-BIT
TRNE 1,77
JRST $TSXB3 ;TOO MANY CHAR'S, RTN + 1
IDPB 0,2 ;PUT INTO WORD
JRST $TSXB1 ;GET NEXT CHARACTER
$TSXB2: AOS (P) ;INCR USRPC FOR RTN + 2 (NORMAL)
$TSXB3: MOVE 0,1 ;SIXBIT WORD IN AC0
MOVE 1,$TSX1 ;RESTORE AC'S
MOVE 2,$TSX2
RTN ;EXIT + 1/+2
SUBTTL *SUBRTN* PRINT SUBROUTINES
S
;* $PNTSX PRINT SIXBIT NORMAL
;* $PTSXF PRINT SIXBIT FORCED
;* $PNTCW PRINT DF10 CONTROL WORD
;* $PNTI1 PRINT OCTAL NUMBER
;* $CHRPN PRINT CHARACTER
;* $ASCPN PRINT ASCII CHARACTER/LINE
;* $DECPN PRINT DECIMAL NUMBER
S
S
;*PRINT SUBROUTINE INITIALIZATION
;*INITIALIZES CONTROL WORDS, AND TTY IF IN USER MODE
S
$PNTIN: SETZM $INTDF# ;CLEAR DEVICE DEFAULT FLAG
SETZM $DVOFF# ;CLEAR DEVICE INITED FLAG
SETZM PDISF# ;CLEAR PRINT DISABLED FLAG
SETZM $PTINH# ;CLEAR PRINT 'TYPE-IN INHIBIT' FLAG
SETZM PNTINH# ;ALLOW EXEC PRINT TYPE IN INHIBIT
SETZM XOFFLAG# ;CLEAR XOFF FLAG
SETZM PNTFLG# ;CLEAR IN PRINT FLAG
SETOM PNTSPC# ;SET PRINT SPACE FLAG
MOVNI 0,^D5000 ;SET PRINT ENABLE TO 5000 LINES
MOVEM 0,PNTENB
SETZM TTYFIL ;ALLOW EXEC FILLERS
SETZM $CRLF# ;ALLOW FREE CR/LF
SETZM $TABF ;ALLOW TAB CONVERSION
SETZM $FFF ;ALLOW FORM FEED CONVERSION
SETZM $VTF ;ALLOW VERTICAL TAB CONVERSION
SKIPN MONTYP
JRST $PNTIX
movei 1,.priou
rfmod ;don't translate print output
trz 2,tt%dam
tro 2,3b29
sfmod
$PNTIX: MOVEI REENTR ;SETUP REENTER ADDRESS
MOVEM JOBREN
SKIPGE MONCTL ;MONITOR CONTROL ?
RTN ;YES, DON'T PRINT TITLE
SKIPE $ONETM ;FIRST TIME?
RTN ;NO .....EXIT
JRST $PNTNM+2 ;YES ...PRINT PROGRAM NAME
;AND EXIT
S
;*PRINT SUBROUTINE ENTRY POINT
;*EXIT VIA $PNTI4 BELOW
S
$PNTIF: SETOM PNTFLG ;SET IN PRINT FLAG
SETOM $PNTTY# ;FORCE TO TTY
SETZM $PTINH
GO $PCLRO ;CLEAR CONTROL 0 & INPUT BUFFER
JRST $PNTIA
$PNTIT: SETOM PNTFLG ;SET IN PRINT FLAG
SETZM $PNTTY ;NOT FORCED TO TTY
SKIPL PNTENB# ;PRINT LIMIT REACHED YET?
JRST $PNTIB ;YES ..DON'T PRINT
GO $SWTCH ;READ DATA SWITCHES INTO AC0
TLNN 0,NOPNT ;NO PRINT SWITCH SET?
JRST $PNTIA
GET AC0 ;YES ...RESTORE AC0 FROM STACK (P - 1)
JRST $PRNTX ;EXIT, DON'T PRINT
$PCLRO: SKIPE MONTYP
JRST .+4
TTCALL 13,0 ;TOPS10 CLEAR CONTROL O
JFCL
RTN
PUT 1
PUT 2
MOVEI 1,.PRIOU
RFMOD
TLZ 2,(TT%OSP) ;CLEAR CONTROL O
SFMOD
GET 2
GET 1
SETZM INUPTR ;CLEAR TTY INPUT BUFFER
RTN
;*PRINT ROUTINE EXIT
S
$PNTI4: SETZM $PNTTY ;CLEAR FORCE TO TTY FLAG
MOVE 1,$PACA1 ;RESTORE AC'S
MOVE 2,$PACA2
MOVE 3,$PACA3
MOVE 4,$PACA4
MOVE 5,$PACA5
$PRNTX: SETZM PNTFLG ;CLEAR IN PRINT FLAG
RTN ;RETURN
;*PRINT LIMIT WARNING & ALTERNATE EXIT PATH
S
$PNTIB: GET AC0 ;RESTORE THE STACK (P - 1)
SKIPE PDISF# ;FIRST TIME PRINT DISABLED?
JRST $PRNTX ;YES ...EXIT )
$PNTB1: SETOM PDISF ;NO ........SET IT
MOVEM 1,$PACA1 ;SAVE AC'S 1 - 5
MOVEM 2,$PACA2
MOVEM 3,$PACA3
MOVEM 4,$PACA4
MOVEM 5,$PACA5
SETOM $PNTTY ;SET FORCE TO TTY FLAG
MOVEI [ASCIZ/
******
EXCEEDED ALLOWED PRINTOUTS
/]
JRST $ASCPN-1 ;PRINT THE WARNING & EXIT
S
;*PRINT ROUTINE SELECTOR
;*BASED ON "AC FIELD" = 12 - 17
S
$PNTIA: MOVEM 1,$PACA1# ;SAVE AC1.
MOVEM 2,$PACA2# ;SAVE AC2.
MOVEM 3,$PACA3# ;SAVE AC3.
MOVEM 4,$PACA4# ;SAVE AC4.
MOVEM 5,$PACA5# ;SAVE AC5.
GET AC0 ;RESTORE AC0 FROM STACK (P - 1)
SETZM $PNT# ;CLEAR PRINT HALF WORDS FLAG
MOVE 2,LUUO
ROT 2,15 ;GET X (AC FIELD)
ANDI 2,17 ;OUT OF THE UUO
$PNTIC: CAIN 2,17 ;X=17?
JRST $PNTLN ;YES. PRINT ASCII LINE
JUMPE 2,$ASCPN ;X=0? YES. GO PRINT 1 WORD ASCII
CAIN 2,15 ;X=15?
JRST $DECPN ;YES, PRINT DECIMALS )
CAIN 2,16 ;X=16?
JRST $DECSP ;YES, PRINT DECIMALS, LEADING SPACES
CAIN 2,13 ;X=13?
JRST $PNTI3 ;YES, PRINT OCTALS, 6 SP 6
CAIN 2,12 ;X=12?
JRST $CHRPN ;YES, PRINT CHARACTER )
JRST $PNTI1 ;NONE OF THE ABOVE, PRINT OCTAL
;(AC FIELD <12 OR = TO 14)
S
;*SIXBIT PRINT SUBROUTINE
;*PRINTS SIXBIT WORD IN AC0
S
;*NORMAL PRINTOUT
S
$PNTSX: PUT 1 ;SAVE AC1 ON STACK (P + 1)
MOVE 1,0 ;PUT SIXBIT WORD IN AC1
MOVEI 0,0
LSHC 0,6 ;GET NEXT CHAR INTO AC0
ADDI 0,40 ;CONVERT TO ASCII
PNTCHR ;PRINT IT
JUMPN 1,.-4 ;LOOP TILL ALL PRINTED
GET 1 ;RESTORE AC1 FROM THE STACK (P - 1)
RTN ;EXIT
;*FORCED PRINTOUT
S
$PTSXF: PUT 1 ;SAVE AC1 ON THE STACK (P + 1)
MOVE 1,0 ;PUT SIXBIT WORD IN AC1
MOVEI 0,0
LSHC 0,6 ;GET NEXT CHAR INTO AC0
ADDI 0,40 ;CONVERT TO ASCII
PNTCHF ;PRINT
JUMPN 1,.-4 ;LOOP TILL ALL PRINTED
GET 1 ;FROM THE STACK (P - 1)
RTN ;EXIT
S
;*SIXBIT MESSAGE PRINT ROUTINE
;*PRINTS THE SIXBIT MESSAGE THOSE ADDRESS IS IN AC0
;*"BACKARROW" (77) SIGNIFIES END OF TEXT
;*"UPARROW" (76) SIGNIFIES CR/LF
;*"RIGHT SQUARE BRACKET" (75) SIGNIFIES TAB
S
$PSIXF: PUT 5
SETO 5, ;SET FORCED PRINTING FLAG
JRST .+3
$PSIX: PUT 5
SETZ 5, ;NORMAL PRINTING
PUT 1
PUT 2
PUT 3
PUT 4
HRRZ 4,0 ;MESSAGE ADDRESS TO AC4
$PSIX1: MOVEI 3,6 ;6 = NUM OF 6BIT CHAR PER WORD
MOVE 1,(4) ;GET FIRST/NEXT WORD OF MESSAGE
$PSIX2: SETZ 2,
ROTC 1,6 ;C(AC1) = CHAR TO BE PRINTED
CAIN 2,77
JRST $PSIX5 ;"BACKARROW", DONE
CAIN 2,76
JRST $PSIX4 ;"UPARROW", CR/LF
CAIN 2,75
MOVEI 2,151 ;"BRACKET", CHANGE TO TAB (151+40=11)
MOVEI 0,40(2) ;CHANGE TO ASCII
JUMPN 5,[PNTCHF
JRST .+2] ;FORCED PRINT
PNTCHR
$PSIX3: SOJN 3,$PSIX2 ;PRINTED ALL CHARS FROM THIS WORD ?
AOJA 4,$PSIX1 ;YES, DO NEXT WORD
$PSIX4: JUMPN 5,[PCRLF
JRST .+2]
PCRL ;PRINT CR/LF
JRST $PSIX3
$PSIX5: GET 4
GET 3
GET 2
GET 1
GET 5
RTN
S
;*OCTAL SUPPRESS LEADING ZEROS PRINT ROUTINE
;*PRINTS NUMBER IN AC0, SUPPRESSING LEADING ZEROS
;*PRINTS MINUS SIGN IF NUMBER IS NEGATIVE
S
$POCSF: PUT 5
SETO 5, ;FORCED PRINTOUT
JRST .+3
$POCS: PUT 5
SETZ 5, ;NORMAL PRINTOUT
PUT 1
PUT 2
PUT 3
PUT 4
MOVE 2,0
JUMPGE 2,$POCS1 ;IS NUMBER NEGATIVE ?
MOVEI "-"
JUMPN 5,[PNTCHF
JRST .+2]
PNTCHR ;YES, PRINT MINUS SIGN
MOVN 2,2 ;MAKE NUMBER POSITIVE
$POCS1: SETZ 4,
SETZB 3,1
JUMPE 2,$POCS3 ;IF NUMBER 0, PRINT 1 ZERO
MOVEI 3,^D12 ;PRINT UP TO 12 DIGITS
$POCS2: SETZ 1,
LSHC 1,3
JUMPE 1,$POCS5 ;IS THIS DIGIT ZERO ?
SETO 4, ;NO, SET NON-ZERO DIGIT FLAG
$POCS3: MOVEI "0"(1) ;MAKE ASCII NUMBER
JUMPN 5,[PNTCHF
JRST .+2]
PNTCHR ;PRINT DIGIT
$POCS4: SOJG 3,$POCS2 ;ALL DONE ?
GET 4
GET 3
GET 2
GET 1
GET 5
RTN
$POCS5: JUMPE 4,$POCS4 ;PRINTED NON-ZERO DIGIT ?
JRST $POCS3 ;YES, PRINT ZEROS
S
;*DF10 CONTROL WORD PRINT ROUTINE
;*PRINTS WORD IN AC0
;*DF22F = 0, ###### ###### ,18 BIT DF10
;* -1, ##### ######## ,22 BIT DF10
S
$PNTCW: MOVEM 1,$PTCA# ;SAVE AC1
MOVEI 1,0 ;NORMAL PRINTOUT
MOVEM 2,$PTCB# ;SAVE AC2
MOVE 2,0
SKIPN DF22F# ;22 OR 18 BIT DF10 ?
JRST $PNTC2
LSH 0,-^D21 ;NEW 22 BIT DF10
TRZ 0,1
JUMPN 1,[PNT5F
JRST .+2]
PNT5 ;PRINT WORD COUNT, 14 BITS
MOVE 0,2
TLZ 0,777760
JUMPN 1,[PNTADF
JRST .+2]
PNTADR ;PRINT ADDRESS, 22 BITS
$PNTC3: MOVE 2,$PTCB
MOVE 1,$PTCA
RTN ;EXIT
$PNTC2: HLRZ ;18 BIT DF10
JUMPN 1,[PNT6F
JRST .+2]
PNT6 ;PRINT WORD COUNT, 18 BITS
MOVEI 40
JUMPN 1,[PNTCHF
JRST .+2]
PNTCHR ;EXTRA SPACE
HRRZ 0,2
JUMPN 1,[PNT6F
JRST .+2]
PNT6 ;PRINT ADDRESS, 18 BITS
JRST $PNTC3
$PNTCF: MOVEM 1,$PTCA ;SAVE AC1
;FORCED PRINTOUT
MOVE 1,$PNTCF
MOVEM 1,$PNTCW ;SETUP RETURN
MOVEI 1,1 ;FORCED PRINT INDEX
JRST $PNTCW+2 ;REST AS ABOVE
S
;*OCTAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S
$PNTI1: MOVE 3,2 ;MOVE X INTO AC3.
ROT 0,-3 ;ROT OCTAL NUM 3 PLACES
SOJN 3,.-1 ;X AMOUNT OF TIMES.
$PNTI2: MOVEI 1,6 ;PUT 6 INTO AC1 SO THAT
ROTC 0,3 ;C(AC1) AFTER THE ROTC WILL BE 60
JSP 3,$TOUT ;PLUS NUMBER TO BE PRINTED
SOJN 2,$PNTI2 ;SUB 1 FROM X...PRINT UNTIL X=0.
MOVEM 1,$PNTSV# ;SAVE NUMBER
SKIPN PNTSPC
JRST .+3
MOVEI 1,40 ;AT THIS POINT WE HAVE PRINTED
JSP 3,$TOUT ;X AMOUNT OF NUMBER(S) AND NOW A SPACE
SKIPN $PNT# ;PRINT 6 SP 6 FLAG SET?
JRST $PNTI4 ;NO, EXIT )
MOVE 1,$PNTSV ;RESTORE NUMBER
MOVEI 2,6 ;SETUP FOR 2ND HALF
SETZM $PNT ;CLEAR PRINT SPACE FLAG
JRST $PNTI2 ;PRINT REST OF NUMBER
$PNTI3: MOVEI 3,14 ;SETUP FOR LH WORD
MOVEI 2,6 ;SETUP FOR FIRST HALF
SETOM $PNT ;SET PRINT 6 SP 6 FLAG
SETOM PNTSPC ;SET THE PRINT SPACE FLAG
JRST $PNTI1+1 ;PRINT FIRST HALF NUMBER
JRST $PNTI4 ;EXIT
S
;*ASCII/CHARACTER PRINTOUT ROUTINE
;*PRINTS CHAR IN LOWER 7 BITS OF AC0
S
$CHRPN: ANDI 0,177 ;STRIP CHAR TO 7 BITS
MOVE 1,0
JSP 3,$TOUT ;PRINT A CHARACTER
JRST $PNTI4 ;LEAVE
S
;*PRINTS ASCII WHOSE ADDRESS IS IN AC0
S
$PNTLN: SETOM $PNT# ;SET PRINT MORE THAN 1 WORD FLAG.
$ASCPN: MOVEM 0,$POINT# ;SAVE ADDRESS OF ASCII MESSAGE.
$ASCP1: MOVEI 2,5 ;5 = NUM OF ASCII CHAR. IN A WORD.
MOVE 0,@$POINT ;C(AC0) = FIRST/NEXT WORD OF ASCII MESS
$ASCP2: SETZ 1, ;CLEAR AC1.
ROTC 0,7 ;C(AC1) = CHAR TO BE PRINTED.
JUMPE 1,$PNTI4 ;CHAR = NULL?..NO MORE CHAR..EXIT
JSP 3,$TOUT ;PRINT A CHAR
SOJN 2,$ASCP2 ;PNT ALL CHAR FROM THIS WORD?
AOS $POINT ;YES. INC TO GET NEXT WORD.
SKIPN $PNT ;PNT MORE THAN ONE WORD FLAG SET?
JRST $PNTI4 ;NO..LEAVE
JRST $ASCP1 ;YES...RETURN TO PNT NEXT WORD.
S
;*DECIMAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S
$DECSP: SETOM $PNT ;SET LEADING SPACES PRINT CONTROL
$DECPN: JUMPGE 0,.+4 ;IS NUMBER NEGATIVE ?
MOVEI 1,"-" ;YES, PRINT MINUS SIGN
JSP 3,$TOUT
MOVN 0,0 ;MAKE NUMBER POSITIVE
GO $RADIX ;DECIMAL-ASCII CONVERSION & PRINT CHARS
JRST $PNTI4 ;EXIT
$RADIX: MOVE 2,RADLSC ;SETUP DIGIT COUNTER
LSHC 0,-^D35 ;SHIFT RIGHT 35 BITS INTO AC1
LSH 1,-1 ;VACATE AC1 SIGN BIT
$DCCMP: DIV 0,RADIX ;DIVIDE DOUBLE LENGTH INTERGER BY 10
HRLM 1,(17) ;SAVE DIGIT
SOS 2 ;COUNT DIGIT
JUMPE 0,$LDSPS ;ALL DIGITS FORMED?
GO $RADIX+1 ;NO, COMPUTE NEXT ONE
$DECP1: HLRZ 1,(17) ;YES, RETRIEVE DIGIT
ADDI 1,60 ;CONVERT TO ASCII
JSP 3,$TOUT ;TYPE-OUT A DIGIT
RTN ;GET NEXT/EXIT
$LDSPS: SKIPN $PNT ;LEADING SPACES PRINT SET?
JRST $DECP1 ;NO ...GO PRINT
;YES ...DO IT
$DCSPS: SOJL 2,$DECP1 ;SPACES COMPLETE ? YES
MOVE 1,RADLSP ;NO, PRINT LEADING SPACE
JSP 3,$TOUT ;TYPE OUT THE SPACE
JRST .-3 ;CHECK FOR NEXT
SUBTTL *SUBRTN* CHARACTER OUTPUT ROUTINES
S
;*OUTPUT TERMINATION CONTROL ROUTINE
S
$TOUT: MOVEM 0,$PACB0# ;SAVE AC0.
MOVEM 1,$PNTYC# ;SAVE CHARACTER TO BE PRINTED
S
;*OVERALL CHARACTER OUTPUT CONTROL ROUTINE
S
$TOUTB: MOVE AC0,CONSW ;DATA SWITCHES INTO AC0
AOS $CARCT# ;INC CHAR CNTR.
CAIN 1,7 ;CHAR A BELL ?
SETZM $PTINH ;YES, CLEAR PRINT INHIBIT
CAIE 1,15 ;CHAR A CR?
JRST $TOUB1 ;NO-CHK FOR LF
SKIPN $PTINH ;DON'T COUNT ^O'ED LINES
AOS PNTENB ;COUNT LINES, TILL NO MORE
SETZM $CARCT ;CLR CHAR CNTR.
$TOUB1: CAIN 1,12 ;IS CHAR A LF?
SETZM $CARCT ;YES-CLR CHAR CNTR.
SKIPE $PNTTY ;NO-IS PRINT FORCED ON?
JRST $TOUB2 ;YES-DON'T CHECK NON-PNT SW
TLNE 0,NOPNT ;IS NON PNT SWITCH ON?
JRST (3) ;YES, RETURN
$TOUB2: JSP 4,$TOUT2 ;SEND CHARACTER USER MODE
$TOUB3: SKIPE USRLFF# ;NEED USER LF FILLERS ?
JRST $USRFL ;YES
SKIPE USRCRF# ;NEED USER CR FILLERS ?
JRST $USRFC ;YES
JRST $TOUTA ;NO-BACK TO PRINT ROUTINE
;*USER MODE LF & CR FILLERS
S
$USRFC: CAIE 1,15 ;CR ?
JRST $TOUTA ;NO-RETURN TO PRINT ROUTINE
MOVE 5,USRCRF ;SEND FILLERS FOR CR
JRST $USRF1 ;DEPENDING ON 'USRCRF'
$USRFL: CAIE 1,12 ;LF ?
JRST $TOUTA ;NO-RETURN TO PRINT
MOVE 5,USRLFF ;SEND FILLERS FOR LF
$USRF1: SOJL 5,$TOUTA ;DEPENDING ON 'USRLFF'
MOVEI 1,001 ;^A
JSP 4,$TOUT2 ;SEND CHARACTER
JRST $USRF1
;*RETURN BACK TO PRINTING ROUTINE FROM CHAR OUTPUT
S
$TOUTA: MOVE AC0,$PACB0 ;RESTORE AC0
JRST (3) ;RETURN TO PRINT ROUTINE
S
;*USER MODE CHARACTER OUTPUT
S
$TOUT2: MOVEM 4,$PACC4#
MOVE 0,CONSW
TLNE 0,PNTLPT ;IS LPT PRINT SWITCH UP ?
JRST $TOUT3 ;YES, GO PRINT ON LOGICAL DEVICE
DROPDV ;CLOSE DEV IF SWITCH CHANGED
$TOUT6: MOVE 0,$CARCT ;CHARACTER NUMBER
CAIN 0,1 ;FIRST CHAR IN LINE ?
JRST $TOUT4 ;YES
$TOUT5: SKIPN MONTYP
OUTCHR 1
SKIPE MONTYP
GO $$TOU5 ;TOPS-20 OUTPUT
JRST @$PACC4 ;GO RESTORE AC0 AND RETURN
$TOUT4: SKIPL MONCTL ;SYSTEM EXERCISER
JRST $TOUT5 ;NO
PUT 1
MOVEI 1,"?" ;PRECEDE LINE WITH ?
SKIPN MONTYP
OUTCHR 1
SKIPE MONTYP
PBOUT
GET 1
JRST $TOUT5
;*USER MODE LOGICAL DEVICE OUTPUT
S
$TOUT3: SKIPN $DVOFF ;DEVICE BEEN INITED YET ?
GO $INTDV ;NO, GO DO IT
GO $PUTCR ;GO OUTPUT CHAR
SKIPN $PNTTY ;SKIP IF MESSAGE ALSO FORCED TO TTY
JRST @$PACC4
JRST $TOUT6 ;OUTPUT
;*TOPS-20 TTY OUTPUT
$$TOU5: CAIE 1,33 ;PRINTING AN ALTMODE ?
JRST $$TOU6 ;NO
PUT 1
PUT 2
PUT 3
MOVEM 1,$$TO5A#
MOVEI 1,.PRIOU
RFCOC ;YES, DON'T TRANSLATE IT
PUT 2
PUT 3
TRZ 3,600000
TRO 3,400000
SFCOC
MOVE 1,$$TO5A
PBOUT ;PRINT AN ACTUAL 33 CODE
MOVEI 1,.PRIOU
GET 3
GET 2
SFCOC ;RESTORE OUTPUT TRANSLATION
GET 3
GET 2
GET 1
RTN
$$TOU6: PBOUT ;NORMAL OUTPUT
RTN
;* LOGICAL DEVICE OUTPUT ROUTINES
S
$PUTCR: SKIPN MONTYP
JRST $PUT10
PUT 1
PUT 2
MOVE 2,1
MOVE 1,DEVJFN
BOUT
GET 2
GET 1
RTN
S
;*LOGICAL DEVICE INITIALIZATION
;*PHY DEV ASSIGNED AT RUN TIME
S
$INTDV: MOVE 0,PNTEXT
MOVEM 0,$OUTEX
MOVE 0,PNTNAM ;SETUP LOGICAL OUTPUT FILE NAME
MOVEM 0,$OUTNM
MOVEM 1,$PACF1#
MOVEM 2,$PACF2#
SETZM $INTD3#
SKIPN MONTYP
JRST $INT10 ;TOPS10
MOVE [POINT 7,FILASC,27]
MOVE 1,[ASCII/DEV:/]
MOVEM 1,FILASC
$INT21: MOVEI 1,$OUTNM
GO SIXASC ;CONVERT SIXBIT TO ASCII
HRLZI 1,(GJ%FOU!GJ%SHT)
HRROI 2,FILASC
GTJFN
ERJMP $INT22 ;DEVICE NOT AVAILABLE, DEFAULT TO DSK
MOVEM 1,DEVJFN#
MOVE 2,[7B5!OF%WR]
OPENF
JRST T20ERR
$INT12: SETOM $DVOFF
MOVE 2,$PACF2
MOVE 1,$PACF1
RTN
$INT22: SKIPE $INTD3
JRST T20ERR
HRROI 1,[ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
PSOUT
MOVE [POINT 7,FILASC,27]
MOVE 1,[ASCII/DSK:/]
MOVEM 1,FILASC
SETOM $INTD3
JRST $INT21
;*USER MODE CLOSE FILE
S
$DRPDV: SKIPN $DVOFF ;DEVICE INITED?
RTN ;NO, DON'T BOTHER
SKIPN MONTYP
JRST $DRP10 ;TOPS10
PUT 1
MOVE 1,DEVJFN
CLOSF
JRST T20ERR
GET 1
SETZM $DVOFF
RTN ;EXIT
T20ERR: MOVEI 1,.PRIOU
HRLOI 2,.FHSLF
SETZ 3,
ERSTR
HALTF
HALTF
HALTF
SIXASC: PUT 2
PUT 3
PUT 4
MOVE 3,0
MOVE 4,1
MOVE 1,(4)
GO SIXSTR
MOVEI "."
IDPB 0,3
HLLZ 1,1(4)
SKIPE 1
GO SIXSTR
IDPB 1,3
GET 4
GET 3
GET 2
RTN
SIXSTR: SETZB 0,2
LSHC 0,6
ADDI 0,40
IDPB 0,3
JUMPN 1,.-4
RTN
;*TOPS10, LOGICAL DEVICE OUTPUT
$PUT10: SKIPE $DVTTY# ;IF DEVICE IS TTY
JRST .+5 ;EMPTY BUFFER AFTER EACH CHAR
SOSG $OBUF+2 ;INCREMENT BYTE COUNT
JRST .+3
IDPB 1,$OBUF+1 ;STORE CHAR
RTN
OUT $DEVCH, ;EMPTY BUFFER
JRST .-3
;*$INT10, TOPS10 INITIALIZE LOGICAL OUTPUT
$INT10: MOVEM 0,$OUTNM
INIT $DEVCH,0 ;ASCII MODE, DEV CHANNEL
SIXBIT /DEV/ ;LOGICAL DEVICE, LPT,DSK,DTAX
XWD $OBUF, ;OUTPUT ONLY
JRST $INT13 ;DEV NOT AVAIL, DEFAULT TO DISK
$INT11: OUTBUF $DEVCH,1 ;SETUP OUTPUT BUFFER
ENTER $DEVCH,$OUTNM ;INIT OUTPUT FILE
JRST $OERR2 ;NO DIR ROOM, ERROR
SETOM $DVOFF ;SET DEVICE INITED FLAG
MOVEI 0,$DEVCH
DEVCHR ;GET DEVICE CHARACTERISTICS
TLNE 0,10
SETOM $DVTTY ;DEVICE IS TTY
JRST $INT12 ;EXIT
$INT13: SKIPN $INTDF ;FIRST DEFAULT INIT ?
OUTSTR [ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
SETOM $INTDF
INIT $DEVCH,0
SIXBIT /DSK/
XWD $OBUF,
JRST $OERR1
JRST $INT11
;*USER MODE CLOSE FILE
$DRP10: CLOSE $DEVCH, ;CLOSE FILE
STATZ $DEVCH,740000 ;RECHECK FINAL ERROR BITS
OUTSTR [ASCIZ/
%PRINT CLOSE ERROR
/]
RELEAS $DEVCH, ;RELINQUISH DEVICE, WRITE DIRECTORY
SETZM $DVOFF
RTN ;EXIT
$OUTER: OUTSTR [ASCIZ/
%PRINT OUTPUT ERROR
/]
SKIPE $$OUTER
XCT $$OUTER ;EXECUTE USERS ERROR RTN, IF PROV.
EXIT 1, ;ERROR, QUIT
JRST BEGIN ;RESTART USER SEGMENT
$OERR1: OUTSTR [ASCIZ/
DSK INIT ERROR/]
JRST $OUTER ;DISK PRINT OUTPUT ERROR
$OERR2: OUTSTR [ASCIZ/
NO DIR ROOM/]
JRST $OUTER ;DISK PRINT OUTPUT ERROR