Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/galaxy-sources/nurd.mac
There are 28 other files named nurd.mac in the archive. Click here to see a list.
TITLE NURD20 Module for Readers and Printers
; COPYRIGHT (C) 1978, 1979 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; ++
; Facility: GALAXY for DN200
;
; Abstract:
; This module implements the DECnet network unit record device protocol
; (NURD). It simulates TOPS-20 JSYS calls for card readers and line
; printers. The simulated JSYS's include GTJFN, OPENF, SINR, SOUT, MTOPR,
; and CLOSF. Interrupt processing is similar to that observed for the
; local card reader and line printer.
;
; Environment: TOPS-20 user mode
; Modified:
; 16 Add copyright and other information so that this turkey can
; be released into loadtest.
;
; 17 XLIST the literals, etc.
;
; 20 Restore registers before turning on interrupt system, so that
; interrupts into the GALAXY context have the GALAXY registers.
;
; 21 Make sure that certain "OWN" locations get a separate copy in
; each fork where we execute. This prevents some interesting
; problems with multiple DN200s.
;
; 22 Fix MTOPR status problem and put ERJMP following SNDINT MTOPR.
; Interrupt setup code did not save AC3.
;
; 23 Fix bug in LMOFLO where confusion over dump buffers and control
; responses were causing problems.
;
; 24 Resolve further problems with flushing buffers.
;
; 25 Do effective address calculation on user byte pointer in USIN.
;
; 26 Do more effective effective-address calculation on user byte
; pointers. Provided routine EFADBY, which alters byte pointer
; to reflect effective address. Also, changed USIN, USOUT, and
; MAPDEV to use this routine.
;
; 27 Put SETER JSYS in NURD error return, at ERRTN.
;
; 30 Changed reader input (USIN) so that EOF detection causes
; ERJMP/ERCAL processing. Also fixed EOF detection code.
;
; 31 Fixed bug introduced in edit #27 - a clumsy typo.
;
; 32 Fixed addressing error in TYPATT, and also repaired trivial typo.
;
; 33 Fix logic to process disconnects on links correctly.
;
; 34 Fix NRM and NRD file spec generators to use different control ID's.
;
; 35 Fix UGTJFN to get rid of aborted NRM JFN's.
;
; 36 Fix UCLOSF to close JFN's with CZ%ABT, so that JFN's go away
; correctly.
;
; 37 Fix bug in USIN which caused loss of last card read if reader went
; offline.
;
; 40 Change usage of IOX69 error code to DCNx8 because IOX69 is no longer
; valid.
;
; 41 Allow 8-bit ASCII mode.
;
; 42 Code cleanup, reformatting, and general bug-fixup.
;
; 43 Rewrote interrupt handling code.
;
; 44 Fixed glitch in UOPENF, where legal device/mode checked.
;
; 45 Changed exit-time handling of interrupts because LPTSPL calls
; us back recursively, causing an endless set of IIC's when the
; device goes offline.
;
; 46 Added defensive code in the interrupt handler routines.
;
; 47 Fixed handling of device-online interrupt. Wrong R value
; was being used to load interrupt channel number.
;
; 50 Added code to solve race condition occurring when online
; indication arrives before offline indication.
;
; 51 Fixed NRDR macro code generation - it caused improper setting
; of info on stack, subsequently causing program execution to
; be improperly dispatched. Also did away with the NRDRJ macro,
; as it is not needed. Fixed bug in SOUTR error handling.
;
; 52 Repaired typo in USOUT which caused illegal instruction trap
; whenever output error was processed for the network.
;
; 53 Fixed bug in data message processing for USIN. This bug caused
; the message length to always appear to be zero.
;
; 54 Fixed problem caused by double edit to fix previous bug
;
; 55 Add debug code for interrupt messages
;
; 56 Fixup on the NRDR macro. BWH
;
; 57 Disabled lower-case raise function, allowing default to lower case.
;
; 60 Support new features msg for downline VFU loading (AWC)
; Also, delete the $CALLR OPDEF and replace all $CALLR's with PJRST's
;
; 61 Support new features msg for translation RAM downline loading (AWC)
; Also, support new translation RAM and VFU name messages
;
; 62 Changed NRDTMO timeout value from 10. retries to 120. retries. This
; effectively changes the timeout from 5. seconds to 60. seconds.
; VERSION NUMBER:
NRDWHO==0 ; WHO LAST EDITED
NRDMAJ==1 ; MAJOR VERSION NUMBER
NRDMIN==2 ; MINOR VERSION NUMBER
NRDEDT==62 ; EDIT NUMBER
%%.NRD==BYTE (3)NRDWHO (9)NRDMAJ (6)NRDMIN (18)NRDEDT ; OUR VERSION NUMBER
SUBTTL AC's, Parameters, Constants, etc.
SEARCH GLXMAC
PROLOG (NURD20)
; ***** Accumulators
J1==1 ; JSYS AC'S
J2==2 ; ...
J3==3 ; ...
J4==4 ; ...
A==5 ; General usage
B==A+1 ; and function
C==B+1 ; arguments
D==C+1 ; ...
T1==D+1 ; Temporaries
T2==T1+1 ; ...
LS==T2+1 ; Data Link Status (NRDSTS)
DS==LS+1 ; Device Status (NRDDST)
R==DS+1 ; RDDB Pointer
P==17 ; Stack Pointer
; ***** Configuration Parameters
NRDBSZ==^D1024 ; NURD MSG BUFFER SIZE (8 BIT BYTES)
IMSGSZ==^D16 ; NSP INTERRUPT MSG SIZE(MAX)
NURDL==^D16 ; LENGTH OF NRDR ERROR HISTORY
NRDLVL==1 ; NURD PRIORITY INT LEVEL
NRDICH==^D35 ; NRD DATA LINK INT CHANNEL FOR INTERRUPT MESSAGES
NRDDCH==^D34 ; NRD DATA LINK INT CHANNEL FOR DATA RECEIVED INT
NRDTMO==^D120 ; NUMBER OF HALF-SECOND INTERVALS FOR TIMEOUT
; ***** Constants and Other Such Trivia
URS==2 ; THE NURD DECNET OBJECT TYPE
MO%RAM==1B32 ; LOCALLY DEFINED VALUE FOR TRANSLATION RAM SUPPORT
; ***** NRM Resource Types
NRDLP==102 ; REMOTE LINE PRINTER
NRDCR==103 ; REMOTE CARD READER
; ***** NRM Function Codes
NRMRID==41 ; NRM REQUESTOR-ID CODE
NRMSPC==50 ; NRM SPECIFY CODE
SPCRES==1 ; RESERVE SUBCODE
SPCREF==3 ; REFER SUBCODE
SPCOFF==4 ; OFFER SUBCODE
NRMACC==51 ; NRM ACCESS CODE
ACCOPN==2 ; OPEN SUBCODE
ACCCLO==3 ; CLOSE SUBCODE
ACCREL==4 ; RELEASE SUBCODE
NRMASN==52 ; NRM ASSIGN CODE
ASNHDN==3 ; HANDOFF SUBCODE
ASNACK==4 ; ACKNOWLEDGE SUBCODE
NRMRSP==47 ; NRM RESPONSE CODE
NRMSTA==53 ; NRM STATUS CODE
STAQRY==1 ; QUERY SUBCODE
STAREP==2 ; REPORT SUBCODE
STALTR==3 ; ALTER SUBCODE
STARLS==20 ; PERFORM AUTOMATIC RELEASE FLAG
; ***** NRM Status Report Codes
; Device Status
; 1 CLOSE PENDING
; 2 OPEN PENDING
; 4 OPEN COMPLETE
; 100 RELEASE PENDING
; 200 RESERVED
; 400 HANDOFF PENDING
; 2000 STATUS-REPORT PENDING
; 4000 OPERATIONAL STATUS PENDING
; 10000 START ERROR PENDING
;
; Asynchronous Report Status
; 1 RECEIVE ERROR THRESHOLD EXCEEDED
; 2 REPLY THRESHOLD EXCEEDED
; 3 NAK THRESHOLD EXCEEDED
; 4 DEVICE PROTOCOL ERROR - FATAL
; 5 INTERVENTION REQUIRED AT DEVICE
; 6 POWERFAIL
; 7 DATA PIPE DISCONNECTED
; 10 DIAL-IN TERMINAL ATTACHED
SUBTTL Local Macros
;***
; NRDR Dispatch to processing code via $CALL.
; NRDRC " " " " " ERCAL.
;
; ERRLOC = Error location, defaulting to NRDR invocation address.
; ERRCOD = Error code, defaulting to DCNX8.
; A dot "." will cause the current value in J1 to be used.
; ERRDSP = Where to go after recording error.
; Defaults to location following NRDR invocation.
;***
DEFINE NRDR. (ERRLOC,ERRCOD,ERRDSP) <
$DSP [
IFB <ERRLOC>,< ;; If errloc not spec, use from stack
HRL J1,(P) ;; just set pc
SUB J1,[1,,0]> ;; & correct it to actual loc
IFNB <ERRLOC>,< ;; If errloc specified
HRLI J1,ERRLOC> ;; Record it
IFNB <ERRCOD>,< ;; Finally, set error code
HRRI J1,ERRCOD> ;; ...
IFNB <ERRDSP>,< ;; If errdsp specified, we want to
MOVEM J1,(P) ;; go to somewhere special after
MOVEI J1,ERRDSP ;; error processing. So replace
EXCH J1,(P)> ;; return addr on stack.
JRST NRDERR]
>
DEFINE NRDR (ERRLOC,ERRCOD,ERRDSP) <
DEFINE $DSP(DEST)<$CALL DEST>
NRDR. ERRLOC,ERRCOD,ERRDSP
>
DEFINE NRDRC (ERRLOC,ERRCOD,ERRDSP) <
DEFINE $DSP(DEST)<ERCAL DEST>
NRDR. ERRLOC,ERRCOD,ERRDSP
>
;***
; ERR Dispatch to literal code via JRST.
; ERRC " " " " " ERCAL.
; ERRJ " " " " " ERJMP.
; ERRI Generate in-line code.
;
; ERRCOD = Error code to be loaded into J1.
; ERRDSP = Where to go after loading code into J1.
; If not specified, J1 is simply loaded.
;***
DEFINE ERR. (ERRCOD,ERRDSP) <
IFB <ERRDSP>,<MOVEI J1,ERRCOD>
IFNB <ERRDSP>,<
$DSP [ MOVEI J1,ERRCOD
IFIDN <ERRDSP><CPOPJ>,<$RET>
IFDIF <ERRDSP><CPOPJ>,<JRST ERRDSP>]>
>
DEFINE ERR (ERRCOD,ERRDSP) <
DEFINE $DSP(DEST)<JRST DEST>
ERR. ERRCOD,ERRDSP
>
DEFINE ERRC (ERRCOD,ERRDSP) <
DEFINE $DSP(DEST)<ERCAL DEST>
ERR. ERRCOD,ERRDSP
>
DEFINE ERRJ (ERRCOD,ERRDSP) <
DEFINE $DSP(DEST)<ERJMP DEST>
ERR. ERRCOD,ERRDSP
>
DEFINE ERRI (ERRCOD,ERRDSP) <
MOVEI J1,ERRCOD
IFNB <ERRDSP>,<
IFIDN <ERRDSP><CPOPJ>,<$RET>
IFDIF <ERRDSP><CPOPJ>,<JRST ERRDSP>>
>
;***
; TYPE
;
; STRING = The ASCII string to be output via PSOUT. For example
; TYPE (This is the string to be typed.)
;***
DEFINE TYPE (STRING) <
LSTOF.
IFNB <STRING>,<MOVEI J1,[ASCIZ /STRING/]>
PSOUT
LSTON.
>
SALL ; DON'T LIST MACRO EXPANSIONS
SUBTTL Remote Device Data Base Definition
; *** IMPURE DATA - PER FORK
SUBJFN:: BLOCK 1 ; SUBSTITUTE JFN FOR THIS FORK & PTR TO DATA BASE
DEBUGF: 0 ; DEBUG FLAGS
DEBUGR: 0 ; RCVMSG MONITOR WORD
; *** Remote Device Data Base (RDDB)
LOC 0
; * GENERAL AREA OF RDDB
RDSAVE:! BLOCK 17 ; USER ACCUMULATOR SAVE AREA (0-16)
RDEPDL:! BLOCK 1 ; U-JSYS ENTRY PDL
RDHOST:! BLOCK 2 ; ASCIZ <NODE>
RDDEV:! BLOCK 1 ; ASCIZ <DEV><UNIT>
RDSTS:! BLOCK 1 ; JSYS SIMULATOR FLAGS
UJ.XT2== 1 ; (rh) JSYS HAS SKIP EXIT FOR SUCCESS
UJ.INT== 2 ; INTERRUPTS ARE ENABLED BY USER
UJ.TDS== 4 ; INTS ARE TEMPORARILY DISABLED BY NURD
UJ.NRD== 10 ; NURD'S AC'S ARE LOADED, NOT USER'S
UJ.RCV== 100000 ; DATA RECIEVED INTERRUPT HAS OCCURRED
UJ.SSO== 200000 ; SOUTR SUSPENDED BEFORE COMPLETION
UJ.FLS== 400000 ; FLUSH DATA BASE ON THE WAY OUT
RDERT:! BLOCK 1 ; PLACE TO REMEMBER ERROR RETURN ADDRESS
RDINTB:! BLOCK 1 ; OLD PC SAVE ADDR ,, PLEVTB
; * NRM AREA OF RDDB
NRMJFN:! BLOCK 1 ; NRM CONTROL LINK JFN
NRMID:! BLOCK 1 ; CONTROL ID FOR DATA LINK
NRMSTS:! BLOCK 1 ; CONTROL LINK STATUS
NRM.CP== 1 ; (rh) NRM CONNECT PENDING
NRM.CC== 2 ; NRM CONNECT COMPLETE
NRM.RS== 4 ; DEVICE RESERVED BY NRM
NRMCFL:! BLOCK 1 ; NRM CONNECT FAILURE CODE
NRMAST:! BLOCK 1 ; DEVICE STATUS FROM STATUS-REPORT
NRMASR:! BLOCK 1 ; REASON CODE FOR ASYNCHRONOUS STATUS-REPORT
;(Cont'd)
; * NRD AREA OF RDDB
NRDJFN:! BLOCK 1 ; NRD DATA LINK JFN
NRDULA:! BLOCK 1 ; BULA FOR DATA LINK
NRDSTS:! BLOCK 1 ; DATA LINK STATUS
NRD.CP== 1 ; (rh) NRD CONNECT PENDING
NRD.CC== 2 ; NRD CONNECT COMPLETE
NRD.LP== 4 ; SET=> DEVICE=LPT, NOT SET=> DEVICE=CDR
NRD.IM== 10 ; COLUMN IMAGE MODE SET
NRD.AI== 20 ; AUGMENTED COLUMN IMAGE MODE SET
NRD.OP== 40 ; DEVICE OPEN PENDING
NRD.OC== 100 ; DEVICE OPEN COMPLETE
NRD.EN== 200 ; INTERRUPTS ARE ENABLED FOR SOFT ERRORS
NRD.EO== 400 ; EOF DETECTED(CDR) OR SET(LPT)
NRD.ER== 1000 ; DATA ERROR DETECTED(CDR)
NRD.PL== 2000 ; PAGE LIMIT EXCEEDED
NRD.AB== 4000 ; ABORT COMPLETE RECEIVED
NRD.FE== 10000 ; FATAL ERROR AT REMOTE DEVICE
NRD.PS== 20000 ; DEVICE PAUSED
NRD.TO== 40000 ; DEVICE TIMED OUT
NRD.RS== 100000 ; RESUME ISSUED
NRD.OF== 1,,0 ; (lh) DEVICE IS OFFLINE
NRD.ON== 2,,0 ; ONLINE RCVD, OFFLINE NOT HERE YET
NRD.NO== 4,,0 ; ONLINE RCVD, BUT REPORTING DEFERRED
NRDDST:! BLOCK 1 ; DEVICE STATUS CODE - KEPT IN MTOPR FLAGS
NRDCFL:! BLOCK 1 ; NRD CONNECT FAILURE CODE
NRDSEQ:! BLOCK 1 ; DATA MSG SEQUENCE NO.
NRDSGC:! BLOCK 1 ; PTR TO SEGMENT COUNT
NRDSEG:! BLOCK 1 ; PTR TO CURRENT SEGMENT HEAD
NRDSGS:! BLOCK 1 ; NO. SEGMENTS LEFT TO PROCESS
NRDSGN:! BLOCK 1 ; CURRENT SEGMENT COUNT
NRDREP:! BLOCK 1 ; REPEATED DATA ITEM
NRDTMC:! BLOCK 1 ; TIMEOUT COUNTER
NRDATT:! BLOCK 1 ; LAST ATTENTION MSG REASON CODE
NRDASQ:! BLOCK 1 ; LAST ATTENTION MSG SEQUENCE NUMBER
NRDLPC:! BLOCK 1 ; PAGE COUNT AT LAST ATTENTION MSG
NRDCSQ:! BLOCK 1 ; LAST CONTROL MSG SEQ NO. (RCVD,,SENT)
NRDCCR:! BLOCK 1 ; LAST CONTROL MSG RECIEVED: COMMAND,,RESPONSE
NRDCAP:! BLOCK 1 ; DEVICE CAPAB. LIST (LENGTH,,ADDRESS)
NRDIER:! BLOCK 1 ; PTR TO LAST INTERNAL ERROR ENTRY
NRDERH:! BLOCK NURDL ; NRDR ERROR HISTORY - LOCATIONS OF DETECTED ERRORS
NRDCHN:! BLOCK 1 ; INTERRUPT CHANNEL ENABLED MASK
NRDRPT:! BLOCK 1 ; NRDRBF PTR (RECEIVE MSG BUFFER)
NRDRCN:! BLOCK 1 ; NUMBER OF BYTES IN NRDRBF
NRDSPT:! BLOCK 1 ; NRDSBF PTR (SEND MSG BUFFER)
NRDSCN:! BLOCK 1 ; NUMBER OF BYTES IN NRDSBF
NRDLIM:! BLOCK 1 ; MAX BLOCK SIZE REMOTE CAN TAKE
;(Cont'd)
; *** NURD DEVICE FEATURES
; FORMAT OF ENTRY:
; WORD 1: 8B7 - FID OF UNKNOWN FID (NRDUFE ONLY)
; 1B8 - FEATURE READ FLAG
; 8B17 - NUMBER OF BYTES IN VALUE
; 18B35 - VALUE IF CLASS 0 OR CLASS 1 WITH 2 OR LESS BYTES
; ADDRESS OF STRING IF MORE THAN 2 BYTES
;
; WORD 2: 9B8 - FEATURE FLAGS RETURNED
; 9B17 - FEATURE CLASS RETURNED
; 18B35 - RESPONSE RETURNED
NRDFET:! ; COMMON DEVICE FEATURES
BLOCK 2 ; FE.ESC RESERVED FOR FUTURE ESCAPE CODE
BLOCK 2 ; FE.DAT DATA MODE
BLOCK 2 ; FE.SER SERIAL NUMBER
NFELCR:! BLOCK 2 ; FE.LCR LOWER CASE RAISE
BLOCK 2 ; FE.FWD FORM WIDTH
BLOCK 2 ; FE.EOF EOF RECOGNITION
BLOCK 2 ; FE.DVT DEVICE TYPE
BLOCK 2 ; FE.TRN RECORD TRUNCATION
BLOCK 2 ; FE.FNM FORM NAME
BLOCK 2 ; FE.DWD DEVICE WIDTH
NRDLPF:! ; LPT SPECIFIC FEATURES
BLOCK 2 ; LP.HT HORIZONTAL TABS
BLOCK 2 ; LP.SFC STANDARD VFU
BLOCK 2 ; LP.OVP OVERPRINT LIMIT
BLOCK 2 ; LP.CVF CUSTOM VFU (DAVFU)
BLOCK 2 ; LP.FCC FORTRAN CARRIAGE CONTROL
BLOCK 2 ; LP.VFR VARIABLE FORMS RATIO
BLOCK 2 ; LP.CHS CHARACTER SET
BLOCK 2 ; LP.PLE PAGE LIMIT ENFORCEMENT
BLOCK 2 ; LP.OPV OPTICAL VFU NAME
BLOCK 2 ; LP.RAM TRANSLATION RAM
NFEVFU: BLOCK 2 ; LP.CVN CUSTOM VFU NAME
NFERAM: BLOCK 2 ; LP.TRN TRANSLATION RAM NAME
NRDCRF:! ; CDR SPECIFIC FEATURES
BLOCK 2 ; CD.CWD CARD WIDTH
NRDUFE:! BLOCK 2 ; CATCHES ANY UNKNOWN FID'S
NRDFSN:! BLOCK 1 ; SEQ NO. OF LAST FEATURE MSG SENT
NRDFSQ:! BLOCK 1 ; SEQ NO. OF LAST FEATURE MSG RECEIVED
; * BUFFERS
NRDRBF:! BLOCK NRDBSZ/4 ; NURD RECEIVE MSG BUFFER
NRDSBF:! BLOCK NRDBSZ/4 ; NURD SEND MSG BUFFER
NRDIBF:! BLOCK IMSGSZ/4 ; INTERRUPT MESSAGE BUFFER
NRDLTR:! BLOCK ^D150 ; VFU/TRANSLATION RAM BUFFER
RDDBSZ:! ; SIZE OF RDDB
RELOC
SUBTTL NURD Message Definition
; ***** NURD Message Format
; MESSAGE TYPE (1):B
NM.TYP==17 ; MESSAGE TYPE MASK
NM.DAT== 0 ; DATA MESSAGE
NM.ATT== 1 ; ATTENTION MESSAGE
NM.FTR== 2 ; FEATURES MESSAGE
NM.CTL== 3 ; CONTROL MESSAGE
NM.ALR== 4 ; ALERT MESSAGE
NM.CAP== 5 ; CAPABILITIES MESSAGE
NM.OTR== 6 ; ***CURRENT OUT OF RANGE VALUE***
; MESSAGE FLAGS (1):BM
; TYPE-DEPENDENT MESSAGE DATA <MSGDATA>
; *** DATA MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; DATA FLAGS (1):BM
ND.ACK== 1 ; ACKNOWLEDGE REQD
ND.IER== 2 ; INPUT ERROR
ND.EOF== 4 ; SEGMENT IS END OF FILE
; SEGMENT COUNT (1):B
; START OF DATA (COUNTED FIELD)
; *** ATTENTION MESSAGE <MSGDATA>
; LAST GOOD ID (1):B
; ATTENTION CODE (1):B
N.ASTC== 1 ; STATUS CHANGE
N.AACK== 2 ; DATA ACKNOWLEDGEMENT
N.ARQS== 3 ; REQUESTED
N.AABC== 4 ; OUTPUT ABORT RECEIVED OR INPUT ABORT COMPLETE
N.APLE== 5 ; PAGE LIMIT EXCEEDED
; ATTENTION FLAGS, UP TO 3 BYTES (EX):BM
NA.FAT== 1 ; <1>FATAL ERROR
NA.OFL== 2 ; OFFLINE
NA.PAU== 4 ; PAUSED
NA.OMD== 10 ; OUT OF MEDIA
NA.JAM== 20 ; JAMMED
NA.OOF== 40 ; OPERATOR OFFLINE
NA.NOE==100 ; NON OPERATOR ERROR
NA.OUF== 1 ; <2>OUTPUT FULL
NA.NAC== 2 ; DEVICE NOT ACCESSIBLE
NA.DTO== 4 ; DEVICE TIME OUT
NA.RNA== 10 ; RESOURCE NOT AVAILABLE
NA.PF== 20 ; (CR) PICK FAILURE
NA.PSE== 20 ; (LP) PAPER SLEW ERROR
NA.RAP== 40 ; (CR) READ AFTER PUNCH ERROR
NA.INK== 40 ; (LP) OUT OF INK
NA.REG==100 ; (CR) REGISTRATION ERROR
NA.OVP== 1 ; <3>(CR) ILLEGAL OVERPRINT
NA.IVP== 1 ; (LP) INVALID PUNCH ERROR
; PAGE/CARD COUNTER (2):B
; *** FEATURES MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; NUMBER OF FEATURES SPECS IN MSG (1):B
; FEATURES IDENTIFIER (1):B
RADIX 10
FE.DAT== 1 ; (C1) DATA MODE
DM.ASC==1 ; 7 BIT ASCII
DM.CLI==2 ; COLUMNIMAGE
DM.EBC==3 ; EBCDIC
DM.AUG==4 ; AUGMENTED COLUMNIMAGE
DM.AS8==5 ; 8 BIT ASCII
FE.SER== 2 ; (C1) SERIAL NUMBER
FE.LCR== 3 ; (C0) LOWER CASE RAISE
FE.FWD== 4 ; (C1) FORM WIDTH
FE.EOF== 5 ; (C1) EOF RECOGNITION
EO.ASC==1 ; ASCII
EO.IMG==2 ; IMAGE
FE.DVT== 6 ; (C1) DEVICE TYPE
FE.TRN== 7 ; (C0) RECORD TRUNCATION
FE.FNM== 8 ; (C1) FORM NAME
FE.DWD== 9 ; (C1) DEVICE WIDTH
LP.HT== 130 ; (C1) HORIZONTAL TAB STOP
LP.SFC==131 ; (C0) STANDARD VERTICAL FORMS CONTROL
LP.OVP==132 ; (C1) OVERPRINT LIMIT
LP.CVF==133 ; (C1) CUSTOM VFU (DAVFU)
LP.FCC==134 ; (C0) FORTRAN CARRIAGE CONTROL
LP.VFR==135 ; (C1) VARIABLE FORMS RATIO
VF.6LI==1 ; 6 LINES PER INCH
VF.8LI==2 ; 8 LINES PER INCH
LP.CHS==136 ; (C1) CHARACTER SET
CH.64== 1 ; 64 CHARACTER SET
CH.96== 2 ; 96 CHARACTER SET
LP.PLE==137 ; (C1) PAGE LIMIT ENFORCEMENT
LP.OPV==138 ; (C1) OPTICAL VFU NAME
LP.RAM==139 ; (C1) TRANSLATION RAM
LP.CFN==140 ; (C1) CUSTOM VFU NAME
LP.TRN==141 ; (C1) TRANSLATION RAM NAME
CD.CWD==130 ; (C1) CARD WIDTH
FE.ALL==255 ; AFFECTS ALL FEATURES(READ OR SET TO STD.)
RADIX 8
; FEATURES FLAGS (1):BM
NF.CMD== 1 ; 0 = READ, 1 = SET FEATURES.
NF.STD== 2 ; STANDARD FLAG
; FEATURE CLASS (1):B
FC.CL0== 0 ; (C0) CLASS 0 => <BIT> FORM
FC.CL1== 1 ; (C1) CLASS 1 => <CNT><...> FORM
FC.SST== 2 ; SET TO STANDARD
; FEATURE RESPONSE FIELD (1):B
FR.USF== 1 ; UNSUPPORTED FEATURE
FR.BCL== 2 ; BAD CLASS SPEC'D
FR.NST== 3 ; NO STANDARD VALUE
FR.ERR== 4 ; FEATURE DATA OR FORMAT ERROR
FR.CPN== 5 ; CHANGE PENDING
FR.NEB== 6 ; NOT ENOUGH BUFFER (FOR REPORT)
FR.DNP== 7 ; DEVICE NOT PAUSED
; FEATURES DATA (CLASS DEPENDENT)
; *** CONTROL MESSAGE <MSGDATA>
; SEQUENCE NUMBER (1):B
; COMMAND (1):B
NC.AUE== 1 ; (INT) ABORT UNTIL EOF
NC.AUC== 2 ; (INT) ABORT UNTIL CLEARED
NC.CAB== 3 ; CLEAR OUTPUT ABORT/ACK INPUT ABORT
NC.RQS== 4 ; REQUEST STATUS
NC.DMP== 5 ; DUMP OUTPUT BUFFERS
NC.PAU== 6 ; (INT) PAUSE
NC.RES== 7 ; (INT) RESUME
NC.RQC==10 ; REQUEST CAPABILITIES
; RESULT CODE (1):B
NR.ABS== 0 ; (AUE,AUC) ABORT STATE
NR.NAB== 1 ; (AUE,AUC) NOTHING TO ABORT
NR.NOE== 2 ; (AUE) NO EOF DEFINED
NR.ACC== 0 ; (CAB) ABORT COMPLETE CLEARED
NR.ACN== 1 ; (CAB) ABORT COMPLETE NOT SET
NR.ATT== 0 ; (RQS) ATTENTION MSG FOLLOWS
NR.DMP== 0 ; (DMP) OUTPUT BEING DUMPED
NR.NOB== 1 ; (DMP) NO OUTPUT BUFFERED
NR.DPS== 0 ; (PAU) DEVICE WILL PAUSE
NR.PAU== 1 ; (PAU) DEVICE ALREADY PAUSED
NR.NDP== 2 ; (PAU) NO DATA TRANSFER TO PAUSE
NR.RES== 0 ; (RES) DEVICE WILL RESUME
NR.NPS== 1 ; (RES) DEVICE NOT PAUSED
NR.NDR== 2 ; (RES) NO DATA TRANSFER TO RESUME
NR.CAP== 0 ; (RQC) CAPABILITIES FOLLOWS
; *** CAPABILITIES MESSAGE <MSGDATA>
; NUMBER OF CAPABILITY CODES IN LIST (1):B
; LIST OF CAPABILITY CODES ():B
SUBTTL UGTJFN
; UGTJFN SIMULATES A GTJFN FOR A REMOTE DEVICE
; AC1 = GJ%SHT+[GJ%FOU]
; AC2 = PTR TO DEVICE SPEC: "<NODE>::P<DEV>[<UNIT>]:"
; DEFAULT UNIT= 0
;
; CALL: PUSHJ P,UGTJFN
; ERROR RETURN - AC1 = ERROR CODE
; SUCCESS RETURN - AC1 = JFN SUBSTITUTE(ADR OF RDDB FOR DEVICE)
UGTJFN::$CALL MKRDDB ; CREATE DATA BASE & SAVE REGS
$RET ; PROBLEMS
$CALL USETUP ; NOW DO SETUPS
MOVE J2,RDSAVE+J2(R) ; GET DEVICE PTR AGAIN
$CALL MAPDEV ; MAP DEVICE SPEC INTO NSP FORMAT
JRST UGTR3 ; J1 = ERROR CODE
; ESTABLISH CONTROL LINK TO NRM
$CALL GNRMSP ; GENERATE DEV SPEC FOR NRM
MOVE J2,A ; GET PTR TO SPEC
MOVX J1,GJ%SHT ; GET NRM JFN
GTJFN ; ...
ERJMP [ MOVE P,-1(A) ; RESTORE STACK PTR
JRST UGTR3] ; ERROR CODE IS IN J1
MOVE P,-1(A) ; FLUSH NRM SPEC FROM PDL
MOVEI T1,NRM.CP ; SET CONNECT PENDING
IORM T1,NRMSTS(R) ; ...
HRRZM J1,NRMJFN(R) ; SAVE NRM JFN
HRRZS J1 ; NOW TO CONNECT TO NRM
MOVX J2,10B5+OF%RD+OF%WR+OF%NWT+OF%PLN ; ...
OPENF ; ...
ERJMP UGTR2 ; ? NO NRM
$CALL CONWAT ; WAIT FOR CONNECT COMPLETE
JRST [ MOVEM J3,NRMCFL(R) ; ? FAILED - SAVE STATUS
ERRI OPNX21,UGTR2] ; CONNECT REFUSED
MOVX T1,NRM.CP!NRM.CC ; CLEAR CONNECT PENDING,
XORM T1,NRMSTS(R) ; & SET CONNECT COMPLETE
HRRZ T1,R ; USE UPPER 16 BITS
LSH T1,-2 ; OF RDDB ADR AS
MOVEM T1,NRMID(R) ; CONTROL ID
$CALL DEVRSR ; RESERVE THE DEVICE
JRST UGTR2 ; NOT AVAILABLE
MOVEI T1,NRM.RS ; SET DEVICE RESERVED
IORM T1,NRMSTS(R) ; ...
MOVE J1,NRMJFN(R) ; DETERMINE MAXIMUM BUFFER
MOVEI J2,.MORSS ; SIZE OF REMOTE NODE
MTOPR ; ...
CAILE J3,NRDBSZ ; WE WILL USE THE SMALLER OF
MOVEI J3,NRDBSZ ; REMOTE'S BUFFER SIZE
MOVEM J3,NRDLIM(R) ; OR OURS.
; ESTABLISH DATA LINK TO NRD
$CALL GNRDSP ; GENERATE DEV SPEC FOR NRD
MOVE J2,A ; COPY THE POINTER TO SPEC
MOVX J1,GJ%SHT ; GET NRD JFN
GTJFN ; ...
ERJMP [ MOVE P,-1(A)
JRST UGTR2]
MOVE P,-1(A) ; FLUSH NRD SPEC FROM PDL
TXO LS,NRD.CP ; SET CONNECT PENDING
HRRZM J1,NRDJFN(R) ; SAVE NRD JFN
HRRZS J1 ; CONNECT TO NRD
MOVX J2,10B5+OF%RD+OF%WR+OF%NWT+OF%PLN ; ...
OPENF ; ...
ERRJ BOTX05,UGTR1 ; ? NO NURD
$CALL CONWAT ; WAIT FOR CONNECT COMPLETE
JRST [ MOVEM J3,NRDCFL(R) ; ? FAILED - SAVE STATUS
ERRI OPNX21,UGTR1] ; CONNECT REFUSED
TXC LS,NRD.CP!NRD.CC ; CLEAR CONNECT PENDING &
; SET CONNECT COMPLETE
; GET THE BULA SUPPLIED IN OPTIONAL DATA OF CONNECT CONFIRM
MOVE J1,NRDJFN(R)
MOVEI J2,.MORDA
MOVSI J3,(POINT 8)
HRRI J3,NRDRBF(R) ; RESULT STRING PTR
MTOPR
CAIGE J4,1 ; CHECK THE AMT RETURNED
NRDR ,0,UGTR1 ; NONE ?
LDB T1,[POINT 8,NRDRBF(R),7] ; 1ST BYTE = BULA
MOVEM T1,NRDULA(R)
MOVEM R,RDSAVE+J1(R) ; DONE WITH UGTJFN, SO RETURN
JRST SUCRTN ; JFN SUBSTITUTE IN CALLER J1
; NRD AND NRM JFNS ASSIGNED - FLUSH BOTH
UGTR1: $CALL FLSNRD ; FLUSH NRD JFN
; NRM JFN ASSIGNED - FLUSH IT
UGTR2: $CALL FLSNRM ; FLUSH THE NRM JFN
; NO JFN'S ASSIGNED
UGTR3:: SETZB LS,NRDSTS(R) ; A CLEAN SLATE
SETZB DS,NRDDST(R) ; ...
MOVEI T1,UJ.FLS ; SET THE "FLUSH" FLAG
IORM T1,RDSTS(R) ; ...
JRST ERRTN ; ERROR RETURN TO THE USER
FLSNRD: SKIPA T1,NRDJFN(R) ; DISCONNECT NRD CONTROL LINK
FLSNRM: MOVE T1,NRMJFN(R) ; DISCONNECT NRM CONTROL LINK
$CALL SAV1J ; PRESERVE J1
MOVE J1,T1 ; SET TO DO CLOSE
CLOSF ; CLOSE THE LINK
MOVE J1,T1 ; ??
RLJFN ; RELEASE THE JFN
$RET ; ??
$RET ; ALL DONE
; WAIT FOR CONNECT EVENT FOR JFN IN J1
CONWAT: MOVEI J2,NRDTMO ; BOUND OUR WAIT TIME
MOVEM J2,NRDTMC(R) ; ...
CONW1: MOVEI J2,.MORLS ; READ LINK STATUS
MTOPR ; ...
NRDRC ,0,CPOPJ ; ? OOPS
TXNE J3,MO%CON ; J3 = LINK STATUS
PJRST CPOPJ1 ; CONNECTED
TXNE J3,MO%WFC+MO%WCC ; WAITING FOR ONE ?
SOSGE NRDTMC(R) ; YES, MORE TIME LEFT ?
$RET ; NOPE - SOMETHING WRONG, RET STATUS
PUSH P,J1 ; WAIT HAF A SECOND
MOVEI J1,^D500 ; ...
DISMS ; ...
POP P,J1 ; ...
JRST CONW1 ; CHECK IT AGAIN
; GET SPACE FOR A REMOTE DEVICE DATA BASE AND INIT IT
MKRDDB: PUSH P,J2 ; SAVE COUPLE OF REGS
PUSH P,J1 ; ...
; THE FOLLOWING CODE ENSURES THAT THE PAGE CONTAINING "SUBJFN" IS COPIED
; INTO EACH FORK WHERE NURD20 RUNS.
MOVEI J1,SUBJFN ; FORM PAGE NUMBER
ADR2PG J1 ; ...
HRLI J1,.FHSLF ; FORK IS THE CURRENT ONE
MOVX J2,PA%RD+PA%WT+PA%EX+PA%CPY ; SET ACCESS ATTRIBUTES
SPACS
ERJMP [ MOVEI J1,.FHSLF ; GET ERROR CODE
GETER ; ...
MOVE J1,J2 ; PUT CODE INTO J1
POP P,J2 ; THROW AWAY SAVED J1
POP P,J2 ; RESTORE J2
$RET] ; LEAVE
MOVEI J1,RDDBSZ ; RDDB BLOCK SIZE
$CALL M%GMEM ; GET DATABASE MEMORY
MOVEM 16,RDSAVE+16(J2) ; STASH USER AC'S IN SAVE AREA
MOVEI 16,RDSAVE(J2) ; ...
BLT 16,RDSAVE+15(J2) ; ...
POP P,RDSAVE+J1(J2) ; COMPLETE USER AC SAVING OPERATION
POP P,RDSAVE+J2(J2) ; ...
MOVX J1,1B<.ICDAE> ; SET DEFAULT SOFT INTERRUPT CHANNEL
MOVEM J1,NRDCHN(J2) ; ...
MOVE R,J2 ; R = PTR TO NEW RDDB
MOVEM R,SUBJFN ; PRESERVE THE RDDB PTR FOR THIS FORK
PJRST CPOPJ1 ; THUS CAUSING THE PAGE TO BE COPIED
SUBTTL UOPENF
; UOPENF SIMULATES AN OPENF FOR A REMOTE DEVICE
; USER MUST HAVE PREVIOUSLY USED UGTJFN TO MAKE THINGS WORK
;
; AC1 = JFN SUBSTITUTE
; AC2 = FLAGS
; OF%BSZ - 6 BIT BYTE SIZE FIELD
; 7,8,12,16 SUPPORTED
; OF%MOD - 4 BIT DATA MODE FIELD
; 0=> ASCII
; 8=> IMAGE
; OF%RD - READ ACCESS
; OF%WR - WRITE ACCESS
; OF%OFL - OPEN DEVICE EVEN IF OFFLINE
;
; LEGAL DATA MODE/BYTE SIZE COMBINATIONS
; SIZE MODE CODE MODE
; 7 0 ASCII
; 8 0 ASCII
; 12 8 COLUMN IMAGE
; 16 8 AUGMENTED COLUMN IMAGE
UOPENF::$CALL SETUP2 ; SETUP FOR SKIP RETURN JSYS
JRST ERRTN ; JFN NOT ASSIGNED
LDB T1,[POINT 6,J2,5] ; GET BYTE SIZE
LDB T2,[POINT 4,J2,9] ; AND DATA MODE
JUMPE T2,[ CAIE T1,7 ; ASCII MODE - CHECK BYTE SIZE
CAIN T1,10 ; ...
SKIPA ; TIS TRULY LEGAL SIZE
ERR SFBSX2,ERRTN ; OOPS !
TXNN LS,NRD.LP ; FOR LPT ?
JRST UOPNC ; NO, CDR THEN
TXNE J2,OF%RD ; MUST WRITE TO LPT
ERR OPNX13,ERRTN ; TUT,TUT - TRYING TO READ
TXNE J2,OF%WR ; BETTER SAY WRITE
JRST UOPNX ; AWRIGHT !
ERRI OPNX4,ERRTN] ; A BUMMER
CAIN T2,^D8 ; THE ONLY OTHER LEGAL MODE IS 8
TXNE LS,NRD.LP ; AND ONLY FOR CDR
ERR OPNX14,ERRTN ; INVALID MODE
CAIN T1,^D12 ; IMAGE MODE - CHECK BYTE SIZE
JRST UOPN1 ; COLUMN IMAGE
CAIE T1,^D16 ; AUG COL IMAGE ?
ERR SFBSX2,ERRTN ; NO, SO BYTE SIZE ERROR
TXOA LS,NRD.AI ; AUGMENTED COLUMN IMAGE MODE
UOPN1: TXO LS,NRD.IM ; COLUMN IMAGE MODE
UOPNC: TXNE J2,OF%WR ; TRYING TO WRITE TO CDR ?
ERR OPNX13,ERRTN ; DUMMY !
TXNN J2,OF%RD ; WE ARE SUPPOSED TO READ FROM IT
ERR OPNX3,ERRTN ; ! READ I SAID
UOPNX: TXO LS,NRD.OP ; OPEN DEVICE NOW
$CALL OPNDEV ; SEND ACCESS-OPEN TO NRM
JRST ERRTN
TXC LS,NRD.OP!NRD.OC ; FLUSH DEV OPEN PENDING
; AND SET DEVICE OPENED
SETZM NRDRCN(R) ; INIT FOR IO
SETZM NRDSCN(R) ; INIT FOR IO
SETOM NRDLPC(R) ; SET PAGE COUNT AS FLAG THAT
; NO STATUS HAS BEEN RECEIVED
$CALL SNDRQS ; REQUEST STATUS
$CALL RCVRQS ; AND WAIT FOR IT
NRDR ,,ERRTN ; DATA MSG BLOCKING STATUS RSP
$CALL SETMOD ; SET DATA MODE
TXNE LS,NRD.LP
TXO DS,MO%LVU ; ** don't do following literal stuff
; $CALL [ TXO DS,MO%LVU ; ONLY OPTICAL VFU AVAIL
; PJRST SETLCR] ; INIT THE LPT AS UPPER CASE
$CALL RDFTRS ; READ DEVICE FEATURES
NRDR ,,ERRTN ; DATA MSG BLOCKING ??
JRST SUCRTN ; ALL DONE !!
SUBTTL USOUT
; USOUT SIMULATES A SOUT FOR A REMOTE DEVICE(LPT)
;
; AC1 = JFN SUBSTITUTE
; AC2 = PTR TO STRING
; AC3 = COUNT
; AC4 = TERMINATION CHAR IF COUNT>0
;
; STRING TERMINATION CONVENTION:
; COUNT > 0=> TERMINATE ON COUNT OR CHAR= (AC4)
; COUNT= 0=> TERMINATE ON CHAR= 0
; COUNT < 0=> TERMINATE ON COUNT
;
; DATA MESSAGE FORMAT:
; <0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
; SEGMENT FORMENT:
; <CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>
USOUT:: $CALL SETUP1 ; NON-SKIP JSYS
JRST ERRTN ; NO SUCH JFN
TXNE LS,NRD.CC ; CHECK LINK STILL CONNECTED
TXNN LS,NRD.OC ; CHECK DEVICE OPENED
ERR DESX5,ERRTN ; "FILE" NOT OPEN
TXNN LS,NRD.LP ; CHECK THAT DEVICE IS AN LPT
ERR IOX2,ERRTN ; "FILE" NOT OPEN FOR WRITING
TLC J2,-1 ; GENERIC POINTER ?
TLCN J2,-1 ; BACK TO ORIG, SKIP IF WAS NONZERO
HRLI J2,(POINT 7) ; IT WAS GENERIC - MAKE IT SPECIFIC
$CALL EFADBY ; DO BYTE POINTER EFFECTIVE ADDR CALC
SKIPA ; J2 IS NOW A PROPER PTR
USO0: $CALL USYCLE ; START NEW BUFFER
USO1: $CALL RCVNRM ; CHECK FOR ASYNCHRONOUS NRM MESSAGES
NRDR ,,ERRTN ; NRM ERROR
JUMPN A,USO1 ; READ ALL OF THEM
USO2: $CALL RCVMSG ; CHECK FOR INCOMING MSGS 1ST
NRDR ,,ERRTN ; READ ERROR
JUMPE A,[NRDR .,0,ERRTN] ; DATA MSG SHOULDN'T BE HERE!!
JUMPG A,USO2 ; PROCESS EVERYTHING ELSE IN SIGHT
TXNE LS,NRD.OF ; CHECK FOR OFFLINE
$CALL [ MOVX T1,NRD.ON ; WE ARE OFF, BUT
TDNE T1,NRDSTS(R) ; ALREADY BACK ?
PJRST SNDRES ; YES, SO TELL DN200 TO RESUME
ERRI GJFX28,ERRTN] ; DEVICE WENT OFFLINE
TXNE DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%LPC
ERR IOX5,ERRTN ; DEVICE ERROR
TXNE LS,NRD.PS ; NO ERRORS - PAUSED ?
$CALL SNDRES ; YES - TRY TO RESUME
$CALL SBFINI ; INIT MSG BUF
MOVE D,NRDLIM(R) ; GET MAX MSG SIZE
SETZB T1,T2 ; INIT NRD DATA MSG
IDPB T1,NRDSPT(R) ; NURD MSG TYPE
IDPB T1,NRDSPT(R) ; NURD MSG FLAGS
AOS T1,NRDSEQ(R)
IDPB T1,NRDSPT(R) ; MSG SEQUENCE NO.
IDPB T2,NRDSPT(R) ; DATA MSG FLAGS
IDPB T2,NRDSPT(R) ; MSG SEGMENT COUNT
MOVE T1,NRDSPT(R)
MOVEM T1,NRDSGC(R) ; SAV PTR TO SEG CNT
SUBI D,5 ; SUB MSG OVERHEAD FROM CNT
USO3: CAIG D,2 ; MAKE SURE THERE IS ROOM FOR A SEGMENT
JRST USO0 ; CYCLE THE MSG BUFFER
SETZ C, ; BEGIN NEW SEGMENT
IDPB C,NRDSPT(R) ; SEGMENT HEAD
MOVE T1,NRDSPT(R)
MOVEM T1,NRDSEG(R) ; SAV PTR TO SEGMENT HEAD
LDB T1,NRDSGC(R) ; COUNT THE SEGMENT IN MSG
AOS T1
DPB T1,NRDSGC(R)
SOJA D,USO5 ; COUNT SEGMENT HEAD IN BUFFER
USO4: CAIL C,^D127 ; CHECK SEGMENT SIZE LIMIT
JRST USO3 ; BEGIN NEW SEGMENT
USO5: ILDB T1,J2 ; STUFF THE SEGMENT FROM STRING
IDPB T1,NRDSPT(R) ; STRING CHARACTER
AOS C
DPB C,NRDSEG(R) ; COUNT THE CHAR IN SEGMENT
JUMPL J3,[ AOJL J3,USO7 ; TERMINATE BY COUNT
JRST USO9] ; ...
JUMPG J3,[ SOJE J3,USO8 ; TERMINATE BY COUNT
CAME J4,T1 ; OR BY CHARACTER
JRST USO7 ; NOPE
JRST USO8] ; STOP NOW
JUMPE T1,USO8 ; TERMINATE BY CHAR= 0
USO7: SOJG D,USO4 ; COUNT CHAR IN BUFFER
JRST USO0 ; CYCLE BUFFER & BEGIN NEW NURD MSG
USO8: MOVNI T1,1 ; SOURCE TERMINATED BY BYTE
ADJBP T1,J2 ; BACK UP PTR
MOVE J2,T1
USO9: $CALL USYCLE ; SOURCE DONE - FLUSH OUT BUFFER
JRST SUCRTN
USYCLE: $CALL SAV4J ; SAVE J1-J4
MOVE J1,NRDJFN(R) ; SET THE OUTPUT JFN
$CALL SNDBUF ; SEND THE STUFF
JRST [ DMOVEM J2,RDSAVE+J2(R) ; SET RETURN J2 & J3, BECAUSE
JRST ERRTN] ; SOUTR ABORT
DMOVEM J2,RDSAVE+J2(R) ; SET RETURN VALUE OF J2,J3
SKIPE DEBUGF
$CALL TYBUF
TXO DS,MO%IOP ; SET IO IN PROGRESS FOR LPT
$RET
SUBTTL USIN
; USIN SIMULATES A SIN FOR A REMOTE DEVICE(CDR)
;
; AC1 = JFN SUBSTITUTE
; AC2 = PTR TO STRING
; AC3 = COUNT
; AC4 = TERMINATION CHAR IF COUNT>0
;
; STRING TERMINATION CONVENTION:
; COUNT > 0=> TERMINATE ON COUNT OR CHAR= (AC4)
; COUNT= 0=> TERMINATE ON CHAR= 0
; COUNT < 0=> TERMINATE ON COUNT
;
; DATA MESSAGE FORMAT:
; <0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
; SEGMENT FORMENT:
; <CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>
USIN:: $CALL SETUP1 ; NON-SKIP JSYS
JRST ERRTN ; BAD JFN
TXNE LS,NRD.CC ; CHECK LINK STILL CONNECTED
TXNN LS,NRD.OC ; CHECK DEVICE OPENED
ERR DESX5,ERRTN ; "FILE" NOT OPEN
TXNE LS,NRD.LP ; CHECK THAT DEVICE IS A CDR
ERR IOX3,ERRTN ; "FILE" NOT OPEN FOR READING
$CALL INTOFF
TXZ LS,NRD.FE!NRD.TO!NRD.OF!NRD.PL
MOVEM LS,NRDSTS(R) ; UPDATE LINK STATUS
TXZ DS,MO%FER!MO%HE!MO%SER!MO%RCK!MO%PCK!MO%SFL!MO%HEM!MO%LCI!MO%LPC!MO%EOF
MOVEM DS,NRDDST(R) ; UPDATE DEVICE STATUS
$CALL INTON
TLC J2,-1 ; GENERIC POINTER ?
TLCE J2,-1 ; BACK TO ORIG, SKIP IF WAS ZERO
JRST SIN0 ; IT'S ALRIGHT LIKE IT IS
TXNN LS,NRD.IM!NRD.AI ; CHECK IMAGE MODES
JRST [ HRLI J2,(POINT 7) ; ASCII
JRST SIN0] ; ...
TXNN LS,NRD.AI
JRST [ HRLI J2,(POINT 12) ; COLUMN IMAGE MODE
JRST SIN0] ; ...
HRLI J2,(POINT 16) ; AUGMENTED COLUMN IMAGE MODE
SIN0: $CALL EFADBY ; DO BYTE POINTER EFFECTIVE ADDR CALC
SKIPE D,NRDRCN(R) ; CHECK FOR CURRENT BUFFER
JRST USIN1 ; BUFFER IN PROGRESS
SIN1: TXNE LS,NRD.OF ; CHECK FOR OFFLINENESS
JRST [ TXNE LS,NRD.EO ; BUT DO WE HAVE EOF TOO ?
JRST USIEF1 ; YEP, SO JUST EOF
MOVX T1,NRD.ON ; SEE IF ALREADY BACK
TDNN T1,NRDSTS(R) ; ...
ERR GJFX28,USINER ; DEVICE IS REALLY OFFLINE
$CALL SNDRES ; TRY TO RERSUME IT
JRST .+1] ; THEN GO ON
TXNE DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%SFL!MO%PCK!MO%RCK
ERR IOX5,USINER ; DEVICE ERROR
TXNE LS,NRD.PS ; NO ERRORS - PAUSED ?
$CALL SNDRES ; YES - TRY TO RESUME
SIN2: $CALL RCVNRM ; CHECK FOR NRM ASYNCHRONOUS MESSAGES
NRDR ,,USINER ; NRM ERROR
JUMPN A,SIN2 ; GOT 1 - READ ALL OF THEM
$CALL RCVMSG ; READ A MSG
JRST USINER ; READ ERROR
JUMPL A,[ MOVEI J1,^D250 ; NOTHING - TRY AGAIN LATER
DISMS ; ZZZ
JRST SIN1] ; ...
JUMPG A,SIN1 ; SOMETHING BESIDES DATA
MOVNI D,5 ; DATA MSG IN NRDRBF
ADDB D,NRDRCN(R) ; GET BUFFER COUNT
JUMPL D,[NRDR .,0,USINER] ; INSUFF DATA FOR NURD MSG
IBP NRDRPT(R) ; ADVANCE PAST NURD MSG FLAGS
ILDB T1,NRDRPT(R) ; MSG SEQUENCE NO.
MOVEM T1,NRDSEQ(R)
ILDB T2,NRDRPT(R) ; DATA FLAGS
ILDB T1,NRDRPT(R) ; GET NO. SEGMENTS
MOVEM T1,NRDSGS(R)
SETZM NRDSGN(R) ; INIT CURRENT SEG CNT
TXNN T2,ND.EOF ; EOF ?
JRST SIN3
TXO LS,NRD.EO
TXO DS,MO%EOF
TXNN LS,NRD.AI!NRD.IM ; CHECK ASCII OR IMAGE
JRST USIEOF ; ASCII EOF MSG GETS SPECIAL TREATMENT
TXZ T2,ND.IER ; IMAGE - IGNORE DATA ERRORS
SIN3: TXNE T2,ND.IER ; DATA ERROR DETECTED
TXOA LS,NRD.ER ; YES
TXZA LS,NRD.ER
TXOA DS,MO%RCK
TXZA DS,MO%RCK
ERR IOX5,USINR1 ; DATA ERROR - USER CAN READ THIS
; CARD BY REISSUING ANOTHER USIN
USIN1: MOVE C,NRDSGN(R) ; GET CURRENT SEGMENT BYTE CNT
JUMPL C,USIN4 ; MORE LEFT IN COMPRESSION SEQUENCE
JUMPG C,USIN6 ; MORE LEFT IN NORMAL SEQUENCE
USIN2: SOSGE NRDSGS(R) ; COUNT SEGMENTS
JRST SIN1 ; MSG DONE
SOJL D,[NRDR .,0,USINER] ; INSUFF DATA FOR SEG HEADER
ILDB T1,NRDRPT(R) ; GET NEXT SEGMENT HEAD
TXZN T1,200 ; CHECK FOR COMPRESSION SEQUENCE
SKIPA C,T1 ; NORMAL
MOVN C,T1 ; COMPRESSION SEQUENCE
JUMPE C,SIN1 ; EOR=> MSG DONE
JUMPG C,USIN6 ; BEGIN NEW NORMAL SEQUENCE
; BEGIN NEW COMPRESSION SEQUENCE
SOJL D,[NRDR .,0,USINER] ; INSUFF DATA FOR LOW DATA BYTE
ILDB T1,NRDRPT(R) ; GET REPEATED DATA ITEM
TXNN LS,NRD.IM!NRD.AI ; CHECK SIZE OF DATA ITEM
JRST USIN3 ; ASCII MODE
SOJL D,[NRDR .,0,USINER] ; INSUFF DATA FOR HIGH BYTE
ILDB T2,NRDRPT(R) ; GET HIGH PART
DPB T2,[POINT 8,T1,27]
USIN3: MOVEM T1,NRDREP(R) ; SAVE REPEAT ITEM
USIN4: MOVE T1,NRDREP(R) ; GET REPEAT ITEM
IDPB T1,J2 ; STUFF THE ITEM
JUMPL J3,[ AOJL J3,USIN5 ; TERMINATE ON COUNT
AOJA C,USINX] ; DEST SURFEITED
JUMPG J3,[ SOSE J3 ; STOP ON COUNT OR BYTE= (AC4)
CAMN T1,J4 ; ...
AOJA C,USINX ; FULL
USIN5: AOJL C,USIN4 ; MORE - COUNT ITEM IN SEGMENT
JRST USIN2] ; NEED NEW SEGMENT
JUMPN T1,USIN5 ; MORE
AOJA C,USIN9 ; SATISFIED
USIN6: SOJL D,[NRDR .,0,USINER] ; INSUFF DATA FOR LOW DATA BYTE
ILDB T1,NRDRPT(R) ; GET NEXT DATA ITEM
TXNN LS,NRD.IM!NRD.AI ; CHECK SIZE OF DATA ITEM
JRST USIN7 ; ASCII
SOJL D,[NRDR .,0,USINER] ; INSUFF DATA FOR HIGH BYTE
ILDB T2,NRDRPT(R) ; GET HIGH PART
DPB T2,[POINT 8,T1,27]
USIN7: IDPB T1,J2 ; STUFF THE DATA ITEM
JUMPL J3,[ AOJL J3,USIN8 ; TERMINATED BY COUNT
SOJA C,USINX] ; STUFFED
JUMPG J3,[ SOSE J3 ; STOP BY COUNT OR BYTE=(AC4)
CAMN T1,J4
SOJA C,USINX ; SATIATED
USIN8: SOJG C,USIN6 ; COUNT DATA ITEM IN SEGMENT
JRST USIN2] ; NEED NEW SEGMENT
JUMPN T1,USIN8 ; TERMINATED BY BYTE= 0
SUBI C,1 ; FULL
USIN9: MOVNI A,1 ; TERMINATED ON ZERO BYTE - BACK UP PTR
ADJBP A,J2
MOVE J2,A
; END OF DEST BUFFER
USINX: MOVEM C,NRDSGN(R) ; DESTINATION STRING TERMINATED
MOVEM D,NRDRCN(R) ; SAVE CURRENT MSG STATUS
DMOVEM J2,RDSAVE+J2(R) ; SET RETURN VALUE OF J2,J3
TXNN LS,NRD.EO ; IF EOF SET (IMAGE EOF) FALL THRU
JRST SUCRTN
; EOF - FLUSH MESSAGE, SET EOF CONDITION
USIEOF: $CALL RCVRQ ; WAIT FOR ATTENTION MSG WHICH FOLLOWS
NRDR ; READ ERROR OR DATA BLOCKING
USIEF1: TXZ LS,NRD.ER!NRD.FE!NRD.TO ; IGNORE HARD ERRORS
TXZ DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%SFL!MO%PCK!MO%RCK
ERR IOX4 ; OK TO PROCEED NOW
SETZM NRDRCN(R) ; MESSAGE FAULT EXIT- FLUSH MSG
TXNE LS,NRD.AI!NRD.IM ; CHECK ASCII OR IMAGE
JRST ERRTN ; LET USER KNOW ABOUT IT
USINER: SETZM NRDRCN(R) ; MESSAGE FAULT EXIT- FLUSH MSG
USINR1: DMOVEM J2,RDSAVE+J2(R) ; SET RETURN VALUE OF J2,J3
JRST ERRTN
SUBTTL UMTOPR
; UMTOPR SIMULATES MTOPR JSYS FOR REMOTE DEIVCES
;
; AC1 = JFN SUBSTITUTE
; AC2 = FUNCTION CODE
; AC3 = ARG OR PTR TO ARG BLOCK
UMTOPR::$CALL SETUP1 ; NON-SKIP JSYS
JRST ERRTN ; BAD JFN
TXNE LS,NRD.CC ; CHECK LINK STILL CONNECTED
TXNN LS,NRD.OC ; MAKE SURE DEVICE IS OPENED
ERR DESX5,ERRTN ; "FILE" NOT OPENED
TXNE LS,NRD.LP ; LPT ?
JRST [ SKIPE NRDSCN(R) ; YES, SO FLUSH OUTPUT
$CALL SNDNRD ; ...
MOVE T1,[-LTOPRL,,LTOPR]
JRST UMT1]
MOVE T1,[-CTOPRL,,CTOPR] ; CDR
UMT1: HLRZ T2,(T1) ; SCAN DEV TABLE FOR FUNCTION
CAMN T2,J2
JRST [ HRRZ T1,(T1) ; DISPATCH TO FUNC PROCESSOR
JRST (T1)] ; ...
AOBJN T1,UMT1 ; CHECK ALL POSSIBILITIES
ERRI MTOX1,ERRTN ; INVALID FUNCTION
; LPT MTOPR FUNCTIONS
LTOPR: .MOPSI,,LMOPSI ; ENABLE SOFTWARE INTERRUPTS
.MONOP,,LMONOP ; IO WAIT
.MOLVF,,LMOLVF ; LOAD VFU
.MORVF,,LMORVF ; READ VFU NAME
.MOLTR,,LMOLTR ; LOAD TRANSLATION RAM
.MORTR,,LMORTR ; READ NAME OF TRANSLATION RAM
.MOSTS,,LMOSTS ; SET LPT STATUS
.MORST,,LMORST ; READ LPT STATUS
.MOFLO,,LMOFLO ; ABORT LPT OUTPUT
LTOPRL==.-LTOPR
; CDR MTOPR FUNCTIONS
CTOPR: .MOPSI,,CMOPSI ; ENABLE SOFTWARE INTERRUPTS
.MORST,,CMORST ; READ CDR STATUS
CTOPRL==.-CTOPR
; ENABLE INTERRUPTS FOR DEVICE CHANGES:
; DEVICE ONLINE STATE OR PAGE COUNTER OVERFLOW
LMOPSI:
CMOPSI: MOVE T2,J3 ; GET ARG BLOCK PTR
$CALL EFADR ; FIND IT
MOVN T2,1(T1) ; GET CHANNEL NUMBER - IGNORE FLAGS
MOVX T1,1B0 ; ...
ROT T1,(T2) ; ...
MOVEM T1,NRDCHN(R) ; SET CHANNEL ENABLE MASK
MOVEI T1,NRD.EN ; SET INTERRUPT ENABLED FLAG
IORM T1,NRDSTS(R) ; ...
TXO LS,NRD.EN ; BOTH PLACES
JRST SUCRTN ; THAT'S ALL FOLKS
; READ LPT STATUS
LMORST: MOVE T1,NRDSEQ(R) ; CHECK AGE OF CURRENT STATUS
XOR T1,NRDASQ(R) ; ...
TXNE T1,377 ; SKIP IF ATT MSG WAS FOR LAST DATA MSG
TXNE LS,NRD.PS ; NO USE IF PAUSED
JRST LMORS1 ; CURRENT STATUS WILL SUFFICE
$CALL SNDRQS ; REQUEST STATUS
$CALL RCVRQS ; WAIT FOR IT
NRDR ,,ERRTN ; DATA MSG BLOCKING STATUS RSP
; MO%LCP IS AUTOMATICALLY MAINTAINED IN FEATURE MSG PROCESSING BASED ON
; CURRENT VALUE OF FE.LCR AS THE STATUS OF THIS FEATURE WILL DETERMINE
; WHETHER LOWER CASE CHARACTERS WILL PRINT. UOPENF INITS THE LPT BY SETTING
; FE.LCR=1=> MO%LCP=0.
; LMOSTS CAN ATTEMPT TO SET FE.LCR=0 AND MO%LCP WILL BE SET ONLY IF THAT
; SUCCEEDS.
LMORS1:
; CDR CAN'T SEND STATUS BECAUSE OF POSSIBLE DEADLOCK IN RETURN DATA STREAM
CMORST: MOVE T2,J3 ; RETURN UPDATED STATUS TO USER
$CALL EFADR ; FIND IT
PUSH P,T1
$CALL SETDST ; UPDATE DEVICE STATUS
POP P,T2
PUSH T2,DS ; STORE DEVICE STATUS
MOVE T1,-1(T2) ; CHECK BLOCK LENGTH
CAILE T1,2
PUSH T2,NRDLPC(R) ; WANTS PAGE COUNT ALSO
JRST SUCRTN
LMONOP: $CALL LPTIOW ; IO WAIT FOR LPTSO WAIT
NRDR ,,ERRTN ; DATA MSG BLOCKING DUMP RSP
JRST SUCRTN ; THEN GO AWAY
; IO WAIT FUNCTION FOR LPT
LPTIOW: $CALL SNDDMP ; DUMP OUTPUT BUFFERS
$CALL RCVCRS ; GET THE RESPONSE
$RET ; DUMP RESPONSE IS BLOCKED BY DATA MSG
CAIN A,NR.NOB ; A = RESULT RETURNED BY DUMP MSG
PJRST CPOPJ1 ; NO OUTPUT BUFFERED - DONE
MOVEI J1,^D1000 ; WAIT A SEC
DISMS
JRST LPTIOW ; TRY AGAIN
LMORVF: ; READ THE VFU NAME
LMORTR: ; READ THE TRANSLATION RAM NAME
ERRI DESX9,ERRTN ; INVALID OPERATION FOR DEVICE
; Load VFU / Translation RAM
LMOLTR: TDZA J1,J1 ;[RAM] Indicate load RAM entry
LMOLVF: SETOM J1 ;[RAM] Indicate load VFU entry
MOVE T2,J3 ;[VFU] Get arg block pointer
$CALL EFADR ;[VFU] Find the users arg block
MOVE D,1(T1) ;[VFU] Save the JFN for a second
STKVAR <ENTYPE> ;[RAM] Allocate temp storage
MOVEM J1,ENTYPE ;[RAM] Save the entry type
JUMPE J1,[TXNN DS,MO%LVU ;[VFU] VFU load - Does it have a DAVFU ?
JRST LMOL.0 ;[VFU] Yes,,leterrip !!!
PUSHJ P,LMOREL ;[VFU] No,,close the users JFN
ERR MTOX15,ERRTN ] ;[VFU] and return the error
TXNN DS,MO%RAM ;[RAM] RAM load - Does it have a RAM ???
JRST [PUSHJ P,LMOREL ;[RAM] No,,close the users JFN
ERR DESX9,ERRTN ] ;[RAM] and return the error
;Open the JFN for read
LMOL.0: MOVE J1,D ;[VFU] Get the DAVFU JFN
MOVX J2,<FLD(^D8,OF%BSZ)+OF%RD> ;[VFU] Assume 8 bit bytes + read
SKIPN ENTYPE ;[RAM] Unless loading the RAM
MOVX J2,<FLD(^D18,OF%BSZ)+OF%RD> ;[RAM] Assume 18 bit bytes + read
OPENF ;[VFU] Open the file
JRST [PUSH P,J1 ;[VFU] Failed,,save the error
PUSHJ P,LMOREL ;[VFU] Close and RLJFN the file
POP P,J1 ;[VFU] Get the error back
JRST ERRTN ] ;[VFU] Return an error
;Read the DAVFU or translation RAM in
MOVE J1,D ;[VFU] Get the JFN back
MOVEI J2,NRDLTR(R) ;[RAM] Get the input buffer address
SKIPE ENTYPE ;[VFU] Loading VFU ???
JRST [HRLI J2,(POINT 8,0) ;[VFU] Yes,,Make it a byte pointer
MOVEI J3,<^D144*2>+2+1 ;[VFU] 144*2 8 bit bytes+2 ctrl bytes
MOVEI J4,357 ;[VFU] Stop on 'END VFU' control byte
JRST .+1 ] ;[VFU] Continue
SKIPN ENTYPE ;[RAM] Loading Translation RAM ???
JRST [HRLI J2,(POINT 16,0) ;[RAM] Yes,,Make it a byte pointer
HRROI J3,-^D256 ;[RAM] 256 Translation RAM bytes
JRST .+1 ] ;[VFU] Continue
SIN ;[VFU] Read the VFU / Translation RAM
ERJMP [MOVX J1,.FHSLF ;[VFU] Get the reason the SIN failed
GETER ;[VFU] Ask monitor
PUSH P,J2 ;[VFU] Save the error
PUSHJ P,LMOREL ;[VFU] Close and RLJFN the file
POP P,J1 ;[VFU] Restore the error
JRST ERRTN ] ;[VFU] Return an error
PUSHJ P,LMOREL ;[VFU] Close and RLJFN the DAVFU file
SKIPN ENTYPE ;[VFU] Loading VFU ???
JRST LMOL.1 ;[VFU] No,,skip this VFU only check
MOVEI J1,NRDLTR(R) ;[VFU] Get the buffer address
TLO J1,(POINT 8,0,15) ;[VFU] Gen pointer to second byte
LDB J1,J1 ;[VFU] Get second byte of VFU file
CAXE J1,354 ;[VFU] Is it a valid start byte ???
CAXN J1,355 ;[VFU] Check for 6 & 8 LPI
SKIPA ;[VFU] Win,,continue
CAXN J1,356 ;[VFU] No,,must be hardware switched
SKIPN D,J3 ;[VFU] Chk and load remaining byte count
ERR IOX5,ERRTN ;[VFU] Bad file format,,return
;Continued on next page
;Continued from the previous page
;Now, flush the pipe and check device state
LMOL.1: TXNN LS,NRD.LP ;[VFU] Lets make sure this is a LPT
ERR IOX2,ERRTN ;[VFU] No,,return "output illegal"
LMOL.2: $CALL RCVNRM ;[VFU] Chk for asynchronous NRM msgs
NRDR ,,ERRTN ;[VFU] NRM error !!!
JUMPN A,LMOL.2 ;[VFU] Read them all
LMOL.3: $CALL RCVMSG ;[VFU] Chk for incomming msgs
NRDR ,,ERRTN ;[VFU] Read error !!!
JUMPE A,[NRDR .,0,ERRTN] ;[VFU] DATA msg shouldn't be here !!!
JUMPG A,LMOL.3 ;[VFU] Read them all
TXNE LS,NRD.OF ;[VFU] Line printer offline ???
$CALL [MOVX T1,NRD.ON ;[VFU] - Said we were off, but...
TDNE T1,NRDSTS(R) ;[VFU] - are we already back ???
JRST SNDRES ;[VFU] - Yes,,resume remote LPT
ERRI GJFX28,ERRTN ] ;[VFU] - Else return 'OFFLINE'
TXNE DS,MO%FER!MO%HE!MO%SER!MO%LCI!MO%HEM!MO%LPC
ERR IOX5,ERRTN ;[VFU] Any of these bits - Device error
TXNE LS,NRD.PS ;[VFU] No errors,,paused ???
$CALL SNDRES ;[VFU] Yes,,resume the remote LPT
SKIPE ENTYPE ;[RAM] Loading Translation RAM ???
JRST LMOL.4 ;[RAM] No,,load VFU then...
;Downline load the translation RAM and return to the user
MOVEI A,LP.RAM ;[RAM] Get trans RAM feature msg typ
MOVEI B,NRDLTR(R) ;[RAM] Get the data address
HRLI B,(POINT 8,0) ;[RAM] Gen input byte pointer
MOVEI C,^D256*2 ;[RAM] 256 trans RAM (16 bit) bytes
PJRST SETFTR ;[RAM] Downline load the RAM and return
;Downline load the VFU and return to the user
LMOL.4: MOVEI A,LP.CVF ;[VFU] Get DAVFU feature msg type
MOVEI B,NRDLTR(R) ;[VFU] Get the data address
HRLI B,(POINT 8,0) ;[VFU] Assume VFU load
MOVEI C,<^D144*2>+2+1 ;[VFU] 144*2 8 bit bytes + 2 cntrl bytes
SUBI C,0(D) ;[VFU] Calc byte count
PJRST SETFTR ;[VFU] Downline load the VFU and return
LMOREL: HRRZ J1,D ;[VFU] Get the JFN
CLOSF ;[VFU] Close the file
JRST [HRRZ J1,D ;[VFU] - Try RLJFN if CLOSE fails
RLJFN ;[VFU] - Release the JFN
POPJ P, ;[VFU] - Ignore errors
POPJ P, ] ;[VFU] - Return
$RET ;[VFU] Return
LMOSTS: MOVE T2,J3 ; SET LPT STATUS
$CALL EFADR ; FIND IT
MOVE D,T1 ; SAVE PTR FOR A WHILE
MOVX T1,MO%EOF ; SET EOF ? - IF SO, MUST BE DONE 1ST
TDNN T1,1(D)
JRST LMOST1 ; NOPE
; YES - CONSTRUCT NULL DATA MSG
$CALL SBFINI ; INIT THE BUFFER
SETZ T2,
IDPB T2,NRDSPT(R) ; DATA MSG
IDPB T2,NRDSPT(R) ; NO NURD FLAGS
AOS T1,NRDSEQ(R)
ANDI T1,377
IDPB T1,NRDSPT(R) ; SEQUENCE NO.
MOVEI T1,ND.ACK!ND.EOF
IDPB T1,NRDSPT(R) ; SET EOF AND ACK THIS MSG !!
IDPB T2,NRDSPT(R) ; NO DATA SEGMENTS
MOVE J1,NRDJFN(R) ; SEND IT
$CALL SNDBUF
JRST ERRTN ; DEVICE WENT OFFLINE
TXO DS,MO%EOF ; SET EOF FLAGS, SINCE RESPONSE WON'T
TXO LS,NRD.EO ; INDICATE EOF STATE(NURD SPEC CROCK)
LMOST1: MOVX T1,MO%LCP ; LOWER CASE ?
TDNN T1,1(D)
JRST LMOST2 ; NO
; SET LOWER CASE RAISE OFF
MOVEI A,FE.LCR ; FEATURE ID
MOVEI B,0 ; VALUE
MOVEI C,0 ; NO. BYTES IN VALUE(CLASS 0)
$CALL SETFTR ; ONLY SUCCESS WILL SET MO%LCP=1
LMOST2: MOVE B,2(D) ; SET THE PAGE LIMIT ??
CAMN B,[-1]
JRST LMOST3 ; NO
; YES, B = VALUE (0 => TURN OFF)
MOVEI A,LP.PLE ; FEATURE ID
MOVEI C,2 ; NO. BYTES IN VALUE
$CALL SETFTR ; SET PAGE LIMIT ENFORCEMENT
LMOST3: MOVX T1,MO%SER ; RESET SOFT ERROR
TDNN T1,1(D)
JRST LMOST4
TDZ DS,T1 ; RESET THE FLAG
MOVEM DS,NRDDST(R) ; UPDATE ENTRY STATE
$CALL SNDRES ; ATTEMPT RESUME - CLEAR ERROR FLAGS
LMOST4: $CALL LPTIOW ; WAIT TIL ALL STATE CHANGES PROCESSED
NRDR ,,ERRTN ; OH?
JRST SUCRTN ; AWRIGHT !
; FLUSH LPT OUTPUT
LMOFLO: $CALL SNDAUC ; SEND ABORT UNTIL CLEAR
$CALL RCVCRS ; WAIT FOR CONTROL RESPONSE
NRDR ,,ERRTN ; DATA MSG BLOCKING CONTROL RSP
CAIE A,NR.NAB ; WHEN NOTHING TO ABORT CONTINUE ON
JRST [ MOVEI J1,^D1000 ; WAIT A SECOND
DISMS ; ZZZ
JRST LMOFLO] ; AND TRY AGAIN
$CALL SNDCAB ; CLEAR THE ABORT
$CALL RCVCRS ; WAIT FOR RESPONSE
NRDR ,,ERRTN ; DATA MSG BLOCKING CONTROL RSP
CAIE A,NR.ACC ; ABORT CLEARED?
NRDR ,0,ERRTN ; NO, THEN PROTOCOL ERROR
JRST SUCRTN
; SET DEVICE STATUS TO CURRENT STATE
SETDST: HLRZ T1,NRDSTS(R) ; GET CONDITIONS FROM INT LEVEL
TLO LS,(T1)
TXNE LS,NRD.OF
TXOA DS,MO%OL
TXZ DS,MO%OL
SKIPE NRMASR(R) ; CHECK NRM REPORTED PROBLEM
TXO DS,MO%FER!MO%SER ; ALWAYS FATAL
$RET
SUBTTL UCLOSF
; UCLOSF SIMULATES A CLOSF JFN FOR REMOTE DEVICES
; AC1 = FLAGS,,SUBSTITUTE JFN
; CLOSE DEVICE=> CLOSE NRD DATA LINK
; CLOSE NRM CONTROL LINK
; RELEASE JFNS
; FLUSH DATA BASE
UCLOSF::$CALL SETUP2 ; SKIP TYPE JSYS
JRST ERRTN ; OOPS!
$CALL INTOFF ; FLUSH INTS
SETO A, ; ASSUME WE WILL BE SUCCESSFUL
MOVX J1,CZ%ABT ; ABORT THE JFNS ANYWAY
HRR J1,NRDJFN(R) ; GET NRD'S JFN
CLOSF ; CLOSE NRD LINK WITH FLAGS
SETZ A, ; ? AN ERROR
MOVE J1,NRDJFN(R) ; NOW TO RELEASE
RLJFN ; THE JFN
SETZ A, ; ??
MOVX J1,CZ%ABT ; NOW THE SAME TREATMENT FOR NRM
HRR J1,NRMJFN(R) ; GET THE JFN
CLOSF ; CLOSE NRM LINK
SETZ A, ; PECULIAR !
MOVE J1,NRMJFN(R) ; GET RID OF JFN
RLJFN ; ...
SETZ A, ; ?
MOVEI T1,UJ.FLS ; NOW TO GET RID OF DATABASE
IORM T1,RDSTS(R) ; SET THE FLUSH FLAG
JUMPE A,ERRTN ; ERROR OCCURED IF ZERO FLAG
JRST SUCRTN ; AHA !!
SUBTTL NSP Support Functions
; J1 = JFN FOR DEST
; CLOBBERED T1,J2,J3,J4
SNDBUF: MOVSI J2,(POINT 8) ; POINT TO THE BUFFER
HRRI J2,NRDSBF(R) ; IN NRDSBF
MOVEI J3,NRDSBF(R) ; CALC NO. BYTES
SUBI J3,@NRDSPT(R) ; J3 = -NO. WORDS
ASH J3,2 ; 4 BYTES PER WORD
LDB J4,[POINT 6,NRDSPT(R),5] ; DET PARTIAL WORD BYTES
HRREI J4,-^D36(J4) ; [0,-8,-16,-24,-32]
ASH J4,-3 ; [0,-1,-2,-3,-4]
ADD J3,J4 ; J3 = -<NO. BYTES IN MSG>
JUMPGE J3,CPOPJ1 ; FORGET IT
SENDER: MOVEI T1,UJ.SSO ; FLUSH SUSPENDED SOUTR FLAG
ANDCAB T1,RDSTS(R) ; ...
TXNE T1,UJ.RCV ; CHECK FOR MSG ARRIVING VERY RECENTLY
JRST BRKS ; SEEMS SO
SKIPE DEBUGR ;[55]
$CALL [$CALL SAV4J
$CALL SAV4
TYPE (***** Sending data message *****)
$CALL TCRLF
MOVE A,J2
MOVM D,J3
JRST RCVTY1]
SOUTR ; SEND THE BUFFER
USOWTR: ERJMP SOERR ; SOUTR ERROR! - PROBABLY LINK BROKEN
SETZM NRDSCN(R) ; MAKE THE BUFFER EMPTY
PJRST CPOPJ1
SOERR: PUSH P,J2 ; SAVE USER J2
PUSH P,J3 ; AND J3
MOVEI J1,.FHSLF ; SOUTR ERROR EXIT
GETER ; DETERMINE ERROR CONDITION
PUSH P,J2 ; SAVE ERROR CODE FOR LATER
MOVE J1,NRDJFN(R) ; CHECK CONDITION OF LINK
MOVEI J2,.MORLS
MTOPR
TXNN J3,MO%ABT!MO%SYN
TXNN J3,MO%CON
TXZA LS,NRD.CC!NRD.OC ; LINK BROKEN
TXOA DS,MO%SER ; SOFT ERROR?
TXOA DS,MO%FER ; BROKEN LINK IS FATAL
SKIPA
TXZ DS,MO%OL ; DON'T GET CONFUSED BY OFFLINE
POP P,J1 ; GET ERROR CODE TO J1
POP P,J3 ; RESTORE USER J3
POP P,J2 ; AND J2
$RET ; LEAVE
; PROCESS RECEIVED DATA IN CASE DEVICE WENT OFFLINE
; NOTE: INTERRUPTS ARE NOT ENABLED UNTIL ALL INITIAL NRM EXCHANGES ARE COMPLETE
; AND DEVICE IS SUCCESSFULLY OPENED. THEREFORE(INVOKE IMPLACABLE LOGIC HERE)
; ANY NRM MESSAGES RECEIVED HERE MUST NECESSARILY BE ASYNCHRONOUS ERROR
; REPORTS - HENCE SHOULD ALWAYS TAKE NONSKIP RETURN FROM RCVNRM!
BRKS: PUSH P,A ; SAVE A COUPLE OF REGS
PUSH P,B ; ...
BR1: $CALL RCVNRM ; CHECK NRM DISASTERS
NRDR ,,BR3
JUMPN A,BR1 ; JUST IN CASE LOGIC FAILS
BR2: $CALL RCVMSG ; PROCESS DATA LINK MSGS
NRDR ,,BR3
JUMPG A,BR2 ; GOBBLE ALL
TXNN LS,NRD.OF!NRD.PS ; DO WE STILL HAVE A DEVICE ?
JRST [ POP P,B ; YES, RESTORE REGS
POP P,A ; ...
JRST SENDER] ; EVERYTHING OK - TRY AGAIN
; DEVICE FELL OVER - SUSPEND SOUTR
BR3: POP P,B ; RESTORE REGS
POP P,A ; ...
SETZM NRDSCN(R) ; FLUSH THE BUFFER
ERRI GJFX28,CPOPJ ; DEV OFFLINE - RET TO CALLER OF SNDBUF
; SEND THE CURRENT BUFFER AS AN INTERRUPT MSG
; J1 = JFN FOR DEST
SNDINT: MOVEI J4,NRDSBF(R) ; CALC NO. BYTES
SUBI J4,@NRDSPT(R) ; J4 = -NO. WORDS
ASH J4,2 ; 4 BYTES PER WORD
LDB J3,[POINT 6,NRDSPT(R),5] ; DET PARTIAL WORD BYTES
HRREI J3,-^D36(J3) ; [0,-8,-16,-24,-32]
ASH J3,-3 ; [0,-1,-2,-3,-4]
ADD J4,J3 ; J4 = -<NO. BYTES IN MSG>
JUMPGE J4,CPOPJ ; FORGET IT
MOVMS J4 ; POSITIVE BYTE COUNT
MOVEI J3,NRDSBF(R) ; OUTPUT STRING PTR
HRLI J3,(POINT 8)
MOVEI J2,.MOSIM
SKIPE DEBUGR ;[55]
$CALL [$CALL SAV4J
$CALL SAV4
TYPE (***** Sending interrupt message *****)
$CALL TCRLF
MOVE D,J4
MOVE A,J3
JRST RCVTY1]
MTOPR ; SEND THE BUFFER
ERJMP CPOPJ ; RETURN ON AN ERROR
SETZM NRDSCN(R) ; MAKE THE BUFFER EMPTY
$RET
; READ A MSG INTO NRDRBF
; J1 = JFN
RCVBUF: MOVSI J2,(POINT 8) ; BUILD BYTE POINTER
HRRI J2,NRDRBF(R) ; INTO BUFFER
MOVEM J2,NRDRPT(R) ; SAVE PTR FOR CALLER'S USE
MOVNI J3,NRDBSZ
SINR ; READ A MSG
ERJMP CPOPJ ; ?
ADDI J3,NRDBSZ ; CALC NO. BYTES READ
MOVEM J3,NRDRCN(R)
PJRST CPOPJ1
SUBTTL NURD Support Functions
; SEND A SPECIFY-RESERVE MSG TO NRM
; CLOBBERS J1,J2,*J3,*J4,T1,T2
DEVRSR: $CALL SBFINI ; INIT BUFFER FOR USE
MOVE J2,NRDSPT(R) ; PICK UP BYTE PTR
MOVEI T1,NRMSPC ; INSERT SPECIFY CODE
IDPB T1,J2 ; ...
MOVEI T1,SPCRES ; INSERT RESERVE SUBCODE
IDPB T1,J2 ; ...
MOVE T1,NRMID(R) ; PUT IN THE CONTROL ID
IDPB T1,J2 ; FIRST THE LOW BYTE
LSH T1,-10 ; THEN THE HIGH BYTE
IDPB T1,J2 ; ...
MOVEI T1,NRDLP ; ASSUME WE ARE RESERVING A LP
TXNN LS,NRD.LP ; IS IT AN LP ?
MOVEI T1,NRDCR ; NOPE, IT IS A CR, SO GUESSED WRONG
IDPB T1,J2 ; INSERT THE RESOURCE CODE
MOVEI T2,3 ; THERE ARE 3 CHARS IN
IDPB T2,J2 ; THE DEVICE NAME
MOVE J1,[POINT 7,RDDEV(R)] ; POINT AT THE DEVICE NAME
ILDB T1,J1 ; GET A CHARACTER OF NAME
IDPB T1,J2 ; DEV NAME CH
SOJG T2,.-2 ; DO EM ALL
MOVEM J2,NRDSPT(R) ; UPDATE THE BYTE PTR IN DATABASE
MOVE J1,NRMJFN(R)
$CALL SNDBUF ; SEND THE MSG TO NRM
$RET ; DEVICE WENT OFFLINE
$CALL RCVRSP ; WAIT FOR RESPONSE
$RET ; BAD RESPONSE - J1 = ERROR CODE
; A = ORIGINAL REQUEST CODE - B = RESPONSE CODE
CAIE A,NRMSPC ; CHECK IF RIGHT RESPONSE
NRDR ,BOTX05,CPOPJ ; NRM NOT RESPONDING TO REQUEST
CAIGE B,^D20 ; CHECK RESPONSE CODE
PJRST CPOPJ1 ; OK
; RESPONSE ERROR
RSPERR: CAIN B,^D20 ; ACCESS NOT PERMITTED
ERR DESX2,CPOPJ ; TERMINAL NOT AVAIL
CAIN B,^D25 ; RESOURCE NON-EXISTENT
ERR GJFX16,CPOPJ ; NO SUCH DEVICE
CAIN B,^D26 ; RESOURCE NOT AVAILABLE
ERR OPNX7,CPOPJ ; DEVICE ASSIGNED TO ANOTHER JOB
ERRI BOTX05,CPOPJ ; ELSE - PROTOCOL INITIALIZATION FAILED
; SEND AN ACCESS-OPEN TO NRM
; CLOBBERS: J1,J2,*J3,*J4,T1,T2
OPNDEV: $CALL SBFINI ; INIT BUFFER FOR USE
MOVE J2,NRDSPT(R) ; GET BYTE PTR
MOVEI T1,NRMACC ; INSERT ACCESS CODE
IDPB T1,J2 ; ...
MOVEI T1,ACCOPN ; PUT IN OPEN SUBCODE
IDPB T1,J2 ; ...
MOVE T1,NRMID(R) ; INSERT THE NRM ID
IDPB T1,J2 ; THE LOW BYTE
LSH T1,-10 ; AND
IDPB T1,J2 ; THE HIGH BYTE
MOVEI T1,URS ; SET THE SERVER PROCESS TYPE
IDPB T1,J2 ; ...
SETZ T1, ; NO SERVER DESCRIPTOR FIELD
IDPB T1,J2 ; ...
MOVEI T1,1 ; SERVER PROCESS OPTIONS FIELD LENGTH
IDPB T1,J2 ; ...
MOVE T1,NRDULA(R) ; SET LINK ADDR
IDPB T1,J2 ; ...
MOVEM J2,NRDSPT(R) ; UPDATE BYTE POINTER
MOVE J1,NRMJFN(R) ; GET NRM'S JFN
$CALL SNDBUF ; SEND THE MSG TO NRM
$RET ; DEVICE WENT OFFLINE
$CALL RCVRSP ; WAIT FOR RESPONSE
$RET ; BAD RESPONSE - J1 = ERROR CODE
; A = ORIGINAL REQUEST CODE - B = RESPONSE CODE
CAIE A,NRMACC ; CHECK RIGHT RESPONSE
NRDR ,BOTX05,CPOPJ ; NRM NOT RESPONDING TO REQUEST
CAIL B,^D20 ; CHECK RESPONSE
JRST RSPERR ; ERROR RESPONSE
MOVE T1,NRDRCN(R) ; RESPONSE OK - CHECK BULA RETURNED
ILDB T2,NRDRPT(R)
CAIL T1,4 ; MUST BE AT LEAST 4 BYTES LEFT
CAIGE T2,3 ; FIELD MUST BE AT LEAST 3 BYTES LONG
NRDR ,BOTX05,CPOPJ ; GARBAGE
IBP NRDRPT(R) ; SKIP BTN
IBP NRDRPT(R)
ILDB T1,NRDRPT(R) ; GET BULA
MOVNI T2,4
ADDM T2,NRDRCN(R) ; FOR DEBUGGING
CAME T1,NRDULA(R) ; BETTER BE US
NRDR ,BOTX05,CPOPJ ; LOSER
PJRST CPOPJ1 ; OK
; RECEIVE A RESPONSE MSG FROM NRM
RCVRSP: $CALL SAV4J ; SAVE J1-J4
MOVEI J1,NRDTMO ; SET TIMEOUT THING
MOVEM J1,NRDTMC(R) ; ...
RCVRS1: $CALL RCVNRM ; GO GET A MSG FROM NRM
NRDR ,DCNX11,STASHJ ; LINK ABORTED
JUMPE A,[ SOSGE NRDTMC(R) ; HAVE WE MESSED LONG ENUF ?
NRDR .,BOTX05,STASHJ ; YES, SO GIVE UP
MOVEI J1,^D500 ; NOTHING, SO WAIT
DISMS ; ...
JRST RCVRS1] ; CHECK AGAIN
MOVE J4,NRDRCN(R) ; CHECK MINIMUM LENGTH
CAIL J4,5 ; FOR RESPONSE MSG
CAIE A,NRMRSP ; CHECK RIGHT MSG TYPE
NRDR ,BOTX05,STASHJ ; THINGS ARE IN A BAD WAY
MOVE A,B ; A = ORIGINAL REQUEST CODE
$CALL GETWRD ; GET CONTROL-ID
CAME J3,NRMID(R) ; CHECK THAT IT IS FOR THIS FORK
NRDR ,0,STASHJ ; WRONG FORK ???
$CALL GETWRD ; GET RESPONSE CODE
MOVE B,J3 ; AND SAVE IN B
MOVNI J4,6 ; ADJUST BUFFER COUNT
ADDM J4,NRDRCN(R) ; ...
PJRST CPOPJ1 ; RETURN A = ORIGINAL REQUEST CODE
; B = RESPONSE CODE
; NRDRPT POINTING AT OPT DATA
; STASHJ
; THIS EXIT ROUTINE ASSUMES THE STACK HAS BEEN MOST RECENTLY CHANGED
; BY A CALL TO SAV4J. IT STORES THE CURRENT J1 INTO SAVED J1, SO THE
; CURRENT J1 WILL BE RETURNED TO CALLER.
STASHJ: MOVEM J1,-4(P) ; OVERWRITE STORED J1
$RET ; AND LEAVE
RCVNRM: $CALL SAV4J ; RECEIVE A MSG FROM NRM
RCVN0: MOVE J1,NRMJFN(R) ; CHECK FOR INPUT
SIBE
JRST RCVN1 ; SOMETHING
SETZB A,B ; RET NOTHING
MOVX J2,.MORLS ; READ LINK STATUS
MTOPR
ERJMP STASHJ ; ERROR RETURN
TXNE J3,MO%CON ; ARE WE CONNECTED STILL?
AOS (P) ; YES, SET FOR SUC RETURN
$RET ; GO BACK
RCVN1: $CALL RCVBUF ; RECEIVE THE MSG
PJRST STASHJ ; READ ERROR
ILDB A,NRDRPT(R) ; A = MSG FUNCTION(BYTE 1)
ILDB B,NRDRPT(R) ; B = SUBCODE(BYTE 2)
CAIN A,NRMSTA ; SPECIAL CHECK FOR STATUS-REPORT
CAIE B,STAREP
PJRST CPOPJ1 ; NOPE - LET CALLER INTERPRET THE MSG
; STATUS-REPORT
$CALL GETWRD ; GET CONTROL-ID
CAME J3,NRMID(R) ; IS IT US ??
ERR DCNX8,STASHJ ; NO !
IBP NRDRPT(R) ; SKIP STSTYPE FIELD
ILDB J3,NRDRPT(R) ; GET COUNT OF STSDAT FIELD
CAIE J3,4 ; MUST BE 4
ERR DCNX8,STASHJ
$CALL GETWRD ; GET J3 = STATUS ASSOC WITH THE DEVICE
MOVEM J3,NRMAST(R)
$CALL GETWRD ; GET J3 = NRM DEVICE STATUS
MOVEM J3,NRMASR(R)
JUMPE J3,RCVN0
TXOA DS,MO%FER!MO%SER
ERRI DCNX8 ; MSG FORMAT ERROR
PJRST STASHJ
GETWRD: ILDB J3,NRDRPT(R) ; GET WORD FROM NRDRBF
ILDB J4,NRDRPT(R)
DPB J4,[POINT 8,J3,27]
$RET
; GENERAL MSG RECEIVER - PROCESSES ALL BUT DATA MSGS
RCVMSG: $CALL SAV4J
MOVEI A,UJ.RCV ; FLUSH DATA RECEIVED FALG
ANDCAM A,RDSTS(R)
SETO A, ; INIT LAST MSG READ FLAG
MOVE J1,NRDJFN(R) ; CHECK FOR INPUT
SIBE
JRST RCVM1 ; SOMETHING THERE
MOVE J1,NRDJFN(R) ; SEE IF LINK STILL CONNECTED
MOVX J2,.MORLS ; READ LINK STATUS
MTOPR
ERJMP STASHJ ; ERROR RETURN
TXNE J3,MO%CON ; ARE WE CONNECTED STILL?
PJRST CPOPJ1 ; YES, BUT NO DATA AT PRESENT
SETZ J1, ; NO,
PJRST STASHJ ; SO GIVE ERROR RETURN
RCVM1: MOVE J1,NRDJFN(R) ; SET APPROP JFN
PUSHJ P,RCVBUF ; RECEIVE IT!
PJRST STASHJ ; READ ERROR
SKIPE DEBUGR
PUSHJ P,RCVTYP
; CHECK TYPE
ILDB A,NRDRPT(R) ; GET NURD MSG TYPE BYTE
CAIL A,NM.OTR ; CHECK RANGE
MOVEI A,NM.OTR ; OOPS, MAP TO KNOWN ILLEGAL VALUE
$CALL @RCVMT(A) ; DO THE REQUESTED THING
SKIPE A ; IF NOT A DATA MESSAGE THEN
SETZM NRDRCN(R) ; ZERO THE MESSAGE LENGTH
PJRST CPOPJ1 ; GET OUT
RCVMT: CPOPJ ; DATA MSG
ATTMSG ; ATTENTION MSG
FTRMSG ; FEATURES MSG
CTLMSG ; CONTROL MSG
[NRDR .,0,CPOPJ] ; ALERT MSG - ILLEGAL HERE
CAPMSG ; CAPABILITIES MSG
[NRDR .,IOX5,CPOPJ] ; SOMEONE CHANGING REMOTE NURD
; ATTENTION MSG FORMAT:
; <NM.ATT><NURD FLGS><LAST SEQ NO.><ATT. REASON CODE><DEVSTS 1-3><PAGE CNT 2>
;
; PROCESS AN ATTENTION MSG IN NRDRBF. NRDRPT IS POINTING TO NURD MSG TYPE BYTE
ATTMSG: IBP NRDRPT(R) ; SKIP NURD MSG FLAGS
ILDB J1,NRDRPT(R) ; GET SEQ. NO.
MOVEM J1,NRDASQ(R) ; SAVE AS INDICATOR OF STATUS CURRENCY
ILDB J1,NRDRPT(R) ; ATTENTION REASON CODE
MOVEM J1,NRDATT(R) ; SAVE FOR POSTERITY
CAILE J1,N.APLE ; CHECK LIMIT
SETZ J1, ; A BAD ONE
PJRST @.+1(J1) ; DISPATCH TO REASON CODE PROCESSOR
[NRDR .,0,ATTM] ; BAD CODE
ATTM ; STATUS CHANGE
ATTM ; DATA ACKNOWLEDGE
ATTM ; REQUESTED
[ TXO LS,NRD.AB ; ABORT COMPLETE
TXZ DS,MO%IOP ; CLEAR IO IN PROGRESS
JRST ATTM]
[ TXO LS,NRD.PL ; PAGE LIMIT EXCEEDED
TXO DS,MO%LPC+MO%SER ; ...
JRST ATTM]
ATTM: ILDB J1,NRDRPT(R) ; BYTE 1 FLAGS
TXNE J1,NA.FAT ; FATAL ERROR ?
TXOA LS,NRD.FE
TXZA LS,NRD.FE
TXOA DS,MO%FER
TXZ DS,MO%FER
TXNE J1,NA.OFL!NA.PAU ; DEVICE OFFLINE OR PAUSED ?
TXOA LS,NRD.OF
TXZA LS,NRD.OF
TXOA DS,MO%OL
TXZ DS,MO%OL
TXNE J1,NA.PAU ; DEVICE PAUSED ?
TXOA LS,NRD.PS
TXZA LS,NRD.PS
TXZ DS,MO%IOP ; FLUSH IO IN PROGRESS
TXNN LS,NRD.LP ; SKIP IF LPT
JRST ATTMC ; TIS A CDR
; LPT
TXNE J1,NA.OMD!NA.JAM!NA.OOF!NA.NOE
TXO DS,MO%HE
TXNN J1,200 ; CHECK EXTENSION
JRST ATTMX
ILDB J1,NRDRPT(R) ; BYTE 2 FLAGS
TXNE J1,NA.DTO ; DEVICE TIME OUT
TXOA LS,NRD.TO
TXZA LS,NRD.TO
TXO DS,MO%FER
TXNE J1,NA.OUF!NA.NAC!NA.RNA!NA.PSE!NA.INK
TXO DS,MO%HE
TXNN J1,200 ; CHECK EXTENSION
JRST ATTMX
ILDB J1,NRDRPT(R) ; BYTE 3 FLAGS
TXNE J1,NA.OVP ; OVERPRINT
TXO DS,MO%HE
JRST ATTMX
; CDR
ATTMC: TXNE J1,NA.OMD ; OUT OF MEDIA
TXOA DS,MO%HEM
TXZ DS,MO%HEM
TXNE J1,NA.JAM!NA.OOF!NA.NOE ; MISC GARBAGE
TXO DS,MO%HE
TXNN J1,200 ; CHECK EXTENSION
JRST ATTMX
ILDB J1,NRDRPT(R) ; BYTE 2 FLAGS
TXNE J1,NA.OUF ; OUTPUT FULL
TXOA DS,MO%SFL
TXZ DS,MO%SFL
TXNE J1,NA.NAC!NA.RNA
TXO DS,MO%HE
TXNE J1,NA.DTO ; DEVICE TIME OUT
TXOA LS,NRD.TO
TXZA LS,NRD.TO
TXO DS,MO%FER
TXNE J1,NA.PF ; PICK FAILURE
TXOA DS,MO%PCK
TXZ DS,MO%PCK
TXNE J1,NA.REG!NA.RAP ; MISC MUNG
TXO DS,MO%FER
TXNN J1,200 ; CHECK EXTENSION
JRST ATTMX
ILDB J1,NRDRPT(R) ; BYTE 3 FLAGS
TXNE J1,NA.IVP ; INVALID PUNCH ERROR
TXOA DS,MO%RCK
TXZ DS,MO%RCK
; DONE WITH DEVICE STATUS
ATTMX: ILDB J1,NRDRPT(R) ; GET LOW PAGE COUNT
ILDB J2,NRDRPT(R) ; GET HIGH PAGE COUNT
DPB J2,[POINT 8,J1,27]
MOVEM J1,NRDLPC(R) ; SAVE COUNT FOR THIS UPDATE
$RET
; FEATURES MESSAGE FORMAT:
; <NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
; FEATURE SPEC FORMAT:
; <FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
; VALUE FORMAT:
; CLASS 0: <VALUE> (LSB)
; CLASS 1: <CNT><CNT BYTES> (LEAST SIGNIFICANT BYTE 1ST)
FTRMSG: $CALL SAV4
IBP NRDRPT(R) ; SKIP NURD FLAGS
ILDB J1,NRDRPT(R) ; GET SEQ NO.
MOVEM J1,NRDFSQ(R)
ILDB C,NRDRPT(R) ; GET NO. FEATURE SPECS
MOVE D,NRDRCN(R) ; MSG LENGTH
SUBI D,3 ; SUBSTRACT MSG OVERHEAD
JUMPL D,[NRDR .,0,CPOPJ] ; PRETTY SHORT FEATURE MSG
; PROCESS NEXT FEATURE SPEC
FTRM1: SOJL C,FTRXIT
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB A,NRDRPT(R) ; GET FEATURE ID
CAILE A,FE.DWD
JRST FTRM2
LSH A,1 ; CALC CELL LOC
ADDI A,NRDFET(R)
JRST FTRM6
; NOT A COMMON FEATURE - TRY DEVICE SPECIFIC
FTRM2: TXNN LS,NRD.LP
JRST FTRM3 ; CDR
CAIL A,LP.HT ; LPT
CAILE A,LP.TRN
JRST FTRM4 ; NOT LPT
SUBI A,LP.HT
LSH A,1
ADDI A,NRDLPF(R)
JRST FTRM6
FTRM3: CAIE A,CD.CWD ; CDR
JRST FTRM4 ; NOT CDR
SUBI A,CD.CWD
LSH A,1
ADDI A,NRDCRF(R)
JRST FTRM6
FTRM4: CAIE A,FE.ALL ; ALLNESS ?
JRST FTRM5 ; NO - A MYSTERY FID
IBP NRDRPT(R) ; FLUSH FLAGS
IBP NRDRPT(R) ; FLUSH CLASS
IBP NRDRPT(R) ; FLUSH RESPONSE
SUBI D,3
JRST FTRM1
FTRM5: SETZM NRDUFE(R) ; UNKNOWN FID
DPB A,[POINT 8,NRDUFE(R),7] ; SAVE ID FOR LAUGHS
MOVEI A,NRDUFE(R)
SKIPA
FTRM6: SETZM (A) ; A = PTR TO FEATURE CELL
SETZM 1(A) ; INIT THE CELL AND LOAD NEW STUFF
MOVEI J1,1
DPB J1,FRDP ; SET FEATURE READ FLAG
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB J1,NRDRPT(R) ; GET FLAGS
DPB J1,FFLP
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB J1,NRDRPT(R) ; GET CLASS
DPB J1,FCLP
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB J2,NRDRPT(R) ; GET RESPONSE
DPB J2,FRSP
JUMPN J2,FTRM1 ; NON-ZERO RESPONSE(ERROR)==> NO VALUE
; EXTRACT THE FEATURE VALUE
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB B,NRDRPT(R) ; GET LOW VALUE
JUMPE J1,FTRM7 ; CLASS 0=> B = VALUE
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB J1,NRDRPT(R) ; CLASS 1=> B = CNT, GET J1 = LOW VALUE
EXCH B,J1 ; B = LOW VALUE, J1 = CNT
DPB J1,FLNP ; SAVE LENGTH OF VALUE
CAILE J1,2
JRST FTRM8 ; STRING
FTRM7: DPB B,FVLPL ; DEP LOW VALUE
SOJLE J1,FTRM1 ; COUNT THE BYTES
SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB B,NRDRPT(R) ; GET HIGH VALUE
DPB B,FVLPH
JRST FTRM1
FTRM8: ADDI J1,3 ; ROUND NUMBER OF BYTES TO FULL WORD
LSH J1,-2 ; AND GET NUMBER OF WORDS NEEDED
$CALL M%GMEM ; GET THE MEMORY
EXCH J1,J2 ; J1 = ADDR, J2 = LENGTH
HRRM J1,(A) ; SAVE PTR TO STRING
HRLI J1,(POINT 8)
JRST FTRM9A
FTRM9: SOJL D,[NRDR .,0,FTRXIT] ; MSG TOO SHORT
ILDB B,NRDRPT(R) ; GET NEXT VALUE BYTE
FTRM9A: IDPB B,J1 ; STUFF IT
SOJG J2,FTRM9
JRST FTRM1
; SPECIAL FEATURE VALUE CHECKS FOR LINE PRINTERS
FTRXIT: TXNN LS,NRD.LP ; DO THIS FOR LPTS ONLY
$RET ; OTHER,,RETURN
PUSHJ P,FTRLCP ; CHECK LOWERCASE STATUS
PUSHJ P,FTRVFU ; CHECK OPTICAL VFU STATUS
PUSHJ P,FTRRAM ; CHECK TRANSLATION RAM STATUS
$RET ; RETURN
FTRVFU: MOVEI A,NFEVFU(R) ; CHECK OPTICAL VFU SUPPORT
TXO DS,MO%LVU ; ASSUME OPTICAL VFU
LDB J1,FRDP ; CHECK IF DEFINED YET
JUMPE J1,CPOPJ ; NOT READ YET
LDB J1,FRSP ; CHECK RESPONSE
JUMPE J1,CPOPJ ; ZERO IS 'FEATURE OK'
TXZ DS,MO%LVU ; HMMM,,MUST BE DAVFU !!!
$RET ; RETURN
FTRLCP: MOVEI A,NFELCR(R) ; CHECK FE.LCR=> MO%LCP STATE
TXZ DS,MO%LCP ; ASSUME UPPER CASE
LDB J1,FRDP ; CHECK IF DEFINED YET
JUMPE J1,CPOPJ ; NOT READ YET
LDB J1,FRSP ; CHECK RESPONSE
JUMPN J1,CPOPJ ; NON-ZERO IS BAD FEATURE
LDB J1,FVLP ; GET THE FEATURE VALUE
JUMPN J1,CPOPJ ; IF SET,,THEN ITS UPPER CASE
TXO DS,MO%LCP ; ELSE RESET TO LOWER CASE
$RET ; RETURN
FTRRAM: MOVEI A,NFERAM(R) ; CHECK TRANSLATION RAM SUPPORT
TXZ DS,MO%RAM ; ASSUME NO TRANSLATION RAM SUPPORT
LDB J1,FRDP ; CHECK IF DEFINED YET
JUMPE J1,CPOPJ ; NOT READ YET
LDB J1,FRSP ; CHECK RESPONSE
JUMPN J1,CPOPJ ; NON-ZERO IS BAD FEATURE
TXO DS,MO%RAM ; DEVICE HAS TRANSLATION RAM
$RET ; RETURN
FRDP: POINT 1,(A),8 ; FEATURE READ FLAG
FLNP: POINT 8,(A),17 ; FEATURE VALUE LENGTH
FVLP: POINT 18,(A),35 ; FEATURE VALUE
FVLPL: POINT 8,(A),35 ; LOW FEATURE VALUE
FVLPH: POINT 8,(A),27 ; HIGH FEATURE VALUE
FFLP: POINT 9,1(A),8 ; FEATURE FLAGS
FCLP: POINT 9,1(A),17 ; FEATURE CLASS
FRSP: POINT 18,1(A),35 ; FEATURE RESPONSE
; CONTROL MESSAGE FORMAT:
; <NM.CTL><NURD FLAGS><SEQ NO.><COMMAND><RESPONSE>
CTLMSG: IBP NRDRPT(R) ; SKIP NURD FLAGS
ILDB J1,NRDRPT(R) ; SEQ NO.
HRLM J1,NRDCSQ(R) ; SAVE
ILDB J1,NRDRPT(R) ; COMMAND
MOVSM J1,NRDCCR(R)
ILDB J1,NRDRPT(R) ; RESPONSE
HRRM J1,NRDCCR(R) ; SAVE IT TOO
$RET
; CAPABILITIES MESSAGE FORMAT:
; <NM.CAP><NURD FLAGS><LIST BYTE COUNT>< COUNT FID'S>
CAPMSG: IBP NRDRPT(R) ; SKIP NURD FLAGS
ILDB J1,NRDRPT(R) ; BYTE COUNT
AOS J1 ; TOTAL LIST LENGTH
ADDI J1,3 ; CALC NUMBER OF WORDS NEEDED
LSH J1,-2 ; ...
HLRZ J2,NRDCAP(R) ; CHECK FOR PREVIOUS LIST
JUMPE J2,CAPM1 ; VIRGIN
CAMG J1,J2 ; IS IT BIG ENOUGH ?
JRST CAPM2 ; OK
PUSH P,J1 ; TOO SHORT - SAVE NEW LENGTH
MOVE J1,J2 ; GET OLD LENGTH
HRRZ J2,NRDCAP(R) ; AND ADDRESS
$CALL M%RMEM ; SEND IT BACK
POP P,J1 ; GET NEW LENGTH BACK
CAPM1: $CALL M%GMEM ; GET A NEW BLOCK
HRL J2,J1 ; J2 = SIZE,,ADDR
MOVEM J2,NRDCAP(R) ; SAVE IT
CAPM2: LDB J2,NRDRPT(R) ; GET NUMBER OF BYTES AGAIN
MOVSI T1,(POINT 8) ; MAKE PTR TO XFER INTO BLOCK
HRR T1,NRDCAP(R) ; ...
SKIPA J1,J2 ; SKIP INTO CAPM3 WITH LENGTH IN J1
CAPM3: ILDB J1,NRDRPT(R) ; GET NEXT BYTE
IDPB J1,T1 ; XFER IT
SOJGE J2,CAPM3 ; MOVE EM ALL
$RET ; DONE
; WAIT FOR RESPONSE OF JUST ISSUED DUMP OR CONTROL MSG
RCVCRS: MOVEI T1,NRDTMO ; SET TIMEOUT COUNTER
MOVEM T1,NRDTMC(R) ; ...
RCVC1: MOVE T1,NRDCSQ(R) ; TEST IF LAST RCVD SEQ=LAST ISSUED SEQ
TSC T1,T1 ; ...
JUMPE T1,[ HRRZ A,NRDCCR(R) ; YES, GET RESPONSE
PJRST CPOPJ1] ; AND LEAVE
$CALL RCVMSG ; RECEIVE SOME MORE MSGS
$RET ; READ ERROR
JUMPL A,[ SOSGE NRDTMC(R) ; NOTHING - COUNT THIS LOOP
$RET ; GIVE UP
MOVEI J1,^D500 ; WAIT .5 SEC
DISMS ; ZZZ
JRST RCVC1] ; GO CHECK AGAIN
JUMPG A,RCVC1 ; SOMETHING - GO SEE
NRDR ,0,CPOPJ ; DATA MSG BLOCKING CONTROL MSG
; WAIT FOR ATTENTION MSG RESPONSE TO JUST ISSUED STATUS REQUEST
RCVRQS: $CALL RCVCRS ; WAIT FOR RESPONSE TO STATUS REQUEST
$RET ; BLOCKED OR READ ERROR
; PJRST RCVRQ ; FINISH UP
; RECEIVE AN ATTENTION MSG
RCVRQ: MOVEI T1,NRDTMO ; SET TIMEOUT COUNTER
MOVEM T1,NRDTMC(R) ; ...
RCVR1: $CALL RCVMSG ; JUST WAIT TIL NEXT ATTN MSG ARRIVES
$RET ; READ ERROR
JUMPL A,[ SOSGE NRDTMC(R) ; SPUN OUR WHEELS LONG ENUF ?
$RET ; YES, SO GIVE UP
MOVEI J1,^D500 ; NO - WAIT A WHILE
DISMS ; YAWN
JRST RCVR1] ; AND TRY AGAIN
JUMPE A,[NRDR .,0,CPOPJ] ; DATA MSG BLOCKING RSP
CAIE A,NM.ATT ; CHECK IF ATT MSG RECEIVED
JRST RCVR1 ; NOPE - TRY AGAIN
PJRST CPOPJ1 ; GOT IT
; WAIT FOR RESPONSE TO JUST ISSUED FEATURE MSG
FTRWAT: MOVEI T1,NRDTMO ; SET TIMEOUT COUNTER
MOVEM T1,NRDTMC(R) ; ...
FTRW1: $CALL RCVMSG ; RECEIVE SOMETHING
$RET ; READ ERROR
JUMPL A,[ SOSGE NRDTMC(R) ; NOTHING - TRY AGAIN ?
$RET ; NOPE, GIVE UP
MOVEI J1,^D500 ; YES, LETS WAIT
DISMS ; ...
JRST FTRW1] ; GO AGAIN
JUMPE A,[NRDR .,0,CPOPJ] ; FTR RSP BLOCKED BY DATA MSG
CAIE A,NM.FTR ; FEATURE MSG ?
JRST FTRW1 ; NO, LOOK FURTHER
MOVE T1,NRDFSN(R) ; COMPARE LAST SEQ RECEIVED
CAMN T1,NRDFSQ(R) ; TO LAST ONE SENT
PJRST CPOPJ1 ; THIS IS IT !
JRST FTRW1 ; DRUDGERY
; CONTROL MESSAGE FORMAT:
; <NM.CTL><NURD MSG FLGS><SEQ NO.><COMMAND><RESULT>
MKCMSG: PUSH P,T1 ; SAVE THE COMMAND
$CALL SBFINI ; INIT THE BUFFER
MOVEI T1,NM.CTL
IDPB T1,NRDSPT(R) ; CONTROL MSG TYPE
SETZ T2,
IDPB T2,NRDSPT(R) ; NURD MSG FLAGS
AOS T1,NRDSEQ(R) ; GEN NEXT CONTROL SEQ NO.
ANDI T1,377 ; 8 BIT WRAP
HRRM T1,NRDCSQ(R) ; SAVE LAST SENT SEQ NO.
IDPB T1,NRDSPT(R) ; NEXT CONTROL SEQ NO.
POP P,T1
IDPB T1,NRDSPT(R) ; COMMAND
IDPB T2,NRDSPT(R) ; NULL RESULT
$RET ; DONE
SNDDMP: SKIPA T1,[NC.DMP] ; SEND A DUMP OUT BUFFER MSG
SNDRQS: MOVEI T1,NC.RQS ; SEND A STATUS REQUEST MSG
$CALL MKCMSG ; MAKE THE MSG
$CALL SAV4J
MOVE J1,NRDJFN(R)
$CALL SNDBUF ; NORMAL MSG
JRST ERRTN ; PROBLEMS
$RET
SNDCAB: SKIPA T1,[NC.CAB] ; SEND A CLEAR ABORT MSG
SNDAUC: MOVEI T1,NC.AUC ; SEND AN ABORT UNTIL CLEAR MSG
MSNDIC: $CALL MKCMSG ; MAKE THE MSG
$CALL SAV4J
MOVE J1,NRDJFN(R)
PJRST SNDINT ; DO THE INTERRUPT MSG AND RETURN
SNDRES: MOVEI T1,NC.RES ; SEND A RESUME MSG
$CALL MSNDIC ; INTERRUPT MSG
TXO LS,NRD.RS ; SET RESUME ISSUED FLAG
$CALL INTOFF ; CLEAR ERR FLAGS - FIXED BY ATTN MSG
TXZ LS,NRD.FE!NRD.PS!NRD.TO!NRD.OF!NRD.ON!NRD.PL
MOVEM LS,NRDSTS(R) ; UPDATE LINK STATUS
TXZ DS,MO%FER!MO%HE!MO%SER!MO%RCK!MO%PCK!MO%SFL!MO%HEM!MO%LCI!MO%LPC!MO%EOF!MO%OL
TXO DS,MO%IOP ; SET IO IN PROGRESS AGAIN
MOVEM DS,NRDDST(R) ; UPDATE DEVICE STATUS
PJRST INTON
; SET LOWER CASE RAISE=> UPPER CASE ONLY PRINTER
SETLCR: $CALL SAV3 ; SAVE A-C
TXZ DS,MO%LCP
MOVEI A,FE.LCR ; FID
MOVEI B,1 ; ITS VALUE
MOVEI C,0 ; 1 BIT VALUE
PJRST SETFTR
; SET THE DATA MODE
SETMOD: $CALL SAV3
MOVEI A,FE.DAT ; FEATURE ID
TXNN LS,NRD.IM!NRD.AI ; DETERMINE DATA MODE
JRST SETMDA ; ASCII
TXNN LS,NRD.AI
SKIPA B,[DM.CLI] ; COLUMN IMAGE
MOVEI B,DM.AUG ; AUGMENTED COLUMN IMAGE
SKIPA
SETMDA: MOVEI B,DM.ASC ; ASCII
MOVEI C,1 ; NO. BYTES IN VALUE
; PJRST SETFTR ; SET THE FEATURE
; FEATURE MESSAGE FORMAT:
; <NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
; FEATURE SPEC FORMAT:
; <FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
; VALUE FORMAT:
; CLASS 0 <VALUE - LOW ORDER BIT OF BYTE>
; CLASS 1 <COUNT><...COUNT BYTES...> (LEAST SIGNIFICANT BYTE 1ST)
;
; A = FEATURE ID
; B = VALUE or BYTE POINTER IF 'C' GREATER THEN 4
; C = NO. BYTES IN VALUE
SETFTR: $CALL SBFINI ; INIT THE BUFFER
MOVEI T1,NM.FTR
IDPB T1,NRDSPT(R) ; MSG TYPE
SETZ T2,
IDPB T2,NRDSPT(R) ; NURD FLAGS
AOS T1,NRDSEQ(R) ; GEN NEXT DATA SEQ NO.
ANDI T1,377
MOVEM T1,NRDFSN(R) ; SAVE NO. OF LAST FEATURE MSG SENT
IDPB T1,NRDSPT(R) ; SEQ NO.
MOVEI T1,1 ; ONLY ALLOWED TO SET 1 AT A TIME
IDPB T1,NRDSPT(R) ; NO. FEATURE SPECS
; NOW FORMAT FEATURE SPEC
IDPB A,NRDSPT(R) ; FEATURE ID
MOVEI T1,NF.CMD ; BIT SET=> SET FEATURE
IDPB T1,NRDSPT(R) ; FLAGS
SKIPE T1,C ; DETERMINE FEATURE CLASS
MOVEI T1,FC.CL1
IDPB T1,NRDSPT(R) ; FEATURE CLASS
IDPB T2,NRDSPT(R) ; NULL RESPONSE FIELD
JUMPE C,SETFTV ;[VFU] Count = 0,,insert value only
IDPB C,NRDSPT(R) ;[VFU] Else set feature length field
CAIG C,4 ;[VFU] Is count greater then 4 ???
JRST SETFTV ;[VFU] No,,'B' has the data so insert it
CAILE C,^D127 ;[VFU] Yes,,will length fit in 7 bits ?
JRST [MOVE T1,C ;[VFU] No,,load count into T1
LSHC T1,-7 ;[VFU] Get 7 bits of count in T1 & T2
LSH T2,-^D29 ;[VFU] Justify low order bits for IDPB
TRO T1,200 ;[VFU] Lite field extension bit
DPB T1,NRDSPT(R) ;[VFU] Save first 7 bits of length
IDPB T2,NRDSPT(R) ;[VFU] Save second 7 bits of length
JRST .+1 ] ;[VFU] Continue
ILDB A,B ;[VFU] Yes,,B is a ptr - get a byte
IDPB A,NRDSPT(R) ;[VFU] Save the byte in the msg data
SOJG C,.-2 ;[VFU] Copy all bytes into the message
PJRST SNDNRD ;[VFU] Send the message and return
SETFTV: IDPB B,NRDSPT(R) ; INSERT NEXT LOWEST BYTE
LSH B,-10
SOJG C,SETFTV
PJRST SNDNRD ; SEND THE MESSAGE
; FEATURE MESSAGE FORMAT:
; <NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
; FEATURE SPEC FORMAT:
; <FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
; VALUE FORMAT:
; CLASS 0 <VALUE - LOW ORDER BIT OF BYTE>
; CLASS 1 <COUNT><...COUNT BYTES...> (LEAST SIGNIFICANT BYTE 1ST)
;
; A = FEATURE ID
; B = FLAG FIELD
; C = CLASS FIELD
REDFTR: $CALL SBFINI ; INIT THE BUFFER
MOVEI T1,NM.FTR
IDPB T1,NRDSPT(R) ; MSG TYPE
SETZ T2,
IDPB T2,NRDSPT(R) ; NURD FLAGS
AOS T1,NRDSEQ(R) ; GEN NEXT DATA SEQ NO.
ANDI T1,377
MOVEM T1,NRDFSN(R) ; SAVE NO. OF LAST FEATURE MSG SENT
IDPB T1,NRDSPT(R) ; SEQ NO.
MOVEI T1,1 ; ONLY ALLOWED TO SET 1 AT A TIME
IDPB T1,NRDSPT(R) ; NO. FEATURE SPECS
; NOW FORMAT FEATURE SPEC
IDPB A,NRDSPT(R) ; FEATURE ID
IDPB B,NRDSPT(R) ; FLAGS
IDPB C,NRDSPT(R) ; FEATURE CLASS
IDPB T2,NRDSPT(R) ; NULL RESPONSE FIELD
; PJRST SNDNRD ; SEND THE MESSAGE
SNDNRD: $CALL SAV4J ; SEND REMAINING OUTPUT
MOVE J1,NRDJFN(R)
$CALL SNDBUF
JRST ERRTN ; DEVICE WENT OFFLINE
$RET
; READ ALL THE DEVICE FEATURES
RDFTRS: $CALL SAV3
MOVEI A,FE.ALL ; FEATURE ID
SETZB B,C ; B = FLAG FIELD, C = CLASS FIELD
$CALL REDFTR ; SEND A READ FEATURE MSG
PJRST FTRWAT ; WAIT ON RESPONSE
; INIT NRDSBF FOR USE
SBFINI: MOVEI T1,NRDSBF+1(R)
HRLI T1,-1(T1)
SETZM -1(T1)
BLT T1,NRDSBF+NRDBSZ/4-1(R)
MOVE T1,[POINT 8,NRDSBF(R)]
MOVEM T1,NRDSPT(R)
$RET
SUBTTL Miscellaneous Support Functions
; MAP A DEVICE SPEC
;
; INPUT: J2 = PTR TO DEVICE SPEC: "<NODE>::P<DEV>[<UNIT>]:"
;
; OUTPUT: DEVICE SPEC IN RDHOST(R)
; T1,T2,J1,J2 = CLOBBERED
MAPDEV: TLC J2,-1 ; GENERIC POINTER ?
TLCN J2,-1 ; BACK TO ORIG, SKIP IF WAS NONZERO
HRLI J2,(POINT 7) ; IT WAS GENERIC - MAKE IT SPECIFIC
$CALL EFADBY ; CALC EFFECTIVE ADDR
MOVEI J1,6 ; LIMIT FOR HOST NAME
SKIPA T1,[POINT 7,RDHOST(R)]
MAPD1: IDPB T2,T1
ILDB T2,J2 ; NEXT CH
JUMPE T2,MAPD4 ; END OF STRING
CAIE T2,":"
JRST [ SOJGE J1,MAPD1 ; END OF HOST NAME
ERRI NODX01,CPOPJ] ; HOST NAME TOO LONG
MOVE T1,[POINT 7,RDDEV(R)]
MOVEI J1,4 ; ALLOW 3 DEV + 1 UNIT
ILDB T2,J2
JUMPE T2,MAPD4
CAIN T2,":"
ILDB T2,J2 ; FLUSH EXTRA :
JUMPE T2,MAPD4
CAIN T2,"P" ; FLUSH LEADING P
MAPD3: ILDB T2,J2
JUMPE T2,MAPD4
CAIN T2,":"
JRST MAPD4
CAIE T2,"T" ; FLUSH T FROM LPT
CAIN T2,"D" ; FLUSH D FROM CDR
SKIPA
IDPB T2,T1
SOJGE J1,MAPD3
ERRI ARGX19,CPOPJ ; INVALID UNIT NO.
MAPD4: LDB T2,T1 ; GET LAST CH
CAIL T2,"0"
CAILE T2,"9"
MOVEI T2,"0" ; USE A DEFAULT OF ZERO
IDPB T2,T1
LDB T1,[POINT 14,RDDEV(R),13] ; GET 1ST 2 CHARS OF DEV NAME
CAIN T1,"CR"
JRST MAPD5
CAIE T1,"LP"
ERR GJFX16,CPOPJ ; NO SUCH DEVICE
TXOA LS,NRD.LP ; SET DEVICE= LPT
MAPD5: TXZ LS,NRD.LP ; SET DEVICE= CDR
CPOPJ1: AOS (P) ; MAKE IT A SKIP RETURN
CPOPJ: $RET ; RETURN
; GNRxSP
; GNRMSP - CREATE AN NRM JFN SPEC
; GNRDSP - CREATE AN NRD JFN SPEC
;
; INPUT: DEVICE SPEC IN RDHOST(R)
;
; OUTPUT: A = PTR TO THE SPEC ON STACK
; -1(A) = PTR TO RESTORE PDL FROM
; T1,T2 = CLOBBERED
GNRMSP: TDZA T2,T2 ; ZERO SIGNALS NRM SPEC
GNRDSP: MOVEI T2,1 ; ONE SIGNALS JFN SPEC
POP P,T1 ; REMOVE THE RETURN ADR
MOVE A,P ; GET RESTORATION PDL PTR
PUSH P,A ; SAVE IT ON STACK
MOVSI A,(POINT 7) ; A = PTR TO BEG OF SPEC
HRRI A,1(P)
ADD P,[6,,6] ; 30 BYTE SPEC
PUSH P,T1 ; PUT RETURN ADR BACK ON
$CALL SAV2 ; SAVE A & B
MOVE B,[POINT 7,[ASCIZ .DCN:.]]
$CALL INSTR ; INSERT NSP DEV TYPE
MOVE B,[POINT 7,RDHOST(R)]
$CALL INSTR ; INSERT NODE NAME
MOVE B,GNRTB(T2) ; GET ID STRING
$CALL INSTR ; INSERT OBJECT AND ATRIB.
MOVEI T1,"0" ; USERID OF 20 MEANS LP
TXNN LS,NRD.LP ; LPT?
MOVEI T1,"1" ; NO,USERID OF 21 MEANS CR
IDPB T1,A ; STORE FINAL CHARACTER
SETZ T1, ; MAKE IT ASCIZ STRING
IDPB T1,A ; ...
$RET ; RET NRM JFN SPEC ON STACK,
GNRTB: POINT 7,[ASCIZ .-NRM;USERID:2.]
POINT 7,[ASCIZ .-002;USERID:2.]
INSTR: ILDB T1,B ; A = DEST PTR, B = SRC PTR
JUMPE T1,CPOPJ ; QUIT ON NULL BYTE
IDPB T1,A ; INSERT THIS BYTE IN DEST STRING
JRST INSTR ; HOHUM
; EFADR - EFFECTIVE ADDRESS CALCULATION FUNCTION
; ENTRY: T2 = WORD TO BEGIN EFFECTIVE ADR CALC ON
; REGS 0-R SAVED AT RDSAVE(R)
; EXIT: T1 = EFFECTIVE ADDRESS
EFADR: LDB T1,[POINT 4,T2,17] ; GET INDEX FIELD
JUMPE T1,EFAD1 ; NO INDEXING
CAIG T1,16 ; CHECK FOR T1 -> SAVED AC
ADDI T1,RDSAVE(R) ; T1 = PTR TO REG SLOT
CAIN T1,P ; CHECK FOR STACK REFERENCE
JRST [ MOVE T1,RDEPDL(R) ; YES, GET CONTENT BEFORE NURD
SOJA T1,.] ; ...
HRRZ T1,(T1) ; T1 = PTR TO INDEX REG - GET CONTENTS
EFAD1: ADDI T1,(T2) ; T1 = INDEXED ADDRESS
CAIG T1,R ; CHECK FOR T1 -> SAVED AC
ADDI T1,RDSAVE(R) ; T1 = PTR TO REG SLOT
TLNN T2,(@) ; CHECK FOR INDIRECT ADDRESSING
$RET ; ALL DONE
MOVE T2,(T1) ; ANOTHER ROUND
JRST EFADR ; ...
; BYTE POINTER EFFECTIVE ADDRESS CALCULATION
;
; INPUT: J2 = BYTE POINTER (NOT THE -1,,ADDR THING)
;
; OUTPUT: J2 = APPROPRIATELY MODIFIED BYTE POINTER
;
; ALL OTHER CONDITIONS ARE EXACTLY AS FOR EFADR, ABOVE.
EFADBY: MOVE T2,J2 ; COPY THE INPUT ARG
TLZ J2,(@(17)) ; TURN OFF INDIR AND INDEX IN RETURN
$CALL EFADR ; DO THE EFFECTIVE ADDR CALCULATION
HRR J2,T1 ; ADD THE ADDR HALFWORD
$RET ; ALL DONE
SUBTTL Entry Setup
; USER ENTRY REGISTER SETUP
;
; INPUT: CALL WITH USER REGS UNMODIFIED
;
; OUTPUT: LS = DATA LINK STATUS - NRDSTS(R)
; DS = DEVICE STATUS - NRDDST(R)
; R = RDDB PTR
; J1,T1,T2 = CLOBBERED
SETUP1: PUSH P,[0] ; NON-SKIP TYPE JSYS
SKIPA
SETUP2: PUSH P,[UJ.XT2] ; SKIP TYPE JSYS
XOR J1,SUBJFN ; SEE IF AN OK JFN
TRNE J1,-1 ; ...
JRST [ POP P,J1 ; NO, CLEAN UP STACK
ERRI DESX3,CPOPJ] ; SAY WE HAVE A PROBLEM
XOR J1,SUBJFN ; BACK TO ORIGINAL J1
MOVEM 16,RDSAVE+16(J1) ; SAVE THE CALLER AC'S
MOVEI 16,RDSAVE(J1) ; ...
BLT 16,RDSAVE+15(J1) ; ...
HRRZ R,J1 ; SET THE DATABASE POINTER
POP P,T2 ; GET THE ENTRY FLAG
AOSA (P) ; SKIP EXIT
; SKIP INTO FOLLOWING CODE
; SPECIAL ENTRY FOR UGTJFN
; INPUTS AND OUTPUTS SAME AS SETUPx, ABOVE.
USETUP: MOVEI T2,UJ.XT2 ; SET FOR SKIP TYPE JSYS
POP P,T1 ; SAVE INITIAL STATE OF PDL
MOVEM P,RDEPDL(R) ; FOR ERROR EXITS
PUSH P,T1 ; PUT RETURN ADDRESS BACK ONTO STACK
MOVE T1,RDSTS(R) ; RECORD ENTRY STATUS
TXZ T1,UJ.XT2 ; SET EXIT TYPE
IOR T1,T2 ; ...
MOVEI J1,.FHSLF ; DETERMINE SOFTWARE INTERRUPT STATE
SKPIR ; SKIP IF ON
TXZA T1,UJ.INT ; INTERRUPTS NOT ON
TXO T1,UJ.INT ; INTERRUPTS ARE ON
TXZ T1,UJ.TDS ; FLUSH TEMP DISABLE FLAG
MOVEM T1,RDSTS(R) ; SAVE ENTRY STATE
$CALL INTOFF ; DISABLE INTERRUPTS
MOVEI T1,UJ.NRD ; PROCLAIM THAT WE
IORM T1,RDSTS(R) ; IS PROCESSING
MOVE LS,NRDSTS(R) ; LOAD DATA LINK STATUS
MOVE DS,NRDDST(R) ; LOAD DEVICE STATUS
$CALL SETDST ; UPDATE DEVICE STATUS
MOVEM DS,NRDDST(R) ; TO ENTRY STATE
$CALL INTON ; ENABLE INTERRUPTS
TXNE LS,NRD.OC ; OPEN COMPLETE?
$CALL INRDIN ; YES,INIT FOR NURD INTERRUPT MESSAGES
SETZM NRDIER(R) ; INIT OUR ERROR PTR AT UJSYS ENTRY
SETZM RDERT(R) ; NO ERROR RETURN YET SPECIFIED
$RET
SUBTTL Exit Routes & Error Processing
; USER LEVEL ERROR EXIT
ERRTN: PUSH P,J2 ; J1 = ERROR CODE
MOVE J2,J1 ; COPY ERROR CODE
MOVEI J1,.FHSLF ; SO CAN DO SETER
SETER ; ...
MOVE J1,J2 ; RESTORE J1
POP P,J2 ; AND J2
CAME R,SUBJFN ; DO WE HAVE A DATABASE ?
$RET ; NO, LEAVE - NO AC'S SAVED
$CALL INTOFF ; DISALLOW INTERRUPTS FOR AWHILE
MOVE P,RDEPDL(R) ; RESTORE ENTRY PDL
MOVEM J1,RDSAVE+J1(R) ; SET ERROR CODE RETURN
LDB T2,[POINT 23,@(P),35] ; GET POSSIBLE ERJMP/ERCAL DISP ADDR
$CALL EFADR ; AND CALC THE EFFECTIVE ADDR TO T1
LDB T2,[POINT 13,@(P),12] ; GET OPCODE TO SEE IF ERJMP OR ERCAL
CAIN T2,<ERCAL>_-^D23 ; HAS CALLER SPECIFIED ERCAL ?
HRRZM T1,RDERT(R) ; SET ADDRESS, WITH 0 FLAG
CAIN T2,<ERJMP>_-^D23 ; WAS AN ERJMP SPECIFIED ?
HRROM T1,RDERT(R) ; SET ADDRESS, WITH -1 FLAG
$CALL SETDST ; UPDATE DEVICE STATUS
TXNE LS,NRD.OF ; IS DEVICE OFFLINE ?
JRST [ MOVEM LS,NRDSTS(R) ; UPDATE STS BEFORE INT
MOVEM DS,NRDDST(R) ; ...
MOVX J1,NRD.EN ; SEE IF USER IS ENABLED
TDNE J1,NRDSTS(R) ; FOR THIS INTERRUPT
JRST CKI3 ; SEEMS TO BE
JRST ERRTX] ; NOPE, JUST BE QUIET
MOVE J1,NRDDST(R) ; GET DEVICE STATUS AT ENTRY
XOR J1,DS ; J1 = BITS CHANGED SINCE ENTRY
MOVE J2,DS
AND J2,J1 ; J2 = BITS GONE HIGH
TXNE J2,MO%FER!MO%HE!MO%LCI ; CHECK FOR HARD ERRORS
JRST CKI2 ; HARD ERROR
TXNE J2,MO%SER!MO%LPC ; CHECK SOFT ERRORS
JRST CKI3 ; SOFT ERROR
TXNN LS,NRD.LP ; DO WE HAVE LPT ?
TXNN J1,MO%EOF ; NO, SEE IF EOF ON CDR
JRST ERRTX ; NEITHER LPT, OR EOF ON CDR
MOVX J2,1B<.ICEOF> ; EOF IT IS!
JRST CKI4 ; GO DO IT TO IT
CKI2: SKIPA J2,[1B<.ICDAE>] ; HARD=> DATA ERROR
CKI3: MOVE J2,NRDCHN(R) ; SOFT=> USE USER DEFINED CHANNEL
CKI4: MOVEI J1,.FHSLF
IIC ; GEN AN INTERRUPT
ERJMP ERRTX ; ??
SETZM RDERT(R) ; CLEAR ERCAL/ERJMP INDICATOR
ERRTX: SKIPN J1,RDERT(R) ; DO WE HAVE ERJMP/ERCAL TO SIMULATE ?
JRST UEXIT ; NOPE
JUMPG J1,[ AOS (P) ; ERCAL, FIX USER'S RETURN ADDR
PUSH P,J1 ; PUT ERCAL LOC ON STACK
JRST UEXIT] ; OK
HRRM J1,(P) ; ERJMP, SET APPROP DISPATCH ADDRESS
PJRST UEXIT ; FINISH UP AND LEAVE
; *** SUCRTN
; THIS IS NORMAL (SUCCESS) EXIT FROM NURD20
SUCRTN: MOVEI T1,UJ.XT2 ; SUCCESS EXIT
MOVE P,RDEPDL(R) ; RESTORE ENTRY PDL
TDNE T1,RDSTS(R) ; CHECK EXIT TYPE
AOS (P) ; A SKIP RETURN
$CALL INTOFF ; TURN OFF INTERRUPTS
UEXIT: TXZ LS,NRD.RS ; FLUSH RESUME ISSUED FLAG
HRRM LS,NRDSTS(R) ; DATA LINK STATUS, RESTORE USER FLAGS
MOVEM DS,NRDDST(R) ; DEVICE STATUS
MOVE J3,NRDSTS(R) ; SEE IF WE HAVE
TXZN J3,NRD.NO ; AN ALERT TO REPORT
JRST UEX0 ; NOPE
MOVEM J3,NRDSTS(R) ; CLEAR THE FLAG
TXNN J3,NRD.EN ; DOES USER WANT TO KNOW ?
JRST UEX0 ; NOPE
MOVEI J1,.FHSLF ; YES, SO WE WILL
MOVE J2,NRDCHN(R) ; INTERRUPT
IIC ; HIM
ERJMP UEX0 ; ? WELL, WE REALLY TRIED
UEX0: MOVEI T1,UJ.NRD ; UNPROCLAIM NURD PROCESSING
ANDCAM T1,RDSTS(R) ; ...
MOVSI 16,RDSAVE(R) ; RESTORE AC'S
BLT 16,16 ; ...
$CALL SAV2J ; SAVE SOME REGISTERS TEMPORARILY
MOVE J2,SUBJFN ; GET DATA BASE POINTER
MOVE J1,RDSTS(J2) ; GET RDSTS
PUSH P,J1 ; FOR LATER PROCESSING
TXNN J1,UJ.FLS ; ARE WE FLUSHING THE DATA BASE?
PJRST UEXX ; NO, ENABLE INTERRUPTS AND GET OUT
SKIPN J1,RDINTB(J2) ; HAVE WE FOOLED WITH INT SYSTEM ?
JRST UEX1 ; NOPE
HLRZM J1,NRDLVL-1(J1) ; YES, SO RESTORE INT PC LOCATION
MOVEI J1,.FHSLF ; TURN OFF OUR INTERRUPTS
MOVX J2,1B<NRDICH>+1B<NRDDCH>; BOTH CHANNELS
DIC ; ...
MOVE J2,SUBJFN ; GET RDDB PTR AGAIN
SKIPN J2,NRDCAP(J2) ; NOW, CLEAN UP CORE CHUNKS
JRST UEX1 ; NONE THERE
HLRZ J1,J2 ; GET LENGTH
HRRZS J2 ; AND ISOLATE ADDRESS
$CALL M%RMEM ; GIVE IT BACK
UEX1: MOVEI J1,RDDBSZ ; NOW FOR MAIN DATABASE
MOVE J2,SUBJFN ; GET ADDRESS OF IT
SETOM SUBJFN ; CLOBBER POINTER
$CALL M%RMEM ; GIVE UP MEMORY
UEXX: MOVEI J1,.FHSLF ; SET TO TURN ON INTERRUPT SYS
POP P,J2 ; GET BACK THE RDSTS WORD
TXNE J2,UJ.TDS ; DID WE DISABLE THE INT SYSTEM ?
EIR ; YES, TURN IT BACK ON
$RET ; AND LEAVE
; INTERNAL ERROR PROCESSOR
; CALL: INVOKED BY NRDR MACRO
; SAVES LOCATION OF ERROR IN NRDIER
;
; IN: J1 = Error location ,, Error code
; (P) = Continuation address (return)
;
; OUT: J1 = Error code
NRDERR: TRNN J1,-1 ; ANY CODE SET ?
HRRI J1,DCNX8 ; NO, SUPPLY THE DEFAULT
PUSH P,J1 ; SAVE INPUT ARG
SKIPE J1,NRDIER(R) ; GET ERR BUFFER PTR
AOBJN J1,NR1 ; OK, ADVANCE PTR
MOVSI J1,-NURDL ; WRAPAROUND
HRRI J1,NRDERH(R) ; ...
NR1: POP P,(J1) ; SAVE LOCATION,,CODE FOR ERROR
MOVEM J1,NRDIER(R) ; UPDATE NRDERH PTR
HRRZ J1,(J1) ; ISOLATE CODE IN J1
TXO DS,MO%FER!MO%SER ; ALL NRDR'S ARE FATAL
$RET
SUBTTL Interrupt Processing
NURDPC: BLOCK 1 ; NURD INTERRUPT LEVEL PC SAVER
; INIT NURD INTERRUPT SERVICE
INRDIN: SKIPE RDINTB(R) ; INTERRUPTS ALREADY ENABLED?
$RET ; YES, JUST EXIT
$CALL SAV3J
MOVEI J1,.FHSLF
RIR ; READ USER'S INTERRUPT DATA
JUMPE J2,CPOPJ ; SIR HAS NOT BEEN DONE
MOVE T1,[NRDLVL,,INRD]
MOVEM T1,NRDICH(J2) ; SET NRD SERVICE IN PCHNTB
MOVE T1,[NRDLVL,,DNRD]
MOVEM T1,NRDDCH(J2)
MOVEI T1,NURDPC
MOVSS J2
HRL J2,NRDLVL-1(J2) ; REMEMBER OLD CONTENTS OF PLEVTB
MOVEM T1,NRDLVL-1(J2) ; SET NURD PC SAVE LOC IN PLEVTB
MOVEM J2,RDINTB(R) ; SAVE THIS INFO FOR LATER FIXUP
MOVE J1,NRDJFN(R) ; ENABLE INTS FOR DATA LINK MSGS
MOVEI J2,.MOACN
MOVX J3,<.MOCIA>B8+<NRDICH>B17+<NRDDCH>B26
MTOPR
MOVEI J1,.FHSLF
MOVX J2,1B<NRDICH>+1B<NRDDCH>
AIC ; ACTIVATE NRD CHANNEL
$RET
; TURN ON INTERRUPTS
INTON: $CALL SAV1J ; SAVE J1
MOVEI J1,UJ.TDS ; CHECK FOR
TDNN J1,RDSTS(R) ; INTERRUPT DISABLE
$RET ; NOT DISABLED
ANDCAM J1,RDSTS(R) ; CLEAR DISABLED FLAG
MOVEI J1,.FHSLF ; TURN THE INT SYSTEM
EIR ; BACK ON
$RET ; LEAVE
; TURN OFF INTERRUPTS
INTOFF: $CALL SAV1J ; SAVE J1
MOVEI J1,UJ.INT ; IS THE INT SYSTEM OFF
TDNN J1,RDSTS(R) ; ?
$RET ; YES, IT IS OFF - GO AWAY
MOVEI J1,.FHSLF ; NO, TURN IT OFF
DIR ; ...
MOVEI J1,UJ.TDS ; REMEMBER THAT WE DID IT
IORM J1,RDSTS(R) ; ...
$RET ; LEAVE
; RECEIVED A DATA INTERRUPT
; WE MUST BE CAREFUL TO PRESERVE USER AC'S
DNRD: PUSH P,A ; SAVE A COUPLE
PUSH P,B ; OF AC'S
SKIPG B,SUBJFN ; GET RDDB POINTER
JRST DNRDX ; DEFENSIVE
MOVEI A,UJ.RCV ; SET RCV DATA INT FLAG
IORM A,RDSTS(B) ; ...
HRRZ A,NURDPC ; CHECK FOR POSSIBLE WAIT CONDITIONS
CAIL A,SENDER ; ARE WE IN REGION OF INTEREST ?
CAILE A,USOWTR ; SOUTR WAIT
JRST DNRDX ; NOT IN SOUTR REGION
CAIN A,USOWTR ; AT ACTUAL SOUTR WAIT ?
JUMPE J3,[ MOVE A,NURDPC ; SOUTR IS DONE
JRST DNBRK] ; GO SET APPROP PC
MOVEI A,UJ.SSO ; SET SUSPENDED SOUTR FLAG
IORM A,RDSTS(B) ; ...
MOVEI A,BRKS ; SET BREAK PC
HLL A,NURDPC ; ...
DNBRK: TXO A,1B5 ; SET USER MODE
MOVEM A,NURDPC ; TOP LEVEL WILL RESUME
DNRDX: POP P,B ; RESTORE CLOBBERED AC'S
POP P,A ; ...
DEBRK ; DISMISS INTERRUPT
; NURD INTERRUPT MESSAGE PROCESSOR
INRD: PUSH P,J1 ; SAVE SOME
PUSH P,J2 ; AC'S FOR
PUSH P,J3 ; WHILE WE
PUSH P,J4 ; ARE WORKING
PUSH P,R ; ...
SKIPG R,SUBJFN ; GET RDDB FOR THIS FORK
JRST INRDX ; DEFENSIVE
MOVE J1,NRDJFN(R) ; READ THE MESSAGE
MOVEI J2,.MORIM
MOVEI J3,NRDIBF(R)
HRLI J3,(POINT 8) ; J3 = PTR TO BUFFER
PUSH P,J3 ; SAVE IT FOR READING
MTOPR ; GET IT - J4 = NO. CHARS READ
POP P,J3
SKIPE DEBUGR ;[55] DEBUGGING
$CALL [$CALL SAV4J ;[55]
$CALL SAV4 ;[55]
TYPE (***** Receving interrupt message *****)
$CALL TCRLF
MOVE D,J4 ;[55]
MOVE A,J3 ;[55]
JRST RCVTY1] ;[55]
JUMPE J4,INRDX ; VACUOUS MSG
ILDB J1,J3 ; GET MSG TYPE
CAIE J1,NM.ALR ; BETTER BE AN ALERT MSG!
JRST INRDX ; IGNORE ???
; ALERT - DEVICE CLAIMS TO BE FIXED
MOVX J1,NRD.OF ; WE ARE NO LONGER OFFLINE
TDNN J1,NRDSTS(R) ; SEE IF WE EVER KNEW WE WERE OFFLINE
JRST [ MOVX J1,NRD.ON ; NO, OFFLINE NOT HERE YET
IORM J1,NRDSTS(R) ; LETS REMEMBER THIS
JRST INRDX] ; FOR LATER
ANDCAB J1,NRDSTS(R) ; WE ARE OFFLINE, SO CLEAR IT
TXNN J1,NRD.EN ; DOES USER WANT TO KNOW ?
JRST INRDX ; NOPE
MOVX J1,UJ.NRD ; CHECK FOR
TDNE J1,RDSTS(R) ; NURD PROCESSING
JRST [ MOVX J1,NRD.NO ; WE WANT TO
IORM J1,NRDSTS(R) ; SAY ONLINE
JRST INRDX] ; AS WE LEAVE
MOVEI J1,.FHSLF ; ISSUE AN INTERRUPT
MOVE J2,NRDCHN(R) ; ON USER'S CHANNEL
POP P,R ; BUT FIRST, BACK TO
POP P,J4 ; USER'S AC'S
POP P,J3 ; ...
IIC ; TICKLE !
ERJMP INRDXX ; ??
JRST INRDXX ; LEAVE
INRDX: POP P,R ; RESTORE AC'S
POP P,J4 ; ...
POP P,J3 ; ...
INRDXX: POP P,J2 ; ...
POP P,J1 ; ...
DEBRK ; DISMISS INTERRUPT
SUBTTL Debug Typeout Routines
TYBUF: $CALL SAV4J
$CALL SAV4
$CALL TCRLF
TYPE (Seq: )
MOVEI A,NRDSBF(R)
HRLI A,(POINT 8)
IBP A ; SKIP NURD MSG TYPE
IBP A ; SKIP NURD FLGS
ILDB J2,A
$CALL NUMO ; SEQ NUMBER
TYPE ( Flags: )
ILDB J2,A
$CALL ONUMO ; DATA FLAGS
TYPE ( Segs: )
ILDB J2,A
MOVE B,J2 ; SAVE IT
$CALL NUMO ; NO. SEGMENTS
$CALL TCRLF ; B = NO. OF SEGMENTS
TYBUF1: SOJL B,CPOPJ ; DONE
ILDB C,A ; GET NEXT SEGMENT HEAD
TYBUF2: SOJL C,TYBUF1 ; SEG DONE
ILDB J1,A
PBOUT
JRST TYBUF2
TCRLF: TYPE (
)
$RET
; CALL WITH NUMBER IN J2, CLOBBERS J1
ONUMO: SKIPA J1,[^D8] ; OCTAL OUT
NUMO: MOVEI J1,^D10 ; DECIMAL OUT
PUSH P,J3 ; SAVE J3
MOVE J3,J1 ; SET RADIX
MOVEI J1,.PRIOU ; SEND TO TTY
NOUT ; SEND THE NUMBER
JFCL ; ??
POP P,J3 ; RESTORE J3
$RET
; MONITOR RECEIVED NURD MESSAGES
RCVTYP: $CALL SAV4J
$CALL SAV4
MOVE D,NRDRCN(R) ; GET BUFFER COUNT
MOVE A,NRDRPT(R) ; GET PTR
TYPE (***** Receiving data message *****)
$CALL TCRLF
RCVTY1: SOJL D,[ TYPE (Empty message !!)
PJRST TCRLF]
ILDB B,A ; GET MSG TYPE
CAIL B,NM.OTR
$RET ; ILLEGAL TYPE
MOVE J1,RMONTP(B) ; CHECK IF THIS TYPE MONITORED
TDNN J1,DEBUGR
$RET ; NO
$CALL TCRLF
MOVE J1,MSGTYP(B) ; TYPE
TYPE
TYPE ( NURD msg flags: )
SOJL D,[ TYPE (...Insuff data)
PJRST TCRLF]
ILDB J2,A
$CALL ONUMO
$CALL TCRLF
PJRST @MTYPER(B) ; DISPATCH TO INDIVIDUAL MSG TYPER
MTYPER: TYPDAT ; DATA
TYPATT ; ATTENTION
TYPFTR ; FEATURES
TYPCTL ; CONTROL
TYPALR ; ALERT
TYPCAP ; CAPABILITIES
MONDAT==1
MONATT==2
MONFTR==4
MONCTL==10
MONALR==20
MONCAP==40
RMONTP: MONDAT
MONATT
MONFTR
MONCTL
MONALR
MONCAP
MSGTYP: [ASCIZ /Data msg: /]
[ASCIZ /Attention msg: /]
[ASCIZ /Feature msg: /]
[ASCIZ /Control msg: /]
[ASCIZ /Alert msg: /]
[ASCIZ /Capabilities msg: /]
; DATA MESSAGE FORMAT:
; <0><MSG FLGS><SEQ. NO.><DATA FLGS><SEG. CNT>[SEGMENTS]
; SEGMENT FORMENT:
; <CNT><... CNT DATA ITEMS ...> OR <200!CNT><DATA ITEM>
;
; A = PTR TO <SEQ NO.>
; D = REMAINING BUFFER COUNT
TYPDAT: SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
$CALL TYPSEQ ; SEQ NO.
TYPE ( Flags: )
SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
ILDB B,A
MOVE C,[-DMFL,,DMFTX]
$CALL TYPAFL ; TYPE THE FLAGS
TYPE ( Segment count: )
SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
ILDB C,A ; GET SEG CNT
MOVE J2,C
$CALL NUMO
MOVNI C,1(C)
MOVSI C,(C) ; C = -<CNT+1>,,0
TYPSEG: $CALL TCRLF ; END LAST SEQUENCE
AOBJP C,TYPDON ; NO MORE SEGS
TYPE (Segment: )
HRRZ J2,C
$CALL NUMO
TYPE ( Count: )
SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
ILDB B,A ; GET SEG SIZE
MOVE J2,B
$CALL NUMO
$CALL TCRLF
JUMPN B,TYPSG1
TYPE (EOR)
JRST TYPSEG
TYPSG1: TXZN B,200 ; CHECK FOR COMPRESSED
JRST TYPSG2
TYPE (Compressed segment: )
MOVE J2,B
$CALL NUMO
MOVEI J1,"<"
PBOUT
TXNE LS,NRD.IM!NRD.AI
SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
$CALL TYPITM
MOVEI J1,">"
PBOUT
JRST TYPSEG
TYPSG2: SOJL B,TYPSEG ; UNCOMPRESSED
TYPSG3: SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
TXNE LS,NRD.IM!NRD.AI
SOJL D,TYPDXR ; NOT ENOUGH FOR NEXT BYTE
$CALL TYPITM
SOJL B,TYPSEG
TXNN LS,NRD.IM!NRD.AI
JRST TYPSG3
MOVEI J1,"," ; SEPARATE IMAGE ITEMS BY COMMAS
PBOUT
JRST TYPSG3
TYPDXR: TYPE (...Insuff data)
$CALL TCRLF
TYPDON: $RET
TYPSEQ: TYPE (Sequence: )
ILDB J2,A
PJRST NUMO
TYPITM: ILDB J1,A ; TYPE A DATA ITEM
TXNN LS,NRD.IM!NRD.AI ; CHECK TWO BYTES
JRST [ PBOUT ; ASCII
$RET] ; ...
ILDB J2,A ; IMAGE MODE
DPB J2,[POINT 8,J1,27]
MOVE J2,J1
PJRST ONUMO
DEFINE DATXT (FLAG,TEXT) <
ND.'FLAG,,[ASCIZ /'TEXT'/]
>
DMFTX: DATXT ACK,Acknowledge
DATXT IER,Input-error
DATXT EOF,EOF
DMFL==.-DMFTX
TYPALR:
TYPCAP: JRST TCRLF
; ATTENTION MSG FORMAT:
; <NM.ATT><NURD FLGS><LAST SEQ NO.><ATT. REASON CODE><DEVSTS 1-3><PAGE CNT 2>
;
; A = PTR TO <LAST SEQ NO.>
; D = REMAINING BYTES IN BUFFER
TYPATT: SOJL D,TYPDXR
$CALL TYPSEQ ; SEQ NO.
TYPE ( Reason: )
SOJL D,TYPDXR
ILDB B,A ; GET REASON
CAIG B,N.APLE
SKIPA J1,RESNCD(B) ; EXPLAIN WHY
MOVEI J1,[ASCIZ /Apparently just for kicks/]
TYPE
$CALL TCRLF ; BEGIN FLAGS ON NEW LINE
TYPE (Flags: )
SOJL D,TYPDXR
ILDB B,A ; GET FLAGS
MOVE C,[-BYT1L,,BYT1TB]
$CALL TYPAFL
TXNN B,200 ; CHECK EXTENSION
JRST TYPAPG
SOJL D,TYPDXR
ILDB B,A
MOVE C,[-BYT2L,,BYT2TB]
$CALL TYPAFL
; DEVICE SPECIFIC FLAGS
TXNN LS,NRD.LP
SKIPA C,[-CBYT2L,,CBYT2T]
MOVE C,[-LBYT2L,,LBYT2T]
$CALL TYPAFL
TXNN B,200 ; CHECK FOR THIRD BYTE
JRST TYPAPG
SOJL D,TYPDXR
ILDB B,A
TXNN LS,NRD.LP
SKIPA C,[-CBYT3L,,CBYT3T]
MOVE C,[-LBYT3L,,LBYT3T]
$CALL TYPAFL
TYPAPG: $CALL TCRLF ; PAGE COUNT ON NEW LINE
TYPE (Page count: )
SOS D
SOJL D,TYPDXR
ILDB J2,A
ILDB J1,A
DPB J1,[POINT 8,J2,27]
$CALL NUMO
PJRST TCRLF
TYPAFL: TSNN B,(C) ; CHECK FOR BIT SET
JRST TYPAFX ; B = FLAGS, C = TABLE
HRRZ J1,(C) ; YES - GET TEXT
TYPE
MOVEI J1," "
PBOUT
TYPAFX: AOBJN C,TYPAFL
$RET
RESNCD: [ASCIZ /No reason at all, really/] ; RESERVED
[ASCIZ /Device status change/]
[ASCIZ /Data acknowledgement/]
[ASCIZ /Requested/]
[ASCIZ /Abort received/]
[ASCIZ /Page limit exceeded/]
DEFINE ATTXT (FLAG,TEXT) <
NA.'FLAG,,[ASCIZ /'TEXT'/]
>
BYT1TB: ATTXT FAT,Fatal
ATTXT OFL,Offline
ATTXT PAU,Paused
ATTXT OMD,Out-of-media
ATTXT JAM,Jam
ATTXT OOF,Opr-offline
ATTXT NOE,Non-opr-error
BYT1L==.-BYT1TB
BYT2TB: ATTXT OUF,Output-full
ATTXT NAC,Device-not-accessible
ATTXT DTO,Device-timeout
ATTXT RNA,Resource-not-avail
BYT2L==.-BYT2TB
LBYT2T: ATTXT PSE,Paper-slew
ATTXT INK,Ink
LBYT2L==.-LBYT2T
LBYT3T: ATTXT OVP,Overprint
LBYT3L==.-LBYT3T
CBYT2T: ATTXT PF,Pick-fail
ATTXT RAP,Read-after-punch-error
ATTXT REG,Registration-error
CBYT2L==.-CBYT2T
CBYT3T: ATTXT IVP,Invalid-punch
CBYT3L==.-CBYT3T
; FEATURES MESSAGE FORMAT:
; <NM.FTR><NURD FLAGS><SEQ NO.><NO. FEATURE SPECS>[...<FEATURE SPEC>...]
;
; FEATURE SPEC FORMAT:
; <FEATURE ID><FLAGS><CLASS><RESPONSE>[<VALUE>]
; VALUE FORMAT:
; CLASS 0: <VALUE> (LSB)
; CLASS 1: <CNT><CNT BYTES> (LEAST SIGNIFICANT BYTE 1ST)
;
; A = PTR TO <SEQ NO.>
; D = REMAINING BYTES IN BUFFER
TYPFTR: SOJL D,TYPDXR
$CALL TYPSEQ ; SEQ NO.
TYPE ( No. feature specs: )
SOJL D,TYPDXR
ILDB C,A ; GET NO. SPECS
MOVE J2,C
TYPFT0: $CALL NUMO
TYPFT1: $CALL TCRLF ; FEATURE SPEC LOOP
SOJL C,CPOPJ
TYPE (Feature ID: )
SOJL D,TYPDXR
ILDB B,A ; GET FID
MOVE J3,[-TCMNL,,TCMNF]
TYPFT2: HLRZ J4,(J3)
CAMN B,J4
JRST TYPFID
AOBJN J3,TYPFT2
TXNN LS,NRD.LP ; CHECK DEVICE SPECIFIC FID'S
SKIPA J3,[-TCDRL,,TCDRF]
MOVE J3,[-TLPTL,,TLPTF]
TYPFT3: HLRZ J4,(J3)
CAMN B,J4
JRST TYPFID
AOBJN J3,TYPFT3
MOVEI J3,[0,,[[ASCIZ /Mystery feature/],,0]]
TYPFID: HRRZ J3,(J3)
HLRZ J1,(J3) ; GET FEATURE NAME
TYPE
TYPE ( Flags: )
SOJL D,TYPDXR
ILDB B,A
TXNN B,NF.CMD
SKIPA J1,[[ASCIZ /READ/]]
MOVEI J1,[ASCIZ /SET/]
TYPE
MOVEI J1,[ASCIZ / STD/]
TXNE B,NF.STD
TYPE
TYPE ( Class: )
SOJL D,TYPDXR
ILDB B,A
CAILE B,FC.CL1
JRST TYPFC2
MOVE J2,B
$CALL NUMO
JRST TYPFRS
TYPFC2: CAIE B,FC.SST
SKIPA J1,[[ASCIZ /No class at all/]]
MOVEI J1,[ASCIZ /Set-to-std/]
TYPE
TYPFRS: MOVE J4,B ; SAVE CLASS FOR VALUE
TYPE ( Response: )
SOJL D,TYPDXR
ILDB B,A
CAILE B,TRSPL
MOVEI B,TRSPL
MOVE J1,TRSPT(B)
TYPE
JUMPN B,TYPFT1 ; NO VALUE IF ERROR RESPONSE
CAILE J4,FC.CL1
JRST TYPFT1 ; SET TO STD=> NO VALUE
TYPE ( Value: )
CAIE J4,FC.CL0
JRST TYPVC1
SOJL D,TYPDXR
ILDB J1,A
TXNN J1,1 ; 1 BIT VALUE
SKIPA J1,[[ASCIZ /OFF/]]
MOVEI J1,[ASCIZ /ON/]
TYPE
JRST TYPFT1
TYPVC1: SOJL D,TYPDXR ; TYPE CLASS 1 VALUE,
; J3->[[NAME],,VALUE TABLE]
ILDB B,A ; GET FIELD SIZE
JUMPE B,TYPFT1 ; NULL VALUE ??
SOJL D,TYPDXR
ILDB J2,A ; LOW ORDER BYTE
SOJE B,TYPVLW ; 1 BYTE
SOJG B,[ AOS B ; STRING
MOVE J1,J2
TYPST: PBOUT ; TYPE AS ASCII
SOJL B,TYPFT1 ; STRING DONE
SOJL D,TYPDXR
ILDB J1,A
JRST TYPST]
SOJL D,TYPDXR ; ASSUME 16 BIT NUM
ILDB J4,A
DPB J4,[POINT 8,J2,27]
TYPVLW: HRRZ J3,(J3) ; TYPE BYTE/WORD VALUE,
; J3->[[NAME],,VALUE TABLE]
JUMPE J3,TYPFT0 ; NO INTERPRETATION - TYPE NUMBER
TPVLW1: SKIPN J4,(J3) ; SEARCH VALUE TABLE
JRST TYPFT0 ; UNKNOWN VALUE - TYPE NUMERIC
HLRZS J4
CAME J4,J2
AOJA J3,TPVLW1
HRRZ J1,(J3) ; GET STR PTR
TYPE
JRST TYPFT1
DEFINE FENAM (FTR,TEXT,VALTBL) <
FTR,,[[ASCIZ /'TEXT'/],,VALTBL]
>
TCMNF: FENAM 0,<Reserved> ; RESERVED FOR FUTURE ESCAPE CODE
FENAM FE.DAT,<Data mode>,DATVL ; (CLASS 1)
; DM.ASC== 1 ; 7 BIT ASCII
; DM.CLI== 2 ; COLUMNIMAGE
; DM.EBC== 3 ; EBCDIC
; DM.AUG== 4 ; AUGMENTED COLUMNIMAGE
; DM.AS8== 5 ; 8 BIT ASCII
FENAM FE.SER,<Serial number> ; (CLASS 1)
FENAM FE.LCR,<Lower case raise> ; (CLASS 0)
FENAM FE.FWD,<Form width> ; (CLASS 1)
FENAM FE.EOF,<EOF recognition>,EOFVL ; (CLASS 1)
; EO.ASC== 1 ; ASCII
; EOFASC== 7417 ; ASCII EOF (COLUMN 1) PUNCH
; EO.IMG== 2 ; IMAGE
FENAM FE.DVT,<Device type> ; (CLASS 1)
FENAM FE.TRN,<Record truncation>; (CLASS 0)
FENAM FE.FNM,<Form name> ; (CLASS 1)
FENAM FE.DWD,<Device width> ; (CLASS 1)
FENAM FE.ALL,<All>
TCMNL==.-TCMNF
DEFINE FEVAL (VAL,TEXT) <
VAL,,[ASCIZ \'TEXT'\]
>
DATVL: FEVAL DM.ASC,<ASCII>
FEVAL DM.CLI,<Column-image>
FEVAL DM.EBC,<EBCDIC>
FEVAL DM.AUG,<Augmented-column-image>
FEVAL DM.AS8,<ASCII(8)>
0 ; TABLE TERMINATOR
EOFVL: FEVAL EO.ASC,<ASCII>
FEVAL EO.IMG,<Image>
0 ; TABLE TERMINATOR
TLPTF: FENAM LP.HT,<Horizontal tab stop> ; (CLASS 1)
FENAM LP.SFC,<Standard (OPTICAL) VFU> ; (CLASS 0)
FENAM LP.OVP,<Overprint limit> ; (CLASS 1)
FENAM LP.CVF,<Custom (DAVFU) VFU> ; (CLASS 1)
FENAM LP.FCC,<FORTRAN carriage control> ; (CLASS 0)
FENAM LP.VFR,<Variable forms ratio>,VFRVL ; (CLASS 1)
; VF.6LI== 1 ; 6 LINES PER INCH
; VF.8LI== 2 ; 8 LINES PER INCH
FENAM LP.CHS,<Character set>,CHSVL ; (CLASS 1)
; CH.64== 1 ; 64 CHARACTER SET
; CH.96== 2 ; 96 CHARACTER SET
FENAM LP.PLE,<Page limit enforcement> ; (CLASS 1)
FENAM LP.OPV,<Custom VFU name> ; (CLASS 1)
FENAM LP.RAM,<Translation RAM> ; (CLASS 1)
TLPTL==.-TLPTF
VFRVL: FEVAL VF.6LI,<6 lpi>
FEVAL VF.8LI,<8 lpi>
0 ; TABLE TERMINATOR
CHSVL: FEVAL CH.64,<64 char set>
FEVAL CH.96,<96 char set>
0 ; TABLE TERMINATOR
TCDRF: FENAM CD.CWD,<Card width> ; (CLASS 1)
TCDRL==.-TCDRF
TRSPT: [ASCIZ /0/]
[ASCIZ /Unsupported feature/]
[ASCIZ /Bad class specified/]
[ASCIZ /No standard value/]
[ASCIZ /Data or format error/]
[ASCIZ /Change pending/]
[ASCIZ /Insufficient buffer space to send this message !!/]
[ASCIZ /Device not paused/]
TRSPL==.-TRSPT
; CONTROL MESSAGE FORMAT:
; <NM.CTL><NURD FLAGS><SEQ NO.><COMMAND><RESPONSE>
;
; A = PTR TO <SEQ NO.>
; D = REMAINING BYTES IN BUFFER
TYPCTL: SOJL D,TYPDXR
$CALL TYPSEQ ; SEQUENCE NO.
TYPE ( Command: )
SOJL D,TYPDXR
ILDB B,A ; GET COMMAND
CAILE B,NC.RQC
MOVEI B,ILCMD
MOVE J1,TYPCTB(B) ; GET TEXT
TYPE
TYPE ( Response: )
SOJL D,TYPDXR
ILDB C,A ; GET RESPONSE CODE
DPB B,[POINT 8,C,27] ; MAKE COM.RES CODE
MOVE B,[-CRESL,,CRESTB]
TYPCT1: HLRZ J1,(B)
CAME J1,C
AOBJN B,TYPCT1
HRRZ J1,(B)
TYPE
PJRST TCRLF
TYPCTB: [ASCIZ /Undefined command(0)/]
[ASCIZ /Abort til EOF/]
[ASCIZ /Abort til clear/]
[ASCIZ /Clear abort/]
[ASCIZ /Request status/]
[ASCIZ /Dump output buffers/]
[ASCIZ /Pause/]
[ASCIZ /Resume/]
ILCMD: [ASCIZ /Undefined command/]
[ASCIZ /Request capabilities/]
DEFINE CTXT (COM,RES,TEXT) <
<NC.'COM>B27!<NR.'RES>B35,,[ASCIZ /'TEXT'/]
>
CRESTB: CTXT AUE,ABS,<Abort state>
CTXT AUE,NAB,<Nothing to abort>
CTXT AUE,NOE,<No EOF defined!>
CTXT AUC,ABS,<Abort state>
CTXT AUC,NAB,<Nothing to abort>
CTXT CAB,ACC,<Abort cleared>
CTXT CAB,ACN,<Abort not set>
CTXT RQS,ATT,<Attention message follows>
CTXT DMP,DMP,<Dumping>
CTXT DMP,NOB,<No output buffered>
CTXT PAU,DPS,<Device will pause>
CTXT PAU,PAU,<Device already paused>
CTXT PAU,NDP,<No data transfer to pause>
CTXT RES,RES,<Device will resume>
CTXT RES,NPS,<Device not paused>
CTXT RES,NDR,<No data xfer to resume>
CTXT RQC,CAP,<Capabilities message follows>
CRESL==.-CRESTB
[ASCIZ /Undefined response code/]
IFNDEF DEBUG,<LSTON.> ; INTERESTING TO LOOK AT, SO XLIST THEM
SUBTTL AC Save Coroutines
; These routines (SAVxx) act as co-routines to the routines which
; call them, thus no corresponding "restore" routines are needed.
; When the calling routine returns to its caller, it returns via
; the appropriate restore routine, automatically.
SAV1J: EXCH J1,(P) ; SAVE J1 GET CALLERS ADDRESS
PUSH P,.+3 ; SAVE RETURN ADDRESS FOR CALLER
HRLI J1,-1(P) ; MAKE IT LOOK LIKE RESULT OF JSA
JRA J1,(J1) ; CALL THE CALLER
CAIA . ; NON-SKIP RETURN
AOS -1(P) ; SKIP RETURN
JRST RES1J ; RESTORE J1
SAV2J: EXCH J1,(P) ; SAVE J1 GET CALLERS ADDRESS
PUSH P,J2 ; SAVE J2
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI J1,-2(P) ; SETUP FOR THE JRA
JRA J1,(J1) ; CALL THE CALLER
CAIA . ; NON-SKIP RETURN
AOS -2(P) ; SKIP RETURN
JRST RES2J ; RESTORE J2,J1
SAV3J: EXCH J1,(P) ; SAVE J1 GET RETURN ADDRESS
PUSH P,J2 ; SAVE J2
PUSH P,J3 ; SAVE J3
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI J1,-3(P) ; SETUP FOR JRA
JRA J1,(J1) ; AND CALL THE CALLER
CAIA . ; NON-SKIP
AOS -3(P) ; SKIP RETURN
JRST RES3J ; AND RESTORE J3,J2,J1
SAV4J: EXCH J1,(P) ; SAVE J1 GET RETURN ADDRESS
PUSH P,J2 ; SAVE J2
PUSH P,J3 ; SAVE J3
PUSH P,J4 ; SAVE J4
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI J1,-4(P) ; SETUP FOR RETURN
JRA J1,(J1) ; AND RETURN
CAIA . ; NON-SKIP RETURN
AOS -4(P) ; SKIP RETURN
POP P,J4 ; RESTORE J4
RES3J: POP P,J3 ; RESTORE J3
RES2J: POP P,J2 ; RESTORE J2
RES1J: POP P,J1 ; RESTORE J1
$RET ; AND RETURN
SAV1: EXCH A,(P) ; SAVE A GET CALLERS ADDRESS
PUSH P,.+3 ; SAVE RETURN ADDRESS FOR CALLER
HRLI A,-1(P) ; MAKE IT LOOK LIKE RESULT OF JSA
JRA A,(A) ; CALL THE CALLER
CAIA . ; NON-SKIP RETURN
AOS -1(P) ; SKIP RETURN
JRST RES1 ; RESTORE A
SAV2: EXCH A,(P) ; SAVE A GET CALLERS ADDRESS
PUSH P,B ; SAVE B
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI A,-2(P) ; SETUP FOR THE JRA
JRA A,(A) ; CALL THE CALLER
CAIA . ; NON-SKIP RETURN
AOS -2(P) ; SKIP RETURN
JRST RES2 ; RESTORE B,A
SAV3: EXCH A,(P) ; SAVE A GET RETURN ADDRESS
PUSH P,B ; SAVE B
PUSH P,C ; SAVE C
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI A,-3(P) ; SETUP FOR JRA
JRA A,(A) ; AND CALL THE CALLER
CAIA . ; NON-SKIP
AOS -3(P) ; SKIP RETURN
JRST RES3 ; AND RESTORE C,B,A
SAV4: EXCH A,(P) ; SAVE A GET RETURN ADDRESS
PUSH P,B ; SAVE B
PUSH P,C ; SAVE C
PUSH P,D ; SAVE D
PUSH P,.+3 ; SAVE RETURN ADDRESS
HRLI A,-4(P) ; SETUP FOR RETURN
JRA A,(A) ; AND RETURN
CAIA . ; NON-SKIP RETURN
AOS -4(P) ; SKIP RETURN
POP P,D ; RESTORE D
RES3: POP P,C ; RESTORE C
RES2: POP P,B ; RESTORE B
RES1: POP P,A ; RESTORE A
$RET ; AND RETURN
END