Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
lcm10.mac
There are 5 other files named lcm10.mac in the archive. Click here to see a list.
; UPD ID= 3565 on 6/3/81 at 4:28 PM by NIXON
TITLE LCM - MESSAGE CONTROL SYSTEM FOR LIBOL.
SUBTTL RUN-TIME SYSTEM FOR MCS
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION
; **** EDIT HISTORY ****
;DMN 3-JUN-80 [635] INCORPORATE MCS-10 FIXES FROM B.C.TEL.
; **** V11 ******
;DRO 11-NOV-77 [517] CHANGE SPACES TO NULLS FOR MCLASS
;DRO 19-SEP-77 [516]FIX MPP SEND WITH BAD ADDRESS
;JM 19-SEP-77 [511] SEND VERB ERROR RET FOR END INDICATOR
;JM 19-SEP-77 [510] DEFAULT TO OLD COMPILER
SEARCH INTERM
SALL
TWOSEG
RELOC 400000
;ENTRY POINTS
ENTRY M.SEND, M.INIT, M.IFM, M.AC, M.RMW, M.RSW
ENTRY M.RMNW, M.RSNW, M.DI, M.DIT, M.DO, M.EI, M.EIT, M.EO
IFN TOPS20,<
ENTRY MBIND, MNAME
M.INIT: M.RMW: M.RSW: M.RMNW: M.RSNW: M.SEND: M.AC:
M.IFM: M.DI: M.DIT: M.DO: M.EI: M.EIT: M.EO:
MBIND: MNAME:
IFN ANS68,<
OUTSTR [ASCIZ "?LIBOL IS NOT CONFIGURED TO SUPPORT TPS-20.
"]
>
IFN ANS74,<
OUTSTR [ASCIZ "?C74OTS IS NOT CONFIGURED TO SUPPORT TPS-20.
"]
>
JRST KILL.##
END
>
IFE MCS,<
M.INIT: M.RMW: M.RSW: M.RMNW: M.RSNW: M.SEND: M.AC:
M.IFM: M.DI: M.DIT: M.DO: M.EI: M.EIT: M.EO:
IFN ANS68,<
OUTSTR [ASCIZ "?LIBOL IS NOT CONFIGURED TO SUPPORT MCS.
"]
>
IFN ANS74,<
OUTSTR [ASCIZ "?C74OTS IS NOT CONFIGURED TO SUPPORT MCS.
"]
>
JRST KILL.##
END
>
;THIS MODULE USES ONLY ONE DATA STRUCTURE WHICH MIGHT BE OF INTEREST---
;THE PAGE TABLE. THIS TABLE IS A LIST OF ALL ACTIVE PAGES (DATA PAGES
;FOR "RECEIVES" AND ACTIVE TRANSACTION PAGES FOR "SENDS"). THE FORMAT
;OF THE PAGE TABLE IS SIMPLY:
;
; BIT 0 = 1 OUTPUT CD
; 0 INPUT CD
; BIT 1-8 ZERO
; BIT 9-17 PAGE #
; BIT 1-35 PTR TO CD,ASSOCIATED WITH THIS PAGE
;
;
;
;REGISTER DEFINITIONS
R.FG=0 ;MCS FLAGS
R.CP=1 ;CURRENT PAGE POINTER
R.CD=2 ;CD-ENTRY PTR
R.PT=3 ;PTR TO CURRENT ENTRY IN PAGE TABLE
R.TD=4 ;CURRENT TEXT DESCRIPTOR
R.TX=5 ;PTR TO TEXT (USUALLY RECEIVING ITEM)
R.6=6
R.IN1=7 ;1ST INPUT-ARGUMENT REG
R.IN2=10 ;2ND "
R.OUT=11 ;USED FOR OUTPUT ARG OF SUBROUTINES
R.13==13
R.14==14
R.15==15
R.16==16
R.17==17
PP==17
;TEMP REGS FOR USE WITH IPCF
T1=1
T2=T1+1
T3=T2+1
T4=T3+1
;FLAG DEFINITIONS IN "R.FLG"
F.SEG==1 ;SEGMENT COMMAND (RSW OR RSNW)
F.ERR==2 ;THERE WAS AN ERROR IN THE SEND COMMAND
F.AT==4 ;THERE IS AN ACTIVE TRANSACTION
F.TOLG==10 ;RECEIVED MESSAGE WAS "TOO LONG" FOR RCV ITEM
F.IFM==20 ;COMMAND WAS "IF MESSAGE ..."
F.AT==40 ;THERE IS AN "ACTIVE TRANSACTION"
;OFFSETS INTO CURRENT PAGE
FC==0 ;FUNCTION CODE
STATUS==1 ;STATUS CODE
TNUM==2 ;TRANS NUMBER
PW==3 ;PASSWORD
Q.0==5 ;PRIMARY Q
SQ.1==^D8 ;SUB-QUEUE 1
SQ.2==^D11 ;SUB-QUEUE 2
SQ.3==^D14
SRCNAM==^D17 ;SOURCE NAME
DATE==^D20
TIME==^D21
TDCNT==^D22 ;TEXT DESCRIPTOR COUNT
GRPCNT==^D23 ;GROUP COUNT
CLASS==^D24 ;CLASS
DSTCNT==^D26 ;DESTINATION COUNT
CHKSUM==^D27 ;CHECKSUM
ADVFLG==^D28 ;ADVANCING FLAG
DSTTAB==^D106 ;DESTINATION TABLE
TEXT==^D256
SUBTTL MORE PARAMETERS AND OFFSETS FOR LIBOL-MCS
;OFFSETS INTO CD-POINTER TABLE
CD.Q==0
CD.SQ1==1
CD.SQ2==2
CD.SQ3==3
CD.DAT==4
CD.TIM==5
CD.SRC==6
CD.LEN==7
CD.END==10
CD.STS==11
CD.CNT==12
;END INDICATOR VALUES
ESI.==1
EMI.==2
EGI.==3
EPI.==4
;SHIFTING CONSTANTS TO CONVERT PAGE # TO WORDS, AND VICE VERSA:
P2WLSH==11
W2PLSH==-11
;VALUES USED FOR LINE PRINTER CHANNEL CONTROL
LF==12
CR==15
VT==13
FF==14
DLE==20
DC1==21
DC2==22
DC3==23
DC4==24
;TABLE OF POINTERS INTO THE CURRENT INPUT CD-ENTRY
;TEMPORARY GLOBAL
INTERN X
X:
;
CDPTRS: POINT 7,(R.CD) ;Q-NAME
POINT 7,2(R.CD),13 ;S-Q 1
POINT 7,4(R.CD),27 ;SUB-Q 2
POINT 7,7(R.CD),6 ;SUB-Q 3
POINT 7,11(R.CD),20 ;DATE
POINT 7,12(R.CD),27 ;TIME
POINT 7,14(R.CD),13 ;SOURCE
POINT 7,16(R.CD),27 ;TEXT LENGTH
POINT 7,17(R.CD),20 ;END KEY
POINT 7,17(R.CD),27 ;STATUS KEY
POINT 7,20(R.CD),6 ;MESSAGE COUNT
;BYTE POINTER FOR END INDICATOR
ENDPTR: POINT 6,(R.TD),17
SUBTTL MACRO DEFINITIONS
;A FEW MACROS...
DEFINE SWON(SWITCH),<
TRO R.FG,SWITCH>
DEFINE SWOFF(SWITCH),<
TRZ R.FG,SWITCH>
DEFINE TSWT(SWITCH),<
TRNN R.FG,SWITCH>
DEFINE TSWF(SWITCH),<
TRNE R.FG,SWITCH>
DEFINE PUTMUL(OFFSET,CHAR,LENGTH),<
MOVE R.IN1,CDPTRS+OFFSET
MOVEI R.IN2,LENGTH
MOVEI R.OUT,"CHAR"
IDPB R.OUT,R.IN1
SOJG R.IN2,.-1>
DEFINE RETURN,<
POPJ PP,
>
DEFINE GETARG(NUM),<
MOVE R.OUT,NUM-1(16) ;GET ARGUMENT
>
DEFINE STORE(OFFSET),<
MOVEM R.6,OFFSET(R.CP)
>
DEFINE GET(OFFSET),<
MOVE R.OUT,OFFSET(R.CP)
>
DEFINE CHKSTS,<
MOVE R.15,STATUS(R.CP)
JUMPL R.15,E.STS
JRST .+1(R.15)
>
DEFINE SETVAL(OFFSET,WHAT,LENGTH),<
MOVE R.IN2,CDPTRS+OFFSET
MOVE R.IN1,[POINT 7,[ASCIZ /WHAT/]]
MOVEI R.15,LENGTH
PUSHJ PP,TRNFER
>
DEFINE OUTSTS(CODE),<
MOVEI R.IN1,"CODE"
DPB R.IN1,[POINT 14,1(R.CD),34] ;STORE OUTPUT STATUS CODE
>
SUBTTL "RECEIVE" PROCESSOR FOR LIBOL-MCS
;THESE ROUTINES RECEIVE A MESSAGE (OR PART THEREOF) FROM
;MCS AND PASS IT BACK TO THE APPLICATION PROGRAM. UNLESS
;R.SW OR R.SNW WERE CALLED, THE PROGRAM RECEIVES AT LEAST
;A COMPLETE MESSAGE (I.E., END INDICATOR IS EQUAL TO OR GREATER THAN EMI).
;OTHERWISE, A MESSAGE SEGMENT MAY BE RECEIVED.
;THE OPERATION OF THE "WAIT" AND "NO-WAIT" ROUTINES
;ARE IDENTICAL EXCEPT THAT A STATUS OF 2 IS POSSIBLE DURING
;THE "NO-WAIT" ROUTINES. IN THIS CASE, A SKIP RETURN IS MADE
;TO THE CALLING PROGRAM.
M.RMNW: PUSHJ PP,SETUP
JRST .+3
M.RSNW: PUSHJ PP,SETUP
SWON F.SEG ;SET SEGMENT FLAG
MOVEI R.6,3 ;SET FUNCTION CODE=3
JRST RCVSTR ;...AND BEGIN
M.RMW: PUSHJ PP,SETUP
JRST .+3
M.RSW: PUSHJ PP,SETUP
SWON F.SEG ;SET SEGMENT
MOVEI R.6,2 ;FUNCTION CODE=2
;AND FALL THRU TO START OF MAIN BODY...
; .
; .
; .
; .
SUBTTL START OF "RECEIVE" PROCESSING
;ALL RECEIVES COME HERE TO DO THEIR THING
RCVSTR: SKIPN R.PT,MCSPT## ;GET PTR TO PAGE TABLE
PUSHJ PP,FRMTAB ;NO, GO FORM A TABLE
RCV.1: SKIPN (R.PT) ;ARE WE AT THE END OF PAGE TABLE?
JRST RCV.3 ;YES
;NOTE-THERE IS NO CHECK HERE FOR A FULL PAGE TABLE.
;COME HERE TO CHECK IF CURRENT CD Q-SPEC MATCHES
;A CURRENTLY ACTIVE TRANSACTION.
RCV.2: SKIPG (R.PT) ;IS THIS EVEN AN INPUT CD?
AOJA R.PT,RCV.1 ;NO
PUSHJ PP,CMPQ ;YES, BUT DO Q'S MATCH?
AOJA R.PT,RCV.1 ;NO, KEEP TRYING
;WE HAVE FOUND A MATCHING ACTIVE TRANSACTION PAGE, SO
;WE ASSUME THAT THIS NEW "RECEIVE" IS A CONTINUATION
;OF THAT TRANSACTION.
HLRZ R.CP,(R.PT) ;SET CURRENT PAGE PTR
LSH R.CP,P2WLSH
STORE FC
GET TDCNT ;GET TEXT COUNT
ANDI R.OUT,777777 ;NEED RIGHT SIDE ONLY
SKIPN R.OUT ;IS THIS PAGE THRU?
PUSHJ PP,GETMOR ;YES, GET ANOTHER PAGE
CHKSTS
JRST RCV.80 ;STATUS=0
JRST RCV.7 ;STATUS=1
JRST RCV.S2 ;STATUS=2
JFCL
JFCL
JRST RCV.6 ;STATUS=5
RCV.3: PUSHJ PP,GETPAG ;GET A FREE PAGE
MOVE R.CP,R.OUT ;SET PTR TO IT
STORE FC ;STORE FUNCION CODE
PUSHJ PP,SETQ ;SET UP ALL Q-SPECS ON IT
RCV.4: PUSHJ PP,MCP.S ;SEND A PAGE TO MCS
PUSHJ PP,MCP.R ; AND GET A RESPONSE
MOVE R.CP,R.OUT
CHKSTS ;JUMP ON STATUS
JRST RCV.8 ;STATUS=0
JRST RCV.7 ;STATUS=1
JRST RCV.S2 ;STATUS=2
JFCL
JFCL
JRST RCV.6 ;STATUS=5 MAX.COUNT VIOLATION
;STATUS=5 DATA VIOLATION
RCV.6: SETVAL CD.STS,<51>,2
SETVAL CD.LEN,<0000>,4
SETVAL CD.CNT,<000000>,6
SETVAL CD.END,<0>,1
JRST RCV.4A
;STATUS=2...NO DATA AVAILABLE
RCV.S2: SETVAL CD.LEN,<0000>,4 ;NO DATA AVAILABLE
SETVAL CD.STS,<00>,2
SETVAL CD.CNT,<000000>,6
AOS (R.17) ;BUMP RETURN ADDRESS
RCV.4A: MOVE R.IN1,R.OUT ;GET PAGE PTR
PUSHJ PP,RELPAG ;GIVE PAGE BACK TO MONITOR
PUSHJ PP,DELPAG ;DELETE ENTRY IN PAGE TABLE
RETURN ;EXIT********
;STATUS=1....UNKNOWN Q-STRUCTURE
RCV.7: SETVAL CD.STS,<20>,2
JRST RCV.4A ;GO RELEASE PAGE
;STATUS=0....EVERYTHING IS OK!!
RCV.8: MOVE R.CP,R.OUT ;SET PTR TO PAGE
LSH R.OUT,W2PLSH ;MAKE PAGE ADDR
HRLM R.OUT,(R.PT) ;SAVE IT
HRRM R.CD,(R.PT) ;ALSO SAVE CD ADDRESS
GET TNUM ;GET TRANSACTION NUMBER
MOVEM R.OUT,MCSTN## ;SAVE IT
RCV.80: GETARG 2 ;GET RECEIVING ITEM PTR
MOVE R.TX,(R.OUT)
MOVE R.6,1(R.OUT) ;GET SIZE OF RECEIVING ITEM
HLLZS M.TMP2 ;ZERO LENGTH
PUSHJ PP,GETQ ;UPDATE Q-SPECS
RCV.8A: GET TDCNT ;GET # OF TEXT DESC.
JUMPE R.OUT,BADERR ;BAD COUNT FROM MCS***
PUSHJ PP,FINDTD ;GET ADDRESS OF CURRENT ONE
;NOW, WE'RE READY TO START MOVING THE TEXT INTO THE CD.
RCV.8B: PUSHJ PP,GETUNT ;GET A TEXT UNIT
TSWF F.TOLG ;WAS IT TOO LONG FOR RCV ITEM
JRST R.END ;YES
HLRZ R.15,(R.TD) ;GET END INDICATOR
TRZ R.15,777700
JUMPE R.15,RCV.8C ;JUMP IF CONTINUATION
CAIE R.15,ESI. ;IS THIS AN ESI?
JRST R.END ;NO, END OF MESSAGE
TSWF F.SEG ;YES, ARE WE IN A SEGMENT COMMAND?
JRST R.END ;YES, SO LEAVE NOW
RCV.8C: SOS R.15,TDCNT(R.CP) ;DECREMENT COUNT
TRNN R.15,-1 ; IF ANY LEFT
PUSHJ PP,GETMORE ;THEN GET MORE
CHKSTS
JRST RCV.8A ;SKIP OVER ESI AND GET NEXT UNIT
JRST RCV.7 ;STATUS=1
JRST RCV.S2 ;STATUS=2
JFCL
JFCL
JRST RCV.6 ;STATUS=5
SUBTTL END OF RECEIVE PROCESSING
;FINISH UP BY STORING SOME DATA ITEMS IN CD
R.END:
;CONVERT AND STORE DATE AND TIME...
PUSHJ PP,SAVREG
GET DATE
MOVE 4,R.OUT ;GET DATE
PUSHJ PP,TODA1.## ;CONVERT IT TO ASCII
MOVE R.15,R.FG ;GET IT IN R15
PUSHJ PP,RESREG
MOVE R.IN2,CDPTRS+CD.DAT ;GET CD PTR TO DATE
MOVEI R.IN1,R.15
MOVEI R.13,6 ;LENGTH =6
PUSHJ PP,SIX.7 ;SIXBIT TO ASCII
GET TIME
MOVE 4,R.OUT
IDIVI 4,^D1000 ;SET UP TO COMPUTE TIME
IDIVI 5,^D10 ;SAVE HUNDRETHS OF SECS
PUSHJ PP,SAVREG
PUSHJ PP,MCSTIM##
MOVE R.14,1 ;R14=TIME IN SIXBIT
PUSHJ PP,RESREG
MOVE R.IN1,5 ;RETRIEVE HUNDRETHS
IDIVI R.IN1,^D10 ;SPLIT INTO TENTHS AND HUNDRETHS
LSH R.IN1,6 ;MAKE ROOM FOR REMAINDER
ADDI R.IN1,(R.IN2) ;INSERT THE OTHER DIGIT
TRO R.IN1,2020 ;CONVERT BOTH TO SIXBIT
DPB R.IN1,[POINT 12,R.15,11] ;STORE IN LEFT 12 BITS OF R15
MOVE R.IN2,CDPTRS+CD.TIM
MOVEI R.IN1,R.14 ;TIME IS IN R14,R15
MOVEI R.13,^D8 ;LENGTH
PUSHJ PP,SIX.7 ;CONVERT AND MOVE
MOVE R.IN1,[POINT 7,SRCNAM(R.CP)] ;MOVE SOURCE NAME
MOVE R.IN2,CDPTRS+CD.SRC
MOVEI R.15,^D12
PUSHJ PP,TRNFZ ;STRAIGHT TRANSFER ( NULLS TO SPACES )
GET TDCNT ;GET TEXT DESC COUNT
PUSHJ PP,FINDTD ;FIND CURRENT TEXT DESC
HRRZ R.15,M.TMP2 ;GET CHAR COUNT IN CURRENT PAGE
GETARG 2 ;GET RECEIVING ITEM PTR
HRRZ R.14,1(R.OUT) ;GET LENGTH OF RCV ITEM
CAML R.15,R.14 ;WHICH IS LESS?
MOVE R.15,R.14
PUSHJ PP,SAVREG ;R.15 CONTAINS THE LESSER LENGTH
MOVE 16,[Z 1,2]
HRRZ 2,R.CD ;GET CD ADDRESS
ADD 2,CDPTRS+CD.LEN ;SET UP ARGS
TLZ 2,7777 ;GET RID OF GARBAGE
TLO 2,4 ;LENGTH =4
MOVE 1,R.15 ;COPY TEXT LENGTH
PUSHJ PP,PD7.## ;CHANGE BINARY TO ASCII AND MOVE
PUSHJ PP,RESREG
;STORE END INDICATOR
HLRZ R.15,(R.TD)
TSWF F.TOLG ;IS MSG BIGGER THAN RCV FIELD?
SETZ R.15, ;YES-END KEY=0 THEN
TRZ R.15,777700
ADDI R.15,"0" ;CONVERT IT TO ASCII
MOVE R.14,CDPTRS+CD.END
IDPB R.15,R.14 ;STORE IT IN CD
SETVAL CD.STS,<00>,2 ;SET STATUS
;STORE GROUP COUNT
PUSHJ PP,SAVREG
GET GRPCNT ;GET GROUP COUNT
HRRZ 2,R.CD
ADD 2,CDPTRS+CD.CNT
MOVE 16,[Z 1,2]
TLZ 2,7777
TLO 2,6 ;LENGTH IF ITEM IS 6
MOVE 1,R.OUT ;COPY VALUE
PUSHJ PP,PD7.##
PUSHJ PP,RESREG
;NOW, WE HAVE TO CHECK IF WE'RE AT THE END OF A TRANSACTION
TSWF F.TOLG ;EXIT IF MESSAGE WAS TOO LONG
RETURN
SOS TDCNT(R.CP) ;DECR TUD COUNT
HLRZ R.15,(R.TD) ;GET CURRENT END INDICATOR
TRZ R.15,777700 ;CLEAR OUT JUNK
CAIGE R.15,EGI. ;IS THIS AN EGI?
RETURN ;IF ESI,OR EMI
PUSHJ PP,DELPAG ;NO, REMOVE PAGE FROM PAGE-TABLE
MOVE R.IN1,R.CP
PUSHJ PP,RELPAG ;AND GIVE IT BACK
RETURN ;EXIT
SUBTTL "SEND" MESSAGE TO MCP
;THIS MODULE PROCESSES ALL "SEND" COMMANDS. IT BUFFERS ALL
;OUTPUT UNTIL AN EMI OR GREATER IS REACHED. AT THIS POINT,
;THE ENTIRE PAGE IS SENT TO MCP. HOWEVER, THE TRANSACTION
;IS CONSIDERED TO BE ACTIVE UNTIL AN EGI OR EPI IS FOUND. WHEN
;THIS OCCURS, THE TRANSACTION PAGE IS FLUSHED FROM THE
;PAGE TABLE. IF AN EPI IS RECEIVED AND THERE ARE AT LEAST 2 ACTIVE
;TRANSACTIONS, AN EGI IS SUBSTITUTED FOR THE EPI AND AN ERROR CODE
;IS RETURNED TO THE USER.
;TEMPORARY STORAGE:
;M.TMP1 = DESTINATION COUNT,,TEXT LENGTH
;M.TMP2 = END INDICATOR VALUE,,TEXT LENGTH (FOR "RECEIVE" ONLY)
M.SEND: PUSHJ PP,SETUP
; HERE WE ARE CHECKING THE DESTINATION COUNT
; IN THE CD TO MAKE SURE IT IS LESS THEN OR
; EQUAL TO LENGTH OF DESTINATION TABLE IN CD
MOVE R.IN1,R.CD
MOVEI R.IN2,4
PUSHJ PP,BINARY ;GET BINARY DESTINATION COUNT
IFN ANS68,< ;[510] OLD COMPILER DEFAULTS TO 0
SKIPN R.OUT ;[510] IS DEST.COUNT = 0?
ADDI R.OUT,1 ;[510] YES - DEFAULT TO 1
> ;[510] END IFN ANS68
HRLZM R.OUT,M.TMP1## ;SAVE IT FOR LATER
;FOR COBOL-68 ONLY
;WE CANNOT CHANGE COBOL-74 SINCE FCTC TESTS WILL FAIL
;[635] MAKE JUMPLE A JUMPL
;[635] SUCH THAT A DESTINATION COUNT OF 0 WILL WORK PROPERLY WITH
;[635] A MESSAGE CLASS OF "ALL".
;[635] OTHERWISE AN ERROR CODE OF <30> OCCURS.
IFN ANS68,<
JUMPL R.OUT,CASE7 ;[635] DESTINATION COUNT MUST BE POSITIVE
>
IFN ANS74,<
JUMPLE R.OUT,CASE7 ;DESTINATION COUNT MUST BE POSITIVE/ZERO
>
MOVE R.6,R.OUT
GETARG 1 ;GET CD-RECORD
MOVE R.14,1(R.OUT) ;FIND ITS LENGTH
SUBI R.14,^D18 ;COMPUTE LENGTH OF TABLE
IDIVI R.14,^D13
CAMG R.6,R.14 ;IS COUNT GREATER THAN TABLE LENGTH?
JRST SEND1 ;NO
CASE7:
OUTSTS <30>
SWON F.ERR ;AND SET ERROR FLAG FOR LATER
;CHECK TEXT LENGTH
SEND1: MOVE R.IN1,R.CD
HRLI R.IN1,100700 ;FORM BYTE PTR TO TEXT LENGTH
MOVEI R.IN2,4 ;SET LENGTH
PUSHJ PP,BINARY ;ASCII TO BINARY
SKIPGE R.6,R.OUT ;POSITIVE?
JRST CASE8 ;NO, BOOBOO!!
HRRM R.6,M.TMP1 ;SAVE IT ALSO FOR LATER
GETARG 2
SKIPE R.OUT ;SKIP IF NO "FROM" CLAUSE
HRRZ R.OUT,1(R.OUT) ;GET SENDING ITEM LENGTH
CAMG R.6,R.OUT ;LENGTH TOO BIG?
JRST SEND2 ;NO
CASE8: OUTSTS <50>
SETZ R.6, ;CLEAR OFFENDING COUNT
SWON F.ERR
;CHECK END INDICATOR
SEND2: GETARG 3
MOVE R.IN1,R.OUT
PUSHJ PP,ARG3.4 ;FIND BINARY VALUE OF END IND.
HRLZM R.OUT,M.TMP2## ;SAVE IT
JUMPN R.OUT,SEND3 ;END INDIC MUST BE NON-0
JUMPN R.6,SEND3 ;AS WELL AS TEXT LENGTH
OUTSTS <60>
SWON F.ERR
;CHECK END IND AGAIN
SEND3:
IFN ANS68,<
JUMPLE R.OUT,STS61 ;[511] END IND MUST BE POSITIVE
>
IFN ANS74,<
;DO NOT CHANGE THIS OR FCTC TESTS WILL FAIL
JUMPL R.OUT,STS61 ;END IND MUST BE POSITIVE OR ZERO
>
CAIG R.OUT,4 ;AND NOT GREATER THAN 4
JRST SEND4 ;OK
STS61: OUTSTS <61>
SWON F.ERR
;CHECK ADVANCING ITEM
SEND4: GETARG 4
MOVE R.IN1,R.OUT
TLNN R.IN1,-1 ;DON'T CHECK IF PAGE OR MNEMONIC
JRST SEND5
PUSHJ PP,ARG3.4 ;FIND VALUE
JUMPGE R.OUT,SEND5 ;ADVANCING ITEM MUST BE POSITIVE
OUTSTS <62>
SWON F.ERR ;YES, ERROR
SEND5: TSWF F.ERR ;DID WE HAVE ANY ERRORS?
RETURN ;YES, FLUSH SEND REQUEST
;NO, FALL THRU TO NEXT PAGE...
SUBTTL CHECK FOR ACTIVE TRANSACTION IN "SEND" VERB
;NOW, WE MUST CHECK THE PAGE TABLE TO SEE IF THERE
;IS A CURRENTLY ACTIVE TRANSACTION FOR THIS DESTINATION TABLE.
SKIPN R.PT,MCSPT ;IF NO PAGE TABLE...
PUSHJ PP,FRMTAB ;..FORM ONE
SEND6:
;NOTE--NO CHECK FOR FULL PAGE TABLE HERE EITHER!
SKIPN (R.PT) ;IS THIS ENTRY EMPTY?
JRST S.NEW ;YES, NO ACTIVE TRANSACTION
SKIPL (R.PT) ;BUT IS THIS AN OUTPUT CD?
AOJA R.PT,SEND6 ;NO, IGNORE IT
HLRZ R.CP,(R.PT) ;GET PAGE NO.
ANDI R.CP,777 ;GET RID OF INOUT BIT
LSH R.CP,P2WLSH ;CONVERT IT TO ADDRESS
HLRZ R.6,M.TMP1 ;GET DESTINATION COUNT
CAME R.6,DSTCNT(R.CP) ;DO THE COUNTS MATCH?
AOJA R.PT,SEND6 ;NO
JUMPE R.6,SEND8 ;DON'T CHECK FURTHER IF BOTH COUNT ARE 0
MOVE R.IN2,R.CD
ADDI R.IN2,2 ;MAKE PTR TO CD DEST TABLE
IBP R.IN2 ;BUMP OVER ERROR KEY
MOVEI R.IN1,DSTTAB(R.CP) ;AND PTR TO OTHER TABLE
SEND6A: HRLI R.IN1,440700
MOVEI R.13,^D12 ;COMPARE 12 CHARS
PUSHJ PP,COMPAR ;MATCH?
AOJA R.PT,SEND6 ;NO, KEEP TRYING
SOJE R.6,SEND8 ;YES, DONE WHOLE TABLE?
IBP R.IN2 ;NO, BUMP OVER ERROR KEY
AOJA R.IN1,SEND6A ;BUMP PAGE PTR
;WE HAVE NOW FOUND AN ACTIVE TRANSACTION IN THE PAGE TABLE
SEND8: HRRZ R.6,(R.PT) ;CHECK CD ADDRESS
HRRZI R.15,0(R.CD) ;NEED ADDRESS ONLY
CAIE R.15,0(R.6) ;IF NOT THE SAME THEN ERROR
JRST SEND8X
SWON F.AT ;SET "ACTIVE TRANSACTION"
MOVEI R.6,5
STORE FC ;SET FUNCTION CODE=5
PUSHJ PP,GETCLS ;GET PTR TO MESSAGE CLASS
MOVE R.IN1,R.OUT
MOVEI R.IN2,CLASS(R.CP)
TLO R.IN2,440700 ;MAKE PTR TO PAGE MSG CLASS
MOVEI R.13,^D8
PUSHJ PP,COMPAR ;COMPARE MESSAGE CLASSES
CAIA ;NO MATCH
JRST MS.AT
OUTSTS <14>
JRST MS.AT
SEND8X: OUTSTS <25>
RETURN
;COME HERE IF NO ACTIVE TRANSACTION EXISTS...
S.NEW: AOS M.ATCT## ;BUMP ACTIVE TRANSACTION COUNT
PUSHJ PP,GETPAG ;GET A NEW PAGE
HRRZI R.CP,0(R.OUT) ;FIX UP ENTRY IN PAGE TABLE
LSH R.OUT,W2PLSH ;CONVERT ADDRESS TO PAGE NO.
TRO R.OUT,1B18 ;SET OUTPUT CD BIT ON
HRLM R.OUT,(R.PT) ;SAVE IN PAGE TABLE
HRRM R.CD,(R.PT) ;ALSO SAVE CD ADDRESS
MOVEI R.6,4
STORE FC ;SET FUNCTION CODE=4
SETZM TNUM(R.CP)
HRRZ R.IN1,MCSTN ;SET TRANSACTION NUMBER FOR NEW SEND
HRLZM R.IN1,TNUM(R.CP) ;...
PUSHJ PP,SETDST ;MOVE DEST TABLE TO NEW PAGE
PUSHJ PP,GETCLS ;GET PTR TO MESSAGE CLASS
SEND10: MOVE R.IN1,R.OUT
MOVEI R.IN2,CLASS(R.CP)
TLO R.IN2,440700
MOVEI R.15,^D8 ;SET UP TO MOVE MSG CLASS
PUSHJ PP,TRNFER ;[517] DO IT ( CONVERT SPACES TO NULLS )
;WE NOW HAVE A PAGE INTO WHICH WE CAN MOVE THE TEXT FROM
;THE SENDING ITEM. FIRST, WE MUST CREATE A NEW TEXT DESCRIPTOR
;(IF THERE'S ROOM).
;NOTE--R6 MUST REMAIN INTACT FROM HERE...
MS.AT: PUSHJ PP,FORMTD ;MAKE A NEW TD
GETARG 5 ;GET "AFTER" FLAG
HRRZ R.OUT,(R.OUT)
SKIPE R.OUT ;SHOULD WE ADVANCE NOW?
PUSHJ PP,ADVANC ;YES
GETARG 2 ;NO, DO IT LATER
JUMPE R.OUT,MS.AT2 ;JUMP IF NO "FROM" ITEM
MOVE R.14,(R.OUT) ;GET ITS PTR
HRRZ R.15,M.TMP1 ;..AND ITS LENGTH
SETZB R.13,R.IN1
LDB R.13,[POINT 6,R.14,11] ;GET BYTE SIZE
SEND12: JUMPE R.15,MS.AT2 ;JUMP IF TEXT LENGTH FINISHED
ILDB R.IN1,R.14 ;GET CHARACTER
CAIE R.13,7 ;IS THIS ASCII?
ADDI R.IN1,40 ;NO, MAKE IT ASCII
PUSHJ PP,PUTCHR ;PUT OUT CHAR
SOJA R.15,SEND12 ;DECREMENT TEXT LENGTH
MS.AT2: GETARG 5 ;CHECK AGAIN FOR ADVANCING
MOVE R.OUT,(R.OUT)
SKIPN R.OUT ;"AFTER"?
PUSHJ PP,ADVANC ;NO, DO ADVANCING NOW
;...TO HERE!!!
HLRZ R.6,M.TMP2 ;GET END INDICATOR
CAIE R.6,EPI. ;IS THIS AN EPI?
JRST NOEPI ;NO, GO ON
HRRZ R.15,M.ATCT## ;YES, CHECK # OF "AT"S
CAIGE R.15,2 ;IF THERE ARE OTHERS BESIDES THIS ONE...
JRST NOEPI ;NO, THERE ARE NONE
MOVEI R.6,EGI. ;THEN CONVERT IT TO AN EGI
OUTSTS <63>
NOEPI: DPB R.6,ENDPTR ;PUT IN TD
PUSHJ PP,WRDCNT ;FILL IN WORD COUNT
HRRZ R.15,FC(R.CP) ;IS THIS THE FIRST CALL?
CAIE R.15,5
JRST S.1ST ;YES, GET A RESPONSE FROM MCP
CAIGE R.6,EMI. ;END OF MESSAGE?
RETURN ;NO, EXIT
PUSH R.17,R.6
PUSHJ PP,PUTOUT ;SEND CURRENT PAGE
POP R.17,R.6
CAIGE R.6,EGI. ;END-OF-TRANSACTION?
RETURN
NOEPI2: SOSGE M.ATCT ;DECREMENT TRANSACTION COUNT
JRST CNTERR ;****MCP ERROR******
MOVE R.IN1,R.CP ;YES, RELEASE OLD PAGE
PUSHJ PP,RELPAG
PUSHJ PP,DELPAG ;AND SHUFFLE PAGE TABLE
CAIE R.6,EPI. ;IF THIS IS A VALID EPI..
RETURN
HRRZ R.PT,MCSPT ;..THEN FLUSH ALL OUTSTANDING
FLUSH: HLRZ R.IN1,(R.PT) ;GET PAGE NO.
ANDI R.IN1,777 ;GET RID OF HIGH BIT
LSH R.IN1,P2WLSH ;MAKE INTO ADDRESS
JUMPE R.IN1,FLUSH2 ;JUMP IF END OF PAGE TABLE
PUSHJ PP,RELPAG ;RELEASE THIS PAGE
PUSHJ PP,DELPAG ;SHUFFLE TABLE UP
JRST FLUSH
FLUSH2: SETZM MCSTN## ;CLEAR TRANSACTION NUMBER
MOVE R.IN1,R.PT ;NOW, RELEASE PAGE TABLE
SETZM MCSPT##
JRST RELPAG
;
;COME HERE ON THE FIRST CALL TO MCP FOR A NEW TRANSACTION...
S.1ST: PUSH PP,R.6 ;SAVE R.6 FOR LATER USE
PUSHJ PP,GETPAG ;GET A PAGE TO SEND TO MCP
MOVE R.IN1,R.OUT
PUSHJ PP,CPYPAG ;COPY OLD PAGE
MOVE R.CP,R.OUT ;GET ITS ADDRESS BACK AGAIN
PUSHJ PP,MCP.S
PUSHJ PP,MCP.R ;GET A RESPONSE
MOVE R.CP,R.OUT
CHKSTS ;WHAT HAPPENED????
JRST S.STS0 ;STATUS=0
JRST S.STS1 ;STATUS=1
JRST S.STS2 ;STATUS=2
JRST S.STS3 ;STATUS=3
OUTSTS <20>
;STATUS=4 (SAME ERROR CODE AS 3)
PUSHJ PP,GETDST ;***FATAL ERROR**
MOVE R.IN1,R.CP ;WE MUST FLUSH ENTIRE TRANSACTION
PUSHJ PP,RELPAG
SOSGE M.ATCT ;[516] FIX UP ACTIVE TRANSACTION COUNT
JRST CNTERR ;[516] HANDLE ERROR
HLRZ R.IN1,(R.PT) ;GET PAGE NO.
ANDI R.IN1,777 ;GET RID OF INOUT BIT
LSH R.IN1,P2WLSH
PUSHJ PP,RELPAG
POP PP,R.6 ;RESTORE R6
JRST DELPAG
S.STS3: OUTSTS <20>
JRST SEND11
S.STS0: OUTSTS <00>
JRST SEND11
S.STS1: OUTSTS <13>
JRST SEND11
S.STS2: OUTSTS <10>
SEND11: PUSHJ PP,GETDST ;UPDATE ERROR KEYS IN CD
MOVE R.IN1,R.CP
PUSH PP,TNUM(R.CP) ;SAVE OLD TRANSACTION SEQ NO.
PUSHJ PP,RELPAG ;RELEASE RESPONSE PAGE
HLRZ R.CP,(R.PT) ;GET PAGE NO.
ANDI R.CP,777 ;DELETE HI BIT
LSH R.CP,P2WLSH ;CONVERT TO ADDRESS
POP PP,TNUM(R.CP) ;STORE THE TRANSACTION SEQUENCE NUMBER
; IN THE OLD PAGE
CLEARM TDCNT(R.CP) ;WIPE OUT LAST MESSAGE CHUNK
POP PP,R.6 ;RESTORE R.6
CAIGE R.6,EGI. ;IS THIS AN END OF GROUP OR END OF PROCESS?
RETURN ;NO LEAVE
JRST NOEPI2 ;OTHERWISE RETURN TO PROCESS SOME MORE
SUBTTL SUBROUTINES FOR "SEND" VERB
;OUTPUT 1 CHARACTER ONTO CURRENT PAGE, IF FULL, OUTPUT THAT PAGE.
;
;ENTER: R.TD=PTR TO CURRENT TEXT DESC
; R.IN1=CHAR
; R.6= CURRENT PAGE TEXT PTR
;
PUTCHR: CAIE R.TD,1(R.6) ;[635] HAVE WE REACHED TD WORD
JRST PUTCH1 ;[635] NO GO ON
PUSH PP,R.IN1 ;[635] SAVE CHAR
LDB R.IN1,[POINT 6,R.6,5] ;[635] GET BIT POINTER
CAIN R.IN1,1 ;[635] HAVE WE FILLED LAST BYTE OF WORD
PUSHJ PP,PUTCH2 ;[635] YES GET NEW PAGE
POP PP,R.IN1 ;[635] GET BACK CHAR
PUTCH1: IDPB R.IN1,R.6 ;[635] DEPOSIT CHAR IN BUFFER
AOS 1(R.TD) ;[635] BUMP CHAR COUNT
RETURN ;[635]
PUTCH2: PUSHJ PP,SAVTMP ;[635] SAVE SOME TEMPS
PUSHJ PP,WRDCNT ;COMPUTE WORD COUNT
PUSHJ PP,PUTOUT ;YES, OUTPUT THIS PAGE
PUSHJ PP,FORMTD ;FORM A NEW TD
PUSHJ PP,RESTMP ;RESTORE TEMPS
RETURN
;SEND A FULL PAGE TO MCP AND START A NEW ONE
PUTOUT: PUSHJ PP,GETPAG ;GET A PAGE
MOVE R.IN1,R.OUT
PUSHJ PP,CPYPAG ;COPY OLD ONE
MOVE R.CP,R.OUT
PUSHJ PP,MCP.S
HLRZ R.CP,(R.PT) ;GET PAGE NO.
ANDI R.CP,777 ;SET HIGH BITS TO ZERO
LSH R.CP,P2WLSH ;CONVERT TO ADDRESS
CLEARM TDCNT(R.CP) ;CLEAR OLD TEXT DESC COUNT
RETURN
;CREATE A NEW TEXT DESCRIPTOR ON THE CURRENT PAGE.
;
ROOM==5 ;THIS VARIABLE INDICATES THE MINIMUM # OF WORDS
;WHICH MUST BE AVAILABLE ON THIS PAGE. IF
;THERE IS LESS THAN THIS NUMBER, THE CURRENT PAGE IS
;SENT AND A NEW ONE IS STARTED. "ROOM" MUST BE AT
;LEAST 3.
;
FORMTD: HRRZ R.OUT,TDCNT(R.CP) ;GET # OF TEXT DESC'S
JUMPN R.OUT,FORM2 ;JUMP IF THERE ARE TEXT DESC'S
MOVEI R.TD,^D512(R.CP) ;NO, RESET ALL STUFF
MOVEI R.IN1,TEXT(R.CP) ;PTR TO START OF TEXT
JRST FORM3
FORM2: PUSHJ PP,FINDTD ;FIND THE LAST TD
HRRZ R.IN1,(R.TD) ;GET THE LAST TEXT PTR
HLRZ R.14,1(R.TD) ;AND ITS LENGTH
ADD R.IN1,R.14 ;COMPUTE START OF NEXT FREE HOLE
ADD R.IN1,R.CP ;ADD START OF CURRENT PAGE
TLZ R.IN1,-1 ;CLEAR LEFT HALF
CAIL R.TD,ROOM(R.IN1) ;IS THERE ROOM FOR IT
JRST FORM3 ;YES
PUSHJ PP,PUTOUT ;NO, PUTOUT THIS PAGE
JRST FORMTD ;..AND START OVER
FORM3: SUBI R.TD,2 ;BUMP BACK TO NEXT TD PLACE
MOVE R.6,R.IN1 ;SAVE TEXT POINTER
HRLI R.6,440700 ;MAKE IT A BYTE PTR
SUB R.IN1,R.CP ;CHANGE IT TO OFFSET
HRLI R.IN1,440700 ;FORM BYTE PTR
MOVEM R.IN1,(R.TD) ;STORE PTR
CLEARM 1(R.TD) ;CLEAR WORD COUNT,,CHAR COUNT
AOS TDCNT(R.CP) ;BUMP TEXT COUNT
RETURN
;COMPUTE WORD COUNT FOR CURRENT TEXT DESCRIPTOR
WRDCNT: HRRZ R.14,1(R.TD)
IDIVI R.14,5 ;CHARS TO WORDS
SKIPE R.15
AOS R.14
HRLM R.14,1(R.TD)
RETURN
;RETRIEVE THE VALUE OF EITHER ARG3 OR ARG4.
;
;ENTER: R.IN1 = ACTUAL ARGUMENT (E.G., 640,,[POINT P,...])
;
;EXIT: R.OUT = VALUE OF ITEM
ARG3.4: HLRZ R.IN2,R.IN1 ;GET LEFT HALF OF ARG
CAIN R.IN2,100
JRST ARG100 ;1-WORD COMP
CAIN R.IN2,440
JRST ARG400 ;2-WORD COMP
CAIE R.IN2,640 ;6-BIT OR ASCII?
JRST BADARG ;NO, COMPILER ERROR
MOVE R.IN2,1(R.IN1) ;GET LENGTH OF ITEM
MOVE R.IN1,(R.IN1) ;AND ITS PTR
LDB R.14,[POINT 6,R.IN1,11] ;GET BYTE SIZE
CAIN R.14,7 ;ASCII?
JRST BINARY ;YES, "BINARY" WILL DO THE REST
PUSHJ PP,SAVREG ;(JUST IN CASE)
MOVE 16,[Z 1,2]
MOVE 2,R.IN1
TLZ 2,7777
TLO 2,(R.IN2) ;SET LENGTH
PUSHJ PP,GD6.## ;SIXBIT TO BINARY
MOVE R.15,1 ;COPY ANSWER
PUSHJ PP,RESREG
MOVE R.OUT,R.15
RETURN
ARG100: MOVE R.OUT,(R.IN1) ;1-WORD COMP
RETURN
ARG400: MOVE R.OUT,1(R.IN1) ;GET LOW-ORDER WORD
SKIPE (R.IN1) ;IF HIGH-ORDER WORD IS NOT 0,..
TLO R.OUT,1B18 ;MAKE VALUE NEGATIVE. (THIS WILL
;BE FLAGGED AS AN ERROR ON RETURN)
RETURN
;PERFORM ALL ADVANCING.
;THIS ROUTINE STORES THE CORRECT CHARACTERS IN THE PAGE TO CORRESPOND
;TO THE ADVANCING ITEM.
;
;ENTER: R.6 = TEXT PTR
;
ADVANC: GETARG 4 ;GET ADVANCING ITEM
JUMPN R.OUT,ADV0 ;JUMP IF THERE IS ADVANCING
HLRZ R.15,M.TMP2 ;IS THERE AN END INDICATOR?
JUMPE R.15,CPOPJ ;RETURN IF NO END INDICATOR
MOVEI R.14,1 ;OUTPUT 1 LINE FEED
JRST ADV1
ADV0: TLNN R.OUT,-1 ;IS LEFT HALF=0?
JRST ADV2 ;YES, ITS A "PAGE" OR CHANNEL NUMBER
MOVE R.IN1,R.OUT
PUSHJ PP,ARG3.4 ;COMPUTE VALUE
JUMPE R.OUT,CPOPJ ;EXIT IF "0" LINES
MOVE R.14,R.OUT
ADV1: MOVEI R.15,LF ;PUT LINE FEED IN R15, COUNT IN R14
JRST ADV3
ADV2: HLRZ R.15,(R.OUT) ;GET CHANNEL NUMBER
MOVE R.15,CHNTAB-1(R.15) ;GET CONTROL CHARACTER
MOVEI R.14,1 ;OUTPUT 1 OF THEM
ADV3: PUSHJ PP,SAVTMP
MOVEI R.IN1,CR ;PUTOUT A CR FIRST
PUSHJ PP,PUTCHR
PUSHJ PP,RESTMP
MOVE R.IN1,R.15
PUSHJ PP,PUTCHR
SOJG R.14,.-2 ;LOOP UNTIL ALL CHARS ARE OUT
RETURN
;TABLE OF CONTROL CHARACTERS FOR LINE PRINTER CONTROL TAPE
CHNTAB: EXP FF
EXP DLE
EXP DC1
EXP DC2
EXP DC3
EXP DC4
EXP VT
EXP FF
;SUBROUTINES TO SAVE AND RESTORE TEMP REGISTERS
SAVTMP: POP R.17,R.IN2
PUSH R.17,R.14
PUSH R.17,R.15
JRST (R.IN2)
RESTMP: POP R.17,R.IN2
POP R.17,R.15
POP R.17,R.14
JRST (R.IN2)
;CONVERT A ASCII STRING TO ITS BINARY VALUE
;
;ENTER: R.IN1 = PTR TO ASCII STRING
; R.IN2 = LENGTH
BINARY: PUSHJ PP,SAVREG
MOVE 16,[Z 1,2]
MOVE 2,R.IN1
TLZ 2,7777
TLO 2,(R.IN2)
PUSHJ PP,GD7.##
MOVE R.15,1
PUSHJ PP,RESREG
MOVE R.OUT,R.15
RETURN
;COMPUTE A PTR TO THE CD MESSAGE CLASS
GETCLS: GETARG 1
HRRZ R.14,1(R.OUT)
SUBI R.14,^D8 ;COMPUTE LENGTH OF CD-MSG CLASS
IDIVI R.14,5 ;CONVERT TO WORDS
ADD R.14,R.CD
JUMPE R.15,.+3 ;REMAINDER?
IBP R.14 ;YES, BUMP 1 CHAR
SOJN R.15,.-1 ;LOOP FOR ALL EXTRA CHARS
MOVE R.OUT,R.14
RETURN
;COMPARE 2 TEXT STRINGS
;
;ENTER: R.IN1, R.IN2 ARE PTRS TO STRINGS
; R.13 = LENGTH
;
;EXIT: NORMAL EXIT IF NO MATCH
; SKIP RETURN IF MATCH
COMPAR: ILDB R.14,R.IN1
ILDB R.15,R.IN2
SKIPN R.14 ;SKIP IF A REAL CHARACTER
MOVEI R.14," " ;NO, GET AN ASCII BLANK
SKIPN R.15 ;SKIP IF A REAL CHARACTER
MOVEI R.15," " ;NO, GET AN ASCII BLANK
CAME R.14,R.15 ;MATCH?
RETURN ;NO
SOJG R.13,COMPAR
CPOPJ1: AOS (R.17) ;BUMP RETURN ADDRESS
CPOPJ: RETURN
SUBTTL INITIALIZE INPUT CD ENTRY
;M.INIT--CALLED WHEN AN INPUT CD SPECIFIES FOR "INITIAL" INPUT.
M.INIT: PUSHJ PP,SETUP
PUSHJ PP,GETPAG
MOVE R.CP,R.OUT
MOVEI R.6,1 ;FUNCTION CODE=1
STORE FC ;STORE IT
PUSHJ PP,MCP.S
PUSHJ PP,MCP.R
MOVE R.CP,R.OUT
CHKSTS ;WHAT'S THE STATUS?
JRST INIT0 ;STATUS=0
JRST INIT1 ;STATUS=1
JRST INIT1 ;STATUS=2
INITX: MOVE R.IN1,R.CP ;EXIT POINT
JRST RELPAG ;RELEASE PAGE AND EXIT
INIT0: PUSHJ PP,GETQ ;UPDATE Q-SPEC
GET GRPCNT ;GET # OF MESSAGE GROUPS
PUTCNT: PUSHJ PP,SAVREG
MOVE 16,[Z 1,2]
HRRZ 2,R.CD ;GET CD ADDRESS
ADD 2,CDPTRS+CD.CNT
TLZ 2,7777 ;GET RID OF GARBAGE
TLO 2,6 ;LENGTH=6
MOVE 1,R.OUT ;SET VALUE
PUSHJ PP,PD7.##
PUSHJ PP,RESREG
JRST INITX ;LEAVE
INIT1: PUTMUL CD.Q,< >,^D48 ;SPACE OUT ALL QUEUES
PUTMUL CD.CNT,<0>,6
JRST INITX
SUBTTL IF MESSAGE/ACCEPT COUNT
;IF MESSAGE...
M.IFM: PUSHJ PP,SETUP ;DO THE SETUP STUFF
TROA R.FG,F.IFM ;SET "IF MSG" FLAG AND SKIP
;ACCEPT COUNT
M.AC: PUSHJ PP,SETUP
PUSHJ PP,GETPAG
MOVE R.CP,R.OUT
MOVEI R.6,6 ;SET FUNCTION CODE
STORE FC
PUSHJ PP,SETQ ;SET Q-SPEC
PUSHJ PP,MCP.S
PUSHJ PP,MCP.R
MOVE R.CP,R.OUT
CHKSTS ;HOW'D WE DO?
JRST IFM0 ;STATUS=0
SETVAL CD.STS,<20>,2 ;SET STATUS=20
SETVAL CD.CNT,<000000>,6
IFMX: MOVE R.IN1,R.CP
JRST RELPAG ;EXIT
IFM0: SETVAL CD.STS,<00>,2
GET GRPCNT ;GET GROUP COUNT
TSWT F.IFM ;IS THIS AN IFM?
JRST PUTCNT ;NO, FORGET ABOUT COUNT
SKIPLE R.OUT ;IS THERE A MESSAGE?
AOS (R.17) ;;YES, BUMP RETURN ADDRESS
JRST PUTCNT ;PROCEED AS ABOVE
SUBTTL DISABLE/ENABLE INPUT
;DISABLE INPUT
M.DI: PUSHJ PP,SETUP
MOVEI R.6,^D7 ;FUNCTION CODE=7
JRST DI.EI
;ENABLE INPUT
M.EI: PUSHJ PP,SETUP
MOVEI R.6,^D10 ;FUNCTION CODE=10
DI.EI: PUSHJ PP,GETPAG
MOVE R.CP,R.OUT ;GET A FRESH PAGE
STORE FC ;STORE FUNCTION CODE
PUSHJ PP,SETPSW ;..AND PASSWORD
PUSHJ PP,SETQ ;..AND Q-SPECS
PUSHJ PP,MCP.S
PUSHJ PP,MCP.R
MOVE R.CP,R.OUT
CHKSTS ;CHECK RESULTS OF MCP SEND
JRST EI.0 ;STATUS=0
JRST EI.1 ;STATUS=1
EI.2: SETVAL CD.STS,<40>,2 ;SET STATUS=40
M.EIX: MOVE R.IN1,R.CP
JRST RELPAG ;RELEASE PAGE AND EXIT
EI.0: SETVAL CD.STS,<00>,2
JRST M.EIX
EI.1: SETVAL CD.STS,<20>,2
JRST M.EIX
SUBTTL DISABLE/ENABLE INPUT TERMINAL
;DISABLE INPUT TERMINAL
M.DIT: PUSHJ PP,SETUP
MOVEI R.6,^D8
JRST DITEIT
;ENABLE INPUT TERMINAL
M.EIT: PUSHJ PP,SETUP
MOVEI R.6,^D11
DITEIT: PUSHJ PP,GETPAG
MOVE R.CP,R.OUT
STORE FC
PUSHJ PP,SETPSW ;SET PASSWORD
PUSHJ PP,SETQ ;AND Q'S
MOVE R.IN1,CDPTRS+CD.SRC
MOVEI R.IN2,SRCNAM(R.CP)
TLO R.IN2,440700
MOVEI R.15,^D12 ;SET UP ARGS FOR MOVE
PUSHJ PP,TRNFER
PUSHJ PP,MCP.S ;SEND THE PAGE
PUSHJ PP,MCP.R
MOVE R.CP,R.OUT
CHKSTS
JRST EI.0 ;STATUS=0
JRST EIT.1 ;STATUS=1
JRST EI.2 ;STATUS=2
JRST EI.1 ;STATUS=3
JRST EIT.1 ;STATUS=4
EIT.1: SETVAL CD.STS,<21>,2
JRST M.EIX
SUBTTL DISABLE/ENABLE OUTPUT
;DISABLE OUTPUT
M.DO: PUSHJ PP,SETUP
MOVEI R.6,^D9
JRST DOEO
;ENABLE OUTPUT
M.EO: PUSHJ PP,SETUP
MOVEI R.6,^D12
DOEO: MOVE R.IN1,R.CD
MOVEI R.IN2,4 ;CONVERT DESTINATION COUNT
PUSHJ PP,BINARY ; TO BINARY
IFN ANS68,< ;[510] OLD COMPILER DEFAULTS TO 0
SKIPN R.OUT ;[510] IS DEST.COUNT = 0?
ADDI R.OUT,1 ;[510] YES - DEFAULT TO 1
> ;[510] END IFN ANS68
JUMPLE R.OUT,EO.ERR ;DEST COUNT MUST NOT BE NEGATIVE
MOVE R.13,R.OUT ;SAVE IT
GETARG 1
MOVE R.14,1(R.OUT) ;GET LENGTH OF CD-ENTRY
SUBI R.14,^D18
IDIVI R.14,^D13 ;COMPUTE # OF "OCCURS"
CAMG R.13,R.14 ;IS COUNT BIGGER THAN THIS?
JRST DO.OK
EO.ERR: MOVEI R.IN1,"30" ;BAD DESTINATION COUNT
DPB R.IN1,[POINT 14,1(R.CD),34]
RETURN ;STORE STATUS AND EXIT
DO.OK: PUSHJ PP,GETPAG
MOVE R.CP,R.OUT
STORE FC
PUSHJ PP,SETPSW ;SET UP PAGE
PUSHJ PP,SETDST ;MOVE ENTIRE DESTINATION TABLE
PUSHJ PP,MCP.S ;SEND A PAGE
PUSHJ PP,MCP.R ;AND GET ONE BACK
MOVE R.CP,R.OUT
CHKSTS ;HOW DID IT GO?
JRST EO.0 ;STATUS=0
JRST E.STS ;STATUS=1
JRST EO.2 ;STATUS=2
JFCL ;STATUS=3 SAME AS 4
MOVEI R.IN1,"20" ;STATUS=4
EO.X1: DPB R.IN1,[POINT 14,1(R.CD),34] ;STORE STATUS
PUSHJ PP,GETDST ;RETURN ERROR KEYS
MOVE R.IN1,R.CP
JRST RELPAG
EO.2: MOVEI R.IN1,"40"
JRST EO.X1
EO.0: MOVEI R.IN1,"00"
JRST EO.X1
SUBTTL SUBROUTINES FOR LIBOL-MCS
;MISCELLANEOUS SUBROUTINES FOR LIBOL-MCS
;FORM A NEW PAGE-TABLE (CALLED ONLY ONCE)
FRMTAB: PUSHJ PP,ONCE## ;SET UP PID'S, ETC.
PUSHJ PP,GETPAG
MOVE R.PT,R.OUT ;GET ADDRESS OF NEW PAGE
MOVEM R.OUT,MCSPT##
RETURN
;SAVE IMPORTANT REGISTERS
SAVREG: POP 17,R.13
PUSH 17,0
PUSH 17,1
PUSH 17,2
PUSH 17,3
PUSH 17,4
PUSH 17,5
PUSH 17,6
PUSH 17,7
PUSH 17,10
PUSH 17,11
PUSH 17,16
JRST (R.13)
;RESTORE REGISTERS
RESREG: POP 17,R.13
POP 17,16
POP 17,11
POP 17,10
POP 17,7
POP 17,6
POP 17,5
POP 17,4
POP 17,3
POP 17,2
POP 17,1
POP 17,0
JRST (R.13)
;RETRIEVES ERROR KEYS FROM DESTINATION TABLE AND STORES
;THEM IN OUTPUT CD.
;
GETDST: MOVEI R.IN1,DSTTAB+2(R.CP) ;POINT TO TABLE
MOVE R.IN2,R.CD
ADDI R.IN2,2 ;BUMP PTR TO DESTINATION TABLE
MOVE R.6,DSTCNT(R.CP) ;# OF ENTRIES
JUMPE R.6,CPOPJ ;EXIT IF NO ENTRIES
GDST0: HRRZ R.15,(R.IN1) ;GET WORD FROM PAGE
TRZ R.15,777600 ;CLEAR OTHER BITS IN CASE OF EXTENSIONS
ADDI R.15,"0" ;BINARY TO ASCII
IDPB R.15,R.IN2
ADDI R.IN1,3 ;BUMP PAGE PTR
ADDI R.IN2,2 ;LIKEWISE FOR CD PTR
IBP R.IN2 ;SKIP OVER 2 CHARS
IBP R.IN2
SOJG R.6,GDST0
RETURN
;RETRIEVES A PASSWORD FROM CD TO CURRENT PAGE
SETPSW: GETARG 2
MOVE R.IN1,(R.OUT) ;GET PTR TO IT
HRRZ R.15,1(R.OUT) ;AND LENGTH
MOVEI R.IN2,PW(R.CP)
TLO R.IN2,440700
TLNE R.IN1,(1B11) ;IS THIS A SIXBIT PASSWORD?
JRST TRNFER ;NO, ASCII TO ASCII
MOVE R.13,R.15 ;MOVE LENGTH SPEC
JRST SIX.7 ;CONVERT SIXBIT TO ASCII
;MOVES A DESTINATION TABLE FROM THE OUTPUT CD TO THE CURRENT PAGE
;
SETDST: MOVE R.IN1,R.CD
MOVEI R.IN2,4 ;SET LENGTH OF DEST COUNT
PUSHJ PP,BINARY ;CONVERT TO BINARY
SKIPN R.6,R.OUT ;DEST COUNT=0?
ADDI R.6,1 ;YES-DEFAULT TO 1
STORE DSTCNT ;STORE IT ON PAGE
MOVE R.IN1,R.CD
ADDI R.IN1,2 ;BUMP PTR TO TABLE
MOVEI R.IN2,DSTTAB(R.CP)
SETD2: HRLI R.IN2,440700
IBP R.IN1 ;SKIP OVER ERROR KEY
PUSHJ PP,SETQ1
AOS R.IN2
SOJG R.6,SETD2
RETURN
;PERFORM COMMON INITIALIZATION
SETUP: SKIPN R.PT,MCSPT## ;GET POINTER TO PAGE TABLE
PUSHJ PP,FRMTAB ;NO, GO GENERATE A TABLE
CLEAR R.FG, ;CLEAR ALL FLAGS
GETARG 1 ;GET CD-ENTRY
MOVE R.CD,(R.OUT)
RETURN
;MOVE Q-SPECS FROM CD ENTRY TO CURRENT PAGE
;ENTER: R.CP, R.CD SET
;
;(R.15 IS DESTROYED)
SETQ: MOVE R.IN1,R.CD ;GET CD-Q PTR
MOVE R.IN2,R.CP
ADDI R.IN2,Q.0 ;BUMP TO Q-SPEC
SETQ0: MOVEI R.13,4 ;MOVE 4 Q'S
SETQ0A: HRLI R.IN2,440700 ;RESET TO START OF WORD
PUSHJ R.17,SETQ1 ;DO IT
AOS R.IN2 ;BUMP PTR TO NEXT Q-SPEC
SOJG R.13,SETQ0A ;MOVED ALL 3?
RETURN ;YES
;GET Q-SPEC FROM CURRENT PAGE AND MOVE IT TO CD ENTRY
GETQ: MOVE R.IN1,R.CP ;SOURCE PTR
ADDI R.IN1,Q.0
MOVE R.IN2,CDPTRS ;CD BYTE PTR
MOVEI R.13,4
GETQ0A: HRLI R.IN1,440700
PUSHJ R.17,GETQ1
AOS R.IN1
SOJG R.13,GETQ0A
RETURN
;GET ANOTHER MESSAGE PAGE WHEN THE LAST ONE RAN OUT.
GETMOR: PUSHJ PP,MCP.S ;SEND IT TO MCP
PUSHJ PP,MCP.R ;GET RESPONSE
MOVE R.CP,R.OUT ;PUT PAGE ADDR IN GOOD PLACE
POPJ PP,
;FIND THE CURRENT TEXT DESCRIPTOR BLOCK
;
;ENTER: R.OUT=TEXT COUNT
;
;EXIT: R.TD=PTR TO TEXT DESC.
FINDTD: HRRZ R.TD,R.CP
ADDI R.TD,^D510 ;START AT LAST TD ENTRY
HLRZ R.15,TDCNT(R.CP) ;GET ORIGINAL COUNT
SKIPN R.15 ;SKIP IF IN A "RECEIVE"
SOSA R.15,R.OUT ;GET # OF TD'S FOR "SEND"
SUB R.15,R.OUT ;COMPUTE # WE HAVE USED
LSH R.15,1 ;DOUBLE IT
SUB R.TD,R.15 ;BACK UP THAT NUMBER OF ENTRIES
RETURN
;TRANSFER A SERIES OF CHARACTERS. STOP WHEN COUNT
;RUNS OUT. ( CONVERTS SPACES TO NULLS ALONG THE WAY )
;
;ENTER: R.IN1= SOURCE PTR
; R.IN2= DEST PTR
; R.15= LENGTH
SETQ1: MOVEI R.15,^D12 ;ENTRY FOR MOVING Q-SPECS
TRNFER: ILDB R.14,R.IN1 ;GET SOURCE BYTE
CAIN R.14," " ;CHANGE SPACES...
SETZ R.14, ;...TO NULLS
IDPB R.14,R.IN2
SOJG R.15,TRNFER
RETURN
; ENTRY SAME AS TRNFER EXCEPT CONVERSION IF FROM NULLS TO SPACES
GETQ1: MOVEI R.15,^D12 ;ENTRY FOR MOVING Q-SPECS
TRNFZ: ILDB R.14,R.IN1 ;GET SOURCE CHARACTER
SKIPN R.14 ;CHANGE NULL...
MOVEI R.14," " ;...TO SPACE
IDPB R.14,R.IN2 ;STORE DESTINATION CHARACTER
SOJG R.15,TRNFZ ;GET THEM ALL
RETURN
;GET THE NEXT TEXT UNIT(SEGMENT, MESSAGE, ETC.)
;
;ENTER: R.TD = TEXT DESCRIPTOR PTR
; R.TX = RECEIVING ITEM PTR
; R.6 = LENGTH OF RECEIVING ITEM
;
;EXIT: TEXT DESCRIPTOR UPDATED
GETUNT: HRRE R.15,1(R.TD) ;GET CHAR COUNT
JUMPL R.15,UNITX ;IF NEGATIVE CHAR COUNT EXIT
CAMG R.15,R.6 ;ITEM LONGER THAN RECV. ITEM?
JRST .+3 ;NO
SWON F.TOLG ;SET "TOO LONG"
SKIPA R.14,R.6 ;LENGTH = LESSER OF 2 LENGTHS
MOVE R.14,R.15
LDB R.13,[POINT 6,R.TX,11] ;GET DEST BYTE SIZE
JUMPE R.14,UNITX ;ZERO LENGTH, EXIT
PUSH R.17,R.14 ;SAVE LENGTH FOR LATER
MOVE R.15,(R.TD) ;GET TD BYTE PTR
LDB R.IN2,[POINT 6,(R.TD),17] ;SAVE END INDICATOR
TLZ R.15,77 ;CLEAR INDEX FIELD
TLO R.15,R.CP ;SET IT AGAIN
MOVEM R.15,(R.TD) ;AND PUT IT BACK
UNIT1: ILDB R.15,(R.TD) ;GET CHAR
CAIE R.13,6 ;RCV ITEM IS SIXBIT?
JRST UNIT2 ;NO, NO CONVERSION
CAIGE R.15,140 ;LOWER CASE?
SKIPA R.IN1,[EXP 40]
MOVEI R.IN1,100 ;YES
SUB R.15,R.IN1 ;CONVERT TO SIXBIT
UNIT2: IDPB R.15,R.TX ;DEPOSIT IN RECEVING ITEM
SOS 1(R.TD) ;DECREMENT COUNT
SOJG R.14,UNIT1 ;THRU?
POP R.17,R.14 ;COMPUTE NEW LENGTH OF..
SUB R.6,R.14 ;..RECEIVING ITEM
HRRZ R.15,M.TMP2 ;GET CURRENT LENGTH
ADD R.15,R.14 ;ADD ADDITIONAL LENGTH
HRRM R.15,M.TMP2 ;SAVE IT FOR LATER
DPB R.IN2,[POINT 6,(R.TD),17] ;RESTORE END INDICATOR
UNITX: RETURN ;YES
;CONVERT A SIXBIT STRING TO ASCII
;
;ENTER: R.IN1 = PTR TO SIXBIT STRING (NOT BYTE PTR)
; R.IN2 = BYTE PTR TO DESTINATION
; R.13 = LENGTH
SIX.7: TLO R.IN1,440600
SIX.7L: ILDB R.OUT,R.IN1 ;GET SIXBIT BYTE
SKIPE R.OUT ; DON'T CONVERT SPACES
ADDI R.OUT,40 ;CONVERT
IDPB R.OUT,R.IN2
SOJG R.13,SIX.7L
RETURN
;REMOVE A PAGE-TABLE ENTRY AND SHUFFLE THE REST OF THE TABLE UP
DELPAG: MOVEI R.IN1,1(R.PT)
CLEARM (R.PT) ;DELETE CURRENT ENTRY
DEL2: SKIPN (R.IN1) ;END OF TABLE?
RETURN
MOVE R.15,(R.IN1)
MOVEM R.15,(R.PT) ;MOVE ENTRY DOWN 1 WORD
CLEARM (R.IN1)
AOS R.PT
AOJA R.IN1,DEL2
;COPY CONTENTS OF A COMPLETE PAGE
;
;ENTER: R.CP = PTR TO OLD PAGE
; R.IN1= PTR TO NEW PAGE
CPYPAG: HRL R.IN1,R.CP
MOVEI R.IN2,^D511(R.IN1)
BLT R.IN1,(R.IN2)
RETURN
;RECEIVE A PAGE FROM MCP
MCP.R: PUSHJ PP,SAVT## ;SAVE T1-T4
PUSHJ PP,RECPAG## ;CALL RECEIVE PAGE
JRST RCVERR ;ERROR
HRRZ R.OUT,T1 ;GET PAGE NUMBER
LSH R.OUT,P2WLSH ;MAKE INTO AN ADDRESS
HRLS TDCNT(R.OUT) ;SAVE ORIGINAL TEXT COUNT
RETURN ;(THIS ALSO RESTORES T1-T4)
;SEND A PAGE TO MCP
;NOTE--THE "R.CP" PAGE IS SEND TO MCP, NOT THE "R.IN1" PAGE!!!
MCP.S: PUSHJ PP,SAVT ;SAVE TEMP REGS
MOVE R.IN1,R.CP ;GET ADDRESS OF PAGE TO SEND
LSH T1,W2PLSH ;MAKE INTO A PAGE NUMBER
PUSHJ PP,SNDPAG## ;DO IT
JRST SNDERR ;BAD RETURN
RETURN ;RETURN AND RESTORE T1-T4
;RELEASE CUSTODY OF A PAGE
RELPAG: PUSHJ PP,SAVT
HRRZS R.IN1 ;JUST INCASE OF A WISE PERSON
MOVE T1,R.IN1 ;GET ADDRESS OF PAGE TO GET RID OF
LSH T1,W2PLSH ;MAKE INTO A PAGE NUMBER
PUSHJ PP,KILPAG## ;KILL IT
RETURN ;RESTORE AND RETURN
;GET A FREE PAGE FROM THE MONITOR
GETPAG: PUSHJ PP,SAVT
SKIPE PAGLST## ;[635] Is there a page on the free chain?
JRST GETPG3 ;[635] Yes - go get next one
GETPG1: PUSHJ PP,GTPAG.## ;[635] NO, GET PAGE FROM IPCF
JRST CRTERR ;NO PAGES AVAILABLE
PUSH R.17,T1 ;SAVE THE AGE NUMBER
PUSHJ PP,CRPAG.## ;CREATE IT IN ADDRESS SPACE
JRST [POP R.17,T1 ;RESTORE T1
JRST CRTERR]
POP R.17,T1 ;RESTORE THE PAGE NUMBER
GETPG2: LSH T1,P2WLSH ;[635]
MOVE R.OUT,T1 ;PUT IN OUT REGISTER
RETURN ;RESTORE AND RETURN
GETPG3: PUSHJ PP,GETPG.## ;[635] Get page from free chain
JRST GETPG1 ;[635] Page went away - create one
JRST GETPG2 ;[635] o do the standard thing
;COMPARE THE Q-SPECS OF THE CD WITH THOSE OF THE
;CURRENT PAGE-TABLE ENTRY TO SEE IF AN ACTIVE TRANSACTION EXITS.
;
;ENTER: R.PT SET
;
;EXIT: SKIP RETURN IF A MATCH EXISTS
CMPQ: HLRZ R.15,(R.PT) ;GET PAGE NO.
ANDI R.15,777 ;DELETE BIT
LSH R.15,P2WLSH ;CONVERT TO PAGE ADDRESS
ADDI R.15,5 ;BUMP TO Q-SPEC
MOVE R.14,CDPTRS+CD.Q
MOVEI R.OUT,4 ;COMPARE 4 Q-SPECS
CMPQ1: HRLI R.15,440700 ;RESET TO START OF WORD
MOVEI R.13,^D12 ;LENGTH OF Q-SPECS
CMPQ2: ILDB R.IN1,R.14 ;GET CD CHAR
CAIN R.IN1," " ;SPACE IN CD NAME?
SETZ R.IN1, ;YES-CONVERT TO NULL
ILDB R.IN2,R.15 ;GET PAGE CHAR
CAME R.IN1,R.IN2 ;MATCH?
RETURN ;NO, STOP
CMPQ3: SOJG R.13,CMPQ2 ;THRU?
AOS R.15 ;BUMP PAGE PTR
SOJG R.OUT,CMPQ1 ;DONE IT 4 TIMES?
JRST CPOPJ1 ;YES, A MATCH--RETURN TO CALL+2
SUBTTL ERROR PROCESSING FOR LIBOL-MCS
LCMFTL:: OUTSTR [ASCIZ/?Cannot connect to MCS-10/]
JRST ALLERR
;ERROR IN CREATING A NEW PAGE
CRTERR: OUTSTR [ASCIZ /?Free page cannot be found/]
JRST ALLERR
;ERROR IN SENDING A PAGE
SNDERR: OUTSTR [ASCIZ /?Cannot send page to IPCF/]
JRST ALLERR
;CANNOT RECEIVE A PAGE FROM LCMIPC
RCVERR: OUTSTR [ASCIZ /?Cannot receive a page from MCS/]
JRST ALLERR
;NOT ALL ACTIVE TRANSACTIONS WERE CORRECTLY FLUSHED FROM SYSTEM--
CNTERR: OUTSTR [ASCIZ /?Fatal--Spurious transaction pages found/]
JRST ALLERR
;A NULL TEXT COUNT WAS PASSED BACK BY MCP
BADERR: OUTSTR [ASCIZ /%Fatal--Null text count received from MCP
/]
JRST RCV.6 ;[635] Go to RCV.6, not RCV.4 (causes loop)
;BAD TRANSACTION NUMBER
BADREQ: OUTSTR [ASCIZ /?Fatal--Bad transaction number from MCP/]
JRST ALLERR
;BAD STATUS CODE RETURNED FROM MCP
E.STS: SKIPLE R.15 ;CHECK FOR LEGAL ERROR CODE
SETZ R.15, ;NOT..
OUTSTR [ASCIZ /?Fatal error detected by MCS-10 /]
OUTSTR @CONERS(R.15) ;APPEND ERROR FOUND
JRST ALLERR
[ASCIZ/(system is not accepting debug MPPs)/] ;-6
[ASCIZ/(asking for new transaction but never EPI'ed the previous)/] ;-5
[ASCIZ/(asking for more data beyond EGI)/] ;-4
[ASCIZ/(asking for old transaction but no current found)/] ;-3
[ASCIZ/(appending to old output but no current found)/] ;-2
[ASCIZ/(LCM sent an invalid function code)/] ;-1
CONERS: [ASCIZ/(whoops! MCS-10 returned an invalid error indicator)/] ; 0
BADARG: OUTSTR [ASCIZ /?Compiler error--bad argument list/]
ALLERR: OUTSTR [ASCIZ /
?Cannot continue
/]
JRST STOPR.##
END