Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0057/sddior.mac
There are 2 other files named sddior.mac in the archive. Click here to see a list.
TITLE S$$IOR INPUT/OUTPUT ROUTINES
SUBTTL P$$DTC DETACH(VARNAME) PRIMITIVE FUNCTION
ENTRY P$$DTC
EXTERN S$$ASB,S$$LKV
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 1.
DETACH(VARNAME) DETACHES ANY INPUT AND(OR) OUTPUT ASSOCIATIONS
THE VARIABLE MAY HAVE, CLEARS THE ASSOCIATION TABLE ENTRY FOR THAT
VARIABLE, AND RETURNS NULL/
P$$DTC: POP ES,R1 ; GET VARIABLE NAME (STRING)
JSP R10,S$$LKV ; LOOKUP VARIABLE
HRRZ R1,(R2) ; GET VARIABLE LOC POINTER
CAIGE R1,^O776000 ; IS IT A TRAP ADDR?
JRST NULRET ; NO, NO ASSOCIATION, RETURN
ASH R1,2 ; COMPUTE ASSOCIATION TABLE ENTRY
ADD R1,S$$ASB
HRRZ R3,(R1) ; GET ACTUAL VARIABLE LOC POINTER
HRRM R3,(R2) ; STORE IN NAME LOC
SETZM (R1) ; CLEAR ENTRY
SETZM 1(R1)
SETZM 2(R1)
SETZM 3(R1)
NULRET: SETZ R1, ; RETURN NULL
JRST (R12)
PRGEND
SUBTTL P$$RLS RELEASE(CHAN) PRIMITIVE FUNCTION
ENTRY P$$RLS
EXTERN S$$MKI,S$$PGL,S$$CHT,S$$MRS,S$$AST,S$$ASB
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 1.
RELEASE(CHAN) RELEASES THE SOFTWARE CHANNEL AND ALL ASSOCIAYIONS
TO IT, RETURNS THE BUFFERS TO FREE STORAGE, AND RETURNS NULL. IF CHAN=0,
ALL CHANNELS ARE RELEASED/
P$$RLS: POP ES,R1 ; GET CHANNEL NUMBER
JSP R7,S$$MKI ; MUST BE INTEGER
CFERR 10,S$$PGL ; BAD ARG IF NOT
JUMPL R1,.+2 ; IF <0
CAILE R1,15 ; OR >15
CFERR 12,S$$PGL ; IT IS AN ILLEGAL UNIT
JUMPE R1,MULRLS ; RELEASE ALL CHANNELS IF =0
JSP R11,CHNRLS ; OR RELEASE JUST ONE
NULRET: SETZ R1, ; RETURN NULL
JRST (R12)
MULRLS: MOVEI R1,15 ; START WITH CHANNEL 15
MOVEM R1,MULCHN ; AND SAVE CHANNEL #
JSP R11,.+2 ; ESTABLISH LOOP ADDR
SOSLE R1,MULCHN ; LOOP UNTIL CHANNEL=0
JRST CHNRLS ; RELEASE CHANNEL
JRST NULRET ; OR FINISH
CHNRLS: SKIPN R10,S$$CHT(R1) ; SKIP IF CHANNEL IN USE
JRST (R11) ; OTHERWISE RETURN
SETZM S$$CHT(R1) ; ZERO CHANNEL TABLE ENTRY
MOVE R9,R1 ; SAVE CHANNEL NUMBER
HRLZI R1,(R1) ; FORM RELEAS CHAN, COMMAND
LSH R1,5
ADD R1,[RELEAS]
XCT R1 ; AND EXECUTE
SETZB R7,R8 ; INITIALIZE I/O CHANNEL FLAGS
TRNN R10,-1 ; INPUT SIDE OPEN?
JRST RLSOUT ; NO, GO CHECK OUTPUT SIDE
MOVEI R1,-1(R10) ; POINTER TO BUFFER HEADER TABLE
JSP R6,S$$MRS ; RETURN BLOCK TO FREE STORAGE
HRRZ R1,(R1) ; POINTER TO BUFFERS
JSP R6,S$$MRS ; RETURN BLOCK
MOVEI R8,(R9) ; SET INPUT FLAG (CHAN #)
RLSOUT: HLRZ R1,R10 ; GET OUTPUT SIDE
JUMPE R1,RLSASC ; SKIP IF OUTPUT SIDE IS NOT OPEN
MOVEI R1,-1(R1) ; POINTER TO BUFFER HEADER TABLE
JSP R6,S$$MRS ; RETURN BLOCK
HRRZ R1,(R1) ; POINTER TO BUFFERS
JSP R6,S$$MRS ; RETURN BLOCK
MOVEI R7,(R9) ; SET OUTPUT FLAG (CHAN # LSH 4)
LSH R7,4
RLSASC: MOVE R10,S$$AST ; GET ASSOC TABLE TOP POINTER
ADDI R10,1 ; POINTER TO LAST ASSOCIATION ENTRY
MOVE R9,S$$ASB ; GET ASSOC. TABLE BOTTOM POINTER
SUBI R9,(R10) ; ASSOC. TABLE LENGTH
LSH R9,-2 ; /4 = # OF ASSOCIATIONS
JRST .+2 ; SKIP INTO LOOP
ASCLOP: ADDI R10,4 ; POINTER TO NEXT ASSOCIATION ENTRY
SKIPN R6,(R10) ; IS IT ACTIVE?
JRST ASCEND ; NO, SKIP AND LOOP
SKIPE R5,1(R10) ; IS THERE NO OUTPUT ASSOCIATION?
JUMPN R7,.+2 ; OR IS OUTPUT FLAG NOT SET?
JRST ASCINP ; YES, SKIP OVER
MOVEI R1,^O360 ; EXTRACT OUTPUT CHANNEL #
AND R1,3(R10)
CAIE R1,(R7) ; IS IT SAME CHANNEL?
JRST ASCINP ; NO
SETZB R5,1(R10) ; YES, ERASE OUTPUT ASSOCIATION
XORM R1,3(R10)
ASCINP: SKIPE R4,2(R10) ; IS THERE NO INPUT ASSOCIATION?
JUMPN R8,.+2 ; OR IS INPUT FLAG NOT SET?
JRST ASCDSC ; YES, SKIP OVER
MOVEI R1,^O17 ; EXTRACT INPUT CHANNEL #
AND R1,3(R10)
CAIE R1,(R8) ; IS IT SAME CHANNEL?
JRST ASCDSC ; NO
SETZB R4,2(R10) ; YES, ERASE INPUT ASSOCIATION
XORM R1,3(R10)
ASCDSC: JUMPN R5,ASCEND ; LOOP IF OUTPUT ASSOC IS NOT 0
JUMPN R4,ASCEND ; LOOP IF INPUT ASSOC IS NOT 0
SETZM (R10) ; BOTH ZERO, RELEASE VARIABLE
MOVS R6,R6 ; ASSOCIATION BY CHANGING NAME
HLRM R6,(R6) ; TO POINT TO LOCATION
ASCEND: SOJG R9,ASCLOP ; LOOP FOR EACH ENTRY
JRST (R11) ; RETURN
; STORAGE
MULCHN: BLOCK 1
PRGEND
SUBTTL P$$CLS CLOSE(CHAN,INHIB,OUTHIB) PRIMITIVE FUNCTION
ENTRY P$$CLS
EXTERN S$$MKI,S$$PGL,S$$CHT
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 3.
CLOSE(CHAN,INHIB,OUTHIB) CLOSES THE INPUT AND(OR) OUTPUT SIDE
OF THE SOFTWARE CHANNEL, AND RETURNS NULL. IF OUTHIB IS NON-NULL, THE
OUTPUT SIDE IS NOT CLOSED; IF INHIB IS NON-NULL, THE INPUT SIDE IS NOT
CLOSED/
P$$CLS: MOVE R8,[CLOSE] ; BARE CLOSE COMMAND
POP ES,R1 ; GET OUTHIB
SKIPE R1 ; IS IT NON-NULL?
ADDI R8,1 ; YES, INHIBIT OUTPUT CLOSING
POP ES,R1 ; GET INHIB
SKIPE R1 ; IS IT NON-NULL?
ADDI R8,2 ; YES, INHIBIT INPUT CLOSING
POP ES,R1 ; GET CHANNEL #
JSP R7,S$$MKI ; MUST BE INTEGER
CFERR 10,S$$PGL ; OR BAD ARG
JUMPLE R1,.+2 ; IF NOT >0
CAILE R1,15 ; OR IF >15
CFERR 12,S$$PGL ; ILLEGAL UNIT
SKIPN S$$CHT(R1) ; HAS CHANNEL BEEN OPENED?
JRST NULRET ; NO, NO SENSE CLOSING
ROT R1,-13 ; GET CHANNEL # INTO AC FIELD
ADD R8,R1
XCT R8 ; EXECUTE CLOSE COMMMAND
NULRET: SETZ R1, ; RETURN NULL
JRST (R12)
PRGEND
SUBTTL P$$LKF,P$$NTF LOOKUP(FILE,CHAN) AND ENTER(FILE,CHAN) PRIMITIVE FUNCTIONS
ENTRY P$$LKF,P$$NTF
EXTERN S$$MKI,S$$PGL,S$$CHT,S$$MKS,P$$OPN,S$$FLR
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 2.
LOOKUP(FILE,CHAN) OPENS FILE FOR INPUT (READING) ON SOFTWARE CHANNEL, RETURNS CHANNEL, FAILS IF FILE NOT FOUND
ENTER(FILE,CHAN) OPENS FILE FOR OUTPUT (WRITING) ON SOFTWARE CHANNEL, RETURNS CHANNEL
IF CHANNEL IS 0, A PRELIMINARY OPEN('DSK') IS PERFORMED. IF INPUT
OR OUTPUT SIDE OF CHANNEL ALREADY SELECTS A FILE, THE OLD FILE IS CLOSED/
P$$LKF: JSP R11,P$$NTF+1 ; LOOKUP, INDEX=0
P$$NTF: JSP R11,P$$NTF+1 ; ENTER, INDEX=1
SUBI R11,P$$NTF
POP ES,R1 ; GET CHAN #
JSP R7,S$$MKI ; MUST BE INTEGER
CFERR 10,S$$PGL ; OR BAD ARG
JUMPN R1,CHKCHN ; SKIP OVER IF NONZERO
PUSH ES,DSKSTR ; OTHERWISE DO OPEN('DSK')
PUSH ES,R1
HRL R11,R12 ; SAVE R11 AND R12
MOVEM R11,DSKSAV
JSP R12,P$$OPN
MOVE R11,DSKSAV ; RESTORE R11 AND R12
HLRZ R12,R11
MOVEI R1,(R1) ; GET CHANNEL #
CHKCHN: JUMPL R1,.+2 ; IF <0
CAILE R1,15 ; OR >15
CFERR 12,S$$PGL ; BAD UNIT
MOVE R2,S$$CHT(R1) ; GET CHANNEL TABLE ENTRY
XCT [TRNN R2,-1
TLNN R2,-1](R11) ; TEST APPROPRIATE SIDE
CFERR 12,S$$PGL ; APPROPRIATE SIDE NOT OPEN
MOVEI R10,(R1) ; SAVE CHANNEL#
POP ES,R1 ; GET FILE NAME
SETO R0, ; CREATE STRING IF NECESSARY
JSP R7,S$$MKS
CFERR 10,S$$PGL ; CANNOT DO
JUMPE R1,BADPRO ; BAD IF NULL
HRRZ R4,(R1) ; GET TOT CHARS IN STRING
JUMPE R4,BADPRO ; BAD IF ZERO
SETZM FILTBL ; INITIALIZE FILE TABLE
SETZM FILTBL+1
SETZM FILTBL+2
SETZM FILTBL+3
MOVE R2,[POINT 6,FILTBL] ; BYTE POINTER FOR FILE NAME
MOVEI R3,6 ; MAX CHARS ALLOWED FOR FILE NAME
FILOOP: ILDB R0,R1 ; GET CHAR
SUBI R0,^O40 ; CONVERT TO SIXBIT
JUMPL R0,BADPRO
CAILE R0,^O77
SUBI R0,^O40
CAIN R0,'.' ; IS IT '.'?
JRST TRYEXT ; YES, GO LOOK FOR EXT
CAIN R0,'[' ; NO, IS IT '['
JRST TRYPRJ ; YES,GO LOOK FOR PROJ,PROG #
IDPB R0,R2 ; NO, PUT CHAR IN FILE NAME
SOJLE R4,FILFIN ; SKIP OUT IF NO MORE CHARS
SOJG R3,FILOOP ; KEEP LOOPING FOR SIX CHARS MAX
ILDB R0,R1 ; GET NEXT CHAR
CAIN R0,"[" ; IS IT "[" ?
JRST TRYPRJ ; YES, GO LOOK FOR PROJ,PROG #
CAIE R0,"." ; IS IT "."?
BADPRO: CFERR 6,S$$PGL ; NO, BAD PROTOTYPE
TRYEXT: SOJLE R4,BADPRO ; ALSO BAD IF NO MORE CHARS AFTER "."
MOVEI R3,3 ; MAX CHARS ALLOWED FOR EXT NAME
MOVE R2,[POINT 6,FILTBL+1] ; BYTE POINTER FOR FILE EXT
EXTLOP: ILDB R0,R1 ; GET CHAR
SUBI R0,^O40 ; CONVERT TO SIXBIT
JUMPL R0,BADPRO
CAILE R0,^O77
SUBI R0,^O40
CAIN R0,'[' ; IS IT '[' ?
JRST TRYPRJ ; YES, GO LOOK FOR PROJ,PROG #
CAIN R0,'<' ; IS IT '<' ?
JRST TRYPRO ; YES, GO LOOK FOR PROTECTION
IDPB R0,R2 ; PUT CHAR IN EXT
SOJLE R4,FILFIN ; SKIP OUT IF NO MORE CHARS
SOJG R3,EXTLOP ; LOOP FOR THREE CHARS MAX
ILDB R0,R1 ; GET NEXT CHAR
CAIE R0,"[" ; IS IT "["?
JRST BADPRO ; NO, BAD PROTOTYPE
TRYPRJ: SOJLE R4,BADPRO ; ALSO BAD IF NO MORE CHARS AFTER "["
MOVEI R3,6 ; 6 CHASS MAX FOR PROJ #
SETZ R2, ; INITIAL VALUE FOR PROJ #
PRJLOP: ILDB R0,R1 ; GET CHAR
CAIN R0,"," ; IS IT ","?
JRST TRYPRG ; YES, GO LOOK FOR PROG #
CAIL R0,"0" ; NO, IS IT A DIGIT?
CAILE R0,"9"
JRST BADPRO ; NO, BAD PROTOTYPE
SUBI R0,"0" ; YES, CONVERT TO INTEGER
IMULI R2,10 ; TOT=TOT*10+INT
ADD R2,R0
SOJLE R4,BADPRO ; BAD IF NO MORE CHARS
SOJG R3,PRJLOP ; LOOP FOR SIX CHARS MAX
ILDB R0,R1 ; GET NEXT CHAR
CAIE R0,"," ; IS IT ","?
JRST BADPRO ; NO, BAD PROTOTYPE
TRYPRG: SOJLE R4,BADPRO ; ALSO BAD IF NO MORE CHARS
HRLZM R2,FILTBL+3 ; SAVE PROJ # IN LH OF FILE TABLE WORD
MOVEI R3,6 ; 6 CHARS MAX FOR PROG #
SETZ R2, ; INITIAL VALUE FOR PROG #
PRGLOP: ILDB R0,R1 ; GET CHAR
CAIN R0,"]" ; IS IT "]"?
JRST PRGFIN ; YES, END UP
CAIL R0,"0" ; IS IT A DIGIT
CAILE R0,"9"
JRST BADPRO ; NO
SUBI R0,"0" ; YES, CONVERT
IMULI R2,10 ; TOTAL
ADD R2,R0
SOJLE R4,BADPRO ; BAD IF NO MORE CHARS
SOJG R3,PRGLOP ; LOOP FOR SIX CHARS MAX
ILDB R0,R1 ; GET NEXT CHAR
CAIE R0,"]" ; IS IT "]"?
JRST BADPRO ; NO, BAD PROTOTYPE
PRGFIN: HRRM R2,FILTBL+3 ; SAVE PROG # IN RH OF FILE TABLE WORD
SOJLE R4,FILFIN ;IF MORE, THEN MUST BE PROTECTION
ILDB R0,R1 ;GET CHAR
CAIE R0,"<" ;PROT ?
JRST BADPRO ;LOSE
TRYPRO: SOJLE R4,BADPRO ;BAD IF NOT LAST CHAR
SETZ R2, ;PROTECTION REGISTER
MOVEI R3,4 ;4 CHAR MAX
PROLOP: ILDB R0,R1 ;GET A CHAR
CAIL R0,"0" ;DIGIT CHECK
CAILE R0,"7"
JRST PROFIN ;DONE
SUBI R0,"0" ;CONVERT TO BINARY
IMULI R2,8 ;SHIFT
ADD R2,R0 ;ADD
SOJL R4,BADPRO
SOJG R3,PROLOP
ILDB R0,R1
PROFIN: CAIE R0,">" ;END OF PROTECTION SPEC
JRST BADPRO ;NO - LOSE
DPB R2,[POINT 9,FILTBL+2,8] ;SET PROTECTION
SOJG R4,BADPRO ;> IS THE LAST CHAR OR ELSE
FILFIN: HRRM R10,RESULT ; SAVE CHANNEL # AS RESULT
ROT R10,-13 ; FORM AC FIELD WITH CHANNEL #
ADD R10,[LOOKUP FILTBL
ENTER FILTBL](R11) ; FORM APPROPRIATE UUO
XCT R10 ; EXECUTE LOOKUP OR ENTER COMMAND
XCT ERRRTN(R11) ; ERROR RETURN
MOVE R1,RESULT ; OK, RETURN CHANNEL #
JRST (R12)
ERRRTN: JRST S$$FLR ; FAIL IF LOOKUP
CFERR 12,S$$PGL ; ILLEGAL I/O IF ENTER
; STORAGE
DSKSTR: POINT 7,.+1,35
BYTE (2)2(16)2(18)3
ASCII/DSK/
RESULT: 1B0
FILTBL: REPEAT 4,<0>
DSKSAV=FILTBL
PRGEND
SUBTTL P$$OPN OPEN(DEV,CHAN) PRIMITIVE FUNCTION
ENTRY P$$OPN
EXTERN S$$MKI,S$$PGL,S$$CHT,S$$GNS,S$$GNP,.JBFF
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 2.
OPEN(DEV,CHAN) OPENS A DEVICE FOR INPUT AND(OR) OUTPUT ON A
SOFTWARE CHANNEL AND ASSIGNS BUFFERS, AND RETURNS THE CHANNEL #/
P$$OPN: POP ES,R1 ; GET CHANNEL
JSP R7,S$$MKI ; MUST BE INTEGER
CFERR 10,S$$PGL ; OR IS BAD ARG
JUMPL R1,.+2 ; IF <0
CAILE R1,15 ; OR >15
CFERR 12,S$$PGL ; ILLEGAL UNIT
MOVEI R11,S$$CHT(R1) ; GET POINTER TO ENTRY IN CHAN TABLE
SKIPE (R11) ; MUST BE UNUSED
BADUNT: CFERR 12,S$$PGL ; OR IS A BAD UNIT
JUMPN R1,OPNCHN ; JUMP IF CHAN NOT =0
HRLI R11,-16 ; OTHERWISE LOOK FOR AVAILABLE ONE
OPNCLP: AOBJN R11,.+2 ; TRY ALL 15 CHANNELS
UFERR 1,S$$PGL ; FATAL ERROR IF ALL CHANNELS ARE IN USE
SKIPE (R11) ; IS CHANNEL AVAILABLE?
JRST OPNCLP ; NO, LOOP
MOVEI R1,(R11) ; YES, GET CHANNEL #
SUBI R1,S$$CHT
OPNCHN: HRRM R1,OPNANS ; SAVE CHANNEL # AS RESULT
ROT R1,-13 ; FORM AC FIELD FOR UUOS
MOVEM R1,OPNDCH ; AND SAVE
POP ES,R1 ; GET DEVICE PROTOTYPE STRING
TLNE R1,^O770000 ; IS IT A STRING?
CFERR 10,S$$PGL ; NO
JUMPE R1,BADPRO ; SKIP OUT IF NULL
SETZM DEVNAM ; CLEAR DEVICE NAME
MOVE R2,[POINT 6,DEVNAM] ; SET UP SIXBIT POINTER
HRRZ R3,(R1) ; GET CHAR COUNT
MOVEI R4,6 ; MAX CHARS FOR DEVICE NAME
SOJL R3,BADPRO ; SKIP OUT IF 0 CHARS
DEVLOP: ILDB R0,R1 ; GET NEXT CHAR
SUBI R0,^O40 ; CONVERT TO SIXBIT
JUMPL R0,BADPRO
CAILE R0,^O77
SUBI R0,^O40
CAIN R0,'(' ; IS IT LEFT PAREN?
JRST BUFSPC ; YES, DECODE BUFFER SPECIFICATION
SOJL R4,BADPRO ; NO, ERROR IF >6 CHARS
IDPB R0,R2 ; FORM DEVICE NAME
SOJGE R3,DEVLOP ; LOOP FOR EACH CHAR
MOVE R10,[XWD 2,2] ; DEFAULT BUFFER SPECIFICATION
DEVCHK: MOVE R0,DEVNAM ; GET DEVICE NAME
DEVCHR R0, ; GET CHARACTERISTICS
JUMPE R0,BADUNT ; DEVICE NOT FOUND
TRNE R0,1B19 ; HAS DEVICE BEEN INIT'ED?
TLNE R0,1B19 ; YES, IS IT A FILE STRUCTURE?
JRST .+2 ; NOT INIT'ED OR IS FILE STRUCTURE
CFERR 12,S$$PGL ; NOT FILE STRUCTURE, CAN'T OPEN TWICE
TLNN R0,1B34 ; DOES DEVICE ALLOW INPUT?
HLRI R10, ; NO, NO INPUT BUFFERS
TLNN R0,1B35 ; DOES DEVICE ALLOW OUTPUT?
HLLI R10, ; NO, NO OUTPUT BUFFERS
SETZ R9, ; INITIALIZE OBUF,IBUF
TLNN R10,-1 ; ANY OUTPUT BUFFERS?
JRST INPHDR ; NO
MOVEI R0,4 ; GET BLOCK FOR OUTPUT BUFFER HEADER TABLE
JSP R6,S$$GNS
HRLZI R9,1(R1) ; POINTER TO FIRST WORD OF HEADER
INPHDR: TRNN R10,-1 ; ANY INPUT BUFFERS?
JRST OPNOPN ; NO
MOVEI R0,4 ; GET BLOCK FOR INPUT BUFFER HEADER TABLE
JSP R6,S$$GNS
HRRI R9,1(R1) ; POINTER TO FIRST WORD OF HEADER
OPNOPN: MOVEM R9,(R11) ; SAVE POINTERS IN CHANNEL TABLE
MOVEM R9,DEVNAM+1 ; AND DEVICE SPECIFICATION
MOVE R0,[OPEN DEVNAM-1] ; OPEN DEVICE
ADD R0,OPNDCH
XCT R0
CFERR 12,S$$PGL ; IF ERROR, ILLEG UNIT
SETZ R8, ; INITIALIZE BUFFER SIZE
HLRZ R9,R9 ; OUTPUT BUFFER HEADER TABLE POINTER
JUMPE R9,INPBUF ; SKIP IF 0
MOVE R11,[OUTBUF 1] ; UUO CALL FOR OUTPUT BUFFER SETUP
HLRZ R0,R10 ; NUMBER OF BUFFERS
JSP R7,MAKBUF ; MAKE BUFFERS
INPBUF: HRRZ R9,DEVNAM+1 ; SAME FOR INPUT BUFFERS
JUMPE R9,OPNFIN
MOVE R11,[INBUF 1]
HRRZ R0,R10
JSP R7,MAKBUF
OPNFIN: MOVE R1,OPNANS ; RETURN CHANNEL #
JRST (R12)
; MAKE BUFFER RING
MAKBUF: ADD R11,OPNDCH ; INSERT CHANNEL # IN BUFFER UUO
JUMPN R8,MAKBU1 ; JUMP IF BUFFER SIZE KNOWN
MOVE R8,.JBFF ; SAVE .JBFF
XCT R11 ; MAKE 1 DUMMY BUFFER
EXCH R8,.JBFF ; RESTORE .JBFF
SUB R8,.JBFF ; CALCULATE BUFFER SIZE
SETZM (R9) ; RESTORE HEADER TABLE
HRLZI R1,^O700
MOVEM R1,1(R9)
SETZM 2(R9)
MAKBU1: HRR R11,R0 ; SET # OF BUFFERS IN UUO CALL
IMULI R0,(R8) ; # OF BUFFERS * SIZE + 1
ADDI R0,1
JSP R6,S$$GNS ; GET BLOCK FOR BUFFERS
HRRM R1,-1(R9) ; SAVE PTR TO BUFFER BLOCK IN HEADER TABLE
ADDI R1,1 ; START OF FIRST BUFFER
EXCH R1,.JBFF ; SAVE .JBFF
XCT R11 ; DO UUO
MOVEM R1,.JBFF ; RESTORE .JBFF
JRST (R7) ; RETURN
; DECODE BUFFER SPEC, WITH PTR IN R1, CHAR COUNT IN R3
BUFSPC: JSP R4,S$$GNP ; GET NEXT NUMERICAL PARAMETER
BADPRO: CFERR 6,S$$PGL ; NO DELIMETER FOUND
JUMPL R2,BADPRO ; PARAMETER NEGATIVE
HRLZI R10,(R2) ; # OF OUTPUT BUFFERS
CAIN R0,"," ; IS DELIMETER A COMMA?
JRST BUFSP1 ; YES, GO FOR SECOND PARAMETER
BUFSP0: CAIN R0,")" ; NO, IS DELIMETER A RPAREN?
JUMPE R3,DEVCHK ; YES, OK IF NO MORE CHARS
CFERR 6,S$$PGL ; MORE CHARS OR NOT ")", ERROR
BUFSP1: JSP R4,S$$GNP ; GET NEXT NUMERICAL PARAMETER
CFERR 6,S$$PGL ; NO DELIMITER
JUMPL R2,BADPRO ; ERROR IF NEG PAR
HRRI R10,(R2) ; # OF INPUT BUFFERS
JRST BUFSP0 ; CHECK FOR PROPER ENDING
; STORAGE
OPNANS: 1B0
OPNDCH: BLOCK 1
0
DEVNAM: BLOCK 2
SUBTTL S$$NIO NORMAL I/O ROUTINES
ENTRY S$$NIO
EXTERN S$$IOI,S$$IIX,S$$IOX,S$$FLR
COMMENT/ THESE ROUTINES PERFORM INPUT AND OUTPUT ON DEVICES OTHER THAN THE
CONTROLLING TTY OR NON-TTYCAL INPUT AND OUTPUT ON THE CONTROLLING TELETYPE.
THEY ARE REQUIRED ONLY IF A SOFTWARE CHANNEL IS OPENED AND THUS ARE IN-
CLUDED IN THIS MODULE FOR THAT REASON/
; NORMAL LINE MODE INPUT
NIOLMI: HRRI R9,0 ; START COUNT AT 0
HRRZ R8,3(R8) ; GET INPUT CHANNEL #
ANDI R8,^O17
MOVEM R8,VIOCHN ; SAVE
HRRZ R8,S$$CHT(R8) ; GET HEADER BLOCK POINTER
EXCH R10,1(R8) ; HEADER BYTE PTR
EXCH R11,2(R8) ; HEADER BYTE COUNT
MOVE [XWD NLILOP,NLICHR] ; MOVE LOOP INTO R2 - R8
BLT NLIEND
JRST NLICHR ; START LOOP
NLILOP: PHASE 2
NLICHR: SOJL R11,NEWIBF ; R2: DECREMENT BUF BYTE COUNT
ILDB R0,R10 ; R3: GET NEXT BYTE FROM BUF
CAIG R0,^O15 ; R4: TEST FOR NULL OR CR
JRST NLIFIN ; R5: BY JUMPING OUT OF LOOP
NLICON: IDPB R0,R1 ; R6: PUT CHAR IN STRING
AOBJN R9,NLICHR ; R7: LOOP UNTIL ASSOC LEN EXHAUSTED
NLIEND: JRST NLIWST ; R8: THROW AWAY REST OF LINE
DEPHASE
NLIFIN: JUMPE R0,NLICHR ; KEEP GOING IF NULL
CAIE R0,^O15 ; IS IT CR?
JRST NLICON ; NO, KEEP GOING
NEWIBR: SOJL R11,NEWIB1 ; DECREMENT BUF BYTE COUNT
ILDB R0,R10 ; GET NEXT CHAR
JUMPE R0,.-2 ; IGNORE IF NULL OTHERWISE MUST BE LF
MOVE R8,VIOCHN ; GET CHAN #
HRRZ R8,S$$CHT(R8) ; GET BUFFER HEADER PTR
EXCH R10,1(R8) ; RESTORE HEADER BYTE POINTER
EXCH R11,2(R8) ; RESTORE HEADER BYTE COUNT
JRST S$$IIX ; FINISH UP INPUT SEQUENCE
NLIWST: MOVE R6,.+1 ; SET UP LOOP TO THOW AWAY REST OF LINE
JRST NLICHR
NEWIB1: MOVE R2,[JRST NEWIBR] ; MODIFY LOOP SO RETURN IS TO NEWIBR
NEWIBF: MOVE R8,VIOCHN ; GET CHAN #
DPB R8,[POINT 4,NEWIB2,12] ; PUT IN APPROPRIATE
DPB R8,[POINT 4,NEWIB3,12] ; UUO CALLS
HRRZ R8,S$$CHT(R8) ; GET BUFFER HEADER PTR
EXCH R10,1(R8) ; RESTORE R10 AND R11
EXCH R11,2(R8)
NEWIB2: IN .-., ; READ IN NEXT BUFFER
JRST NEWIOK ; TRANSMISSION OK
NEWIB3: STATZ .-.,^O740000 ; CHECK STATUS
CFERR 11,S$$IOI+1 ; ERROR
VIOEOF: SETZM @S$$IOI ; EOF, SET VAL TO NULL
JRST S$$FLR ; FAIL
NEWIOK: EXCH R10,1(R8) ; GET HEADER BYTE PTR
EXCH R11,2(R8) ; GET HEADER BYTE COUNT
MOVE R8,NLIFIN-1 ; RESTORE LAST INSTRUCTION WORD OF LOOP
JRST NLICHR ; GO TO BEGINNING OF LOOP
; NORMAL CHARACTER MODE INPUT
NIOCMI: HRRZI R9,1 ; 1 CHARACTER
HRRZ R8,3(R8) ; GET INPUT CHANNEL #
ANDI R8,^O17
HRRZ R7,S$$CHT(R8) ; GET BUFFER HEADER TABLE POINTER
NCICHR: SOSGE 2(R7) ; DECREMENT BYTE COUNT
JRST NEWIBC ; NEED NEW BUFFER
ILDB R0,1(R7) ; LOAD CHAR
JUMPE R0,NCICHR ; LOOP IF NULL
IDPB R0,R1 ; OTHERWISE, PUT IN STRING
HRRM R9,-1(R1) ; SET CHAR COUNT TO 1
JRST S$$IIX+2 ; GO RESTORE IN INPUT SEQUENCE
NEWIBC: DPB R8,[POINT 4,NEWIB4,12] ; PUT CHANNEL # IN APPROPRIATE
DPB R8,[POINT 4,NEWIB5,12] ; UUO CALLS
NEWIB4: IN .-., ; READ IN NEXT BUFFER
JRST NCICHR ; TRANSMISSION OK
NEWIB5: STATZ .-.,^O740000 ; CHECK STATUS
CFERR 11,S$$IOI+1 ; ERROR
JRST VIOEOF ; EOF
; NORMAL LINE MODE OUTPUT
NIOLMO: HRRI R9,0 ; START COUNT AT 0
MOVE [XWD NLOLOP,NLOCHR] ; MOVE LOOP INTO R2 - R7
BLT NLOEND
HRRZ R8,3(R8) ; GET OUTPUT CHANNEL #
LSH R8,-4
MOVEM R8,VIOCHN ; SAVE
HLRZ R8,S$$CHT(R8) ; GET BUFFER HEADER TABLE POINTER
EXCH R10,1(R8) ; GET BYTE PTR
EXCH R11,2(R8) ; GET BYTE COUNT
JUMPE R1,CRLFNM ; SKIP OUT IF NULL STRING
HRRZ R8,(R1) ; GET CHAR COUNT
JUMPE R8,CRLFNM ; SKIP OUT IF 0
JRST NLOCHR ; START LOOP
NLOLOP: PHASE 2
NLOCHR: SOJL R11,NEWOBF ; R2: GET NEW BUFFER IF OUT OF CHARS
ILDB R0,R1 ; R3: GET CHAR FROM STRING
IDPB R0,R10 ; R4: PUT CHAR IN BUFFER
SOJE R8,CRLFNM ; R5: SKIP OUT IF STRING EXHAUSTED
AOBJN R9,NLOCHR ; R6: LOOP IF WITHIN ASSOC LEN
NLOEND: JRST ASCLNM ; R7: OTHERWISE, PUT OUT EXTRA CR,LF
DEPHASE
CRLFNM: ADDI R5,CRLFND-CRLFNM ; COME BACK TO CRLFND
MOVE R1,CRLFST ; GET CR,LF STRING PTR
MOVEI R8,2 ; 2 CHARS
MOVE R6,.+1 ; DON'T WORRY ABOUT ASSOC LEN
JRST NLOCHR ; GO TO LOOP
CRLFND: MOVE R8,VIOCHN ; GET OUTPUT CHAN #
HLRZ R8,S$$CHT(R8) ; GET BUFFER HEADER TABLE PTR
EXCH R10,1(R8) ; RESTORE BYTE PTR
EXCH R11,2(R8) ; RESTORE CHAR COUNT
JRST S$$IOX ; FINISH UP OUTPUT SEQUENCE
ASCLNM: MOVEM R1,ASCLR1 ; SAVE R1 AND R8
MOVEM R8,ASCLR8
ADDI R5,ASCLND-CRLFNM ; COME BACK TO ASCLND
JRST CRLFNM+1 ; GET IN A CR,LF SEQUENCE
ASCLND: MOVE R1,ASCLR1 ; RESTORE R1 AND R8
MOVE R8,ASCLR8
SUBI R5,ASCLND-CRLFNM ; RESTORE NORMAL EXIT FROM LOOP
MOVE R6,CRLFNM-2 ; RESTORE ASSOC LEN TEST
MOVNI R9,(R9) ; GET -ASSOC LEN,0 INTO R9
HRLZI R9,(R9)
JRST NLOCHR ; GO BACK TO LOOP
NEWOBF: MOVE R2,VIOCHN ; GET OUTPUT CHAN #
DPB R2,[POINT 4,NEWOB1,12] ; PUT IN UUO CALL
HLRZ R2,S$$CHT(R2) ; GET BUFFER HEADER TABLE POINTER
EXCH R10,1(R2) ; RESTORE R10 AND R11
EXCH R11,2(R2)
NEWOB1: OUT .-., ; OUTPUT BUFFER
JRST .+2 ; TRANSMISSION OK
UFERR 11,S$$IOI+1 ; OUTPUT ERROR
EXCH R10,1(R2) ; GET BYTE PTR
EXCH R11,2(R2) ; GET BYTE COUNT
MOVE R2,NLOLOP ; RESTORE FIRST WORD OF LOOP
JRST NLOCHR ; RETURN TO LOOP
; NORMAL CHARACTER MODE OUTPUT
NIOCMO: JUMPE R1,S$$IOX ; SKIP OUT IF NULL
HRRZ R7,(R1) ; GET CHAR COUNT
JUMPE R7,S$$IOX ; SKIP OUT IF 0
HRRZ R8,3(R8) ; GET OUTPUT CHANNEL #
LSH R8,-4
MOVEM R8,VIOCHN ; SAVE
HLRZ R8,S$$CHT(R8) ; GET BUFFER HEADER TABLE POINTER
EXCH R10,1(R8) ; GET BYTE PTR
EXCH R11,2(R8) ; GET BYTE COUNT
MOVE [XWD NCOLOP,NCOCHR] ; MOVE LOOP INTO R2 - R6
BLT NCOEND
JRST NCOCHR ; JUMP INTO LOOP
NCOLOP: PHASE 2
NCOCHR: SOJL R11,NEWOBF ; R2: GET NEW BUFFER IF NO MORE CHARS
ILDB R0,R1 ; R3: GET CHAR FROM STRING
IDPB R0,R10 ; R4: PUT CHAR IN BUFFER
SOJN R7,NCOCHR ; R5: LOOP UNTIL STRING IS EXHAUSTED
NCOEND: JRST CRLFND+2 ; R6: RESTORE BYTE PTR, COUNT, AND QUIT
DEPHASE
; STORAGE
S$$NIO: XWD NIOLMO,NIOLMI ; NORMAL LINE MODE OUTPUT/INPUT
XWD NIOCMO,NIOCMI ; NORMAL CHAR MODE OUTPUT/INPUT
VIOCHN: BLOCK 1
ASCLR1: BLOCK 1
ASCLR8: BLOCK 1
CRLFST: POINT 7,.+1 ; CR,LF SEQUENCE
BYTE (7)^O15,^O12
PRGEND
SUBTTL P$$INP,P$$OUT INPUT() AND OUTPUT() PRIMITIVE FUNCTIONS
ENTRY P$$INP,P$$OUT
EXTERN S$$MKI,S$$PGL,S$$CHT,S$$AST,S$$ASB,S$$NIO
EXTERN S$$LKV,S$$MRS,S$$GNS
RADIX 10
SEARCH S$$NDF
COMMENT/
CALL: FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 3.
INPUT(VARNAM,CHAN,LENGTH) CREATES AN INPUT ASSOCIATION BETWEEN
A VARIABLE AND A SOFTWARE CHANNEL, IN EITHER CHARACTER MODE OR LINE MODE
WITH ASSOCIATION LENGTH SPECIFIED, AND RETURNS NULL
OUTPUT(VARNAM,CHAN,LENGTH) IS LIKE 'INPUT()', BUT CREATES AN OUT-
PUT ASSOCIATION INSTEAD
LENGTH > 0 INDICATES LINE MODE
LENGTH = 0 INDICATES LINE MODE WITH DEFAULT LENGTH
LENGTH < 0 OR NOT INTEGER INDICATES CHARACTER MODE
CHANNEL = 0 INDICATES TELETYPE (TTYCAL) INPUT AND OUTPUT
CHANNEL > 0 INDICATES NORMAL BUFFERED OUTPUT AND INPUT ON THAT
SOFTWARE CHANNEL
CHANNEL < 0 OR NOT INTEGER INDICATES THAT THE APPROPRIATE
ASSOCIATION IS TO BE DISCONNECTED (BUT THE VARIABLE IS NOT DETACHED)
IF AN ASSOCIATION ALREADY EXISTS, THE NEW ONE REPLACES IT/
P$$INP: JSP R11,P$$OUT+1 ; 'INPUT', INDEX = 0
P$$OUT: JSP R11,P$$OUT+1 ; 'OUTPUT', INDEX = 1
SUBI R11,P$$OUT
; DETERMINE LENGTH
POP ES,R1 ; GET LENGTH
JSP R7,S$$MKI ; IS IT INTEGER?
SETO R1, ; NO, SET = -1
JUMPN R1,.+2 ; IS IT 0?
MOVEI R1,P$ALEN ; YES, SET = DEFAULT ASSOC LEN
MOVEM R1,SAVLEN ; SAVE LENGTH
; DETERMINE CHANNEL
POP ES,R1 ; GET CHAN #
JSP R7,S$$MKI ; IS IT INTEGER?
SETO R1, ; NO, SET = -1
CAILE R1,15 ; IS IT > 15?
CFERR 12,S$$PGL ; YES, ILLEGAL UNIT
MOVEM R1,SAVCHN ; SAVE CHANNEL #
; DETERMINE VARIABLE
POP ES,R1 ; GET VARNAM
JSP R10,S$$LKV ; LOOKUP VARIABLE
MOVE R1,(R2) ; GET NAME DESCR FOR VARIABLE
TLNE R1,3B23 ; IS IT DEDICATED?
CFERR 10,S$$PGL ; YES, ERROR
HRRZI R1,(R1) ; FORM ADDRESS ONLY
CAIL R1,^O776000 ; IS IT A TRAP ADDR?
HRREI R1,(R1) ; YES, MAKE NEG
SKIPL R10,SAVCHN ; GET CHAN # AND SKIP IF < 0
JRST NEWASC ; OTHERWISE GO TO NEW ASSOCIATION SECTION
; DELETE OLD ASSOCIATION
JUMPGE R1,NULRET ; FINISH IF NOT ASSOCIATED ALREADY
ASH R1,2 ; OTHERWISE COMPUTE ASSOC TABLE ENTRY PTR
ADD R1,S$$ASB
XCT [SETZM 2(R1)
SETZM 1(R1)](R11) ; AND ELIMINATE APPROPRIATE
JRST NULRET ; ASSOCIATION AND RETURN NULL
; CHECK FOR OLD ASSOCIATION
NEWASC: JUMPE R10,.+4 ; SKIP OVER IF CHAN # IS 0
SKIPE R3,S$$CHT(R10) ; TEST IF APPROPRIATE SIDE OPEN
XCT [TRNN R3,-1
TLNN R3,-1](R11)
CFERR 12,S$$PGL ; NO, BAD UNIT
JUMPGE R1,CRTASC ; CREATE NEW ASSOCIATION IF ADDR > 0
ASH R1,2 ; OTHERWISE COMPUTE ASSOCIATION TABLE ENTRY PTR
ADD R1,S$$ASB
JRST SAVASC ; AND GO SAVE ASSOCIATION
; CREATE NEW ASSOCIATION
CRTASC: MOVE R3,S$$AST ; ASSOC TBL TOP PTR
MOVE R4,S$$ASB ; COMPUTE -TOT # OF ASSOC ENTRIES
SUBI R4,1(R3)
ASH R4,-2
MOVN R4,R4
HRLI R3,(R4) ; AND SAVE FOR AOBJ COUNT
CRTLOP: SKIPN 1(R3) ; IS ENTRY AVAILABLE?
JRST CRTFND ; YES
ADDI R3,3 ; OTHERWISE POINT TO NEXT ENTRY
AOBJN R3,CRTLOP ; AND LOOP
; EXPAND ASSOCIATION TABLE
MOVEM R2,SAVCHN ; NO FREE ENTRIES, SAVE POINTER TO NAME
MOVE R1,S$$AST ; GET OLD ASSOC TABLE BLOCK
HLRZ R0,(R1) ; MAKE NEW ONE OF SIZE =
ANDI R0,^O177777 ; OLD SIZE +
HRRZ R7,(R1) ; EXTENSION SIZE
ADDI R0,(R7)
JSP R6,S$$GNS
HRRM R7,(R1) ; SAVE EXTENSION SIZE IN NEW BLOCK
MOVEI R2,2(R1) ; ZERO ALL NEW ADDITIONAL ENTRIES
HRLI R2,1(R1)
SETZM 1(R1)
ADDI R7,(R1)
BLT R2,(R7)
ADDI R0,(R1) ; NEW TABLE BASE POINTER
EXCH R1,S$$AST ; SAVE NEW TABLE TOP POINTER
JSP R6,S$$MRS ; RETURN OLD BLOCK
HRRZI R2,1(R7) ; MOVE REMAINING ENTRIES FROM OLD TABLE
HRLI R2,1(R1) ; TO NEW ONE
MOVEM R0,S$$ASB ; AND SAVE NEW TABLE BASE POINTER
MOVE R1,R0
BLT R2,-1(R1)
MOVE R2,SAVCHN ; RESTORE PTR TO NAME
HRRZ R1,(R2) ; AND PTR TO VARIABLE
JRST CRTASC ; AND GO FIND ENTRY
; NEW ENTRY SPACE FOUND
CRTFND: HLRM R3,(R2) ; SAVE ENT^Y INDEX IN NAME DESCR
HRLI R1,(R2) ; AND NAME POYNTER, VAR POINTER
MOVEM R1,1(R3) ; IN FIRST WORD OF ENTRY
MOVEI R1,1(R3) ; POINTER TO ENTRY
; DETERMINE TYPE OF I/O
SAVASC: MOVEI R2,S$$NIO ; NORMAL I/O ROUTINES POINTER
JUMPN R10,.+2 ; IS CHANNEL 0?
MOVEI R2,S$$ASB+1 ; YES, POINT TO TTYCAL ROUTINES
SKIPGE R3,SAVLEN ; IS IT LINE MODE?
ADDI R2,1 ; NO, <0, CHAR MODE, DIFFERENT I/O ROUTINES
XCT [HRRZ R4,(R2)
HLRZ R4,(R2)](R11) ; GET APPROPRIATE ROUTINE
JUMPL R3,.+3 ; SKIP IF CHAR MODE
MOVNI R5,(R3) ; OTHERWISE LOAD -LENGTH
HRLI R4,(R5)
; SAVE ASSOCIATION INFO IN ENTRY
XCT [MOVEM R4,2(R1)
MOVEM R4,1(R1)](R11) ; SAVE IN ENTRY
MOVEI R9,^O17 ; CHANNEL BYTE MASK
XCT [JRST SAVINP
LSHC R9,4](R11) ; PREPARE FOR ENTRY MODIFICATION
SAVINR: ANDCAM R9,3(R1) ; CLEAR CHANNEL BYTE, ETC
ADDM R10,3(R1) ; SET CHANNEL BYTE, ETC
NULRET: SETZ R1, ; RETURN NULL
JRST (R12)
SAVINP: JUMPGE R3,.+2 ; SKIP IF LINE MODE
AOJA R3,.+2 ; SET R3=0 FOR CHAR MODE
MUL R3,[^F0.2B0] ; COMPUTE # WORDS IN INPUT STRING BLOCK
HRLI R10,2(R3)
HRROI R9,(R9) ; MODIFY CHANNEL BYTE MASK
JRST SAVINR ; GO BACK TO SEQUENCE
; STORAGE
SAVLEN: BLOCK 1
SAVCHN: BLOCK 1
END