Trailing-Edge
-
PDP-10 Archives
-
decuslib10-07
-
43,50443/hmon.mac
There are 2 other files named hmon.mac in the archive. Click here to see a list.
TITLE XPLLIB -- THE XPL SYSTEM LIBRARY
SUBTTL R.W. HAY - MODIFIED FOR TTY AND BINARY - 22-JUL-74
EXTERNAL .JBFF,.JBREL
R0=0;
R1=1;
R2=2;
R3=3;
R4=4;
R5=5;
R6=6;
R7=7;
R8=10;
R9=11;
R10=12;
R11=13;
R12=14;
R13=15;
R14=16;
R15=17;
P=R15 ;PUSH-DOWN LIST FOR PACKAGE
; ASCII CHARACTER CODES
CR==15 ;CARRIAGE RETURN
LF==12 ;LINE FEED
FF==14 ;FORM FEED
HT==11 ;HORIZONTAL TAB
;
; FLAG BIT DEFINITIONS
;
;LEFT HALF
FILOPN= 1 ;FILE HAS HAD OPEN DONE ON IT
FILOUT= 2 ;FILE IS OUTPUT FILE
FILIN= 4 ;FILE IS INPUT FILE
CHNCLS= 10 ;SOFTWARE CHANNEL IS NOT OPEN (CLOSED)
CHNCHG= 20 ;SOFTWARE CHANNEL MUST BE REOPENED BEFORE NEXT LOOKUP/ENTER
CHNFAL= 40 ;LAST OPEN FAILED
FILBIN= 100 ;FILE (SOFTWARE CHANNEL) IS INITED FOR BINARY (14)
;ENTRY DECODER
;
; R11=LIBRARY SERVICE
;
;
LOC 40
UUO: Z ;UUO STORED HERE.
JSR XPLLIB ;UUO ENTRY POINT
RELOC
ENTRY XPLLIB
XPLLIB: Z
MOVEM R15,SAVE+R15 ;SAVE AC 15
MOVEI R15,SAVE ;MAKE A BLT POINTER WORD
BLT R15,SAVE+R14 ;SAVE THEM ALL
MOVE P,PDL ;INITIALIZE PDL
MOVE R14,UUO
LDB R11,[POINT 9,R14,8] ;PUT FUNCTION CODE IN R11
HRREI R12,0(R14) ;PUT FILE NUMBER INTO R12
LDB R13,[POINT 4,R14,12] ;ARGUMENT REGISTER # TO R13
MOVE R13,SAVE(R13) ;LOAD R13 WITH ACTUAL ARG.
JUMPA TABLE(R11) ;GO ON FUNCTION CODE IN R11
TABLE: JRST RETURN ;0 = IMPOSSIBLE
JUMPA INITS ;1 = INITIALIZE
JUMPA INPUTS ;2 = SEQUENTIAL INPUT
JUMPA PUTOUT ;3 = SEQUENTIAL OUTPUT
JUMPA EXITS ;4 = EXIT CALLED
JRST FILSET ;5 = SET FILE NAME AND DEVICE
JRST BININ ;6 = BINARY SEQUENTIAL FILE INPUT
JRST BINOUT ;7 = BINARY SEQUENTIAL FILE OUTPUT
JRST FILSET ;8 = DUMMY
JRST RETURN ;9 = DUMMY
;
;STANDARD LIBRARY RETURN
;
RETURN:
RET1: MOVSI R15,SAVE ;SET UP FOR RETURN
BLT R15,R15 ;RESTORE R1 TO R15
JRST @XPLLIB ;RETURN TO CALLER
;
;INITIALIZE XPL SYSTEM
;
;
;RETURNS
;
; R12=FIRST WORD OF STRING SPACE
; R13=LAST WORD OF STRING SPACE
;
INITS: RESET ;RESET CHANNELS
MOVE R1,.JBFF ;GET FIRST FREE LOCATION
LSH R1,2 ;CONVERT TO BYTE ADDRESS
MOVEM R1,SAVE+R12
MOVE R1,.JBFF ;GET FIRST FREE AGAIN
ADDI R1,4*2000 ;AT LEAST 4K FOR STRINGS
CAMLE R1,.JBREL
CORE R1,
JFCL ;IGNORE ERROR
MOVE R1,.JBREL
SUBI R1,^D700 ;SUBTRACT SPACE FOR PDL
MOVEM R1,SAVE+R15 ;CONSTRUCT PDL POINTER
SUBI R1,^D300 ;**TEMP **
LSH R1,2 ;CONVERT TO BYTE ADDRESS
MOVEM R1,SAVE+R13
MOVNI R1,^D699 ;SIZE OF PDL
HRLM R1,SAVE+R15 ;FINISH PDL POINTER
MOVE R1,.JBREL ;GET TOP OF CURRENT CORE
MOVEM R1,.JBFF ;MAKE SURE MONITOR DOESN'T USE SPACE
AOS .JBFF
SETZM ZERST ;CLEAR ALL LOCATIONS CHANGED DURING EXECUTION
MOVE R1,[XWD ZERST,ZERST+1]
BLT R1,ZERSTP
MOVE R1,[SIXBIT /SYSIN/] ;LOGICAL DEVICE 0 = SYSIN
MOVEM R1,DEVLST
HRRI R1,'OUT' ;LOGICAL DEVICE 1 = SYSOUT
MOVEM R1,DEVLST+1
MOVSI R1,'DSK' ;DEFAULT FOR ALL OTHERS IS DSK
MOVEM R1,DEVLST+2
MOVE R1,[XWD DEVLST+2,DEVLST+3]
BLT R1,DEVLST+^D15
MOVSI R1,-^D16 ;SET FILNAMES TO 'XPLNN.DAT'
MOVE R2,[SIXBIT /XPL00 /]
MOVSI R3,'DAT'
MOVEM R2,FILNAM(R1)
MOVEM R3,FILNAM+1(R1)
ADDI R2,100 ;INCREMENT FILE NAME
TRNE R2,1000 ;IS IT 08,09,OR 10?
TRNN R2,600 ;IS IT 10?
SKIPA ;NO
HRRI R2,'10 ' ;YES. MAKE IT LOOK RIGHT
ADDI R1,3 ;WANT INDEX TO INCREMENT BY 4
AOBJN R1,.-8 ;LOOP FOR ALL FILES
MOVSI R0,CHNCLS ;INITIAL FLAGS: ALL CHANNELS CLOSED
MOVEM R0,FLAGS
MOVE R1,[XWD FLAGS,FLAGS+1] ;
BLT R1,FLAGS+^D15
JRST RETURN
;SEQUENTIAL INPUT
;
;INPUT PARAMETERS
;
; R12=UNIT (0)
; SYSIN
; R13=TSA
;
;RETURNS
;
; R12=XPL STRING DOPE VECTOR
; R13=NEW TSA
;
;REGISTER USAGE
;
; R1=INPUT BUFFER
; R2=OUTPUT STRING POINTER
; R3=INPUT BUFFER LENGTH
; R4=WORK
;
INPUTS: MOVE R13,SAVE+R13 ;REGISTER 13 SET UP BY XPL PROG
JUMPL R12,TTYIN ;DO TTCALL INPUT IF -VE UNIT
CAIE R12,1 ;1 IS ILLEGAL FOR INPUT
CAILE R12,^D15 ;MAKE SURE OF LEGAL FILE NUMBER
JRST INERR1 ;TELL USER AND QUIT
MOVE R0,FLAGS(R12) ;LOAD FLAGS FOR THIS FILE.
TLNN R0,FILIN ;IS IT SET FOR INPUT?
JRST .+3 ;NO.
TLNN R0,FILBIN ;IS IT ASCII?
JRST INPOK ;YES. GO USE IT
PUSHJ P,CLOSFL ;NO TO ANY OF ABOVE: CLOSE FILE
TLNE R0,CHNCLS ;IS CHANNEL INITED?
PUSHJ P,INITAS ;NO. OPEN IN ASCII
TLNE R0,FILBIN ;BINARY MODE?
PUSHJ P,SETASC ;YES. SET IT TO ASCII
PUSHJ P,LOOKFL ;DO LOOKUP, ETC.
MOVEM R0,FLAGS(R12) ;SAVE FLAGS
;
INPOK:
SKIPE R0,EOFSW(R12) ;TEST FOR EOF
JUMPA INPUT2 ;GO RETURN NULL STRING
MOVE R1,R13 ;ADDRESS OF FIRST BYTE
SUBI R1,1 ;CORRECT FOR IDPB
LSHC R1,-2 ;CORE ADDRESS IN R1
LSH R2,-42 ;BYTE NO. IN R2
HLL R1,BYTEPT(R2) ;CONSTRUCT 9-BIT BYTE POINTER
MOVEI R2,0 ;CLEAR COUNT OF BYTES INPUT
;
GETIN: SOSLE @ICNT(R12) ;ANYTHING IN BUFFER?
JRST INLD ;YES
XCT INLST(R12) ;GET NEXT BUFFER. ANY ERRORS?
JRST INLD ;NO
SETOM EOFSW(R12) ;YES
JRST ENDLIN
;
INLD: ILDB R0,@IPTR(R12) ;PICK UP CHAR.
CAIN R0,CR ;IGNORE CARRIAGE-RETURN
JRST GETIN
JUMPE R0,GETIN ;IGNORE NULLS
CAIE R0,LF ;LF?
CAIN R0,FF ;OR FF?
JRST ENDLIN
IDPB R0,R1
AOJA R2,GETIN
;
ENDLIN: JUMPE R2,ONEBLK ;NOTHING. GIVE HIM A SINGLE BLANK
MOVE R1,R2
LSH R1,33 ;PUT COUNT INTO R1
ADD R1,R13 ;CONSTRUCT NEW DOPE VECTOR
ADDM R2,SAVE+R13 ;UPDATE TSA FOR RETURN
JRST INPTEX ;RETURN
;
ONEBLK: MOVEI R0," " ;LOAD A BLANK
IDPB R0,R1 ;STORE IT AWAY
AOJA R2,ENDLIN ;INCREMENT COUNT AND FINISH UP
;
INPUT2: SETZ R1, ;FINAL RESULT = 0 (NULL)
INPTEX: LDB R12,[POINT 4,R14,12] ;FIND RESULT REGISTER
MOVEM R1,SAVE(R12) ;STORE RESULT IN DESIGNATED REG.
JUMPA RETURN ;GOTO EXIT
TTYIN: MOVE R1,R13 ;GET TSA
SUBI R1,1 ;ADJUST FOR IDPB
IDIVI R1,4 ;CALCULATE WORD ADDRESS
HLL R1,BYTEPT(R2) ;AND MAKE A BYTE POINTER
MOVEI R2,0 ;CLEAR COUNT OF BYTES INPUT
TTYIN1: INCHWL R0 ;GET NEXT CHARACTER FROM INPUT
CAIN R0,CR ;CARRIAGE RETURN?
JRST TTYIN2 ;YES.
IDPB R0,R1 ;NO. PUT AWAY IN NEW STRING
AOJA R2,TTYIN1 ;LOOP UNTIL CR.
TTYIN2: INCHWL R0 ;LOOK FOR LINE-FEED
CAIE R0,LF
JRST TTYIN2 ;LOOP UNTIL FOUND
JRST ENDLIN ;GO TO COMMON ROUTINE
INERR1: OUTSTR [ASCIZ /ILLEGAL FILE NUMBER IN CALL TO INPUT.
/]
JRST EXITS
;SEQUENTIAL OUTPUT
;
;INPUT PARAMETERS
;
; R12=UNIT (0,1,2,3) FOR
; SYSOUT
; SYSOUT WITH CC
; SYSUT1
; SYSUT2
; R13=XPL STRING DOPE VECTOR
;
;REGISTER USAGE
;
; R0=OUTPUT BUFFER LENGTH
; R1=INPUT STRING LENGTH
; R2=INPUT STRING POINTER
; R3=OUTPUT BUFFER POINTER
; R4=WORK
;
PUTOUT: JUMPL R12,TTYOUT ;TYPE IF FILE # -VE
CAILE R12,^D15 ;MAKE SURE FILE NUMBER IS LEGAL
JRST OTERR1 ;TELL USER AND QUIT
SETZM NOCTL ;TESTED LATER
JUMPG R12,PUT0 ;FILE 0?
SETOM NOCTL ;YES. CHANGE TO 1 , BUT REMEMBER
AOJ R12, ;INCREMENT R12 TO RIGHT NUMBER
PUT0: MOVE R0,FLAGS(R12) ;LOAD FLAGS FOR THIS FILE.
TLNN R0,FILOUT ;IS IT SET FOR OUTPUT?
JRST .+3 ;NO.
TLNN R0,FILBIN ;IS IT ASCII?
JRST OUTOK ;YES. GO USE IT
PUSHJ P,CLOSFL ;NO TO ANY OF ABOVE: CLOSE FILE
TLNE R0,CHNCLS ;IS CHANNEL INITED?
PUSHJ P,INITAS ;NO. OPEN IN ASCII
TLNE R0,FILBIN ;BINARY MODE?
PUSHJ P,SETASC ;YES. SET IT TO ASCII
PUSHJ P,ENTFIL ;DO ENTER, ETC.
MOVEM R0,FLAGS(R12) ;SAVE FLAGS
;
OUTOK: MOVE R2,R13 ;COPY DV FOR BURSTING
MOVEI R1,0 ;CLEAR LENGTH REG
LSHC R1,11 ;LENGTH TO R1 (9 BITS)
MOVE R0,R1 ;COPY LENGTH IN R0
LSH R2,-11 ;BYTE ADDR ONLY
SUBI R2,1 ;DECR OPTR FOR ILDP
LSHC R2,-2 ;BYTE OFFSET TO R3
LSH R3,-42 ;RIGHT JUSTIFY BYTE OFFSET
HLL R2,BYTEPT(R3) ;FORM PDP-10 OPTR
CAIN R12,1 ;CC UNIT SPECIFIED?
SKIPE NOCTL ;WAS 0. NO CONTROL.
JUMPA OUT3 ;NO
SUBI R1,1 ;DECR INPUT COUNT FOR CC CHAR
ILDB R4,R2 ;PICK UP CC BYTE
CAIE R4,"0" ;IS IT 0? (DOUBLE SPACE)
JUMPA OUT1 ;NO, GO LOOK FOR OTHERS
PUSHJ P,LFOUT ;PUT OUT A LINE FEED
JUMPA OUT3 ;
;
OUT1: CAIE R4,"1" ;IS IT 1? (EJECT)
JUMPA OUT3 ;NO, IGNORE IT
MOVEI R4,14 ;FF
PUSHJ P,CHAROT ;PUT IT OUT
OUT3: JUMPE R1,OUT5 ;GO AROUND IF NULL STRING
OUT4: ILDB R4,R2 ;PICK UP ONE BYTE
PUSHJ P,CHAROT ;OUTPUT CHARACTER
SOJG R1,OUT4 ;LOOP THRU ALL BYTES
OUT5: PUSHJ P,CRLF ;ADD CR-LF SEQUENCE AT END OF STRING
JUMPA RETURN ;GOTO EXIT
TTYOUT: MOVE R1,R13 ;GET STRING POINTER
TLZ R1,777000 ;CLEAR COUNT
SUBI R1,1 ;ADJUST FOR ILDB
IDIVI R1,4 ;GET WORD ADDRESS
HLL R1,BYTEPT(R2) ;MAKE CORRECT BYTE POINTER
LDB R2,[POINT 9,R13,8] ;GET COUNT FROM R13
JUMPE R2,TTYODN ;JUST CR,LF IF COUNT = 0
TTYOU1: ILDB R0,R1 ;GET NEXT BYTE
TRNE R0,173 ;SKIP IT IF = 004(EOT) OR 000(NUL)
OUTCHR ;STUFF IT OUT
SOJG R2,TTYOU1 ;LOOP UNTIL ALL OUT
;
TTYODN: CAME R12,[-2] ;NO CR-LF IF FILE # =-2
OUTSTR [BYTE (7)CR,LF,0] ;TYPE CR,LF
JRST RETURN ;RETURN TO CALLER
OTERR1: OUTSTR [ASCIZ /ILLEGAL FILE NUMBER IN OUTPUT CALL
/]
JRST EXITS
CRLF: MOVEI R4,CR ;LOAD CR INTO REGISTER
PUSHJ P,CHAROT ;PUT IT OUT
LFOUT: MOVEI R4,LF ;LOAD A LINE FEED
CHAROT: SOSG @OCNT(R12) ;DECREMENT ITEM COUNT
XCT OUTLST(R12) ;NO SPACE LEFT. DO OUTPUT
IDPB R4,@OPTR(R12) ;PUT BYTE INTO BUFFER
POPJ P, ;RETURN
;
;CALL EXIT ROUTINE
;
EXITS: MOVSI R2,-^D16 ;SET LOOP COUNTER
ELOOP: MOVE R0,FLAGS(R2) ;GET FILE FLAGS
TLNN R0,FILOPN ;IS FILE OPEN?
JRST EXT1 ;NO. CHECK NEXT FILE
TLNE R0,FILOUT ;YES. IS IT OUTPUT?
XCT OUTLST(R2) ;YES. ONE LAST OUTPUT TO CLR BUFFER
XCT CLSLST(R2) ;CLOSE FILE
EXT1: AOBJN R2,ELOOP ;LOOP FOR ALL FILES
EXIT
; SET NEW FILE NAME ROUTINE
; CALL WITH STRING = DEVICE:FILENAME.EXTENSION
; IF DEVICE IS OMITTED, DSK ASSUMED
; IF EXTENSION IS OMITTED, 'DAT' IS ASSUMED.
;;
FILSET:
JUMPL R12,SETER1 ;ONLY FILE NUMBERS 0-15 LEGAL
CAILE R12,^D15
JRST SETER1
MOVE R0,FLAGS(R12) ;GET FILE'S FLAGS
PUSHJ P,CLOSFL ;MAKE SURE FILE IS CLOSED
LDB R1,[POINT 9,R13,8] ;GET BYTE COUNT
MOVE R2,R13 ;GET COPY OF POINTER
TLZ R2,777000 ;CLEAR LENGTH CODE
SUBI R2,1 ;ADJUST FOR ILDB
IDIVI R2,4 ;FIND WORD ADDRESS AND DISPL.
HLL R2,BYTEPT(R3) ;MAKE A BYTE POINTER IN R2
MOVE R13,R12 ;CONSTRUCT INDEX TO FILE TABLE
IMULI R13,4
MOVE R3,[SIXBIT /XPL00/] ;MAKE DEFAULT FILE NAME
MOVE R4,R12 ;GET FILE NUMBER
IDIVI R4,^D10 ;TWO DIGITS
LSH R4,^D12 ;SHIFT TENS DIGIT
LSH R5,^D6 ;UNITS DIGIT
ADD R3,R4
ADD R3,R5 ;MAKE FILE NAME RIGHT
MOVEM R3,FILNAM(R13) ;MAKE DEFAULT NAME BLOCK
MOVSI R3,'DAT'
MOVEM R3,FILNAM+1(R13)
SETZM FILNAM+2(R13)
SETZM FILNAM+3(R13) ;OWN PROJ-PROG NUMBER
MOVSI R3,'DSK' ;STANDARD DEVICE NAME
MOVEM R3,TEMPDV# ;SAVE FOR LATER REF.
SETZB R4,R6 ;CLEAR REGS
MOVE R5,[POINT 6,R6] ;INIT BYTE POINTER
JUMPLE R1,FILDON ;JUST RESET FILE IF GIVEN NULL STRING
;
FILST1: ILDB R3,R2 ;GET FIRST (NEXT) BYTE
CAIN R3,":" ;END OF DEVICE NAME SPEC?
JRST FILST2 ;YES
CAIE R3,"." ;EITHER . OR [ MARK END OF NAME
CAIN R3,"[" ;OF FILE
JRST FILST4
SUBI R3,40 ;CONVERT TO SIXBIT
AOJ R4, ;INCREMENT COUNT OF CHARACTERS
CAIG R4,6 ;MAXIMUM IS SIX
IDPB R3,R5 ;STUFF INTO ACC.
SOJG R1,FILST1 ;LOOP BACK IF MORE THERE
JRST FILST4 ;NOPE--MUST BE JUST NAME
;
FILST2: MOVEM R6,TEMPDV ;SAVE NEW DEVICE NAME
SETZB R4,R6 ;CLEAR REGS FOR FILE NAME
MOVE R5,[POINT 6,R6] ;INITIAL BYTE POINTER
SOJLE R1,FILDON ;ALL DONE IF NO MORE CHARS
FILST3: ILDB R3,R2 ;GET NEXT BYTE
CAIE R3,"." ;LEGAL TERMINATORS ARE .
CAIN R3,"[" ;AND [
JRST FILST4 ;FOUND ONE. DO NAME STUFF
SUBI R3,40 ;CONVERT TO SIXBIT
AOJ R4, ;INCREMENT COUNT OF CHARS
CAIG R4,6 ;ONLY SIX ALOWWED
IDPB R3,R5 ;STUFF INTO ACC.
SOJG R1,FILST3 ;LOOP BACK IF MORE THERE
;
FILST4: MOVEM R6,FILNAM(R13) ;SAVE NEW FILE NAME
SETZB R4,R6 ;INIT REGS
MOVE R5,[POINT 6,R6] ;INIT BYTE POINTER
SOJLE R1,FILDON ;ALL DONE IF COUNT EXHAUSTED
CAIN R3,"[" ;IF STOPPED ON [, THERE IS NO EXT
JRST FILST7 ;GO LOOK FOR PROJ,PROG
FILST5: ILDB R3,R2 ;GET NEXT BYTE
CAIN R3,"[" ;ONLY LEGAL TERMINATOR IS [
JRST FILST6 ;SAVE NEW EXT
SUBI R3,40 ;CONVERT TO SIXBIT
ADDI R4,1 ;INCREMENT CHAR COUNT
CAIG R4,3 ;ONLY THREE ALLOWED
IDPB R3,R5 ;STUFF IT IN
SOJG R1,FILST5 ;LOOP BACK IF THERE IS MORE
;
FILST6: MOVEM R6,FILNAM+1(R13) ;STORE NEW EXTENTION
SOJLE R1,FILDON ;ALL DONE WHEN COUNT DONE
FILST7: SETZB R4,R6 ;CLEAR REGS
FILST8: ILDB R3,R2 ;GET NEXT CHAR
CAIN R3,"," ;PROJ NUMBER TERMINATED BY ,
JRST FILST9 ;
ANDI R3,7 ;KEEP ONLY OCTAL BITS
ADDI R4,1 ;COUNT NUMBER OF DIGITS
CAILE R4,6 ;MUST NOT EXCEED 6
JRST SETER2
IMULI R6,10 ;MULITPLY PREV. NO. BY 8
ADD R6,R3 ;ADD NEW DIGIT
SOJG R1,FILST8 ;GO BACK FOR NEXT DIGIT
JRST SETER2 ;ERROR IF EXHAUSTED
;
FILST9: HRLZ R5,R6 ;PUT PROJ NO. IN LEFT HALF
SETZB R4,R6 ;CLEAR REGS
SOJLE R1,SETER2
FILSTA: ILDB R3,R2 ;GET NEXT CHAR
CAIN R3,"]" ;LEGAL TERMINATOR IS ]
JRST FILSTB ;FOUND IT
ANDI R3,7 ;MAKE INTO OCTAL DIGIT
ADDI R4,1 ;INCREMENT COUNT
CAILE R4,6 ;MUST NOT EXCEED 6
JRST SETER2 ;OR ERROR
IMULI R6,10 ;MULTIPLY BY 8
ADD R6,R3 ;ADD NEW DIGIT
SOJG R1,FILSTA ;LOOP FOR REST
JRST SETER2 ;ERROR IF NOT ENOUGH
;
FILSTB: HRR R5,R6 ;PROG NO TO RIGHT HALF
MOVEM R5,FILNAM+3(R13) ;SAVE PROJ,PROG NO.
;
FILDON: MOVE R5,TEMPDV ;GET NEW DEVICE NAME
CAME R5,DEVLST(R12) ;IS IT SAME AS OLD DEVICE?
TLO R0,CHNCLS ;NO. INDICATE INIT IS REQUIRED
MOVEM R5,DEVLST(R12) ;STORE NEW DEVICE NAME
MOVEM R0,FLAGS(R12) ;SAVE FILE FLAGS
;
JRST RET1 ;RETURN TO CALLER
SETER1: OUTSTR [ASCIZ /INVALID FILE NUMBER TO "FILENAME".
/]
JRST EXITS
SETER2: OUTSTR [ASCIZ /IMPROPER PROJ,PROG NUMBER TO "FILENAME".
OWN NUMBER USED INSTEAD.
/]
JRST FILDON
; BINARY INPUT (SEQUENTIAL) ROUTINE
;
;
BININ:
CAILE R12,1 ;FILES 0,1 ARE ASCII ONLY
CAILE R12,^D15 ;MAX FILE # IS 15
JRST INERR1 ;TYPE ERROR MESSAGE
MOVE R0,FLAGS(R12) ;LOAD FLAGS FOR THIS FILE.
TLNN R0,FILIN ;IS IT SET FOR INPUT?
JRST .+3 ;NO.
TLNE R0,FILBIN ;IS IT BINARY?
JRST BINOK ;YES. GO USE IT
PUSHJ P,CLOSFL ;NO TO ANY OF ABOVE: CLOSE FILE
TLNE R0,CHNCLS ;IS CHANNEL INITED?
PUSHJ P,INITBI ;NO. OPEN IN BINARY
TLNN R0,FILBIN ;BINARY MODE?
PUSHJ P,SETBIN ;NO. SET IT TO BINARY
PUSHJ P,LOOKFL ;DO LOOKUP, ETC.
MOVEM R0,FLAGS(R12) ;SAVE FLAGS
;
BINOK: SKIPE EOFSW(R12) ;ANYTHING LEFT?
JRST BIN1 ;RETURN A ZERO FOR NOW
SOSLE @ICNT(R12) ;DECREMENT BYTE COUNTER
JRST BINLD ;OK. GO LOAD BYTE
XCT INLST(R12) ;DO INPUT FOR NEW BUFFER
JRST BINLD ;OK. LOAD BYTE
SETOM EOFSW(R12) ;FLAG END OF FILE (MAYBE ERROR)
BIN1: SETZ R1, ;RETURN A ZERO
JRST BINRET
;
BINLD: ILDB R1,@IPTR(R12) ;LOAD NEXT BYTE FROM BUFFER
BINRET: LDB R12,[POINT 4,R14,12] ;GET RESULT REGISTER #
MOVEM R1,SAVE(R12) ;RETURN IT IN R12
JRST RETURN ;RETURN TO CALLER
; BINARY SEQUENTIAL OUTPUT ROUTINE
;
BINOUT:
CAILE R12,1 ;FILES 0, 1 ARE ASCII ONLY
CAILE R12,^D15 ;FILE NUMBER 15 OR LESS
JRST OTERR1 ;WRONG: TYPE ERROR MESSAGE
MOVE R0,FLAGS(R12) ;LOAD FLAGS FOR THIS FILE.
TLNN R0,FILOUT ;IS IT SET FOR OUTPUT?
JRST .+3 ;NO.
TLNE R0,FILBIN ;IS IT BINARY?
JRST BOUTOK ;YES. GO USE IT
PUSHJ P,CLOSFL ;NO TO ANY OF ABOVE: CLOSE FILE
TLNE R0,CHNCLS ;IS CHANNEL INITED?
PUSHJ P,INITBI ;NO. OPEN IN BINARY
TLNN R0,FILBIN ;BINARY MODE?
PUSHJ P,SETBIN ;NO. SET IT TO BINARY
PUSHJ P,ENTFIL ;DO ENTER, ETC.
MOVEM R0,FLAGS(R12) ;SAVE FLAGS
;
BOUTOK: SOSG @OCNT(R12) ;SPACE LEFT IN BUFFER?
XCT OUTLST(R12) ;NO. DO OUTPUT
IDPB R13,@OPTR(R12) ;PUT WORD INTO BUFFER
JRST RETURN ;RETURN TO CALLER
; COMMON SUBROUTINES
; OPEN (INIT) A LOGICAL CHANNEL
INITAS: MOVEI R1,0 ;SET MODE BITS = ASCII
JRST INITFL ;INIT THE FILE
INITBI: MOVEI R1,14 ;SET MODE BITS TO BUFFERED BINARY
;FALL INTO INIT ROUTINE
; ENTER WITH MODE BITS IN AC R1
INITFL: MOVE R2,DEVLST(R12) ;GET SPECIFIED DEVICE
MOVE R3,[XWD 3,3] ;SET UP BUFFER HEADER POINTERS
IMUL R3,R12 ;DISPLACEMENTS INTO IBUFS AND OBUFS
ADD R3,[XWD OBUFS,IBUFS]
INITF1: XCT OPNLST(R12) ;TRY OPEN
JRST INITF2 ;FAILED
TLZ R0,CHNCLS!CHNCHG ;CLEAR CHANNEL CLOSED AND CHANNEL CHANGE BITE
CAIN R1,0 ;WAS THIS ASCII?
TLZA R0,FILBIN ;YES
TLO R0,FILBIN ;NO. ASSUME BINARY
TLZ R0,FILOPN!FILIN!FILOUT ;CLEAR FLAG BITS
SETZM EOFSW(R12) ;CLEAR END-OF-FILE FLAG
POPJ P, ;RETURN
INITF2: CAMN R2,[SIXBIT /DSK/] ;FIALURE ON DEVICE DSK?
JRST INITFE ;YES
MOVSI R2,'DSK' ;NO. CHANGE TO DSK LEAVE DEVLST ENTRY ALONE
JRST INITF1 ;TRY AGAIN
INITFE: OUTSTR [ASCIZ /CAN'T INIT LOGICAL DEVICE.
/]
JRST EXITS
; SET LOGICAL CHANNEL TO BINARY (14) MODE
SETBIN: TLO R0,FILBIN ;SET BIT
XCT GSTLST(R12) ;GET FILE STATUS BITS
TRNE R1,10 ;BINARY MODE?
POPJ P, ;YES
TRZE R1,17 ;NO CLEAR ALL BITS
TRO R1,14 ;SET MODE 14
XCT SSTLST(R12) ;SET FILE STATUS
POPJ P, ;RETURN
; ROUTINE TO SET ASCII MODE ON LOGICAL CHANNEL
SETASC: TLZ R0,FILBIN ;CLEAR BINARY BIT
XCT GSTLST(R12) ;GET FILE STATUS BITS
TRZN R1,17 ;ANY MODE BITS ON?
POPJ P, ;NO. MUST BE ASCII
XCT SSTLST(R12) ;YES. SET NEW FILE STATUS
POPJ P, ;RETURN
;ROUTINE TO CLOSE A FILE IF IT IS OPEN.
CLOSFL: TLNN R0,FILOPN ;IS FILE OPEN?
JRST CLOS1 ;NO
TLNE R0,FILOUT ;YES. IS IT OUTPUT FILE?
XCT OUTLST(R12) ;YES. DO OUTPUT TO FLUSH BUFFER
XCT CLSLST(R12) ;CLOSE THE FILE
CLOS1: TLZ R0,FILOPN!FILIN!FILOUT ;CLEAR THE RELEVANT BITS
TLNN R0,CHNCLS ;UNLESS CHANNEL NOT INITED,
XCT REWLST(R12) ;REWIND THE FILE.
POPJ P, ;RETURN
; OPEN FILE ON LOGICAL CHANNEL FOR INPUT
LOOKFL: MOVS R4,R12 ;FILE NUMBER TO R4 LH
LSH R4,2 ;TIMES 4 TO ADDRESS RIGHT NAME BLOCK
ADD R4,[XWD FILNAM,R1] ;MAKE A BLT WORD
BLT R4,R4 ;LOOKUP BLOCK IN R1-R4
XCT LUKLST(R12) ;DO LOOKUP
JRST LUKER1 ;NOT THERE
TLO R0,FILOPN!FILIN ;SET CHANNEL STATUS BITS
SETZM EOFSW(R12) ;CLEAR END-OF-FILE SWITCH
POPJ P, ;RETURN
; OPEN FILE ON LOGICAL CHANNEL FOR OUTPUT
ENTFIL: MOVS R4,R12 ;FILE NUMBER TO LH R4
LSH R4,2 ;TIMES 4 TO ADDRESS RIGHT FILE NAME BLOCK
ADD R4,[XWD FILNAM,R1] ;MAKE A BLT WORD
BLT R4,R4 ;ENTER BLOCK IN R1-R4
XCT ENTLST(R12) ;DO ENTER
JRST ENTER1 ;FAILED
TLO R0,FILOPN!FILOUT ;SET MODE BITS FOR CHANNEL
POPJ P, ;RETURN
LUKER1: OUTSTR [ASCIZ /LOOKUP FAILURE.
/]
JRST EXITS
ENTER1: OUTSTR [ASCIZ /ENTER FAILURE.
/]
JRST EXITS
;
;DATA AREA
;
DEFINE OPBLK (OPN,ADR) ;GENERATES BLOCK OF OPS FOR EACH CHN
< CHN=0
REPEAT ^D16,< OPN CHN,ADR
CHN=CHN+1>
>
DEFINE INDIR (LOC)
< CHN=0
REPEAT ^D16,< EXP LOC'CHN
CHN=CHN+1>
>
SAVE: BLOCK ^D16 ;REGISTER SAVE AREA
;
IPTR: INDIR <IBUFS+1+3*> ;INPUT BYTE POINTERS
ICNT: INDIR <IBUFS+2+3*> ;INPUT ITEM COUNTS
OPTR: INDIR <OBUFS+1+3*> ;OUTPUT BYTE POINTERS
OCNT: INDIR <OBUFS+2+3*> ;OUTPUT ITEM COUNTS
OUTLST: OPBLK OUTPUT
INLST: OPBLK IN ;IN UUOS FOR INPUT ROUTINES.
CLSLST: OPBLK CLOSE
OPNLST: OPBLK OPEN,R1
LUKLST: OPBLK LOOKUP,R1 ;LOOKUP INSTR
ENTLST: OPBLK ENTER,R1 ;ENTER INSTR
GSTLST: OPBLK GETSTS,R1
SSTLST: OPBLK SETSTS,R1
REWLST: OPBLK MTAPE,1 ;REWIND OPERATION
ZERST:
IBUFS: BLOCK 3*^D16 ;INPUT BUFFER POOL BLOCKS
OBUFS: BLOCK 3*^D16 ;OUTPUT BUFFER POOL BLOCKS
EOFSW: BLOCK ^D16 ;END-OF-FILE INDICATORS
FILNAM:
BLOCK 4*20 ;SPACE FOR 16 FILE NAME BLOCKS
FLAGS: BLOCK ^D16 ;FLAG CELLS
DEVLST: BLOCK ^D16 ;DEVICE NAMES FOR THE FILES
ZERSTP=.-1 ;STOP ADDRESS FOR INITIAL CLEAR
BYTEPT: POINT 9,0,8 ;XPL BYTE POINTERS
POINT 9,0,17
POINT 9,0,26
POINT 9,0,35
NOCTL: BLOCK 1 ;FLAG FOR ASCII OUTPUT ON FILE 0/1
PDLSIZ=20
PDL: IOWD PDLSIZ,.+1 ;INITIAL PDL POINTER WORD
BLOCK PDLSIZ ;PUSH-DOWN LIST
VAR
LIT
END ;