Trailing-Edge
-
PDP-10 Archives
-
klad_sources
-
klad.sources/subsmm.mac
There are no other files named subsmm.mac in the archive.
;[toed.xkl.com]DXX:<KLAD.SOURCES>SUBSMM.MAC.2, 18-Apr-96 17:19:08, Edit by GORIN
;fixed $CPTYP, old code used an indeterminate form of BLT
SUBTTL *CONTRL* MAIN SUBROUTINE PACKAGE CONTROL
PNTLPT==0 ;NO LINE PRINTER ON KS10 IN EXEC MODE
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
;*LOAD COPY OF START PARAMETERS AT 1000 TO 1020
S
JRST $SBSRT ;START SUBROUTINE BY ITSELF
JRST $REINI ;REINIT SUBROUTINE
JRST $PGMIN ;SUBROUTINE INIT ROUTINE
JRST $MODCK ;OPERATIONAL MODE CHECK LINKAGE
-1 ;-1=NOT INITED, 0=CLEAR, +1=PROTOCALL
SIXBIT/SUBRTN/ ;"SUBRTN" IDENTIFICATION WORD
MCNVER,,DECVER ;"SUBRTN" VERSION INFORMATION
-1 ;MONITOR TTY SPEED
HALT . ;PROGRAM NOT CODED FOR EXEC MODE
HALT . ;FATAL PUSH LIST POINTER ERROR
HALT . ;INITIAL PUSH LIST POINTER ERROR
HALT . ;MUUO WITH LUUO HANDLER WIPED OUT
HALT . ;SM10 INTERRUPT WITHOUT DOORBELL
HALT . ;SM10 CLOCK INTERRUPT WITHOUT FLAG SET
HALT . ;CPU INITIALIZATION ERROR
HALT . ;END OF PROGRAM ERROR
HALT . ;INTERRUPT WITH LUUO HANDLER WIPED OUT
LOC 2000 ;THIS STARTS THE ACTUAL SUBROUTINE PROGRAM
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
COMFLG: -1 ;-1=NOT INITED, 0=CLEAR, +1=PROTOCALL
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
SMBER: HALT . ;SM10 INTERRUPT WITHOUT DOORBELL
SMCER: HALT . ;SM10 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 1024K MAPPING
PGMINT
JRST BEGEND
$REINI: SETZM $ONETM ;FOR NOW
SETOM COMFLG ;REINIT COMM
SETZM PASCNT
SETZM ERRTLS
JRST BEGIN
STARTA: JRST BEGEND
PGMNAM: ASCIZ/
DECSYSTEM 2020 (KS-10) DIAGNOSTIC SUBROUTINE'S
/
S
;*CONTRL* SUBROUTINE PACKAGE INITIALIZATION
S
$PGMIN: MOVEM 0,$$PAC0
MOVE 0,[2000,,1000] ;SETUP ORIGINAL INITIALIZE BLOCK
BLT 0,1020
SETOM USER
JSP 0,.+1 ;LOAD FLAGS INTO AC0
TLNN 0,USERF ;USER MODE ?
SETZM USER ;EXEC MODE
SKIPN MONFLG ;DIAG MON, SPECIAL USER MODE ?
SETZM USER ;YES, TREAT I/O AS EXEC
SKIPE USER
JRST $NOUSR ;NO USER MODE IN "SUBSM"
CONO PI,PICLR ;CLEAR PI SYSTEM
CONO APR,IOCLR ;CLEAR I/O
S
;*INITIALIZE PROCESSOR FLAGS AND PUSH LIST
S
$PGMN1: HLRZ JOBSA ;RESET JOB FIRST FREE TO
MOVEM JOBFF ;END OF LOW SEGMENT
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
PUT CSHFLG
SETOM CSHFLG ;PREVENT CACHE ON STARTUP
GO $MAPEX ;MAP EXEC
GET CSHFLG
GO $UUOIN ;INIT UUO TRAP TRANSFER LOCATION
GO $PNTIN ;INIT PRINT SUBROUTINE
GO $SWTIN ;INIT SWITCH INPUT SUBROUTINE
GO $ITRIN ;INIT INTERRUPT SUBROUTINE
SKIPE $MMAP ;MEMORY ROUTINES ?
GO $MEMMP ;MAP MEMORY
GO $SMCSH ;INIT CACHE
SETOM $ONETM ;SET ONE TIME FLAG
SETZM SCOPE ;INIT ERROR SCOPE LOOP
SETZM ERRPC ;INIT ERROR PC
SETZM PERTLS# ;INIT PRINTED ERROR TOTAL
JRST @$$PAC0# ;RETURN
S
;*$MODCK -- 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: OUTSTR [ASCIZ/
EXEC ONLY
/]
OUTSTR @$PNAME ;PRINT THE NAME OF THIS FILE
JRST @RETURN ;LEAVE FOR EVER
S
;* $MAPEX - SM10 0 TO 112K PAGE MAP SETUP
;* 0 TO 112K POINTS TO ITSELF
S
$MAPEX: MOVE [540000,,540001]
SKIPN CSHFLG
TRO 020000
MOVEM 600 ;SET EPT NON-CACHED
MOVSI 1,-157
MOVE [540000,,540001]
SKIPN CSHFLG ;REST CACHED IF ALLOWED
TDO [020000,,020000]
ADD [2,,2]
MOVEM 601(1)
AOBJN 1,.-2
RTN
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
MOVEM AC0,$$AC0# ;SAVE AC0
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
PUT $$AC0 ;SAVE AC0 ON PUSH LIST
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
$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
;*MONITOR UUO ERROR EXIT ROUTINE
S
SALL
MUUOER: SKIPE $$MUUO
XCT $$MUUO ;EXECUTE USERS MUUO ROUTINE, IF PROV
MOVE AC0,JOB41 ;GET UUO HANDLER
CAME AC0,[GO $UORTN]
HALT MUOERR ;NOT VALID
MOVE MUUOPC
MOVEM ITRCH1
CONI APR,$SVAPR
CONI PI,$SVPI
PMSG <^ERROR MUUO = >
MOVE MUUO
PNTHW ;PRINT MUUO
SETZM 0
JRST $ITR1B ;COMMON INTERRUPT ROUTINE START
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
$UOERX,,$MEMMP
$UOERX,,$UOERX
$FSELECT,,$MTROP
$FRD36,,$FREAD
$UOERX,,$FRD8
$CLOCK,,$END
$FATAL,,$ERHLT
$UOERX,,$EOP
$EG4: MOVE JOBUUO ;IMMEDIATE CHARACTER PRINT
CAMN [PBELL]
JRST $EGBELL
CAMN [PFORCE]
JRST $EGFRC
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
$EGBELL:SKIPG COMFLG
JRST [PNTCHF
JRST $EGFRC]
COMBELL ;SEND BELL
$EGFRC: SETZM $PTINH ;CLEAR PRINT INHIBIT
JRST $EGX
$MODDV:
$MODDP:
$DRPDV:
$MTROP:
$CLOCK:
$PNTMG: JRST $UOERX ;N/A ON SM-10
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.
S
S
;*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#
PUT JOBUUO
GO $TALTM ;DO ALTMODE CHECK
JRST .+4 ;NOT ONE
MOVEI .+3 ;SAVE RESTART ADDRESS
MOVEM JOBOPC
JRST @ALTMGO ;TRANSFER TO ALTMODE ROUTINE
GET JOBUUO
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
S
;*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.
S
;*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
AOS PERTLS ;INCREMENT PRINTED ERROR TOTAL
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
S
;*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
S
;*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
S
;*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
S
;*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 $SWTCH
S
;*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
S
;*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
S
;*EXAMINE LOOPER SWITCH AND SCOPE LOOP ON ERROR IF SET.
S
%ERSW2: TLNN 3,LOOPER
SETZM SCOPE ;CLEAR SCOPE LOOP CONTROL
AOS %ERCNT ;INCREMENT ERROR COUNT
S
;*RING TTY BELL IF DING SWITCH IS SET.
S
%ERSW3: TLNE 3,DING
PBELL
S
;*RETURN TO ERROR CALL ADDRESS+1
S
%EXCAL: GO %EACR1
SKIPL MONCTL ;UNDER DIAGNOSTIC MONITOR ?
JRST %EXCL1 ;NO, CONTINUE PROGRAM
MOVE 0,PERTLS ;YES
CAIL 0,5 ;PRINTED ALLOWED ERRORS ?
JRST %EXCL2 ;YES
%EXCL1: MOVE 0,%AC0
SKIPE %ERHI2 ;ANY USERS INSTRUCTION ?
XCT %ERHI2 ;YES, DO USERS ROUTINE
RTN ;CONTINUE PROGRAM
%EXCL2: PMSGF <^EXCEEDED ALLOWED ERRORS^>
JRST $BEND2 ;END OF PROGRAM
SUBTTL PROCESSOR TYPE DETERMINATION
S
$CPUTP: SETZM CYCL60
SETZM KLFLG
SETZM KAIFLG
$CPSM: SETZ 1, ;source 0, dest 0
BLT 1,0 ;copy 1 word from 0 to 0
SKIPN 1 ;If SM10, BLT will change AC1
HALT CPIERR ;WRONG PROCESSOR
SETOM KLFLG ;SM10 - SET FLAG
SETOM SM10
$CPLII: MOVE [JRST PFSTRT] ;SET POWER FAIL RECOVERY INSTRUCTION
MOVEM 70
SETZM $PWRF
BLKI APR,0 ;GET SM10 HARDWARE OPTIONS
TRNE 0,1B18 ;50 HZ BIT SET ?
SETOM CYCL60 ;YES, SET INDICATOR
CTYINI ;INITIALIZE CTY
SKIPE MONCTL ;DIAGNOSTIC MONITOR ?
RTN ;YES, NO FURTHER INIT
MOVEI $IPGFL ;SETUP INITIALIZATION PAGE FAIL TRAP
MOVEM LPGFTR
CONI PAG,0
TRZ 0,57777
CONO PAG,@0 ;CLEAR EBR
CONI PAG,0 ;READ EBR
TRZ 0,620000 ;CLEAR CACHE & TRPENB
CAIE 0,0
HALT CPIERR ;NOT CLEAR, FATAL ERROR
DATAO PAG,[LLDUSB,,400000] ;CLEAR UBR
DATAI PAG,0 ;READ UBR
ANDI 0,3777 ;KEEP ONLY BASE REG BITS
CAIE 0,0
HALT CPIERR ;NOT CLEAR, FATAL ERROR
RTN
$SMCSH: MOVE CONSW
TLNN INHCSH ;CACHE INHIBITED ?
SKIPE CSHFLG
RTN ;YES
SKIPN PVPAGI ;PREVENT PAGE INHIBIT ?
TLNN INHPAG ;NO, IS PAGING INHIBITED ?
JRST .+2 ;NO, PAGING ALLOWED
RTN ;YES, NO CACHE THEN EITHER
GO $MAPEX ;REMAP EXEC FOR CACHE
CONI PAG,0
TRZ 0,LSMODE ;CLEAR SECTION MODE
TRO 0,LTRPEN ;SET TRAP ENABLE
CONO PAG,@0
RTN
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
S
;*"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
S
;*SUBROUTINE ERROR HALT
S
$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: COMCLR
GET AC0
HALT @$ERH0 ;HALT WHERE ERROR OCCURED
S
;*FATAL PROGRAM ERROR HALT
S
$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
COMCLR
GET 0
JRST @DDTLNK ;DDT LOADED, GO TO IT
SUBTTL PROGRAM NAME PRINTER
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
$SMSN: BLKI APR,$SMSNX# ;GET SM10 CPU ID INFO
MOVE $SMSNX
ANDI 77777
GO $SNPNT ;PRINT CPU SERIAL NUMBER
PMSG <, MCV=>
MOVE $SMSNX
MOVSS
ANDI 777
PNTOCS ;PRINT MICRO-CODE VERSION
PMSG <, MCO=>
MOVE $SMSNX
LSH -^D27
ANDI 777
PNTOCS ;PRINT MICRO-CODE OPTIONS
PMSG <, HO=>
MOVE $SMSNX
LSH -^D15
ANDI 7
PNTOCS ;PRINT HARDWARE OPTIONS
PMSG <, KASW=>
MOVE $80STAT
PNTHW ;PRINT KEEP ALIVE AND STATUS WORD
$PNM2: PCRL
RTN ;EXIT
$SNPNT: PUT 0
PMSG <, CPU#=>
GET 0
PNTDEC ;PRINT CPU SERIAL NUMBER
RTN
SUBTTL *SUBRTN* INTERRUPT HANDLING ROUTINES
LALL
S
;*PUSH DOWN LIST EXCESSIVE POPJ ROUTINE
S
PSHERR: PMSGF <^*****^PLIST UFLOW^>
FATAL ;PRINT LOCATION AND EXIT
S
;*INTERRUPT ROUTINE INITIALIZATION
S
$ITRIN: MOVE [JSR ITRCH1]
MOVEM 42
MOVEM 44
MOVEM 46
MOVEM 50
MOVEM 52
MOVEM 54
MOVEM 56
MOVE [JRST $ITRC1] ;SETUP "FIXED" LINKING
MOVEM ITRCH1+1
MOVE [JRST RESRTX]
MOVEM RESRT1
JRST $SM10
S
;*DIAG SEGMENT TRANSFER POINT FOR INTERRUPT ROUTINES
S
SALL
$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
$MPVU: MOVEI SIXBTZ <^MEMORY PROT>
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
$NXMU: MOVEI SIXBTZ <^NON-EX MEMORY>
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
$PAREX: MOVE 0,$ACC0
XCT $PARER ;EXECUTE USER ROUTINE, IF PROVIDED
MOVEI SIXBTZ <^MEMORY PARITY>
JRST $ITR1A ;COMMON INTERRUPT ROUTINE
LALL
S
;*COMMON INTERRUPT HANDLERS
S
SALL
$ITRHZ: MOVE 0,$ACC0
XCT $ITRHL ;EXECUTE USER ROUTINE, IF SUPPLIED
CONO PI,PIOFF ;CLEAR PI SYSTEM
MOVEI SIXBTZ <^UNKNOWN INTERRUPT>
LALL
S
;*PRINT CAUSE AND OTHER PERTINENT INFO
S
SALL
$ITR1A:
$ITR1B: SKIPE 0
PSIXL ;PRINT CAUSE
PMSG <^APR PI FLAGS PC PROG^>
MOVE $SVAPR#
PNTHW ;PRINT APR CONI BITS
PSP
MOVE $SVPI#
PNTHW ;PRINT PI CONI BITS
PSP
MOVE ITRCH1
SOS
PNTHW ;PRINT FLAGS, PC
PSP
HRRZ 0,(P)
SOS
PNT6 ;PRINT LAST PUSHJ ENTRY
PCRL
MOVE 0,$ACC0
XCT $ITRX1 ;EXECUTE USER ROUTINE, IF SUPPLIED
FATAL
LALL
S
;*COMMON INTERRUPT ROUTINE
S
$ITRC1: MOVEM AC0,$ACC0# ;SAVE AC0
CONI APR,$SVAPR ;SAVE APR SYSTEM
CONI PI,$SVPI ;SAVE PI SYSTEM
MOVE AC0,JOB41
CAME AC0,[GO $UORTN]
HALT LUOERR ;UUO HANDLER INVALID
MOVE AC0,$ACC0
JRST $SMITR
S
;*RESTORE PROCESSOR ON POWER FAIL RESTART
S
SALL
RESRTX: CONO PAG,0 ;RESET PAGING
WRUBR ACB7
JSR CLRACB ;CLEAR AC BLOCK 7
WRUBR ACB6
JSR CLRACB ;CLEAR AC BLOCK 6
WRUBR ACB5
JSR CLRACB ;CLEAR AC BLOCK 5
WRUBR ACB4
JSR CLRACB ;CLEAR AC BLOCK 4
WRUBR ACB3
JSR CLRACB ;CLEAR AC BLOCK 3
WRUBR ACB2
JSR CLRACB ;CLEAR AC BLOCK 2
WRUBR ACB1
JSR CLRACB ;CLEAR AC BLOCK 1
WRUBR ACB0
JSR CLRACB ;CLEAR AC BLOCK 0
SKIPN $PWRF ;DID POWER FAIL WORK?
JRST $PWRFL ;NO
JRST $SMRST ;SM10
CLRACB: 0
MOVSI 17,-17
SETZM (17) ;CLEAR ALL AC'S
AOBJN 17,.-1
SETZM 17
JRSTF @CLRACB
ACB7: 1B0!7B8 ;WRUBR ARGUMENTS
ACB6: 1B0!6B8
ACB5: 1B0!5B8
ACB4: 1B0!4B8
ACB3: 1B0!3B8
ACB2: 1B0!2B8
ACB1: 1B0!1B8
ACB0: 1B0!0B8
$RSTCM: MOVS [1,,POWER+1] ;RESTORE AC'S
BLT 17
PMSGF <^POWER FAIL RESTART^>
SETZM $PWRF#
MOVE 0,POWER
XCT $RSRTX ;EXECUTE USER ROUTINE, IF PROVIDED
CONO APR,@$SVAPR ;RESET APR SYSTEM
MOVS [1,,POWER+1] ;RESTORE AC'S
BLT 17
MOVE 0,POWER
XCT $RSRTY ;EXECUTE USER ROUTINE, IF PROVIDED
JRSTF @$PWRST
$PWRFL: PGMINT ;REINIT THE SUBROUTINE PACKAGE
PMSGF <^POWER INTERRUPT FAILED^>
HALT BEGIN
LALL
S
;*SM10 PUSHDOWN OVERFLOW TRAP ROUTINE
S
$PDLOV: MOVEM AC0,ITRCH1 ;SAVE USRPC (VIA JSP)
CONI APR,$SVAPR ;SAVE PROCESSOR STATUS
CONI PI,$SVPI ;SAVE PI STATUS
JRST $PDOVU ;GO HANDLE IT
S
;*SM10 PAGE FAIL TRAP ROUTINE
S
SALL
$PGFL: MOVE AC0,LPFWPC ;GET PAGE FAIL PC
AOS ;BECAUSE INTERRUPT ERROR SOS'S
MOVEM AC0,ITRCH1 ;SAVE USRPC
CONI APR,$SVAPR ;SAVE PROCESSOR STATUS
CONI PI,$SVPI ;SAVE PI STATUS
PMSG <^PAGE FAIL TRAP ERROR^PAGE FAIL WORD- >
$PGFL1: MOVE LEUPFW ;GET SM10 PAGE FAIL WORD
PNTHW ;PRINT IT
JRST $PGFL2 ;SM10, REPORT APR ERRORS ALSO
LALL
S
;*SM10 TRAP 3 ROUTINE
S
SALL
$TRP3: MOVEM AC0,ITRCH1 ;SAVE THE USRPC
CONI APR,$SVAPR ;SAVE PROCESSOR STATUS
CONI PI,$SVPI ;SAVE PI STATUS
MOVEI AC0,SIXBTZ ^TRAP 3 ERROR
JRST $ITR1B ;COMMON INTERRUPT ROUTINE START
LALL
S
;*SM10 COMMON TRAP & MMUO SETUP
S
$SMI: MOVSI (JFCL)
MOVEM AROVTP ;SETUP ARITHMETIC OV TRAP
MOVE [JSP $PDLOV]
MOVEM PDOVTP ;SETUP PDL OV TRAP
MOVE [JSP $TRP3]
MOVEM TRP3TP ;SETUP TRAP 3
MOVEI MUUOER ;SETP MUUO AS ERROR FOR THE FOLLOWING:
MOVEM KNTRP ;KERNAL MODE - NO TRAP ENABLED
MOVEM KTRP ; " TRAP ENABLED
MOVEM SNTRP ;SUPERVISOR - NO TRAP
MOVEM STRP ; " TRAP
MOVEM CNTRP ;CONCEALED - NO TRAP
MOVEM CTRP ; " TRAP
MOVEM PNTRP ;PUBLIC - NO TRAP
MOVEM PTRP ; " TRAP
RTN
S
;*SM10 INTERRUPT ROUTINE
S
SALL
$SMITR: DATAI PAG,$SVPAG# ;SAVE PAGE
CONI PAG,$SPAG1#
CONSO APR,LPWRFL ;POWER FAILURE?
JRST $SMIT1 ;NO ...LOOK FOR PARITY ERROR
$SMPWR: MOVE [1,,POWER+1] ;YES
BLT POWER+17
MOVE $ACC0
MOVEM POWER
MOVE ITRCH1
MOVEM $PWRST# ;USER RESTART IF WANTED
MOVE [JRST PFSTRT]
MOVEM 70
SETOM $PWRF ;NOTIFY OF POWER FAIL ON RESTART
HALT BEGIN ;UNTIL POWER ON
$SMIT1: MOVE $SVAPR ;GET APR CONDITIONS
TRNN LNXMER!LPARER
JRST $ITRHZ ;NONE OF THESE INTERRUPTS
TRNE LNXMER ;NON-X-MEM ERROR ?
JRST $NXMU ;YES
TRNE LPARER ;PARITY ERROR ?
JRST $PAREX ;YES
JRST $ITRHZ ;NO ...REST ARE COMMON
LALL
S
;*SM10 INTERRUPT AND TRAP INITIALIZATION
S
$SM10: MOVEI $SMPGFL
MOVEM LPGFTR ;SETUP PAGE FAIL TRAP
GO $SMI ;SETUP TRAPS & MUUOS
$SMCLR: CONO PI,LRQCLR!LPICLR!LCHNOF!LPIOFF ;CLEAR PI SYSTEM,CHNL & REQ PEND
CONO APR,LAPRAL ;CLEAR PROCESSOR ALL
CONO APR,60160 ;DISABLE SOFT MEMORY ERROR,CLK & 8080
$SMENB: SKIPN MONFLG ;MONITOR CONTROL (SPECIAL USER) ?
JRST .+5
MOVE CONSW
SKIPN PVPAGI ;PREVENT PAGE INHIBIT ?
TLNN INHPAG ;PAGING & TRAPPING INHIBITED ?
GO SMPAG ;NO, SETUP TRAP ENABLE
CONO APR,LAPRP1 ;ENABLE CHANNEL 1
CONO PI,LCHNON!LPION!LPICHA ;ENABLE ALL PI CHNS
RTN ;EXIT
$IPGFL: HALT CPIERR ;SM10 INITIALIZATION PAGE FAIL
$SMPGFL:HLRZ 0,LEUPFW ;GET PAGE FAIL WORD
ANDI 0,770000 ;ISOLATE PAGE FAIL CODE
CAIE 0,370000 ;IS IT NXM ?
JRST $PGFL ;NO
CONSO APR,LNXMER ;IS NXM FLOP SET ?
JRST $PGFL ;NO, REAL AR PARITY ERROR
AOS LPFWPC ;YES, INCREMENT PAGE FAIL PC
JRSTF @LPFWPC ;RETURN TO NEXT INSTRUCTION
$PGFL2: MOVE $SVAPR
TRNN LNXMER!LPARER
JRST $ITR1B+2 ;NO APR ERRORS
JRST $SMIT1 ;YES, REPORT APR ERRORS
$SMRST: MOVE 17,POWER+17 ;RESTORE PUSH POINTER
GO $SMCLR ;CLEAR & ENABLE APR & PI
DATAO PAG,$SVPAG ;RESET PAGING
MOVE $SVAPR ;GET ORIGINAL APR
MOVE 1,0
ANDI 0,7 ;KEEP PI ASSIGNMENT
HLRZ 1,1
ANDI 1,1760 ;GET ENABLE CONDITIONS
OR 0,1
MOVEM $SVAPR ;SET TO REENABLE APR
MOVE 0,[2000,,1000] ;SETUP ORIGINAL INITIALIZE BLOCK
BLT 0,1020
JRST $RSTCM ;RESTORE CPU & RESTART
SUBTTL *SUBRTN* END OF PASS/END OF PROGRAM ROUTINES
LALL
S
;*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 ?
SETZM ITRCNT ;YES
$END2: SKIPGE MONCTL ;DIAGNOSTIC MONITOR ?
JRST $END3 ;YES
PMSGF <END PASS >
MOVE PASCNT ;PRINT END OF PASS COUNT
PNTDCF
PNTCIF "."
PCRLF
$END3: SKIPN ITRCNT
AOS (P)
RTN
LALL
S
;*END OF PROGRAM ROUTINE
S
$EOP: COMCLR
SKIPE MONTEN ;LOADED BY ITSELF ?
JRST @RETURN ;NO, RETURN TO LOADER
MOVE DDT+1
CAME [ASCII/DDT/]
HALT BEGIN ;DDT NOT LOADED
JRST @DDTLNK ;OTHERWISE GO TO DDT
SUBTTL *SUBRTN* MEMORY CONTROL
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
;* (MAPNEW=-1 FOR PAGED SEGMENTS UP TO 1024K)
;* (MAPNEW= 0 FOR DIRECT ADDRESSING UP TO 256K)
;* $MZRO (MEMZRO) ZERO'S THE MAPPED MEMORY
;* $MPADR (MAPADR) VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
S
S
;*EXEC MODE MEMORY MAPPING
S
$MEMMP: SETZM MEMSIZ ;CLEAR MAP TABLE START ADDR
MOVE [MEMSIZ,,MEMSIZ+1]
BLT MEMSIZ+^D40 ;CLEAR MEMSIZ TABLE
SKIPN MONFLG ;SPECIAL USER MODE ?
JRST $MPOL1 ;YES, USE UPMP & 256K
MOVEI 0,337777 ;NO
MOVE 1,CONSW ;SETUP SWITCHES
SKIPN PVPAGI ;PREVENT PAGE INHIBIT ?
TLNN 1,INHPAG ;PAGING INHIBITED ?
JRST $MEPAG ;NO ...USE PAGING
JRST $MPOL1+1 ;YES, USE UNPAGED MEM, 0-112K
$MEPAG: CONO PAG,0 ;TURN OFF KL STYLE PAGING
MOVSI 1,-20 ;SETUP EXEC-PER-PROCESS MAP
MOVE [540336,,540337]
SKIPN CSHFLG
TDO [020000,,020000]
ADD [2,,2] ;SO 112K-128K POINTS TO ITSELF
MOVEM 400(1) ;VIRTUAL = PHYSICAL
AOBJN 1,.-2
MOVSI (JFCL) ;SETUP ARITHMETIC TRAP
MOVEM 421 ;JUST IN CASE
SKIPN MAPNEW ;"MAPNEW" = 0 ?
JRST $MPOLD ;YES ...USE 256K MAPPING
S
;*MEMORY MAPPING CONTROL
;*MAP 1024K, 256K, 112K OR 256K SPECIAL USER
S
$MPNEW: MOVE 1,JOBFF ;USE FIRST FREE UP TEMP
MOVEI 16,^D7 ;1024K IS 8 128K CHUNKS
MOVE 0,16
GO $MPSET ;SET PAGE MAP FOR 128K CHUNK
MOVE [400000,,777777] ;LOAD AC0 WITH PAGABLE ADDR BOUNDARIES
GO $MPCNK ;MAP 128K-256K VIRTUAL
SOJGE 16,.-4 ;COMPLETED 1024K ?
JRST $MPCMB ;YES, COMBINE POINTERS
$MPOLD: MOVSI 1,-200 ;128K-256K VIRTUAL POINTS
MOVE [540376,,540377] ;TO PHYSICAL 128K-256K
GO $CSHALW ;CACHE ALLOWED ?
TDO [020000,,020000]
ADD [2,,2] ;AND MEMORY ENDS AT 256K
MOVEM 200(1)
AOBJN 1,.-2
GO SMPAG ;SET TRAP ENABLE
$MPOL1: MOVEI 0,777777 ;MAP 0-256K
MOVE 1,JOBFF ;USE FIRST FREE UP TEMP
SETZM MAPNEW ;DIRECT ADDRESSING ONLY
GO $MPCNK ;MAP CHUNK
JRST $MPCMB ;COMBINE POINTERS
$CSHALW:SKIPE CSHMEM
JRST CPOPJ1 ;DON'T CACHE MEMORY SEGMENTS
SKIPE CSHFLG
JRST CPOPJ1 ;DON'T CACHE AT ALL
PUT 0
MOVE CONSW
TLNE INHCSH
JRST .+3 ;CACHE SWITCH INHIBITED
GET 0
RTN ;OK, CACHE
GET 0
JRST CPOPJ1
S
;*COMBINE EXISTENT CHUNKS FROM MAPCNK
;*PUT POINTERS IN MEMSIZ TABLE
S
$MPCMB: SETZM 2 ;SET MEMSIZ TABLE POINTER (AC2) @ 0
SUBI 1,1 ;DECREMENT TEMP POINTER
MOVE AC0,(1) ;GET LOWEST ADR OF LOWEST CHUNK
CAIE 0,0 ;SHOULD BE 0 (THATS WHERE MEMORY STARTS)
FATAL ;NOT 0
MOVEM MEMSIZ(2) ;PUT IN MEMSIZ TABLE (AC2 IS PTR)
ADDI 2,1 ;INCR THE TABLE POINTER
$MPCM1: SUBI 1,1 ;DECR TEMP POINTER
CAIG 1,@JOBFF ;COMBINED ALL CHUNK POINTERS ?
;(TEMP PTR > JOBFF)
JRST $MPCM2 ;YES
MOVE AC0,(1) ;NO ...GET CHUNK END ADDRESS
MOVE 3,-1(1) ;GET NEXT CHUNK START ADR IN AC3
MOVE 4,0 ;PUT END ADDR IN AC4
ADDI 4,1 ;INCR THE END ADDR
CAMN 3,4 ;IF END & START NOW EQUAL
SOJA 1,$MPCM1 ;IT IS CONT. CHUNK - DO NEXT ONE
$MPCM3: MOVEM 0,MEMSIZ(2) ;IF NOT =, PUT END ADR IN MEMSIZ TABLE
CAIL 2,^D38 ;HAVE WE FILLED MEMSIZ TABLE ?
JRST $MPCMX ;YES ...IGNORE REST OF CHUNKS
ADDI 2,1 ;NO ...INCR MEMSIZ TABLE PTR (AC2)
MOVEM 3,MEMSIZ(2) ;AND NEXT CHUNK START ADR
SOJA 1,$MPCM1-1 ;DO NEXT ONE
$MPCM2: MOVE (1) ;GET LAST ADDR OF LAST CHUNK
MOVEM MEMSIZ(2) ;SAVE LAST ADR OF LAST CHUNK
SETOM MEMSIZ+1(2) ;FLAG END OF MEMSIZ TABLE WITH 1'S
JRST $PMAP ;PRINT THE MAP
$MPCMX: SETOM MEMSIZ+1(2) ;FLAG END OF MEMSIZ TABLE WITH 1'S
PMSGF <^TOO MANY MAP SEGMENTS^>
JRST $PMAP ;PRINT THE MAP
S
;*"MAPCNK" MEMORY CHUNK MAPPER
;*STARTS AT HIGHEST POSSIBLE ADDRESS AND MAPS (ASSUMING NON-X-MEM)
;*UNTIL THE NXM BIT GOES AWAY - THEN MAPS EXISTENT MEMORY
;*IF NXM BIT COMES BACK IT SWITCHES BACK TO NON-X-MEM MAPPING AND
;*MAPS THE HOLE IN EXISTENT MEMORY
;*AC0 HAS BEEN PREVIOUSLY SET UP BY $MPOLD/$MPNEW WITH ADDR LIMITS
S
$MPCNK: MOVEM 2,$ACMP1# ;SAVE AC2 - AC4
MOVEM 3,$ACMP2#
MOVEM 4,$ACMP3#
HRRZ 2,0 ;LOAD ADDRESSER WITH HIGHEST POSS ADDR
HLRZ 3,0 ;LOAD WITH LOWEST POSS ADDR
CONI PI,$MSPI# ;SAVE THE PI STATUS
CONO PI,PIOFF ;TURN OFF INTERRUPTS
CONI APR,$MSAPR# ;SAVE PROCESSOR STATUS
PUT LPGFTR
MOVEI $MPGFL
MOVEM LPGFTR
CAMG 2,3 ;END GREATER THAN START ?
FATAL ;NO
$MPCN1: MOVEI 4,LCNXER ;SETUP SM10 NXM BIT
JRST $MPNXM ;CONO/CONI BIT(S) SET UP - GO MAP
SMPAG: PUT 0
CONI PAG,0 ;GET PRESENT STATE
TRO 0,LTRPEN ;MAKE SURE TRAP ENABLE SET
TRZ 0,40000 ;MAKE SURE 20 PAGING IS OFF
CONO PAG,@0 ;PAGE RESET
GET 0
RTN
S
;*NON-X-MEMORY SEGMENT MAPPER
S
$MPNXM: CONO APR,(4) ;CLEAR NXM BIT, IF SET
CAM (2) ;ADDRESS THE MEMORY
CAM -1(2) ;INTERLEAVE MAP
CAM -2(2) ;IF NON-X-MEM FROM ANY 4-WAY INTERLEAVE
CAM -3(2) ;MARK ALL NON-X-MEM
CONSO APR,LNXMER ;IS NIXM UP ?
JRST $M5 ;NO ..CONV VIRT & REMAP EXISTENT
$M2: CONO APR,(4) ;YES ...CLEAR THE BIT
SUBI 2,20000 ;STEP DOWN 8K
CAIL 2,(3) ;MEMORY CHUNK DONE ? (< LOWEST POSS)
JRST $MPNXM ;NO ...MAP THE NEXT CHUNK
S
;*RESTORE OVERALL SYSTEM STATUS AFTER MAPPING
S
$MPRST: GET LPGFTR
CONO APR,LAPRAL ;RESET SM APR STATUS
HRRZ 3,$MSAPR
ANDI 3,7
CONO APR,(3) ;REASSIGN APR CHANNEL
$MPRPI: MOVE 3,$MSPI ;GET SAVED PI STATUS
TRNE 3,PION ;IF INTERRUPTS WERE ON
CONO PI,PION ;TURN BACK ON
MOVE 2,$ACMP1 ;RESTORE AC'S
MOVE 3,$ACMP2
MOVE 4,$ACMP3
RTN ;EXIT
$MPGFL: HLRZ LEUPFW ;ISOLATE PAGE FAIL REASON
ANDI 770000
CAIE 360000 ;PARITY ERROR ?
JRST $SMPGFL ;NO
AOS LPFWPC ;YES, INCREMENT PAGE FAIL PC
JRSTF @LPFWPC ;RETURN TO NEXT INSTRUCTION
S
;*EXISTANT MEMORY MAPPER
S
$MPEXM: CAM (2) ;ADDRESS THE MEMORY
CAM -1(2) ;INTERLEAVE THE MAP
CAM -2(2)
CAM -3(2)
CONSZ APR,LNXMER ;IS NIXM CLEAR
AOJA 2,$M6 ;NO
$M4: SUBI 2,20000 ;YES, STEP DOWN 8K
CAIL 2,(3) ;BELOW START ADDRESS ?
JRST $MPEXM ;NO ...MAP NEXT CHUNK
AOJA 2,$M7 ;YES, THIS CHUNK DONE
S
;*SAVE POINTERS TO TOP AND BOTTOM OF EXISTANT CHUNKS
;*TEMPORY STORAGE POINTER IN AC1
;*VIRTUAL ADDRESS IN AC0
;*"MAPADR" CONVERTS TO ACTUAL PHYSICAL ADDRESS
S
$M5: GO $MPCXX
AOJA 1,$MPEXM ;GO MAP EXISTANT CHUNK
$M6: GO $MPCXX
ADDI 1,1 ;INCREMENT ADDR
SOJA 2,$MPCN1 ;GO MAP NON-X CHUNK
$M7: GO $MPCXX
AOJA 1,$MPRST ;RESTORE AC'S AND RETURN
$MPCXX: MOVE 0,2
GO $MPADR ;CONVERT VIRTUAL TO PHYSICAL
FATAL ;CAN'T DO IT
MOVEM (1) ;SAVE IN TEMP
RTN
S
;*"MAPSET" SETUP SM10 PAGE MAP
;*FOR VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
;*ARGUMENTS PASSED IN AC0:
;* NEG - CLEAR PAGE MAP
;* 0-7 - MAP CORRESPONDING 128K SEGMENT
S
$MPSET: MOVEM 1,$ACMP4# ;SAVE AC1
JUMPGE 0,$MPSE2 ;ARG NEG ?
SETZM 200 ;YES, CLEAR PAGE MAP
MOVE 0,[200,,201]
BLT 0,377
$MPSE3: GO SMPAG ;SET TRAP ENABLE
MOVE 1,$ACMP4 ;RESTORE AC1
RTN ;EXIT
$MPSE2: CAIL 0,40 ;ARG 0-37 ?
FATAL ;NO, FATAL ERROR
IMULI 0,400 ;COMPUTE PHYSICAL RELOCATION
TRO 0,540000 ;SET A,W,S BITS
GO $CSHALW ;MEM SEG'S CACHED ?
TRO 0,020000 ;YES
HRL 0,0 ;MAKE BOTH HALVES SAME
ADDI 0,1 ;RIGHT HALF ODD PAGE
MOVSI 1,-200 ;128K IN PAGE MAP
MOVEM 200(1) ;PUT RELOCATION DATA IN PAGE MAP
ADD [2,,2] ;BUMP FOR NEXT ENTRY
AOBJN 1,.-2
JRST $MPSE3 ;CLEAR ASSOC MEMORY & EXIT
S
;*"MEMSEG" ## MAPNEW = -1 ##
;*SETS UP TO 128K SEGMENT IN PAGE MAP
;*ARGUMENTS: 0-7 - MAP CORRESPONDING 128K SEGMENT
;* 10-37 - DOES NOT EXIST ON SM-10
;* GT 37 - MAP USING PHYSICAL ADDRESS
;*RETURNED IN AC0:
; 0 - NO MEMORY AVAILABLE
;* HIGHEST VIRTUAL ADDRESS
;* BIT 0 SET IF NON-CONSECUTIVE CORE WAS COMBINED
;*PAGE MAP SET UP SO VIRTUAL ADDRESS 400000 AND UP POINTS
;*TO MEMORY REQUESTED
;* RETURNS +2
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
SKIPN MAPNEW
JRST $MSKA ;DIRECT ADDRESSING ONLY
MOVE 2,[POINT 18,200]
CAIL 0,40
JRST $MSEGP ;ARG IS FOR PHYSICAL CORE
JRST $MSEGV ;VIRTUAL CORE
S
;*SETUP MAP FOR REQUESTED 128K SEGMENT IN VIRTUAL CORE
S
$MSEGV: MOVE 1,MEMLOW
GO $MPSET ;SETUP MAP FOR REQ SEGMENT
MOVE [400000,,777777]
GO $MPCNK ;MAP THAT SEGMENT
$MSGV1: CAIG 1,@MEMLOW
JRST $MSEG3 ;NO CORE IN THIS 128K SEGMENT
;EXIT
SETZM 200 ;CLEAR PAGE MAP
MOVE [200,,201]
BLT 0,377
$MSGV2: SUBI 1,1
MOVE 3,(1) ;GET CHUNK START ADDRESS
JUMPN 3,.+2 ;IF CHUNK ADR IS ZERO
MOVE 3,MEMLOW ;USE EVEN BREAK ABOVE JOBFF
SUBI 1,1
MOVE 4,(1) ;GET CHUNK END ADDRESS
CAMG 4,3 ;END GREATER THAN START ?
FATAL ;NO ...ABORT
SUB 4,3 ;YES ..END - START = SIZE OF CHUNK
ADDI 4,1
TRNE 4,777 ;CHUNK SHOULD BE EVEN # OF PAGES
FATAL ;NO ...ABORT
LSH 4,-^D9 ;COMPUTE # OF PAGES
ADD 5,4 ;KEEP COUNT
LSH 3,-^D9
TRO 3,540000 ;CREATE RELOCATION DATA
GO $CSHALW ;MEM SEG'S CACHED ?
TRO 3,020000 ;YES
SOJL 4,$MSGV3
IDPB 3,2 ;PUT IN PAGE MAP
ADDI 3,1 ;INCREMENT RELOCATION DATA
JRST .-3
$MSGV3: CAIN 1,@MEMLOW ;ANY MORE CHUNKS IN THIS 128K ?
JRST $MSEG2 ;NO ...EXIT)
SETOM $MNCON ;YES, NON-CONSECUTIVE CHUNKS
JRST $MSGV2 ;PACK INTO VIRTUAL
S
;*EXIT FROM MEMSEG ROUTINE
S
$MSEG2: IMULI 5,1000 ;CONVERT # OF PAGES INTO
ADDI 5,377777 ;HIGHEST VIRTUAL ADDRESS
SKIPE $MNCON ;WERE CHUNKS COMBINED ?
TLO 5,400000 ;YES, SET BIT 0 AS FLAG
$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
SKIPN MAPNEW ;1024K MAPPING (BIG TROUBLE IF NOT)
RTN ;NO ...ERROR RETURN +1)
$MSEG4: GO SMPAG ;SET TRAP ENABLE
AOS (P) ;RETURN +2
RTN ;RETURN +1
S
;*PHYSICAL CORE ASSIGNMENT
S
$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
SKIPN MAPNEW
JRST $MSKAP+3 ;DIRECT ADDRESSING
SUB 0,1 ;COMPUTE # OF PAGES
ADDI 0,1
LSH 0,-^D9
CAILE 0,^D256 ;MORE THAN 128K WORTH ?
MOVEI 0,^D256 ;YES, LIMIT AT 128K
MOVEM 0,3 ;AC3 = MAP FILL COUNTER
MOVEM 0,5 ;KEEP COUNT OF # OF PAGES
SETZM 200 ;CLEAR PAGE MAP
MOVE [200,,201]
BLT 0,377
MOVE 0,1
LSH 0,-^D9 ;CREATE RELOCATION DATA
TRO 0,540000
GO $CSHALW ;MEM SEG'S CACHED ?
TRO 0,020000 ;YES
SOJL 3,$MSEG2 ;EXIT
IDPB 0,2 ;PUT DATA IN PAGE MAP
ADDI 0,1 ;INCREMENT RELOCATION DATA
JRST .-3
S
;*"MEMSEG" ## MAPNEW = 0 ##
;*ARGUMENTS 0-10: SETUP CORRESPONDING CHUNK FROM MEMSIZ TABLE
;* 11-37 RETURN 0, MAXIMUM OF 8 CHUNKS IN 256K
;* GT 37 - RETURNS MEMORY AT PHYSICAL ADDRESS
;*RETURNED IN AC0:
;* 0 - NO MEMORY AVAILABLE
;* START ADDRESS,,END ADDRESS
;*RETURNS +1
S
$MSKA: CAIL 0,40
JRST $MSKAP ;DIRECT PHYSICAL CORE
CAIL ^D9
JRST $MSEG3 ;NO MEMORY 11-37 ...EXIT
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
$MSKAP: CAILE 0,777000 ;REQUEST FOR OVER 256K ?
JRST $MSEG3 ;YES, NO MEMORY
JRST $MSEGP ;DO PHYSICAL SETUP
MOVE 5,0 ;1 = PHY ADR, 0 = END ADR
HRL 5,1 ; START ADR,,END ADR
JRST $MSEG3 ;EXIT
S
;*"MEMZRO"
;*ZERO'S MEMORY FROM MEMLOW UP TO MAXIMUM
;*MAPNEW = 0 DIRECT MEMORY ZERO
;* =-1 1024K SM10 PAGED MEMORY ZERO
S
$MZRO: MOVEM 1,$MZROB# ;SAVE AC1 & AC2
MOVEM 2,$MZROC#
SKIPN MAPNEW ;1024K PAGED OR DIRECT ZERO ?
JRST $MZRO2 ;DIRECT ZEROING
$MZRO1: SETO 2, ;PAGED ZEROING
ADDI 2,1
CAILE 2,7
JRST $MZROX ;DONE
MOVE 0,2
GO $MSEG ;SETUP MEMORY SEGMENT
FATAL
JUMPE 0,$MZRO1+1 ;NO MEMORY THIS SEGMENT
TLZ 0,400000 ;DON'T CARE IF COMBINED
SETZM 400000
MOVE 1,[400000,,400001]
BLT 1,@0 ;ZERO VIRTUAL
JRST $MZRO1+1
$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" CONV VIRT ADDR TO PHYS ADDR
;*VIRTUAL ADDRESS IN AC0, PHYSICAL ADDRESS RETURNED IN AC0
;*SKIP RETURN IS NORMAL, NON-SKIP RETURN IS SM10 PAGE INACCESSIBLE
S
$MPADR: MOVEM 1,$ACMP0# ;SAVE AC1
HRRZ 1,0 ;18 BIT VIRTUAL ADR IN AC1
CAIG 1,17 ;ACCUMULATOR ADDRESS ?
JRST $MPAD3-1 ;YES
MOVE 0,CONSW ;GET CONSOLE SWITCHES
SKIPN PVPAGI ;PREVENT PAGE INHIBIT ?
TLNN 0,INHPAG ;PAGING INHIBITED
JRST $MPADL ;NO
JRST $MPAD2 ;YES
$MPAD7: AOS (P) ;INCREMENT USRPC (+2 RETURN)
$MPAD3: MOVE 1,$ACMP0 ;RESTORE AC1
RTN ;RETURN +1/+2
$MPAD2: MOVE 0,1 ;VIRTUAL IS PHYSICAL ADDRESS
JRST $MPAD7
$MPADL: MAP 0,(1) ;SM10. GET RELOCATION DATA
TLNE 0,200000 ;PAGE FAILURE
JRST $MPAD3 ;YES
TLZ 0,777000 ;CLEAR STATUS BITS
TRNE 1,777 ;LO-ORDER 9 VIRTUAL = 0
TRNE 0,777 ; & LO-ORDER 9 MAPPED = 0 ?
JRST $MPAD7 ;YES
ANDI 1,777 ;NO, SM-10 BUG, LOW-ORDER 9 FROM VIRTUAL
OR 0,1 ;COMBINE
JRST $MPAD7
S
;*PRINT MEMORY MAP
S
SALL
$PMAP: SETOB 0,2
CAMN 0,MEMSIZ+2 ;ONLY ONE SEGMENT ?
MOVEI 2,1 ;YES, SET INDICATOR
SETZ 4,
SKIPL MONCTL ;UNDER DIAGNOSTIC MONITOR ?
JRST $PMAP3 ;NO
HLRZ MONCTL ;FIRST PASS ?
CAIE -1
JRST $PMAP1 ;NO
$PMAP3: SKIPN $ONETM ;FIRST TIME ?
SETO 4, ;YES, SET FLAG FOR PRINTING
$PMAP1: JUMPE 4,$PMAPL-1 ;NO
SKIPN MAPNEW
PMSG <^VIRTUAL>
PMSG <^MEMORY MAP =^FROM TO SIZE/K>
CAIE 2,1 ;IF (2) = 1, ONLY ONE SEGMENT
PMSG <]START ADR/K>
PCRL
SETZB 3,5
$PMAPL: SKIPGE MEMSIZ(3) ;GET MAP COORDINATES
JRST $PMAP4
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,$PMAP5
$PMAP7: PNTDEC ;PRINT DECIMAL SIZE
CAIN 2,1
JRST .+5
PNTCI " "
MOVE MEMSIZ(3)
IDIVI ^D1024
PNTDEC ;PRINT START ADR IN K
PCRL
$PMAP5: ADDI 3,2
JRST $PMAPL ;GET NEXT IF ANY
$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
CAIN 2,1
JRST $PMAP6-1 ;CRLF & RETURN
PMSG <TOTAL MEMORY/K = >
MOVE MEMTOT ;OUTPUT TOTAL MEMORY
PNTDEC
PCRL
PCRL
$PMAP6: RTN ;EXIT
LALL
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
JRST $SWU1 ;YES, USE SAVED SWITCHES
$SWCH1: SKIPGE MONCTL ;MONITR CONTROL ?
HRR 0,MONCTL ;YES, USE PRESTORED RH SWITCHES
MOVEM 0,CONSW ;SAVE
RTN ;EXIT
$SWU1: MOVE 0,CONSW
JRST $SWCH1
$SWU2: MOVE 0,CONSW
RTN
S
;*SWITCH INITIALIZATION ROUTINE
S
SALL
$SWTIN: 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
SALL
$SW0: PUT 0
SKIPE $$TOGGLE ;SWITCHES PREVENTED ?
JRST $SW9+2 ;YES, USE C(CONSW)
$SW0A: 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 OR Y <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
$SWERR: 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
$SW8: GET 0
RTN
$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
LALL
S
;*PROMPT FOR SWITCHES
S
SALL
$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, DON'T SET SWITCH BIT
$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/
0 ;SIXBIT/PNTLPT/
SIXBIT/DING/
SIXBIT/LOOPER/
SIXBIT/ERSTOP/
SIXBIT/PALERS/
SIXBIT/RELIAB/
SIXBIT/TXTINH/
SIXBIT/INHPAG/
SIXBIT/MODDVC/
SIXBIT/INHCSH/
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
$TYINI: 0
SETZM $80CIW ;CLEAR INPUT WORD
SETZM $80COW ;CLEAR OUTPUT WORD
SETZM $80KIW ;CLEAR INPUT WORD
SETZM $80KOW ;CLEAR OUTPUT WORD
SETZM MMFLAG#
MOVE 0,$80STAT ;GET CONSOLE STATUS WORD
TLNE 0,($80MM) ;MAINTENANCE MODE BIT SET ?
SETOM MMFLAG ;YES, SET TTY IN MAINT MODE
JRST @$TYINI
$TYCLR: 0
JRST @$TYCLR ;NOTHING REQUIRED
$CYTYI: 0
MOVE 0,$80CIW ;GET INPUT WORD
TRNN 0,$80CHR ;CHAR FLAG BIT SET ?
JRST @$CYTYI ;NO
SETZM $80CIW ;CLEAR INPUT WORD
ANDI 0,177
AOS $CYTYI
AOS $CYTYI
JRST @$CYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
$KYTYI: 0
MOVE 0,$80KIW ;GET INPUT WORD
TRNN 0,$80CHR ;CHAR FLAG BIT SET ?
JRST @$KYTYI ;NO
SETZM $80KIW ;CLEAR INPUT WORD
ANDI 0,177
AOS $KYTYI
AOS $KYTYI
JRST @$KYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
$BYTYI: 0
CTYTYI ;ANY CTY INPUT ?
JRST .+5 ;NO
HALT .
AOS $BYTYI
AOS $BYTYI
JRST @$BYTYI ;DOUBLE SKIP RETURN, CHAR IN AC0
KTYTYI ;ANY KLINIK INPUT ?
JRST @$BYTYI ;NO
HALT .
JRST .-6
$COMTI: 0
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
JRST .+7 ;YES
CTYTYI ;ANY CTY INPUT ?
JRST @$COMTI ;NO
HALT .
AOS $COMTI
AOS $COMTI
JRST @$COMTI ;DOUBLE SKIP RETURN, CHAR IN AC0
KTYTYI ;ANY KLINIK INPUT ?
JRST @$COMTI ;NO
HALT .
AOS $COMTI
AOS $COMTI
JRST @$COMTI ;DOUBLE SKIP RETURN, CHAR IN AC0
$CYTYO: 0
TRO 0,$80CHR ;SET FLAG BIT
MOVEM 0,$80COW ;PUT IN COMM AREA
CONI APR,0 ;GET PRESENT APR
ANDI 7 ;KEEP PI ASSIGNMENT
TRO $80INT ;SET INTERRUPT 8080
CONO APR,@0 ;INTERRUPT 8080
MOVE 0,$80COW ;GET OUTPUT WORD
TRNE 0,$80CHR ;8080 SENT THIS CHAR ?
JRST .-2 ;NO, WAIT
JRST @$CYTYO ;YES
$KYTYO: 0
TRO 0,$80CHR ;SET FLAG BIT
MOVEM 0,$80KOW ;PUT IN COMM AREA
CONI APR,0 ;GET PRESENT APR
ANDI 7 ;KEEP PI ASSIGNMENT
TRO $80INT ;SET INTERRUPT 8080
CONO APR,@0 ;INTERRUPT 8080
MOVE 0,$80KOW ;GET OUTPUT WORD
TRNE 0,$80CHR ;8080 SENT THIS CHAR ?
JRST .-2 ;NO, WAIT
JRST @$KYTYO ;YES
$BYTYO: 0
MOVEM 0,$BYTYC# ;SAVE OUTPUT CHAR
CTYTYO ;OUTPUT CHAR TO CTY
MOVE 0,$BYTYC ;GET OUTPUT CHAR
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
KTYTYO ;YES, OUTPUT CHAR TO KLINIK
JRST @$BYTYO
$COMTO: 0
SKIPE MMFLAG ;IN MAINTENANCE MODE ?
JRST .+3 ;YES
CTYTYO ;OUTPUT CHAR TO CTY
JRST @$COMTO
KTYTYO ;OUTPUT CHAR TO KLINIK
JRST @$COMTO
S
;*TTLOOK
;*CHECKS FOR ANY KEY STRUCK, RETURNS IMMEDIATELY
;*RETURNS +1 IF NO TYPEIN, RETURNS +2 IF CHAR TYPED
S
$TTLK: GO ANYOUT ;IF ANY OUTPUT, PRINT IT
SETZ AC0,
JRST $HEAR ;CHECK & INPUT IF THERE
S
;*TTYINP
;*TELETYPE IMAGE MODE INPUT
;*PROVIDES UNBUFFERED MODE INPUT
;*WAITS FOREVER, RETURN WITH CHAR UPPER CASED & ECHOED
S
$TTYIN: GO ANYOUT ;IF ANY OUTPUT, PRINT IT
GO $HEAR ;GET CHAR
JRST .-1 ;WAIT FOR IT
RTN
S
;*TTICHR
;*TELETYPE INPUT OPERATOR RESPONSE ROUTINE
S
$OPTLK: GO ANYOUT ;IF ANY OUTPUT, PRINT IT
MOVEM 4,$TACB4#
MOVE 4,[44,,30600] ;1 SEC FUDGE FACTOR
SOJLE 4,.+4 ;WAITED LONG ENOUGH YET ?
GO $HEAR ;NO, GO LOOK FOR INPUT & RETURN
JRST .-2 ;NO RESPONSE, REPEAT
AOS (P) ;CHAR TYPED, RETURN +2
MOVEM 4,$TWCNT ;SAVE TTY WAIT COUNT
MOVE 4,$TACB4
RTN ;NO CHAR, RETURN +1
S
;*TTALTM
;*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
CAIN 004 ;IS CHAR CONTROL D (^D) ?
JRST $DDTENT ;YES
CAIN 024 ;IS CHAR CONTROL T (^T) ?
JRST $TALT3 ;YES
CAIN 005 ;IS CHAR CONTROL E (^E) ?
JRST $TALT4 ;YES
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
$TALT3: PMSGF <TEST PC = >
HRRZ TESTPC
PNT6F ;PRINT TEST PC
PCRLF
MOVEI 0,024
RTN
$TALT4: PMSGF <ERROR PC = >
HRRZ ERRPC
PNT6F ;PRINT ERROR PC
PMSGF < ERROR TOTALS = >
MOVE ERRTLS
PNTDCF ;PRINT ERROR TOTALS
PCRLF
MOVEI 0,005
RTN
S
;*TELETYPE INPUT CHARACTER ROUTINE
S
$HEAR: GO $TIRDY ;KEY BEEN STRUCK ?
RTN ;NO, EXIT
$TIEX2: MOVEM 0,$TTCHR# ;SAVE ACTUAL CHARACTER
ANDI 0,177
CAIN 0,023
JRST $HEAR ;XOFF
CAIN 021
JRST $HEAR ;XON
AOS $CARCT
GO $TYOUT ;ECHO IT
CAIN 0,003 ;IS IT ^C ?
JRST $HEAR1 ;YES, TERMINATE
CAIE 0,15 ;IS IT CR ?
JRST $HEAR4 ;NO-PROCESS IT
SETZM $CARCT
MOVEI 0,12 ;YES
GO $TYOUT ;ECHO LF
JRST $HEAR4 ;PROCESS THE CHARACTER
$TIRDY: BTYTYI ;GET INPUT CHAR
RTN ;NOT AVAILABLE
HALT .
JUMPE 0,CPOPJ ;NO GOOD IF NULL
JRST CPOPJ1 ;SKIP RETURN
$TPCLR: RTN ;CLEAR TTY INPUT (EXEC=NO-OP)
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
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
$HEAR1: MOVEI 0,$HEAR+0 ;CONTROL C, SAVE ENTRY TO
MOVEM 0,JOBOPC ;TTY ROUTINE FOR RESTART
SKIPL MONCTL ;DIAG MONITOR ?
JRST @CNTLC ;TERMINATE
JRST DIAMON ;YES, RESTART MONITOR
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
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
S
;*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
S
;*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
S
;*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
S
;*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
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
MOVEI $BEND2
MOVEM CNTLC ;SET ^C TO ALWAYS END PROGRAM
SETZM ENQFLG#
MOVE [POINT 7,$OUTBF]
MOVEM P$PTR# ;SETUP PRINT STORE POINTER
COMINI ;IF TIMEOUT, SEND IN CLEAR
;IF ACK'D, SEND IN PROTOCALL MODE
$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
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
S
;*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.
SKIPLE COMFLG
COMENQ ;REQUEST COMM SERVICE
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
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
S
;*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 CONTROL ROUTINE
S
$TOUT: MOVEM 0,$PACB0# ;SAVE AC0.
MOVEM 1,$PNTYC# ;SAVE CHARACTER TO BE PRINTED
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 $TOUT1 ;NO-CHK FOR LF
SKIPN $PTINH ;DON'T COUNT ^O'ED LINES
AOS PNTENB ;COUNT LINES, TILL NO MORE
SETZM $CARCT ;CLR CHAR CNTR.
$TOUT1: CAIN 1,12 ;IS CHAR A LF?
SETZM $CARCT ;YES-CLR CHAR CNTR.
SKIPE $PNTTY ;NO-IS PRINT FORCED ON?
JRST $TOUT2 ;YES-DON'T CHECK NON-PNT SW
TLNE 0,NOPNT ;IS NON PNT SWITCH ON?
JRST $TOUTA ;YES, RETURN
$TOUT2: HRRZ 0,P$PTR ;FILLED OUTPUT BUFFER ?
CAIL 0,$OUTBF+^D28
JRST $TOUT4 ;YES
SKIPE $TABF ;TAB CONV INHIBITED ?
JRST .+3 ;YES, DON'T DO IT
CAIN 1,11 ;IS CHAR A TAB?
JRST $TABS ;YES. TURN TAB INTO SPACES.
IDPB 1,P$PTR ;STORE CHAR
CAIE 1,12 ;LF ?
JRST $TOUTA ;NO
MOVE 1,[ASCII/ O /]
MOVEM 1,$OUTBF-1
SETZM QFLAG#
$TOUT5: SETZ 1,
IDPB 1,P$PTR ;YES, END WITH NULL
MOVE 1,[POINT 7,$OUTBF]
MOVEM 1,P$PTR ;RESET STORE POINTER
MOVE 0,CONSW
TLNE 0,PNTLPT ;PRINT ON LINE PRINTER ?
JRST .+1 ;JRST $TLPT ;YES !NO LPT YET ON 2020
$TOUT3: SKIPN MMFLAG ;IN MAINTENANCE MODE ?
JRST $TOUT6 ;NO
JSR $TOUTB ;YES, SEND TO CTY
SKIPG COMFLG ;IN PROTOCOL MODE ?
JRST $TOUTA ;NO, ALL DONE
$TOUT7: MOVE [POINT 7,$OUTBF-1,20]
COMCMD ;SEND MESSAGE
HALT . ;EOT ????
JRST $TOUTA ;DONE, EXIT
$TOUT6: SKIPLE COMFLG ;IN PROTOCOL MODE ?
JRST $TOUT7 ;YES
JSR $TOUTB ;NO, SEND TO CTY
JRST $TOUTA ;DONE
$TOUT4: IDPB 1,P$PTR ;BUFFER FULL, STORE CHAR
MOVEI 1,15
IDPB 1,P$PTR ;END WITH CR/LF
MOVEI 1,12
IDPB 1,P$PTR
MOVE 1,[ASCII/ Q /]
MOVEM 1,$OUTBF-1
SETOM QFLAG
JRST $TOUT5
ANYOUT: PUT 0
PUT 1
PUT 2
PUT 3
MOVE P$PTR
CAMN [POINT 7,$OUTBF]
JRST .+2
JSP 3,$TOUT4+1
SETZM XOFFLAG
GET 3
GET 2
GET 1
GET 0
RTN
S
;*DIRECT TERMINAL OUTPUT
S
$TOUTB: 0
MOVE 1,[POINT 7,$OUTBF]
SKIPE PNTINH ;INHIBIT INPUT CHECKS ?
JRST $TOUB2 ;YES - GO OUTPUT
;LOOK FOR TTY TYPE INS
BTYTYI ;KEY STRUCK ?
JRST $TOUB2 ;NO ...GO OUTPUT
HALT .
CAIN 0,004 ;IS IT ^D ?
JRST $DDTENT ;YES, GO TO DDT
CAIN 0,003 ;IS IT ^C ?
JRST $TUTX2 ;YES, TERMINATE THE OUTPUT
CAIE 175
CAIN 176
JRST $TUTX3 ;ALTMODE, GO TO USER'S ROUTINE
CAIN 33
JRST $TUTX3
CAIE 0,017 ;IS IT ^O ?
JRST $TOUB1 ;NO
MOVEI 0,136 ;"^"
GO $TYOUT
MOVEI 0,117 ;"O"
GO $TYOUT
SETCMM $PTINH ;STOP OR START OUTPUT
JRST $TOUB2
$TOUB1: CAIN 0,023 ;IS IT XOFF (^S) ?
SETOM XOFFLAG ;YES, SET FLAG, STOP BEFORE CR
$TOUB2: ILDB 0,1 ;GET CHARACTER
JUMPE 0,@$TOUTB ;IF NULL, DONE
CAIN 0,15
SKIPN QFLAG
JRST .+2
JRST $TOUTB+2
CAIN 0,12
SKIPN QFLAG
JRST .+2
JRST $TOUTB+2
CAIN 0,15 ;CR ?
GO XONCHK ;YES, CHECK IF XOFF'ED FOR XON
SKIPN $PTINH ;CONTROL O'ED ?
GO $TYOUT ;NO, OUTPUT CHAR
JRST $TOUTB+2 ;LOOP TILL NULL
XONCHK: SKIPN XOFFLAG ;XOFF'ED ?
RTN ;NO
BTYTYI ;ANY KEY STRUCK ?
JRST .-1 ;NO, WAIT
HALT .
CAIN 004 ;CONTROL D ?
JRST $DDTENT ;YES, GO TO DDT
CAIN 003 ;CONTROL C ?
JRST $TUTX2 ;YES, ABORT
CAIE 021 ;XON (^Q) ?
JRST XONCHK ;NO
SETZM XOFFLAG ;YES, CLEAR FLAG & CONTINUE PRINTING
SETZM $PTINH
MOVEI 0,15 ;RELOAD CR FOR PRINTING
RTN
S
;*ALT-MODE TRANSFER TO USER ROUTINE
S
MOVEM 0,JOBOPC ;2-TERMINATED IN JOBOPC
JRST @CNTLC ;3-TERMINATE
$TUTX2: JSP 0,.-2 ;1-SAVE PC WHERE
JRST $TOUTB+2 ;4-HERE IF CONTINUED
MOVEM 0,JOBOPC ;2-TERMINATED IN JOBOPC
JRST @ALTMGO ;3-TERMINATE
$TUTX3: JSP 0,.-2 ;1-SAVE PC WHERE
JRST $TOUTB+2 ;4-HERE IF CONTINUED
S
;*RETURN BACK TO PRINTING ROUTINE FROM CHAR OUTPUT
S
$TOUTA: MOVE AC0,$PACB0 ;RESTORE AC0
JRST (3) ;RETURN TO PRINT ROUTINE
S
;*TELETYPE TABS CONVERSION
S
$TABS: SOS 1,$CARCT ;PUT CHAR CNT - 1 TAB INTO AC1.
SUBI 1,10 ;DIVIDE
JUMPGE 1,.-1 ;BY 10.
MOVN 1,1 ;C(AC1) NOW = NO. OF SPACES TO PNT.
$TABS1: MOVEI 0,40 ;PRINT SPACES
IDPB 0,P$PTR ;STORE A SPACE
AOS $CARCT ;INCREMENT CHAR CNTR.
SOJG 1,$TABS1 ;DECREMENT SPACES CNTR.
JRST $TOUTA ;RETURN
S
;*SM-10 EXEC MODE TELETYPE DRIVER ROUTINE
S
$TYOUT: MOVEM AC0,$TYAC0# ;SAVE AC0
MOVEM 1,$TYAC1# ;SAVE AC1 & AC2
MOVEM 2,$TYAC2#
ANDI 0,177 ;STRIP TO 7 BITS
$TYOU4: SKIPG COMFLG ;IN PROTOCOL MODE ?
JRST .+3 ;NO
CTYTYO ;YES, SEND TO CTY
JRST $TYOU3
BTYTYO ;SEND CHAR
$TYOU3: MOVE 0,$TYAC0 ;DONE, RESTORE AC'S
MOVE 1,$TYAC1
MOVE 2,$TYAC2
RTN ;EXIT
SUBTTL COMMUNICATION ROUTINES
S
;*$$C - COMM SAVE AC1 - AC5
S
$$C: 0
PUT 1
PUT 2
PUT 3
PUT 4
PUT 5
JRST @$$C
S
;*$$CE2 - DOUBLE SKIP RETURN
S
$$CE2: AOS -5(P)
S
;*$$CE1 - SINGLE SKIP RETURN
S
$$CE1: AOS -5(P)
S
;*$$CE - NO SKIP RETURN
S
$$CE: GET 5
GET 4
GET 3
GET 2
GET 1
RTN
S
;*COMACK - COMMUNICATION ACKNOWLEDGE
S
$COMACK: JSR $$C
AOS MSGNBR# ;COUNT MESSAGE
MOVEI AC5,ACKMSG
JRST $COMCX
S
;*COMNAK - COMMUNICATION NEGATIVE ACKNOWLEDGE
S
$COMNAK: JSR $$C
MOVEI AC5,NAKMSG
JRST $COMCX
S
;*COMCMD - COMMUNICATION COMMAND
S
$COMCMD: JSR $$C
SETZ AC5,
$COMCX: MOVEI AC4,^D16 ;RETRY 16 TIMES
JUMPN AC5,$COMC1 ;CONTROL SEQUENCE ?
COMSND ;NO, COMMAND SEND
JRST $COMC2
$COMC1: MOVE AC0,AC5
COMCTL ;CONTROL SEQUENCE SEND
$COMC2: COMLIN ;GET REPLY
JRST $COMC3 ;ERROR
JRST $COMC4 ;CONTROL SEQUENCE
;NORMAL MESSAGE
MOVEI AC3,136
MOVE AC0,MSGNBR ;ODD OR EVEN MESSAGE NUMBER ?
TRNE AC0,1
MOVEI AC3,041 ;ODD
CAME AC3,COMNBR ;CORRECT MESSAGE NUMBER ?
JRST $COMACK+2 ;NO, MUST BE REPEAT
SETZ ;NEW MESSAGE READY
JRST $$CE2 ;DOUBLE SKIP RETURN
$COMC3: SOJN AC4,.+2 ;EXCEEDED RETRY LIMIT ?
JRST COMERR ;YES, REPORT ERROR & ABORT
JUMPN AC5,.+5 ;CONTROL REPEAT ?
CAIN AC0,-5 ;NO, RECIEVED CHECKSUM ERROR ?
JRST .+3 ;YES, SEND NAK
COMRTRY ;COMMAND RETRY
JRST $COMC2
MOVEI AC5,NAKMSG ;NAK & TRY AGAIN
JRST $COMC1
$COMC4: CAIN AC0,"A" ;ACK, SINGLE-SKIP RETURN
JRST $$CE1
CAIN AC0,"Z" ;EOT, NO-SKIP RETURN
JRST $$CE
CAIN AC0,"N" ;NAK, TRY AGAIN
JRST .+3
MOVEI AC0,-10
JRST $COMC3 ;ERROR, TRY AGAIN
MOVEI AC0,-7 ;LOAD NAK ERROR CODE
JRST $COMC3 ;TRY AGAIN
S
;*COMSND - COMMUNICATION SEND
S
$COMSND:JSR $$C
MOVE AC5,[POINT 7,COUTBF,27]
SETZ AC3,
MOVEM AC0,AC4
$COMS1: ILDB AC0,AC4
CAIN AC0,12
JRST $COMS1 ;IGNORE LF
CAIN AC0,15
JRST $COMS2 ;FOUND CR
CAIN AC0,33
JRST $COMS2 ;FOUND ALTMODE
JUMPE AC0,$COMS2 ;REACHED NULL BYTE ?
ADD AC3,AC0 ;ACCUMULATE CHECKSUM
IDPB AC0,AC5 ;TRANSFER MSG TO OUTPUT BUFFER
JRST $COMS1
$COMS2: MOVEI AC0,15 ;END MSG WITH CR & NULL
IDPB AC0,AC5
SETZ
IDPB AC0,AC5
MOVE AC5,[POINT 7,COUTBF]
MOVEI AC1,136 ;SETUP MSG NUMBER CHAR
MOVE MSGNBR
TRNE 1
MOVEI AC1,041
IDPB AC1,AC5
MOVN AC3,AC3 ;NEGATE CHECKSUM
LDB AC0,[POINT 4,AC3,23]
GO COMASC
LDB AC0,[POINT 6,AC3,29]
GO COMASC
LDB AC0,[POINT 6,AC3,35]
GO COMASC
JRST $COMRTRY+1
S
;*COMRTRY - COMMUNICATION RETRY
S
$COMRTRY:JSR $$C
MOVEI AC0,COUTBF ;SETUP MSG POINTER
JRST $COMCTL+1
S
;*COMCTL - COMMUNICATION CONTROL
S
$COMCTL:JSR $$C
MOVE AC5,AC0
COMTYI ;FLUSH OLD INPUT
JRST .+6
CAM
ANDI 177
CAIE 003
JRST .-5
JRST $TUTX2 ;CONTROL C'ED
MOVEI 001 ;SEND TWO SYNC CHARS
COMTYO
MOVEI 001
COMTYO
HRLI AC5,(POINT 7,) ;CREATE BYTE POINTER
ILDB AC0,AC5 ;SEND MSG TILL NULL
JUMPE AC0,.+3
COMTYO
JRST .-3
JRST $$CE ;COMPLETED
S
;*COMLIN - COMMUNICATION LINE
S
$COMLIN:JSR $$C
MOVE AC1,[POINT 7,CINBF]
SETZB AC5,$TTYTIM#
$COML1: SKIPL COMFLG ;FIRST TIME ?
JRST .+3 ;NO
GO COMTIME ;YES, IF IT TIMES OUT, SEND IN CLEAR
JRST $CMLE1 ;TIMED OUT
COMTYI ;GET INPUT CHAR
JRST $COML1 ;NONE AVAILABLE
CAM
ANDI 177
CAIN 003
JRST $TUTX2 ;CONTROL C'ED
CAIN 004 ;CONTROL D'ED
JRST $DDTENT ;YES, TRANSFER TO DDT
CAIE 017 ;CONTROL O'ED
JRST .+3
SETCMM $PTINH ;YES, COMPLEMENT PRINT INHIBIT
JRST $COML1
CAIN 001 ;SYNC ?
AOJA AC5,$COML1 ;YES
JUMPE AC0,$COML1 ;NULL, IGNORE
JUMPE AC5,$COML1 ;RECIEVED SYNC YET ?
CAIN 033 ;ALTMODE ?
JRST $COML2 ;YES, CONTROL SEQUENCE
CAIN 012 ;LF ?
JRST $COML3 ;YES, MESSAGE SEGMENT
IDPB AC0,AC1 ;STORE CHAR
AOS AC5 ;COUNT IT
CAILE AC5,^D136 ;STILL ROOM IN BUFFER ?
JRST $CMLE2 ;NO, LINE TOO LONG
JRST $COML1 ;KEEP GOING
$COML2: LDB [POINT 7,CINBF,6]
JRST $$CE1 ;CONTROL SEQUENCE RETURN
$COML3: IDPB AC0,AC1 ;STORE LF
SETZ
IDPB AC0,AC1
MOVE AC4,[POINT 7,CINBF]
ILDB AC0,AC4 ;GET MESSAGE NUMBER
CAIN 041
JRST $COML4
CAIN 136
JRST $COML4
JRST $CMLE3 ;MSG NUMBER INCORRECT
$COML4: MOVEM AC0,COMNBR# ;SAVE MESSAGE NUMBER
SETZ
MOVEI AC5,3 ;CHARS 1,2,3 ARE CHECKSUM
LSH 6
ILDB AC1,AC4 ;GET CHAR
ANDI AC1,77
OR AC0,AC1 ;INSERT INTO 16 BIT CHECKSUM
SOJG AC5,.-4 ;DO 3 CHARS
ILDB AC1,AC4
CAIN AC1,015 ;REACHED EOL ?
JRST .+4
JUMPE AC1,$CMLE4 ;PAST EOL WITHOUT CR ?
ADD AC0,AC1 ;ACCUMULATE CHECKSUM
JRST .-5
TRNE AC0,177777 ;DID CKSUM COMPUTE TO ZERO ?
JRST $CMLE5 ;NO, CHECKSUM ERROR
JRST $$CE2 ;MSG OK, DOUBLE-SKIP RETURN
$CMLE1: MOVEI -1 ;NO RESPONSE
JRST $$CE
$CMLE2: MOVEI -2 ;LINE TOO LONG
JRST $$CE
$CMLE3: CAIN "?" ;MSG NUMBER QMARK ?
JRST COMQ ;YES, HOST ERROR
MOVEI -3 ;MSG NUMBER CHAR ERROR
JRST $$CE
$CMLE4: MOVEI -4 ;NO CR ERROR
JRST $$CE
$CMLE5: MOVEI -5 ;MESSAGE CHECKSUM ERROR
JRST $$CE
S
;*COMQ - HOST ERROR, PRINT ERROR REPLY
S
COMQ: SETZM COMFLG
MOVEI CINBF
PNTALF
PCRLF
HALT .
COMTIME:AOS $TTYTIM
MOVE $TTYTIM
CAMG [140000] ;3 SECONDS ?
AOS (P)
RTN
S
;*COMINI - COMMUNICATION INITIALIZE
$COMINI:SKIPE MMFLAG ;IN MAINTENANCE MODE ?
SETZM COMFLG ;YES, SEND IN CLEAR
SKIPL COMFLG ;-1=NOT INITED, 0=CLEAR, +1=PROTOCALL
RTN ;CLEAR
JSR $$C
$COMI1: SETZM MSGNBR ;INIT MESSAGE NUMBER
MOVEI INIMSG
COMCTL ;SEND INI MSG
COMLIN ;GET REPLY
JRST $COMI2 ;ERROR
JRST $COMI3 ;CONTROL SEQUENCE
$COMI4: SETZM COMFLG
MOVEI CINBF ;MSG, PRINT IT
PNTALF
JRST $$CE
$COMI2: SETZM COMFLG
CAIE AC0,-1 ;TIMED OUT ?
JRST COMERR ;NO, COMM ERROR
MOVEI 40
COMTYO ;OUTPUT A SPACE, PREVENTS DROPPING 1ST CHAR
JRST $$CE ;YES, SEND IN CLEAR
$COMI3: SETZM COMFLG
CAIE "A" ;ACK'ED ?
JRST $COMI4 ;NO, COMM ERROR
AOS COMFLG ;YES, SET PROTOCALL MODE
JRST $$CE
S
;*COMENQ - COMMUNICATION ENQUIRY
$COMENQ:SKIPE ENQFLG ;BEEN ENQ'ED YET ?
RTN ;YES
SETOM ENQFLG ;NO, REQUEST COMM SERVICE
JSR $$C
MOVEI AC4,3
$COME1: SETZM MSGNBR ;INIT MESSAGE NUMBER
MOVEI ENQMSG
COMCTL ;SEND ENQ MSG
COMLIN ;GET REPLY
JRST $COME2 ;ERROR
JRST $COME3 ;CONTROL SEQUENCE
MOVEI CINBF ;MSG, PRINT IT
PNTALF
JRST $$CE
$COME2: SOJGE AC4,$COME1 ;RETRY ?
JRST COMERR ;NO, COMM ERROR
$COME3: CAIN "A"
JRST $$CE ;ACK, GO AHEAD
CAIE "Z" ;EOT, WAIT ?
JRST $COME2 ;NO, ERROR
JRST $COMENQ+1 ;TRY AGAIN
S
;*COMEOT - COMMUNICATION END OF TRANSMISSION
S
$COMEOT:JSR $$C
MOVEI EOTMSG
COMCTL
JRST $$CE
S
;*COMCLR - COMMUNICATION CLEAR
S
$COMCLR:SKIPG COMFLG
RTN
JSR $$C
SETZM ENQFLG
MOVEI CANMSG
COMCTL
JRST $$CE
S
;*COMBELL - COMMUNICATIONS BELL
S
$COMBELL:JSR $$C
MOVEI BELMSG
COMCTL
JRST $$CE
INIMSG: BYTE (7) 5,33 ;^E, ALTMODE
BELMSG: BYTE (7) 7,33 ;BELL, ALTMODE
ENQMSG: BYTE (7) 105,33 ;E, ALTMODE
ACKMSG: BYTE (7) 101,33 ;A, ALTMODE
NAKMSG: BYTE (7) 116,33 ;N, ALTMODE
CANMSG: BYTE (7) 103,33 ;C, ALTMODE
EOTMSG: BYTE (7) 132,33 ;Z, ALTMODE
TIMEMSG:BYTE (7) "T",15
S
;*COMASC - COMMUNICATION ASCIIZE
S
COMASC: CAIG AC0,74 ;LEAVE 75,76,77 ALONE
TRO AC0,100
IDPB AC0,AC5
RTN
S
;*COMERR, COMMUNICATIONS ERROR REPORTER
S
COMERR: SETZM COMFLG
MOVE AC2,AC0
PMSG <?COMM ERROR: >
MOVN AC2,AC2
MOVE AC0,CMERTB(AC2)
PNTALF
PCRLF
HALT .
CMERTB: 0
CMER1
CMER2
CMER3
CMER4
CMER5
CMER6
CMER7
CMER10
CMER1: ASCIZ %NO RESPONSE%
CMER2: ASCIZ %LONG LINE%
CMER3: ASCIZ %MSG NBR%
CMER4: ASCIZ %NO CR%
CMER5: ASCIZ %MSG CKSUM%
CMER6: ASCIZ %FORMAT%
CMER7: ASCIZ %NAK%
CMER10: ASCIZ %UNKNOWN%