Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/forots.mac
There are 27 other files named forots.mac in the archive. Click here to see a list.
TITLE FOROTS %5A(721) - FORTRAN OBJECT TIME SYSTEM
SUBTTL D. TODD/DRT/HPW/MD/NEA/DPL/JNG/CLRH/MEB/SJW/JMT/SWG/DCE 21-OCT-77
;COPYRIGHT (C) 1972,1977 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.
MLON
ENTRY FOROT% ;ENTRY POINT TO FOROTS - MUST BE DEFINED BEFORE
.JBOPS=135
.JBVER=137
EXTERNAL FORER% ;DEFINE FORERR AS EXTERNAL
EXTERNAL TRACE% ;DEFINE TRACE AS EXTERNAL
SEARCH FORPRM ;GLOBAL SYMBOL DEFINED IN FORPRM
VERNO==05 ;MAJOR VERSION NUMBER
VEDIT==721 ;MAJOR EDIT NUMBER
VMINOR==01 ;MINOR EDIT NUMBER
VWHO==0 ;WHO EDITED LAST
VEROTS==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT
SUBTTL REVISION HISTORY
;EDIT SPR COMMENT
;---- --- -------
;************* BEGINNING VERSION 4
;247 ----- IMPLEMENT FULL SLIST AND ELIST
;250 ----- IMPLEMENT ARRAY BOUNDS CHECKING
;256 ----- CORRECTION TO EDIT 247
; ALLOW ELISTS WITH 1 ARRAY
;260 ----- SWITCH FT.EXT AND FT.ELT
;271 ----- ALLOW ' TO DELIMIT FORMAT ELEMENT
;275 ----- FIX DOUBLE WORD BINARY AND FORMATTED IOLST
; PROCESSING WITH NON-UNARY INCREMENT
;276 ----- FIX RELOC TO RETURN ONLY RIGHT HALF OF IMMEDIATE MODE ARGUMENTS
; FIX FOROTS TO READ CHARACTER COUNT IN ENCODE/DECODE
; IN NEW IMMEDIATE MODE FORMAT
;326 (QAR) SLIST AND ELIST DO NOT RETURN ALL ALLOCATED
; CORE BLOCKS.
;341 (QAR) CORRECT CHAIN OF BLOCKS FOR SLIST AND ELIST
;342 (Q2338) IN DIALOG MODE TYPE CR-LF AFTER ALTMODE SEEN
;343 (Q2072) VERSION NUMBER IS FULL WORD
;344 (Q2046) IMPLEMENT /DISPOSE=LIST FOR OPEN/CLOSE STATEMENT
;345 (Q2322) F FORMAT WILL OUTPUT DBLE-PREC VAR AS D
;346 ----- PRESERVE .JBHRL TO CALL FORQUE
;347 ----- RESTRICT DELIMITER FOR LIST-DIRECTED INPUT
; TO BLANK, COMMA AND LINE TERMINATOR
;350 (13704) LIST-DIRECTED INPUT DOES NOT TAKE END= RETURN
;351 (Q2394) RETURN AC0/-1 IF NO CORE AVAILABLE (ALCOR.)
;352 (Q2337) TEST FULL WORD FOR MTA DENSITY ARGUMENT
;353 ----- FIX TO EDIT 332
;354 ----- FIX FREE FORMAT INPUT
;355 (13315) ALLOW ARGUMENT BLOCK IN REGISTERS
;356 (13877) MOVE CONSTANTS IN FORDBL
;357 ----- REDEFINE LABEL ERROR IN FORCNV
;360 ----- FIX CONTINUATION LINE FOR MACRO V50
;361 (13134) MTA POSITIONNING PROBLEMS
;362 (13976) MAKE SWITCHING FROM READ TO WRITE ALWAYS USE THE WHOLE BLOCK
;363 ----- DEFINE CEXIT. FOR NON FORTRAN USE OF LIB ROUTINES
;364 ----- DEFINE FDDT. IF FORDDT NOT LOADED
;365 ----- INSERT FORX40 IN FORMSC
;366 ----- FIX LIST-DIRECTED INPUT TO ARRAYS
;367 (13951) FIXED INTEGER FORMAT LOOSES BLANKS AT END OF RECORD
;370 (Q2648) FIX CLEAN UP OF ENCODED FORMAT LIST
;371 (Q2600) FIX EOF IN IMAGE MODE
;372 ----- FIX NAMELIST
;373 (13917) FIX SCALING FACTOR
;374 ----- END OF NAMELIST LIST FOR F10-V2
;375 ----- DO NOT ALLOW SEQUENTIAL ACCESS ON RANDOM FILE
;376 ----- CORRECT FIXED "A" FORMAT AFTER FREE FORMAT
;377 ----- CORRECT F FORMAT
;400 ----- FIX TO EDIT 372
;401 ----- SAVING REGISTERS IN FORINI MAY FAIL
;402 ----- COMPLETE EDIT 375 (APPEND MODE)
;************* BEGINNING VERSION 4A
;406 ----- CONFORM TO DATE 75 STANDARDS
;************* BEGINNING VERSION 4B
;403 14020 CORRECT HANDLING OF RECORD DELIMITERS (LF-VT-FF)
; WHEN DOING BACKSPACE (REREAD)
;404 14108 DEFAULT ACCESS IS SEQINOUT TO ALLOW READ/WRITE
; ON NON SPECIFICALLY OPEN FILE.
;405 14115 DEFINE FORER. FOR NON FORTRAN MAIN PROGRAM
; CALLING ROUTINES OF FORLIB (FORDUM)
;406 ----- CONFORM TO DATE 75 STANDARDS
;407 14414 FIX TO EDIT # 310 (FORQUE)
;410 14339 REWRITE LIBRARY ROUTINE RESET
;411 14350 MAKE $ FORMAT DESCRIPTOR WORK ON ANY TERMINAL.
;412 14525 MAKE TRACE ROUTINE CHECK FOR INDIRECT CALLS
;413 ----- INDEX THE LIBRARY
;414 14602 CORRECT TYPING OF ERROR MESSAGE WHEN ILLEGAL CHAR
; IS FOUND IN RECORD
;415 14823 REMOVE EXTRA END STATEMENT FROM FORERR.MAC
;416 14778 FIX FILE NAME SCAN IN OPEN ARGS TO DETECT INVALID
; CHARACTERS AND ENTER DIALOG MODE
;417 14747 FIX '$' FORMAT CONTROL CHARACTER TO WORK ON LINE PRINTER
;420 14876 FIX 'T' FORMAT BACKWARDS
;421 14935 FIX FRSOPN PROTECTION FAILURE CAUSED BY CLOSE DOING
; A RENAME ESPECIALLY AFTER 5-JAN-75
;422 14729 FIX 'X' FORMAT
;423 15030 FIX FORPSE TO NOT DESTROY REG.
;424 14996 FIX FOROTS TO RECOGNIZE UNWRITTEN RANDOM ACCESS RECORD
; IN ASCII MODE AND ADD AN ERROR MESSAGE TO FORERR
;425 15042 FIX FOROTS TO RETURN CORRECT VALUE TO ASSOCIATED
; VARIABLE FOR RANDOM ACCESS FILES READ TO END.
;426 15142 FIX NAMELIST TO ACCEPT ANY 6 CHARS NAMELIST NAME
;427 14996 FIX FOROTS TO DISTINGUISH BETWEEN END-OF-FILE AND AN
; UNWRITTEN RANDOM ACCESS ASCII RECORD (THIS EDIT MUST
; HAVE EDIT 424).
;430 15596 FIX FORCNV TO HANDLE SCALING FACTOR ON OUTPUT AFTER
; NAMELIST INPUT
;431 15629 FIX FOROTS TO NOT CONTINUE READING BEYOND EOF WHEN EOF
; HAS BEEN ENCOUNTERED ON MAGTAPE DURING I/O LIST PROCESING
;432 15764 FIX PRINTING OF PPN PROTECTION OF THE FORM <X0Y> IN FORERR
;433 15880 FIX FORCNV TO CORRECTLY HANDLE OCTAL NUMBERS WITH MINUS
; SIGN
;434 15891 FIX FMTSRC TO CORRECTLY HANDLE FORMATS SUCH AS (/I2/I3
; /I2/I3/I2/I3/I2/I3/I2/I3/I2/I3/I3/I2).
;435 ----- FIX ERROR MACRO IN FORPRM AND FORERR TO ASSEMBLE
; DIFFERENT NO-OPS TO ALLOW UP TO 48 ERROR MSGS PER CLASS.
;436 15720 MAKE BACKSPACE WORK FOR ACCESS=APPEND
;437 ----- FIX GMEM9, IT BLT'S ONE WORD TOO MANY WHEN A REQUEST
; FOR ONE WORD OF CORE IS MADE
;440 16052 FIX CLRUSE TO CLEAR ALL USE BITS BECAUSE OF TIMING
; PROBLEM WITH LARGE RANDOM ACCESS FILES
;441 16108 FIX FORCNV(FLOUT%) TO NORMALIZE SINGLE PRECISION
; NUMBERS SO NOS. LIKE -1.999999 DON'T LOSE PRECISION
;442 16298 FIX FOROTS SO SEQOUT WITH A RECORD SIZE AND T FORMAT
; WILL NOT LOOP.
;443 16609 FIX FOROTS SO IT WILL RECOGNIZE AN SFD NAME IN AN ARRAY
; NAME IN THE OPEN STATEMENT
;444 16573 FIX EDIT 436 IN FOROTS SO APPEND DOESN'T START NEW RECS
; ON BLOCK BOUNDARY
;445 16517 FIX NAMELIST INPUT IN FORCNV SO FLOATING POINT TO
; INTEGER CONV. WORKS ALL THE TIME EVEN FOR #'S LIKE 1.0
;446 15993 FIX FORFUN IN CBC SO IT WILL CUT BACK CORE PROPERLY
; FOR LINK OVERLAY'S
;447 16733 FIX IN FOROTS AND FORERR EOF PROCESSING SO IO LIST
; VARIABLES DO NOT GET CLEARED
;450 ----- FIX EDIT 424 IN FORERR TO CHECK P3 NOT P2 FOR IO.FMT
;451 ----- FIX FORERR IN DAT7 TO NOT TRY TO PRINT A FORMAT STATE-
; MENT WHEN ILLEGAL CHAR IN DATA DETECTED FOR NAMELIST
;452 16666 FIX DIALOG MODE TO WORK FOR DIALOG=FOO AND JUST DIALOG
;453 ----- FIX FOROTS IN OPNNAM SO STORING THE EXT WON'T CAUSE DATE
; 75 PROBLEM
;454 ----- FIX RECOGNITION OF EOF ON RANDOM ACCESS FILES WHEN
; LAST BLOCK OF FILE IS PARTIAL
;455 ----- FIX ENTER. SO EXTENDED LOOKUP/ENTER/RENAME FORCED
; FOR ALL DIR DEVICES BUT DTA(THE RIGHT WAY)
;456 16991 FIX EDIT 443 TO PICK UP ARGS IN A SINGLE PRECISION
; ARRAY AS WELL AS DOUBLE PRECISION
;457 ----- REMOVE EDIT 442 IN CPYSTR AND FIX LOOP WITH RECORD SIZE
; AND T-FORMAT WITH CHANGE IN NXTLNO
;460 16632 FIX FOROTS SO SEQINOUT DOES NOT GET BLOCK TOO LARGE
; ERROR OR QUOTA EXCEEDED
;
;*************** BEGINNING VERSION 4C
;
;461 16741 FIX NAMELIST IN FORCNV TO ACCEPT ANY VARIABLE NAME OF
; 6 CHARS
;462 16796 FIX FORCNV IN FLIRT% SO CALL TO ILL WILL CORRECTLY
; CAUSE ILLEGAL CHARS IN DATA TO BE SET TO ZERO AND
; NOT SKIP VALID FOLLOWING CHARS
;463 16661 FIX FORERR SO ILLEGAL MODE FOR DEVICE MESSAGE SAYS
; MORE CORRECTLY 'ILLEGAL MODE OR MODE SWITCH'
;464 17090 PREVENT WIPING OUT RANDOM CORE IN THE FORMAT STATEMENT
; PROCESSOR IF THE FIRST FORMAT STATEMENT HAS MORE THAN
; 2 LEVELS OF NESTED PARENTHESIS.
;465 17142 READ STRINGS INTO D.P. VARIABLES CORRECTLY.
;466 17152 FIX SNG.X WHEN ARG IS NEGATIVE AND CLOSE TO A POWER OF 2
;467 17304 FIX FORMAT PROCESSING CORE ALLOCATION ONCE AND FOR ALL.
;470 ----- DON'T TRAP OVERFLOWS OUT OF DDT.
;471 17385 AVOID ILL MEM REF ON RANDOM ASCII FORMATTED READ.
;472 ----- PUT DATA FILES IN DEFAULT PATH IF NONE SPECIFIED
;473 17572 CLEAR CH.SAV IN FIN%% SO DECODE WILL WORK.
;474 17648 DON'T STOP PRINTING BAD RECORD ON LF IN FORERR.
;475 ----- ADD DBMS% DUMMY ROUTINE FOR UNBUNDLED DBMS.
;476 17725 FIX G FORMAT WHEN FIELD IS TOO SMALL, BUT OK W.O. 4X.
;477 17759 ALWAYS ALLOCATE AT LEAST 2 WORDS OF CORE IN FORFUN.
;500 17818 RESET ELIST/SLIST FLAGS WHEN STARTING NEW LIST.
;501 17900 CLEAR IO.EOL AT CPYSTR SO SOME DATA WILL ALWAYS MOVE.
;502 17899 MAKE TTY BUFFER 132 CHARS FOR REASONABLE REREAD.
;503 17871 CLEAR CH.SAV ON T FORMAT IN CASE FREE FORMAT PRECEDED.
;504 18010 CORRECT SAVE IN FOROPN TO SAVE T5, AS IT TRIES TO.
;505 18011 STORE BLOCKS (NOT WORDS) IN .RBEST ON FILESIZE= IN OPEN.
;506 17107 DELETE OVRLAY HANDLER'S FREE CORE LIST -- JUST USE ONE.
;507 17107 DELETE CORE USED BY FLU EVEN IF FILE HAS GONE AWAY.
;510 17898 DON'T TAKE EOF RETURN WITH RING POINTING TO STRING.
;511 17107 MAKE CORE MANAGEMENT FIRST FIT FROM SMALL ADDRESSES UP.
; THIS IS TO MAKE OVERLAYS WORK A LOT BETTER.
;512 17107 IF GAD FAILS IN FORFUN, DELETE FORMAT BLOCKS & RETRY.
;513 15636 FIX INCORRECT RESULTS FOR DATAN(X), WHERE
; (5*SQRT(5)-2)/11 < ABS(X) < (5*SQRT(5)+2)/11, I.E.
; IF .8346 < ABS(X) < 1.198
;514 18030 RETURN AN ERROR TO FUNCT. COR FUNCTION IF NO CORE AVAIL
;515 18756 FIX EDIT 424 TO FORER. TO CHECK RIGHT REGISTER P3 AT
; ER%DA1+10.
;516 18207 FIXES TO FORPLT TO USE INT. RATHER THAN INT, ETC.
;517 18268 FIX FORMATS LIKE F2.0 TO NEVER PRINT JUST A DOT
;520 18814 FIX EDIT 510 FOR T FORMAT AFTER END-OF-FILE
;521 18526 FIX DIALOG MODE OPENS W/O = FOR F40 -- SENDS ARGUMENT
; OF ZERO RATHER THAN ADDRESS OF ZERO TO OPNDIA
;522 18445 FIX PROTECTION ERROR DURING RENAME/CLOSE FOR FILES
; PROTECTED 2 OR GREATER
;523 18138 DO LOOKUP BEFORE RENAME IN MODE CHANGE FOR
; SEQINOUT, AND MAKE ERRORS FATAL.
;524 18699 FIX QUOTA EXCEEDED MESSAGE
;525 18856 FIX SEQINOUT TO TRUNCATE REST OF SUPERSEDED FILE,
; NOT JUST INTEGRAL NUMBER OF BLOCKS
;526 19256 FIX ^Z WITH END= IN DIALOG MODE DUE TO AN ERROR
;527 19205 FIX ILL MEM REFS IN DISPATCH TABLES (FORERR)
;530 18247 FIX T-FORMAT (THE RIGHT WAY)
;531 18074 INSERT MISSING PORTALS IN FORTRP FOR CONCEALED MODE
;532 18896 FIX AXIS (FORPLT) TO PRINT CORRECT SCALE FACTOR
;533 19239 CLEAR DOUBLE PRECISION FLAG AT START OF NEW I/O LIST
; (MAKES LIST-DIRECTED I/O WORK)
;534 19239 FIX TO NMLST% (FORCNV) FOR LIST-DIRECTED INPUT
; OF STRINGS
;535 18506 DO DUMMY OUT BEFORE POSITIONNING FOR APPEND MODE
; TO SET UP BUFFERS FOR MONITOR
;536 19030 ACCEPT DEFAULT PROJECT OR PROGRAMMER NUMBER FOR
; DIRECTORY IN OPEN STATEMENTS
;537 18903 ALLOW DISPOSE PARAMETER IN CLOSE TO WORK WITH SFD'S.
;540 19612 FIX TIMING PROBLEMS CLOSING APPEND-MODE FILES
;541 19793 FIX NMLST% IN FORCNV TO CORRECTLY RESET
; FT.QOT AT END OF QUOTED STRING
;542 19786 USE SYSTEM DEFAULT IF BUFFER COUNT OR SIZE IS INVALID
; AS GIVEN
;543 19696 FIX WRITE AFTER EOF ON RANDOM ACCESS BINARY FILES
;544 12882 MAKE SCALING FACTOR FOR F FORMAT WORK FOR NUMBERS
; WHICH ARE IDENTICALLY ZERO
;545 19834 ALTMODE IS A BREAK CHARACTER (MAKES DIALOG MODE WORK)
;546 15285 FIX TRACE% IN FORERR TO PRINT CORRECT TYPES FOR
; ARGUMENTS TO ROUTINES
;547 ----- GIVE FATAL ERROR FOR MEMORY MANAGEMENT ERRORS
;550 19538 DO NOT DEFAULT TO INVALID ACCESS OR MODE IN SETOPN
;551 20056 RETURN -1 FOR NEGATIVE CHANNEL REQUEST IN ALCHN%
;552 19131 CLEAR IO ACTIVE BIT AFTER GETSTS BEFORE JFFO IN
; ER%DEV IN FORERR
;553 ----- FIX TO EDIT 550 FOR DEFAULT OPENS.
;554 20095 CORRECT SPELLING OF ERROR MESSAGE IN DSQRT. IN FORDBL
;555 ----- FIX PLOT ROUTINES TO NOT USE CHANNEL 17 WITHOUT
; CALLING ALCHN.
;556 20228 FIX ILL MEM REFS IN FOROPN WHEN USING F10 AND CALLING
; BUFFER, EOFC, EOF1, IBUFF, OBUFF, OR MAGDEN
;557 ----- FIX WRITE AFTER END= WITH SEQINOUT READ OF NULL FILE
;560 ----- FIX SEQINOUT OUTPUTS AFTER END= EXIT TAKEN
;561 20308 PREVENT IO TO UNASSIGNED CHANNEL AFTER ERRORS IN
; FIND%% CALLED FROM SETIO2
;562 20376 MAKE MKTBL IN FORPLT CORRECTLY SET TABLE ADDRESS
; IN CTBL
;563 (V5) ALLOW F FORMAT TO PRINT ALL DIGITS OF DOUBLE PRECISION
; NUMBERS (FLIRT% AND FLOUT% IN FORCNV)
;************** BEGIN VERSION 5
;564 VER5 HANDLE HARD & SOFT ERRORS WITH ERR=
;565 20347 MAKE X FORMAT DO FMTPSH IF UNBOUND OP PRECEDED
;566 Q00569 PRINT ZERO EXPONENT FOR IDENTICAL ZERO, D OR E
; FORMAT (FORCNV)
;567 20498 FIX + FORMAT DESCRIPTOR FOR NON-INTERACTIVE DEVICES
;570 20352 PREVENT LOST RECORDS WHEN RECORDSIZE IS EXACTLY FILLED
; ON OUTPUT
;571 ----- ADD FUNCTIONS RRS & WRS TO FORFUN RESERVED FOR DBMS
;572 ----- ALLOW CEXP TO LOAD WITH F40LIB OFF BY DEFINING EXP3..
; LIKE EXP2.. (FORSIN AND FORCPX)
;573 ----- PARSE UNBOUND X FORMAT DESCRIPTOR AS 1X.
;574 Q00654 LIST DIRECTED INPUT OF COMPLEX NUMBERS SHOULD
; REQUIRE PARENTHESIS AROUND THE ARGUMENT, AND
; IF THERE IS A REPEAT COUNT IT SHOULD BE DELIMITED
; BY AN ASTERISK.
;575 18964 FIX SLISTS WITH LIST-DIRECTED I/O WHEN INCREMENT
; IS NOT ONE
;576 18964 FIX SLISTS WITH LIST-DIRECTED INPUT WHEN INCREMENT
; IS NOT ONE
;577 QARSW2 FIX EDIT 567 FOR BLANK CARRIAGE CONTROL AFTER DOLLAR
; SIGN FORMAT--USE RUBOUT, NOT NULL
;600 Q00573 ADD STATIC WORD FOR MAIN. ADDRESS FOR TRACE%
;601 Q00688 MAKE STACK SIZE IN PLOT ROUTINES 40 WORDS TO ALLOW
; ROOM FOR FORERR CALLS.
;602 VER5 COMPILE FORCPU.K? + FORPRM.MAC TO GET DEFINITION
; OF CPU = KA10 OR KI10
;603 Q00820 DO NOT ALLOW ENTER TO SUCCEED ON SECOND TRY TO LIB:
;604 Q00822 FIX TO EDIT 575 FOR ELISTS
;605 10062 DO NOT SPECIFY ANY PROTECTION IN EXTENDED RENAME BLOCK
; UNLESS IT IS BEING CHANGED--THIS AVOIDS HAVING
; THE COMPATIBILITY PACKAGE CHANGE THE PROTECTION
; WHEN THE USER INTENDED IT TO NOT BE CHANGED
;606 QAR832 ZERO ERR=,,END= ADDRESSES AT EXIT%% SO ER%SYS 1
; (WHICH DOES THE STOP) WON'T TRAP ON ERR=
;607 Q00837 FIX 0P FORMAT DESCRIPTOR, BROKEN BY EDIT 573, BY
; DUPLICATING CODE FROM FMTX IN FMTP
;610 Q00845 FIX ERRBS (ERR= RECOVERY USING BACKSPACE) TO SET/RESET
; IO.BSE IN P3 TO TELL BSREAD TO STOP BACKING UP WHEN
; IT FINDS THE FIRST DELIMITER (SINCE THE ERROR OCCURRED
; BEFORE THE END-OF-LINE (IE, DELIMITER) WAS HIT)
;611 Q00846 RESET IN FORJAK MUST RESTORE T0 SO RESET. (INIT%) CAN
; SAVE IT
;612 Q00839 ER%OPN 5 <- "ILLEGAL SEQUENCE OF MONITOR CALLS"
;613 20719 ADDITIONS TO 557 AND 560 FOR WRITES AFTER END= TAKEN
; ON A SEQINOUT FILE
;614 21142 ZERO THE BUFFER LENGTH WHEN BACKING UP THE BUFFER RING
; HEADER AT EOF AT SETRWB IN CODE ADDED BY EDIT 560.
;615 10110 IMPLEMENT 1600 BPI TAPE WITH A TAPOP. UUO
;616 21316 FIX T FORMAT FOR ENCODE/DECODE
;617 21371 MOVE EDIT 603 FROM FILOPN TO LOOKU.. THIS PREVENTS
; HAVING THE PPN WORD OF THE EXTENDED BLOCK
; CHANGED INCORRECTLY BY ANY LOOKUP, ENTER,
; OR RENAME.
;
; BEGIN VERSION 5A, 7-NOV-76
;
;620 21396 ALLOW LOWER CASE LETTERS IN FORMAT DESCRIPTORS.
;621 21149 ENFORCE FIXED-LENGTH RECORDS IN IMAGE MODE. THIS WILL
; ALSO FIX RANDOM ACCESS IN IMAGE MODE.
;622 QA873 NAMELIST PARTIAL ARRAYS AT END OF LIST
;623 21441 USE EXP2.. INSTEAD OF EXP2.0 IN FORPLT SO THAT IT
; WILL LOAD IF FORSIN WAS COMPILED WITH
; F40LIB TURNED OFF
;624 19860 CHANGES TO DEXP.2,DEXP.3,EXP.3 FOR CONSISTENT
; 20411 HANDLING OF NEGATIVE SINGLE AND DOUBLE
; PRECISION NOS TO NON-INTEGER POWERS. ALSO
; REARRANGED ORDER OF FORDBL.MAC BY REVERSING
; POSITION OF DEXP.2 AND DEXP.3 TO FACILITATE
; CALL FROM DEXP.3 TO DEXP.2
;625 ----- FIXES TO FORTRP FOR DOUBLE PRECISION ZERO DIVIDE.
; IT SHOULD RETURN PLUS OR MINUS INFINITY,
; DEPENDING ON THE SIGN OF THE DIVIDEND. 4B(460)
; ALWAYS RETURNED POSITIVE INFINITY; AFTER PATCH
; 531, ZERO WAS RETURNED.
;626 ----- CHANGE DATA ERROR 11 IN ER%DAT IN FORERR TO
; SPECIFY NAMELIST NAME AND INVALID VARIABLE NAME
;627 21476 ALLOW ^C AND .CLOSE WHEN APPENDING TO A NULL FILE
;630 QAR951 AVOID IO TO UNASSIGNED CHANNEL IF RENAME UUO TO
; DELETE A FILE WITH DISPOSE='DELETE' LOSES
;631 21591 FIX SCALE IN FORPLT SO XMIN GETS SET RIGHT IF
; INT(LOWEST VALUE/DX)=0, AND PREVENT ZERO
; DIVIDES WHEN ALL VALUES TO BE SCALED ARE
; EQUAL BY ARBITRARILY SETTING UP THE SCALING.
;632 ----- FIX PLOTS IN FORPLT TO ACCEPT OPTIONAL SECOND
; ARGUMENT WHICH IS STEP SIZE
;633 Q00923 MOVE EDIT 605 AND CHANGE EDIT 522 SO THAT IF IT IS
; NECESSARY TO RENAME A FILE WHEN IT IS
; CLOSED, THE REASON FOR THE RENAME IS KNOWN.
;634 10201 LOGICAL DEVICE NAMES IGNORE THE DIRECTORY IF A
; DIRECTORY WAS SPECIFIED
;635 QA870 FIX OPEN(DISPOSE=DELETE),REWIND,END SO
; THAT FILE WILL BE DELETED AT EXIT TIME
;636 Q1037 FIX FORERR FOR ILLEGAL CHARACTER IN DATA WITH T FORMAT
;637 ----- CHANGE TO RANDOM NO GENERATOR - FIX SO THAT 'Y' PART OF
; HRLI INSTRUCTION IS 0 RATHER THAN MNEMONIC
; FOR REGISTER 0.
;640 ----- ADD F20LIB SWITCH TO FORPRM AND MODIFY
; PLOTS TO ASSEMBLE VALUE
; OF STPSIZE CONDITIONALLY UPON
; F20LIB SWITCH.
;641 21699 CHANGE DEFINITIONS OF FORSE ENTRY POINTS IN
; FORJAK FROM INTERNS TO ENTRYS.
;642 ----- REWRITE OF ALOG ROUTINE IN FORSIN. SPECIAL CASE
; FOR VALUES OF X AROUND 1; MORE ACCURATE ALSO
;643 ----- FORDBL(DEXP.3) MOVE ARGAX FOR DMOVE MACRO UNDER KA
;644 ----- CHANGE ERRF40 MACRO IN FOROPN TO ACCOMODATE USE WITH
; F40 LIB SWITCH TURNED OFF.
;645 ----- IN FORXIT, TAKE DEFINITION OF EXIT. OUT FROM
; UNDER F40LIB SWITCH SO IT WILL ALWAYS BE DEFINED.
;646 22428 FIX DISPOSE='PRINT!LIST!PUNCH' TO GET FILE'S PATH TO PASS
; TO QMANGR AS "ORIGINAL DIRECTORY". AFTER EDIT 537
; (DUE TO EDIT 617) DD.PPN CONTAINS 0 NOT PPN AFTER
; LOOKUP
;647 22171 USE DEVICE= AS QUEUE NAME FOR DISPOSE='PRINT' ON CLOSE
;650 ----- IN FOROTS,FORFUN, AND FORERR CHANGE THE NAMES OF TWO
; EXTERNALS TO BE UNIQUE AND NOT VALID IN FORTRAN.
; THE EXTERNALS ARE 'DMPSTR' AND 'ALCOR' AND WILL BE
; 'DMPST.' AND 'FMEM%%'
;651 22415 IN FOROTS, FIX EDIT 615 TO ZERO OUT DENSITY FIELD CORRECTLY
;652 22508 IN FORCNV, ALLOW LOWER CASE D AND E IN INPUT EXPONENTS
;653 22543 IN FORCNV, ALLOW LOWER CASE T AND F FOR TRUE AND FALSE
;654 22691 IN FORCNV, FIX FLIRT TO HANDLE INTEGERS CORRECTLY AND
; NAMELIST TO RECORD DATA TYPE IN LOW CORE
;655 22727 FIX EOF ON BINARY/IMAGE INPUT OF SLIST TO CLEAR REST
; OF SLIST
;656 22726 FIX DUMP MODE I/O TO PROPERLY HANDLE CHAINING OF
; IOWD LIST BLOCKS.
;657 21821 RECOVER FROM ILLEGAL LSCW IN SEQ FILE BY SCANNING FORWARD
; UNTIL FIND A WORD WHICH LOOKS LIKE AN LSCW (LH=001...)
; NO RECOVERY IF FORSE. BINARY RECORD !
;660 ----- FIX FLOUT% IN FORCNV TO USE 8 NOT 9 AS MAX NUMBER OF
; MANTISSA DIGITS TO PRINT ON SINGLE PRECISION SO 5.55
; IN F20.17 WON'T BE 5.55000001...
;661 ----- GET RID OF RUBOUT ON '$' AND '+' FORMAT
; DESCRIPTORS I.E., FIX PATCHES 567 AND 577
;662 ----- FIX FORINI TO RESET .JBOPS AFTER GETSEG
;663 22507 FIX EDIT 610 TO UPDATE CHANNEL TABLE SO IO.BSE
; (ERRBS IN PROGRESS FOR BSREAD) WILL BE RESET
;664 22708 FIX '$' FORMAT ON NON-CCC DEVICES NOT TO LOSE REST OF
; LINE AFTER '$'. FIXES ERROR MADE BY PATCH 223, PAR-
; TIALLY REPAIRED BY 616.
;665 22886 FIX EDIT 624 TO SAVE AND RESTORE TEMPORARY REGISTERS
; PROPERLY IN ALL CASES. IN DEXP.3 IN FORDBL
;666 21877 CLEAR FST.DY AT FIN% SO ON ERR= OF RANDOM READ, PREVIOUS
; FORMAT ARRAY WHICH WAS FREED IS NOT FREED AGAIN (SINCE
; THAT LOOPS PMEM%%)
;667 22601 IN OPEN/CLOSE, IF USER SPECIFIES DIRECTORY=0,0, DON'T
; DEFAULT BOTH PROJ,PROG TO USER'S PPN (LIKE EDIT 536
; SAYS). JUST PASS 0 SO MONITOR CAN USE DEFAULT PATH
;670 22686 UNCOMMENT 6250 BPI ENTRY IN TAPOP. DENSITY TABLE
;671 ----- HANDLE SINGLETON ELIST AS SLIST (BEWARE: FT.INC
; IN FLIRT% = FT.ELT)
;672 QA2104 FIX EDIT 621 TO ENFORCE RECORD LENGTH ONLY ON OUTPUT IN
; IMAGE MODE
;673 22607 IMPLEMENT VBL WIDTH DOUBLE PRECISION OCTAL I/O (FORCNV).
;674 23036 OPEN NEW CHANNEL FOR DIRECTORY DEVICE EVEN IF DEVICE
; ALREADY ASSIGNED TO PROGRAM
;675 23611 SAVE + RESTORE AOBJN PTR IN EXIT CODE WHICH GETS
; CLOBBERED IF ANY QUEUING IS DONE.
;676 ----- FIX 'DISPOSE=LIST!PRINT!PUNCH' TO GIVE VALID
; QUEUE NAME WHEN DISPOSE SPECIFIED AT OPEN AND
; IMPLICIT CALL TO CLOSE. FIX TO 674.
;677 22964 FIX CLOSE TO CHECK STATUS AFTER CLOSE UUO TO
; CATCH ANY ERRORS DURING CLOSE.
;700 23542 FIX DEXP. IN FORDBL NOT TO GIVE FLOATING DIVIDE
; CHECK.
;701 23412 HANDLE EOL IN DIALOG MODE CORRECTLY
;702 22877 MAKE DUMP MODE IO ERRORS UNRECOVERABLE BUT TRAPPABLE
;703 22687 IN FOROPN PUT BUFFER, IBUFF, OBUFF, EOF1, EOFC AND MAGDEN
; UNDER IFN F40LIB
;704 23073 CHANGE SETDEN TO DO NOTHING IF NO DENSITY WAS SPECIFIED
; TO PREVENT OVERWRITING IF SET BY SET DENSITY
; FIX TO EDIT 615.
;705 ----- DON'T CLOBBER SCAN FLAGS REG WHEN RETURNING PATH BLOCK
; WHEN PROCESSING PPN
;706 ----- FIX SCNSIX TO ALWAYS SET CHARS/WORD WHEN SCANNING CORE
; SO SFD'S DEEPER THAN 1 WORK
;707 ----- FIX PPN SCANNING TO HANDLE MAX OF 5 SFD'S
;710 23046 FIX SCNSTR TO STOP DIALOG SCAN ON $ AND MEMORY
; SCAN ON NULL WORD
;711 ----- STOP RECURSIVE ERRORS IN ER%DEV
; FIX EXIT% TO RESET ERR.V2 SINCE NO ERROR IS IN PROGRESS
;712 ----- FIX TRACEBACK IN ER%LIB TO USE CORRECT TOP OF STACK
;713 ----- FIX TRACEBACK OVER OVERLAYS IN TRACE%
;714 ----- FIX ERROR RECOVERY IN FORERR AT ERR%ER TO RETURN
; "RECOVERY FAILED" IF THERE IS AN ERR= BUT NO
; RECOVERY ROUTINE SPECIFIED
;715 QA2126 INCLUDE ERR= SETUP IN CLOSE%. ADJUST EDIT 564 SO ERR=
; INITIALIZATION HAPPENS IN SAVE.
;716 23432 IN FORPLT AUGMENT EDIT 555 TO USE SAME OUTPUT CHANNEL
; FOR MULTIPLE CALLS TO PLOTS
;717 QA2174 FIX EDIT 706 TO HANDLE CHAR COUNT FOR FILE=DOUBLE PREC:
; MOVE COUNT SETUP BACK TO SCNSTR
;720 ----- FIX EDIT 710 TO TREAT DIALOG MODE == LITERAL SCAN FOR
; STOPPING SFD SEARCH IN SCNSTR
;721 ----- FIX EDIT 714 SO ERRORS DURING DIALOG MODE PROCESSING
; ARE REPORTED TO TTY:
;**************** END OF REVISION HISTORY
;
; DEFINE THE LOADING
LOC .JBOPS ;MUST DEFINE .JBOPS
Z ;EQUAL TO ZERO TELLS FORINI THAT
;FOROTS WAS LOADED FROM FORLIB
LOC .JBVER
VEROTS
SEGMEN
PAGE
SUBTTL FOROTS ENTRY POINTS DEFINED BY FORDIR IN (FORPRM)
FOROT%=.
LALL
FORDIR
SALL
EXTERN FUNCT% ;[232] DEFINE OVERLAY ENTRY
EXTERN DBMS% ;[475] DEFINE DBMS ENTRY
PAGE
SUBTTL RESET FOROTS INITIALIZATION ROUTINE
; CALLED BY FORINI IN THE LOW SEGMENT
; .JBFF POINTS TO THE BEGINNING OF THE DYNAMIC CORE AREA
; .JBOPS AND P4 CONTAIN THE BASE REGISTER TO THE STATIC LOW SEGMENT
; AC'S 0-16 ARE SAVE FY FORINI IN ACC.SV
INTERNAL INIT%
INIT%: ;THIS ROUTINE FINISHES THE JOB OF
; INITIALIZATION STARTED BY FORINI
MOVEI T1,LOW.SZ(P4) ;GET THE END OF THE STATIC AREA
HRRZM T1,.JBFF ;UPDATE JOB FIRST FREE
CAMG T1,.JBREL ;IN OUR ADDRESSING SPACE
JRST .+3 ;YES, OK
CORE T1, ;NO, PUT IT IN OUT ADDRESSING SPACE
HALT ;NO, CORE AVAILABLE
HRRI T2,ACC.SV+21(P4);BUILD A BLT POINTER TO CLEAR THE LOW
HRLI T2,ACC.SV+20(P4); SEGMENT FROM THE SAVE AREA
SETZM ACC.SV+20(P4) ;CLEAR THE FIRST WORD
BLT T2,@.JBREL ; TOP OF THE DYNAMIC AREA
MOVE T1,ACC.SV+0(P4) ;[320]
MOVEM T1,REGS.0(P4) ;[320]
MOVE T1,ACC.SV+7(P4) ;[320]
MOVEM T1,REGS.1(P4) ;[320]
MOVE T1,ACC.SV+11(P4);[320]
MOVEM T1,REGS.2(P4) ;[320]
MOVEI T1,LOW.SZ(P4) ;GET THE LOCATION OF THE DYNAMIC CORE
MOVE T2,.JBREL ;[306] GET .JBREL
ADDI T2,1 ;[306] BUILD A NEW JOBFF
HRRM T2,.JBFF ;SAVE AS END OF DYNAMIC MEMORY
SUBI T2,(T1) ;COMPUTE LENGTH OF DYNAMIC CORE
HRLZM T2,(T1) ;SAVE AS A CONTROL WORD FOR GMEM%%
HRRZM T1,FRE.DY(P4) ;START THE FREE CORE LIST
; STRUCTURED DYNAMIC CORE
HRRI P,STK.SV-1(P4) ;BUILT THE FOROTS STACK POINTER
HRLI P,-STK.SZ ;PUT THE SIZE OF THE STACK IN THE LEFT
MSTIME T1, ;GET THE CURRENT TIME OF DAY
MOVEM T1,DAY.TM(P4) ;SAVE IN STATIC LOW CORE
SETZ T1, ;CLEAR AC FOR OUR JOB
RUNTIM T1, ;GET THE RUNTIME SO FAR (SINCE LOG IN)
MOVEM T1,RUN.TM(P4) ;SAVE IN STATIC LOW CORE
MOVEI T1,2 ;SET UP THE MAX ERROR COUNT
MOVEM T1,ERRMX.(P4) ;STORE THE ERROR COUNTER
MOVE T1,[XWD 17,11] ;GET CNFTBL (CONFIGURATION TABLE)
GETTAB T1, ; FROM THE MONITOR
SETZ T1, ;MUST BE A 4 SERIES MONITOR
MOVEM T1,MON.SV(P4)
TLNN T1,1 ;IS THE MONITOR BUILT FOR FOROTS
ERROR (SYS,3,17) ;NO, STOP THIS JOB
SETOM JOB.SV(P4) ;SET FLAG TO GET OUR CHARASTICS
GETLCH JOB.SV(P4) ;GET OUR CHARASTICS
MOVEI T0,DDB.SZ ;GET A TTY DDB
PUSHJ P,GMEM%% ;ALLOCATE THE MEMORY
HRRI P3,(T1) ;LOAD THE I/O REG
HRLI P3,IO.FMT!IO.CCC!IO.TTA!IO.TTY!IO.INT!
IO.OPN!IO.SIN!IO.SOU ;[360] SET FLAGS
MOVSI T0,(SIXBIT /TTY/);GET THE TTY NAME
MOVEM T0,DD.DEV(P3) ;SAVE IN THE DD.BLK
MOVSI T0,DD.HRO(P3) ;GET THE OUTPUT RING HEADER
HRRI T0,DD.HRI(P3) ;GET THE INPUT RING HEADER
MOVEM T0,DD.RNG(P3) ;SAVE IN THE DD.BLK
MOVE G3,[XWD DV.TTA!DV.TTY!DV.AVL!DV.IN!DV.OUT,400403]
MOVEM G3,DD.STS(P3) ;SAVE THE DEVICE STATUS
;**; [530] CHANGE @ INIT% + 62L CLRH 31-MAR-76
MOVE G1,[XWD 2,<STRCNK+3>] ;[530] GET THE BUF SIZE AND COUNT
MOVSI T1,(20B12) ;SET TTY ON PSEUDO CHANNEL 0
HLLZM T1,DD.UNT(P3) ;PUT THE CHANNEL ENTRY IN THE DD.BLK
PUSHJ P,OPEND6 ;OPEN THE TTY
PUSHJ P,TRPIN.## ;INITIALIZE THE TRAP ROUTINE
;**; [600] INSERT @ INIT%+71 AFTER TRPIN. CALL CLRH 24-SEP-76
HRRZ T0,L ;[600] GET RETURN ADDRESS
SUBI T0,2 ;[600] GET ADDRESS OF MAIN.
MOVEM T0,SA.ADR(P4) ;[600] SAVE IT FOR TRACE%
MOVEM L,USR.PC(P4) ;SAVE THE USR'S PC
HRLZI L,ACC.SV(P4) ;LOAD THE USER'S AC SAVE AREA
BLT L,L ;RESTORE THE USERS AC'S
JRST 1(L) ;RETURN TO THE USER
PAGE
SUBTTL SAVE. GENERAL AC SAVE ROUTINE
; SAVE. IS CALLED ON ALL ENTRIES INTO THE FOROTS SYSTEM
; ALL AC'S ARE SAVE IN THE STATIC CORE ACC.SV
; ACC.SV+P CONTAINS A PUSHDOWN POINTER WHOSE ADDRESS IS TWO (2)
; GREATER THAN THE STACK ADDRESS OF THE ROUTINE
; THAT CALLED FOROTS. (USED BY THE ERROR ROUTINE FOR TRACE)
SAVE.:: PUSH P,P4 ;SAVE P4 ON THE STACK
HRRZ P4,.JBOPS ;LOAD THE SAVE AREA POINTER
POP P,ACC.SV+P4(P4) ;SAVE P4 IN THE SAVE AREA
DMOVEM L,ACC.SV+L(P4) ;SAVE THE LINK AND STACK POINTER
TRNN L,-20 ;[355] LINK POINTER TO ACS
ADDI L,ACC.SV(P4) ;[355] YES, RELOCATE
MOVEM P3,ACC.SV+P3(P4);SAVE P3 IN THE SAVE AREA
MOVEI P3,ACC.SV(P4) ;SET UP A BLT TO SAVE THE USR'S ACS
BLT P3,ACC.SV+P2(P4);SAVE ALL AC'S T0-P2
POP P,T1 ;RESTORE THE CALLER'S ADDRESS
POP P,USR.PC(P4) ;SAVE THE USER'S PC AND FLAGS
;**; [715] INSERT @SAVE. + 10 1/2 SJW 28-SEP-77
SETZM ERR.V1(P4) ;[715] CLEAR ERROR VALUE WORDS
SETZM ERR.V2(P4) ;[715] SO "NO ERROR IN PROGRESS"
MOVE T0,P ;[715] SAVE STK PTR AFTER PUSHJ
ADD T0,[1,,1] ;[715]
MOVEM T0,ERR.SP(P4) ;[715] TO CUT STACK ON ERR=
PUSHJ P,(T1) ;RETURN TO SAVE CALLER
JFCL ;[337] PREVENT ERRONEOUS RETURN
;**; [530] INSERT @ SAVE. + 12 1/2 CLRH 1-APR-76
SETZM ALT.PC(P4) ;[530] CLEAR ALT.PC
MOVSI L,ACC.SV+L(P4) ;SET UP A JRA RETURN AND RESTORE L
HRR L,USR.PC(P4) ;GET THE USER'S RETURN ADDRESS
MOVSI P4,ACC.SV(P4) ;FOROTS, RETURNS HERE LOAD SAVE AREA
BLT P4,P4 ;RESTORE ALL AC'S BUT L
JRA L,(L) ;RETURN TO THE USER
PAGE
SUBTTL OPEN ROUTINE TO PROCESS THE OPEN STATEMENT
SETOPN: ;DEFAULT OPEN ROUTINE
PUSH P,G2 ;[255] PRESERVE THE FLU
PUSH P,L ;SAVE THE LINK REGISTER
PUSH P,P2 ;SAVE THE FLAG REGISTER
MOVEI T0,6 ;ALLOCATE SPACE FOR AN ARG BLOCK
PUSHJ P,GMEM%% ;FROM THE HEAP
PUSH P,T1 ;SAVE THE ADDRESS
MOVEI L,1(T1) ;POINT THE ARG BLOCK +1
MOVSI T1,-5 ;SET THE ARG COUNT
MOVEM T1,-1(L) ;STORE
MOVEM G2,(L) ;PUT IN ARG BLOCK
HRRZ T1,ERR.PC(P4) ;[176] END= ?
JUMPE T1,SETOP1 ;[176] NO
HRLI T1,340 ;[176] SET TP%LAB
MOVEM T1,1(L) ;[176] SET IN ARGUMENT BLOCK
SETOP1: HLRZ T1,ERR.PC(P4) ;[176] ERR= ?
JUMPE T1,SETOP2 ;[176] NO
HRLI T1,340 ;[176] SET TP%LAB
MOVEM T1,2(L) ;[176] SET IN ARGUMENT BLOCK
SETOP2: ;[176] END OF PATCH
MOVE T1,[XWD 12740,[ASCIZ /ASCII/]] ;ASSUME ASCII MODE
TLNN P2,IO.FMT ;CHECK MODE BIT
HRRI T1,[ASCIZ /BINARY/] ;SWITCH TO BINARY
MOVEM T1,3(L) ;SAVE THE MODE ARGUEMNT
MOVE T1,[XWD 2740,[ASCIZ/SEQIN/]] ;ASSUME INPUT
TLNN P2,IO.SIN ;SEQIN MODE
HRRI T1,[ASCIZ/SEQOUT/] ;NO SET OUTPUT
TLC P2,IO.SIN!IO.SOU;CHECK FOR
TLCN P2,IO.SIN!IO.SOU;SEQIN OUT MODE
HRRI T1,[ASCIZ /SEQINOUT/]
TLNE P2,IO.RAN ;UNLESS RANDOM ACCESS
HRRI T1,[ASCIZ /RANDOM/]
MOVEM T1,4(L) ;PUT IN ARG BLOCK
;**; [550] INSERT @ SETOP2 + 14 1/2 (8) CLRH 28-MAY-76
MOVE T1,G2 ;[550] GET FLU
PUSHJ P,GETDV. ;[550] GET DEVCHR BITS
TLNE G3,DV.LPT!DV.TTA!DV.TTU!DV.PTY!DV.TTY ;[550]
JRST [MOVE T1,[XWD 12740,[ASCIZ /ASCII/]] ;[550] ASCII MODE
MOVEM T1,3(L) ;[550] INTO BLOCK
JRST SETOP3 ] ;[550] OUT
SETOP3: TLNE G3,DV.PTR ;[550] PAPER TAPE READER ?
JRST [MOVE T1,[XWD 2740,[ASCIZ /SEQIN/]] ;[550] YES
MOVEM T1,4(L) ;[550] ACCESS IS SEQIN
JRST SETOP4 ] ;[550] OUT
TLNE G3,DV.LPT!DV.PTP ;[550] PTP OR LPT ?
JRST [MOVE T1,[XWD 2740,[ASCIZ /SEQOUT/]] ;[550] YES
MOVEM T1,4(L) ;[550] ACCESS IS SEQOUT
JRST SETOP4 ] ;[550] OUT
;**; [553] INSERT @ SETOP3 + 7 1/2 L CLRH 10-JUN-76
TLC G3,DV.CDR!DV.IN ;[553]
TLCN G3,DV.CDR!DV.IN ;[553] [550] CARD READER ?
JRST [MOVE T1,[XWD 2740,[ASCIZ /SEQIN/]] ;[550] YES
MOVEM T1,4(L) ;[550] ACCESS IS SEQIN
JRST SETOP4 ] ;[550] OUT
;**; [553] INSERT @ SETOP3 + 11 1/2 L CLRH 10-JUN-76
TLC G3,DV.CDR!DV.OUT ;[553]
TLCN G3,DV.CDR!DV.OUT ;[553] [550] CARD PUNCH ?
JRST [MOVE T1,[XWD 2740,[ASCIZ /SEQOUT/]] ;[550] YES
MOVEM T1,4(L) ;[550] ACCESS IS SEQOUT
JRST SETOP4 ] ;[550] OUT
SETOP4: ;[550]
PUSHJ P,OPEN%% ;OPEN THE DEVICE
MOVEI T1,ACC.S2 ;[404] SEQINOUT ACCESS
TLC G3,DV.IN!DV.OUT ;[404] CAN DEVICE DO INPUT
TLCN G3,DV.IN!DV.OUT ;[404] AND OUTPUT
DPB T1,[POINT 4,DD.BLK(P3),9] ;[404] YES
POP P,T1 ;GET THE HEAP POINTER BACK
POP P,P2 ;RESTORE THE FLAGS
POP P,L ;RESTORE THE LINK
POP P,G2 ;[255] RESTORE THE FLU
PJRST PMEM%% ;RETURN THE HEAP SPACE, RETURN TO CALLER
PAGE
SUBTTL OPEN% ROUTINE TO DEFINE THE DD.BLK
;AC USAGE
; P= THE PUSH DOWN POINTER
; L= THE POINTER TO THE ARGUMENT BLOCK
; P4= THE LOW SEG BASE POINTER
; P3= THE DIALOG DEVICE
; P2= THE POINTER TO THE DD.BLK BEING DEFINE
; P1= THE JSP POINTER
; G4= ACCESS IN OPEND
; CHARACTER COUNT IN SCNNER
; G3= THE CURRENT DISPATCH ENTRY
; G2= GLOBAL SCRATCH
; G1= POINT TO THE INCORE ARGUMENT (SET BY EFCTIVL)
; T5= TYPE ARGUMENT TYPE CODE
; T4= SCRATCH
; T3= SCRATCH
; T2= FLAGS DEFINING WHAT STOPPED THE DIALOG SCAN
; T1= A VALUE RETURNED FROM SCNNER (SWITCH NAME OR VALUE)
; T0= USED TO ASSEMBLE THE CONTENTS OF T1
SIXBIT /OPEN./ ;NAME FOR TRACE
OPEN%: PUSHJ P,SAVE. ;SAVE ALL AC'S AND LOAD P4
;**; [715] DELETE @OPEN% + 1 SJW 28-SEP-77 (CODE MOVES TO SAVE.)
OPEN%%: MOVEI T0,SKPRET ;[564] CLEANUP == SKIP RETURN
MOVEM T0,ERR.RT(P4) ;[564]
JSP P1,SRCFLU ;IS THE FLU ASSIGNED
JRST OPEN0 ;NO, CONTINUE
PUSHJ P,RELE%% ;YES, RELEASE THE UNIT FIRST
OPEN0: MOVEI T0,DDB.SZ ;FOROTS ENTRY - LOAD THE DD BLOCK SIZE
PUSHJ P,GMEM%% ;GET DYNAMIC MEMORY TO DD BLOCK
MOVEI P2,(T1) ;SET UP P2 POINTING TO THE DD BLOCK
HRRZM G2,DD.UNT(P2) ;PUT THE FLU IN THE DD.BLK
JSP P1,GT.CHN ;[265] GET A SOFTWARE CHANNEL
ERROR (OPN,10,10,) ;NO CHANNEL AVAILABLE
LSH T1,5 ;PUT THE CHANNEL IN THE AC FIELD
HRLM T1,DD.UNT(P2) ;PUT THE CHANNEL IN THE DD.BLK
PUSHJ P,OPNARG ;GET THE OPEN STATEMENT ARGUMENTS
OPEN5: MOVEI T0,OPENER ;[564] CLEANUP == CLOSE
MOVEM T0,ERR.RT(P4) ;[564]
MOVEI P3,(P2) ;SET OP TO OPEN THE DEVICE
PUSHJ P,OPEND ;OPEND THE DEVICE
POPJ P, ;DEVICE IS OK
MOVEI P2,(P3) ;ERROR DURING OPEN
TLO P2,OP.ERR ;SET THE ERROR FLAG
;**; [526] INSERT @ OPEN5 + 4 1/2 CLRH 23-MAR-76
PUSH P,ERR.PC(P4) ; [526] SAVE END= AND ERR= ARGS.
SETZM ERR.PC(P4) ; [526] AND ZERO THEM
;**; [721] @OPEN5 + 8 SJW 21-OCT-77
SETZM ERR.V2(P4) ;[721] CLEAR ERROR IN PROGRESS
PUSHJ P,OPNAR5 ;FORCE ERROR DIALOG (MAY BE BATCH)
SETZM ERR.V2(P4) ;[721] CLEAR ERROR FROM DIALOG
;**; [526] INSERT @ OPEN5 + 5 1/2 CLRH 23-MAR-76
POP P,ERR.PC(P4) ; [526] RESTORE ERR= AND END= ARGS.
JRST OPEN5 ;TRY TO OPEN AGAIN
PAGE
SUBTTL ROUTINES TO OPEN THE DEVICE AND ASSIGN BUFFERS
OPEND:
SKIPN T1,DD.DEV(P3) ;GET THE DEVICE NAME
HRRZ T1,DD.UNT(P3) ;NO DEVICE SPECIFIED, GET FLU
PUSHJ P,GETDV. ;GET THE DEVICE SPECS
MOVEM G1,DD.DEV(P3) ;STORE THE FAULTY DEVICE NAME
JUMPN G3,OPEND3 ;DEVICE EXISTS
ERROR (OPN,6,7,OPENER);NO, SUCH DEVICE
OPEND3: MOVEM G2,DD.DEV(P3) ;SAVE THE PHYSICAL DEVICE NAME
TLNN G3,DV.AVL ;IS THE DEVICE AVAILABLE
ERROR (OPN,5,7,OPENER);NO,ERROR GO TO DIALOG
LDB G4,[POINT 4,DD.BLK(P3),9] ;GET THE ACCESS INDEX
HRLZ G4,ACC.DP(G4) ;GET THE ACCESS BITS
TLNN G4,IO.SIN ;IS INPUT REQUIESTED
TLO P3,IO.INO ;NO, SET OUTPUT MODE
MOVSI T1,7 ;SET UP A MASK
AND T1,G4 ;GET A COPY OF THE DEVICE CHARASTICS
IOR P3,T1 ;SET THE ACCESS IN P3
TDZ T1,G3 ;MATCH THE I/O REQUIREMENTS
TLNE G4,IO.RAN ;RANDOM ACCESS FILES REQUIRE A DISK
TLNE G3,DV.DSK ;YES, MUST BE A DISK TYPE DEVICE
TLNE T1,DV.IN!DV.OUT ;CAN THE DEVICE PREFORM THE NEEDED I/O
ERROR (OPN,2,7,OPENER);NO, DEVICE CAN NOT PREFORM I/O
TLNN G4,IO.RAN ;[257] RANDOM ACCESS REQUESTED
JRST OPENDB ;[257] NO
LDB T1,[POINT 4,DD.BLK(P3),13] ;[257] YES - LOOK AT MODE
CAIN T1,MOD.DU ;[257] DUMP MODE REQUESTED
ERROR (OPN,15,7,OPENER) ;[257] CANNOT RANDOM ACCESS FILE IN DUMP MODE
OPENDB: TRNN G3,DV.ASP ;[257] IS DEVICE ASSIGND BY PROGRAM
JRST OPEND2 ;NO, CONTINUE
;**;[674] INSERT @OPENDB + 1 1/2 SJW 21-AUG-77
TLNE G3,DV.DSK!DV.DIR ;[674] IS DEVICE DSK OR DIRECTORY ?
JRST OPEND2 ;[674] YES: ALWAYS GET NEW CHANNEL
MOVSI T2,-20 ;SET UP AN AOBJP T2,POINTER
HRRI T2,CHN.TB(P4) ;TO THE CHANNEL TABLE
AOBJP T2,OPEND2 ;NOT IN THE TABLE
SKIPE T1,(T2) ;IS THE CHANNEL DEFINED
CAME G2,DD.DEV(T1) ;AND POINTED TO BY THIS DEVICE
JRST .-3 ;NO, LOOK AT THE NEXT ENTRY
PUSH P,T1 ;YES, SAVE THE DD POINTER
PUSHJ P,RELE%1 ;RELEASE THIS BLOCK
POP P,P3 ;SET UP P3 WITH THE DD.BLK POINTER
OPEND1: HLRZ T1,DD.UNT(P3) ;GET THE PSEUDO CHANNEL
LSH T1,-5 ;POSITION PSEUDO CHANNEL
DPB T1,FLU.BP(P4) ;POINT FLU TO THE CHANNEL TABLE
POPJ P, ;RETURN
OPEND2: MOVE G2,DD.DEV(P3) ;GET THE DEVICE NAME
DEVTYP G2, ;GET THE DEVICE TYPE BITS
SETZ G2, ;UUO NOT IMPLEMENTED
TLNE G2,TY.INT ;IS DEVICE INTERACTIVE
TLO P3,IO.INT ;YES, SET INTERACTIVE BITS
TLNE G2,TY.SPL ;IS DEVICE BEING SPOOLED
TLO G3,DV.DIR ;YES, SET THE DISK BITS
MOVEI T1,(G2) ;GET THE DEVTYPE BIT
ANDI T1,77 ;ISOLATE THE DEVICE CODE
CAIN T1,12 ;IS THIS A PSEUDO TTY
TLO G3,DV.PTY ;YES SET TTY FLAG
MOVEM G3,DD.STS(P3) ;SAVE THE DEVCHR BITS (SAVES TIME)
JSP P1,OPENDM ;DEFINE THE MODE IN THE DD.BLK
ERROR (OPN,1,7,OPENER);ILLEGAL MODE FOR DEVICE
TLNE G3,DV.TTA ;IS THIS THE USER'S TTY
JRST [PUSHJ P,RELE%1 ;YES DEALLOCATE THE DDB
MOVE P3,CHN.TB+20(P4) ;GET THE TTY CHANNEL
JRST OPEND1] ;SET UP THE CHANNEL TABLE
SETZ T1, ;CLEAR THE RING HEADER
TLNE G3,DV.IN ;INPUT MODE REQUESTED
HRRI T1,DD.HRI(P3) ;YES, SET POINTER TO INPUT RING
TLNE G3,DV.OUT ;OUTPUT MODE REQUESTED
HRLI T1,DD.HRO(P3) ;SET POINTER TO OUTPUT RING HEADER
MOVEM T1,DD.RNG(P3) ;PUT POINTER IN OPEN BLOCK
HLL T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(OPEN) ;SET OPEN UUO IN T1
HRRI T1,DD.OPN(P3) ;SET POINTER TO OPEN ARGS
XCT T1 ;OPEN THE UNIT
ERROR (OPN,5,7,OPENER);DEVICE NOT AVAILABLE
;**; [615] INSERT @ OPEND2 + 28 1/2 L JMT 4-NOV-76
TLNN G3,DV.MTA ;[615] IS DEVICE A MAG TAPE ?
JRST OPNJMT ;[615] NO, SO CONTINUE
PUSHJ P,SETDEN ;[615] YES, SET DENSITY IF NECESSARY
ERROR (OPN,2,7,OPENER) ;[615] GIVE ERROR
OPNJMT: ;[615] NORMAL RETURN
TLNN G3,DV.DIR ;DIRECTORY DEVICE
JRST OPEND5 ;NO, IGNORE LOOKUP/ENTER
PUSHJ P,FILDFT ;CHECK ON FILE NAME
TLNN G3,DV.DTA ;IS THIS A DEC TAPE UNIT
JRST OPEND4 ;MUST BE A DISK OF SOME SORT
SKIPN T1,DD.PPN(P3) ;WAS A PPN SPECIFIED
JRST .+4 ;NO, DON'T WORRY ABOUT IT
TLZN T1,-1 ;YES, CHECK FOR A SFD'S LIST
PUSHJ P,PMEM%% ;YES, RETURN SFD LIST TO FREE CORE
SETZM DD.PPN(P3) ;CLEAR THE PPN POINTER FOR DECTAPE
IFE QUEUER,< ;[240] IF QUEUEING IS NOT ALLOWED
OPEND4: MOVEI T1,DD.ALC-DD.CNT ;[240] SET ARG BLOCK SIZE FOR LOOKUP/ENTER
> ;[240] END OF QUEUER CONDITIONAL
IFN QUEUER,< ;[240] IF QUEUEING IS ALLOWED
OPEND4: MOVEI T1,DD.STR-DD.CNT ;[240] SET ARG BLOCK SIZE FOR LOOKUP/ENTER
> ;[240] END OF QUEUER CONDITIONAL
MOVEM T1,DD.CNT(P3) ;PUT COUNT IN DD.BLK
; ROUTINE TO DO ENTERS/LOOKUPS ON THE DSK TYPE DEVICE
FILOPN: TLNN G4,IO.RAN!IO.SIN;CHECK FOR SEQOUT MODE
JRST FILOP2 ;YES, PROCESS SPEERATELY
;**; [617] MOVE EDIT 603 TO LOOKU. FROM FILOPN + 1 1/2 9-NOV-76
;**; [603] INSERT @ FILOPN+1 1/2 CLRH 8-OCT-76
; PUSH P,DD.PPN(P3) ;[617] [603] SAVE PPN WORD TO REPLACE AFTER ENTER
JSP P1,LOOKU. ;DO A LOOKUP(SEQIN,SEQINOUT,RANDOM,APPEND)
;**; [603] CHANGE @ FILOPN+3 CLRH 8-OCT-76
; JRST [POP P,DD.PPN(P3) ;[617] [603] RESTORE PPN WORD
; JRST FILOP3 ] ;[617] [603] CHECK IF FATAL
; POP P,DD.PPN(P3) ;[617] [603] RESTORE PPN WORD
JRST FILOP3 ;[617] CHECK IF FATAL
TLNE G4,IO.SOU ;CHECK FOR APPEND OR RANDOM ACCESS
TLNN G4,IO.RAN ;RANDOM ACCESS OF APPEND
JRST FILOP4 ;NO, MUST BE SEQIN OR RANDIN ALL DONE
JSP P1,ENTER. ;DO AND ENTER (UPADTE MODE)
ERROR (OPN,0,7,OPENER) ;BAD (CAN DO LOOKUP BUT NO ENTER)
;MUST BE READ ONLY FILE
JRST FILOP4 ;[300] ALL DONE
FILOP3: LDB T1,[POINT 4,DD.BLK(P3),9];GET THE ACCESS BITS
CAIN T1,ACC.RO ;RANDOM MODE
JRST FILOP6
TLNN G4,IO.SOU ;IS OUTPUT LEGAL
ERROR (OPN,0,6,OPENER);NO, FILE NOT FOUND
FILOP2:
FILOP6: JSP P1,ENTER. ;SEQOUT OR RANDOM ACCESS CREATE A FILE
ERROR (OPN,0,7,OPENER);CAN'T ENTER THE FILE
TLNN P3,IO.RAN ;[205] RANDOM ACCESS?
JRST FILOP7 ;[205] NO - SEQOUT - JUST ENTER FILE
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(CLOSE) ;SET UP TO CLOSE THE DUMMY FILE
XCT T1 ;CLOSE THE DUMMY FILE
JRST FILOPN ;START OVER WITH A FILE
;
FILOP7: TLO P3,IO.INO ;[213] SET OUTPUT LAST
FILOP4: ;END OF LOOKUP/ENTER ROUNTINE
TLNE G4,IO.RAN ;[300] RANDOM ACCESS?
TLNN G4,IO.SIN ;[327] APPEND DOES NOT REQUIRE IT
JRST OPEND5 ;[327] NO NEED FOR RECORD SIZE
SKIPL DD.LOG(P3) ;[300] [327] YES. MUST HAVE A RECORD LENGTH
;;;;; JRST OPEND5 ;[300] [327] NO RANDOM ACCESS OR OK
ERROR (OPN,12,6,OPENER) ;[300]TELL USER TO ENTER RECORD SIZE
;; ALOCATE BUFFERS FOR THE DEVICE INCREASE BUFF COUNT FOR
;; FIXED LENGTH RECORDS IF REQUIRED
OPEND5: CAIN T5,MOD.DU ;DUMP MODE I/O
JRST OPEND7 ;YES, SKIP THE BUFFER STUFF
MOVEI T4,DD.OPN(P3) ;GET POINTER FOR DEVSIZ UUO
DEVSIZ T4, ;GET THE DEFAULT BUFFERCOUNT,,BUFFER SIZE
ERROR (SYS,3,17,) ;MUST HAVE THE DEVSIZ UUO (ALWAYS)
MOVE G1,DD.BUF(P3) ;GET THE USER'S COUNT,,SIZE
TRNE G1,-1 ;BUFFER SIZE SPECIFIED?
TLNN G2,TY.VAR ;DOES DEVICE SUPPORT VARIABLE BUFFERS
HRR G1,T4 ;NO, SET MONITOR DEFAULT
TLNN G1,-1 ;USER SUPPLIED BUFFER COUNT
HLL G1,T4 ;NO, USE MONITOR DEFAULT (2)
OPEND6: MOVEM G1,DD.BUF(P3) ;SAVE THE BUFCNT,,BUFSIZ
PUSHJ P,ALCBUF ;ALLOCATE THE BUFFER RING
HRRI T2,-2(T1) ;MAKE A CORE BLOCK POINTER
HRRM T2,-1(P3) ;LINK BUFFERS TO DD.BLK
HRLI T1,400000 ;SET THE USE BIT ON (BUFFERS ALLOCATED)
TLNE G3,DV.IN ;CAN DEVICE DO INPUT
MOVEM T1,DD.HRI(P3) ;SET POINTER TO BUFFER RING (INPUT)
TLNE G3,DV.OUT ;CAN DEVICE DO OUTPUT
MOVEM T1,DD.HRO(P3) ;SET POINTER TO BUFFER RING (OUTPUT)
TLNN G3,DV.TTA!DV.TTY!DV.PTY;SOME TYPE OF TTY
JRST OPEND8 ;NO, SINGLE RINGS O/K
TLO P3,IO.TTY ;[411] SET FLAG DEVICE IS A TERMINAL
HLL T1,(T1) ;GET THE SIZE FILED
EXCH T1,(T1) ;REALLOCATE THE TWO BUFFERS
MOVEM T1,(T1) ;INTO TWO SINGLE BUFFER RINGS
HRRM T1,DD.HRO(P3) ;SET UP THE OUTPUT RING HEADER
TLNN G3,DV.TTA ;USER'S TTY
JRST OPEND8 ;NO, SLAVE TTY
HRLI T1,(POINT 7) ;ASCII
ADDI T1,1 ;POINT TO THE DATA AREA
MOVEM T1,DD.HRO+1(P3) ;PUT IN RING HEADER
SETZM DD.HRI+2(P3) ;CLEAR THE BYTE COUNTER
MOVEM P3,CHN.TB+20(P4) ;DEFINE THE TTY CHANNEL
POPJ P, ;RETURN
OPEND8: TLC G4,IO.RAN!IO.SOU ;CHECK FOR APPEND
TLCE G4,IO.RAN!IO.SIN!IO.SOU
JRST OPEND9 ;NO,
MOVE T4,DD.SIZ(P3) ;GET THE TOTAL SIZE OF THE FILE(WORDS)
IDIVI T4,200 ;CONVERT TO BLOCKS AND WORD
MOVEI T0,1(T4) ;GET THE BLOCK POINTER
HRRM T0,DD.BLK(P3) ;SAVE THE BLOCK NUMBER
HLL T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
;**; [627] AT OPEND8+8L, MOVE NEXT TWO LINES TO BE AFTER EDIT 535
;**; [627] CLRH 6-DEC-76
;**; [535] INSERT @ OPEND8 + 9L CLRH 26-APR-76
HLLZ T1,DD.UNT(P3) ;[535] GET CHANNEL NUMBER
TLO T1,(OUT) ;[535] DO A DUMMY OUT
XCT T1 ;[535] TO POSITION OUTPUT FOR MONITOR
JFCL ;[535] IGNORE AND LET REAL OUTPUT LOSE
;**; [627] INSERT TWO LINES MOVED FROM OPEND8+8L HERE
;**; [627] OPEND8+14L AFTER 535 AND BEFORE 540 CLRH 6-DEC-76
SKIPN T4 ;[627] CHECK FOR A NULL FILE
JUMPE T5,OPEND0 ;[627] AND A NULL WORD COUNT
;**; [540] INSERT @ OPEND8 + 13 1/2 L CLRH 4-MAY-76
JUMPE T5,OPENDC ;[540] INTEGRAL NUMBER OF BLOCKS
TLO T0,(USETI) ;SET UP FOR INPUT OF LAST BLOCK
XCT T0 ;GET THE FILSER TO THE LAST BLOCK
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
;**; [540] INSERT @ OPEND8 + 16 1/2 L CLRH 4-MAY-76
MOVE T4,DD.HRI(P3) ;[540] GET FIRST BUFFER ADDRESS
PUSH P,0(T4) ;[540] SAVE IT
HRRM T4,0(T4) ;[540] MAKE SINGLE BUFFER FOR INPUT
TLO T1,(IN) ;TRY TO READ THE LAST BLOCK
XCT T1 ;GET THE BLOCK
JFCL ;READ PROTECTED IGNORE
;**; [540] INSERT @ OPEND8 + 19 1/2 L CLRH 4-MAY-76
POP P,0(T4) ;[540] RESTORE REAL BUFFER RING
OPENDC: TLO T0,(USETO) ;[540] SET THE OUTPUT BLOCK NUMBER
XCT T0 ;TELL FILSER
OPEND0: HRRZ T1,DD.HRI(P3) ;GET THE INPUT HEADER
PUSHJ P,FIND4 ;SET UP THE RING HEADRS
TLO P3,IO.RNG ;SET RING CHANGE FLAG
TLZ P3,IO.RAN ;[436] APPEND IS REALLY SEQOUT
TLZ G4,IO.RAN ;[436] ONCE INITIAL POS IS DONE
MOVSI T1,3400 ;[436] SO FUNNY BIT NOT NEEDED NOW
XORM T1,DD.BLK(P3) ;[436] NOW BACKSPACE WILL WORK
JRST OPENDA ;[444] NOW APPEND WILL WORK AGAIN
OPEND9: JUMPI OPENDA ;JUMP ON INPUT
TLNN P3,IO.RAN ;RANDOM ACCESS
PUSHJ P,OBLOK. ;DO A DUMMY OUTPUT
OPENDA: TLNE G3,DV.TTY!DV.TTA!DV.LPT ;CHECK FOR FORM CONTROL
;NO, FORMS CONTROL ON A PTY
TLO P3,IO.CCC ;SET FORMS FLAG
OPEND7: HLRZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
LSH T1,-5 ;POSITION THE CHANNEL NUMBER
DPB T1,FLU.BP(P4) ;PUT TH CHANNEL IN THE FLU TABLE
ADDI T1,CHN.TB(P4) ;RELOCATE TO THE CHANNEL TABLE
TLO P3,IO.OPN ;SET FILE OPEN
MOVEM P3,(T1) ;SAVE THE I/O REG IN THE CHANNEL TABLE
TLNN G3,DV.MTA ;IS THIS A MAG TAPE
SKIPN T1,DD.RLS(P3) ;CHECK FOR A REELS PARAMETER
POPJ P, ;RETURN
SETZM DD.RLS(P3) ;CLEAR THE REELS POINTER
PJRST PMEM%% ;YES, DELETE THE REELS ARRAY
OPENER: HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(RELEAS) ;GET A RELEASE UUO
XCT T1 ;DELETE ALL MONITOR REFERENCES
HRRZ T1,-1(P3) ;GET THE BUFFER LINK POINTER
JUMPE T1,OPENE0 ;ARE BUFFERS ASSIGNED
HLLZS -1(P3) ;CLEAR THE LINK POINTER
PUSHJ P,PMEM13 ;DELETE THE BUFFERS
OPENE0: AOS (P) ;SKIP ON ERROR RETURN
POPJ P, ;TAKE THE ERROR RETURN
PAGE
SUBTTL SETDEN ROUTINE TO SET THE DENSITY FOR THE CURRENT MAG TAPE
;**; [615] INSERT BEFORE ALCBUF ROUTINE JMT 4-NOV-76
;**; [615] /SETDEN/ ROUTINE TO SET THE DENSITY FOR MAG TAPE
;**; [704] CHANGE @ SETDEN SWG 15-SEP-77
SETDEN: SKIPN T1,DD.DEN(P3) ;[704] PICK UP DEN CODE; IF 0
JRST DENRET ;[704] LEAVE UNIT DEFAULT SET
MOVEI T0,.TFDEN ;[615] GET TAPOP. FUNCTION CODE
MOVEM T0,TAP.TB(P4) ;[615] TO SET DENSITY
LDB T0,[POINT 4,DD.UNT(P3),12] ;[615] GET CHANNEL
MOVEM T0,TAP.TB+1(P4) ;[615] STORE IT IN ARGUMENT BLOCK
;**; [704] DELETE SETDEN+4 SWG 15-SEP-77
MOVEM T1,TAP.TB+2(P4) ;[615] STORE DESIRED DENSITY CODE
MOVSI T1,3 ;[615] LENGTH OF ARGUMENT BLOCK
HRRI T1,TAP.TB(P4) ;[615] POINTER TO ARGUMENT BLOCK
TAPOP. T1, ;[615] DO TAPOP. TO SET DENSITY
JRST DENFIX ;[615] LOST--GO DO A SETSTS
DENRET: AOS (P) ;[615] WON--GIVE SKIP RETURN
POPJ P, ;[615] RETURN
DENFIX: MOVE T0,DD.DEN(P3) ;[615] GET REQUESTED DENSITY
CAILE T0,3 ;[615] VALID FOR SETSTS ?
MOVEI T0,0 ;[615] NO, USE THE DEFAULT
LSH T0,7 ;[615] LEFT SHIFT INTO POSITION
MOVEI T1,T2 ;[615] WHERE TO PUT STATUS BITS
HLL T1,DD.UNT(P3) ;[615] GET CHANNEL NUMBER
TLO T1,(GETSTS) ;[615] MAKE GETSTS
XCT T1 ;[615] DO GETSTS
HLL T2,DD.UNT(P3) ;[615] GET CHANNEL NUMBER
TLO T2,(SETSTS) ;[615] MAKE SETSTS
;**; [651] CHANGE @DENFIX+10L, DCE, 4-APR-77
TRZ T2,600 ;[651][615] CLEAR OLD DENSITY (SHOULD BE ZERO)
OR T2,T0 ;[615] OR IN NEW DENSITY
XCT T2 ;[615] DO SETSTS
JRST DENRET ;[615] RETURN
PAGE
SUBTTL ALCXXX GENERAL ROUTINES TO ACCESS AND DEFINE DD.BLK AREAS
ALCBUF: PUSH P,G2 ;SAVE GLOBAL G2
HLRZ G2,G1 ;LOAD THE BUFFER COUNT
PUSH P,G1 ;SAVE THE CONTROL WORD
HRLZI G1,-2(G1) ;GET THE TRUE BUFFER SIZE
HRRZ T0,(P) ;GET THE SIZE OF THE CORE BLOCK
PUSHJ P,GMEM%% ;ALLOCATE THE CORE BLOCK
HRRI G1,1(T1) ;SET G1 TO THE SECOND WORD OF THE RING HEADER
PUSH P,G1 ;SAVE THE INITIAL POINTER TO THE RING
SOJLE G2,ALCBU2 ;CHECK FOR SINGLE BUFFERING
ALCBU1: HRRZ T0,-1(P) ;GET THE CORE BLOCK SIZE
PUSHJ P,GMEM%% ;GET ANOTHER CORE BLOCK
MOVEM G1,1(T1) ;SET THE SECOND WORD OF THE RING HEADER
SUBI T1,1 ;POINT TO THE LINK WORD IN THE CORE LIST
HRRM T1,-2(G1) ;LINK THE CORE BLOCK TOGETHER
HRRI G1,2(T1) ;CREATE THE NEXT RING POINTER
SOJG G2,ALCBU1 ;BACK FOR ANOTHER BUFFER
ALCBU2: POP P,T1 ;GET THE INITIAL RING POINTER
MOVEM G1,(T1) ;LINK THE BUFFER IN A RING
POP P,G1 ;RESTORE THE ARGUMENT WORD
POP P,G2 ;RESTORE GLOBAL G2
POPJ P,0 ;RETURN
; GENERAL LOOKUP/ENTER ROUTINES FOR DECTAPE AND DSK
RENAM.: MOVE T1,[RENAME 0,DD.CNT(P3)] ;GET THE RENAME UUO
JRST RENAM1 ;[421] DON'T CLEAR DATES ON RENAME
LOOKU.: SKIPA T1,[LOOKUP 0,DD.CNT(P3)] ;GET LOOKUP FOR DSK
ENTER.: MOVE T1,[ENTER 0,DD.CNT(P3)] ;GET ENTER FOR DSK
HLLZS DD.EXT(P3) ;CLEAR THE ERROR BITS
MOVSI T0,777740 ;[406] SET MASK FOR PROTECTION CODE
ANDM T0,DD.PRV(P3) ;[406] CLEAR ALL BUT PROT. AND MODE
;[406] MONITOR TAKES CARE OF DATES
RENAM1: HLLZ T0,DD.UNT(P3) ;[421] GET THE CHANNEL NUMBER (BITS 9-12)
IOR T1,T0 ;PUT CHANNEL NUMBER IN UUO
TLNE G3,DV.DTA ;[455] IS THIS A DSK(EXTENDED LOOKUP/ENTER)
ADDI T1,DD.NAM-DD.CNT;LEVEL C OR NOT DSK(USE STANDARD LOOKUP)
;**;[472] Insert @ RENAM1+4L JNG 19-Nov-75
MOVE T0,DD.PPN(P3) ;[472] REMEMBER PPN IN CASE OF ERROR
XCT T1 ;DO THE UUO
SKIPA T1,DD.EXT(P3) ;GET THE ERROR CODE IN T1
;**; [617] CHANGE @ RENAM1 + 7 CLRH 9-NOV-76
JRST [MOVEM T0,DD.PPN(P3) ;[617] RESTORE PPN WORD
JRST 1(P1) ] ;[617] OK, RETURN
MOVEM T0,DD.PPN(P3) ;[472] RESTORE PPN (ERROR WIPES 0)
TRNE T1,-1 ;CHECK FOR FILE NOT FOUND
ERROR (OPN,0,7,OPENER);SOMETHIN ELSE ERROR RETURN TO TRY AGAIN
JRST (P1) ;TAKE FILE NOT FOUND RETURN
;DEFINE THE MODE OF THE FILE
OPENDM: LDB T5,[POINT 4,DD.BLK(P3),13] ;GET THE MODE INDEX
HLRZ T4,MOD.DP(T5) ;GET THE OPEN MODE
ANDI T4,17 ;MAKE IN 4 BITS WIDE
MOVEI T3,1 ;MAKE A 1 BIT MASK
LSH T3,(T4) ;POSITION THE BIT FOR MODE CHECK
TDNN T3,DD.STS(P3) ;IS THE MODE LEGAL
JRST (P1) ;TAKE ERROR RETURN
MOVEI T3,17 ;GET A 4 BIT MASK
ANDCAM T3,DD.OPN(P3) ;CLEAR THE MODE FIELD
LDB T3,[POINT 3,DD.BLK(P3),5];GET PARITY/DENSITY
LSH T3,7 ;POSITION
TLNE G3,DV.MTA ;IS THE DEVICE MAG TAPE
IORI T4,(T3) ;YES, PUT IN THE OPEN STATUS
IORM T4,DD.OPN(P3) ;YES, LEGAL MODE STORE FOR OPEN
CAIGE T5,MOD.FM ;IS THE MODE REQUESTE FORMATED
TLO P3,IO.FMT ;YES, SET FORMATED I/O MODE
CAIE T5,MOD.AS-MOD.DP;ASCII MODE
CAIN T5,MOD.BN-MOD.DP;OR BINARY
TLZA P3,IO.NON ;YES, CLEAR NON- STANDARD MODE
TLO P3,IO.NON ;NON-STANDARD MODE REQUEST
JRST 1(P1) ;RETURN TO CALLER
PAGE
SUBTTL OPNARG PICKS UP THE OPEN/CLOSE STATEMENT ARGS
OPNARG:
SETZ P3, ;CLEAR THE I/O REGISTER
IFN %V1,<
JUMPL L,OPNAR0 ;JUMP IF NEW CALL
LDB T1,[POINT 9,(L),8];GET THE ARG COUNT
MOVNI T1,(T1) ;NEGATIVE COUNT
HRLI L,(T1) ;BUILD THE AOBJN POINTER
>
OPNAR0: AOBJP L,OPNAR4 ;JUMP IF ARG LIST IS NULL
OPNAR1: JSP P1,EFCTV. ;[265] GET THE EFFECTIVE ADDRESS
LDB T5,[POINT 4,(L),12] ;GET THE USER SUPPLIED ARG TYPE
LDB G3,[POINT 8,(L),8] ;GET THE FUNCTION CODE
LDB G2,[POINT 3,OP.DSP(G3),8] ;GET THE ARGUMENT TYPE
CAIN G3,INXDIA ;[452] SEE IF DIALOG
JUMPE G1,OPNAR6 ;[452] YES, SEE IF DIALOG W/O =
TRNN G1,-20 ;IN THE AC SAVE AREA
ADDI G1,ACC.SV(P4) ;YES, RELOCATE
MOVE T1,(G1) ;GET THE VALUE OF THE ARGUMENT
CAILE G2,SCNSIX-SCNNER ;COMPARE THE ARGUMENT
CAIN T5,TP%LIT ;AGAINST THE USER'S SUPPLIED
PUSHJ P,SCNNER(G2) ;YES, CONVERT TO SIXBIT
OPNAR6: ;[452]
PUSHJ P,@OP.DSP(G3) ;GO TO SWITCH ROUTINE
AOBJN L,OPNAR1 ;GET THE NEXT ARGUMENT
TLZN P3,20 ;[452] DID WE HAVE DIALOG W/O =
JRST OPNAR4 ;[452] NO
JRST OPNAR7 ;[452] YES, GO READ IN STUFF NOW
OPNAR3: TLO P2,OP.OPN ;YES, COLLECT THE PARAMETERS
PUSHJ P,DIALOG ;GO TO THE DIALOG ROUTINE
OPNAR4: TLNN P2,OP.ERR ;ERROR PENDING
POPJ P, ;END OF OPEN ARG AND DIALOGS
OPNAR5: SKIPGE JOB.SV(P4) ;FORCE THE ERROR DIALOG IF NOT BATCH
ERROR (SYS,4,16,) ;EXIT WITH FATAL ERROR MESSAGE
OPNAR7: ;[452]
MOVE P3,CHN.TB+20(P4);GET THE TTY CHANNEL FOR DIALOG
JRST OPNAR3 ;DO IT AGAIN WITH THE USER'S TTY
PAGE
SUBTTL OPEN DIALOG MODE ROUTINE
SCNSWT: SETZ G3, ;CLEAR THE SWITCH INDEX
JUMPN T2,SCNSW0 ;IS THERE A DELIMETER PENDING
SCNSWZ: PUSHJ P,SCNSIX ;NO, GO GET SOMETHING
JUMPE T1,SCNSW0 ;GO CHECK FOR A SWITCH
MOVEI G3,INXNAM ;ASSUME A FILE NAME
TRZE T2,1B':' ;IS THIS A DEVICE
MOVEI G3,INXDEV ;YES, PROCESS THE DEVICE NAME
JRST SCNSW6 ;DATAM IS IN AC T1
SCNSW0: TLZE T2,(1B'/') ;IS THIS A SWITCH
JRST SCNSW1 ;YES, PROCESS THE SWITCH
TLZE T2,400000 ;CHECK FOR END
POPJ P,
TRZE T2,1B'<' ;CHECK FOR A PROTECTION CODE
MOVEI G3,INXPRV ;YES, GO TO PROTECTION ROUTINE
TRZE T2,1B19 ;NO,CHECK FOR A [ PPN,SFD]
MOVEI G3,INXPPN ;YES GO PROCESS THE PPN,SFD
JUMPN G3,SCNSW5 ;PROCESS THE PSEUDO SWITCH
SWTDLM: SETZB T1,T1 ;[237] SET ILLEGAL DELIMITER
SWTERR: SETZB G3,G3 ;SET SWITCH ERROR FOUND(MAKE SURE IT IS ZERO)
SWTERV: TLO P2,OP.ERR ;SET ERROR FOUND FLAG(ARGUMENT)
ERROR (OPN,11,7,CPOPJ)
SCNSW1: TLNE P2,OP.DIA ;SWITCH STOP THE DIALOG ARGUMENT SCAN
POPJ P, ;RETURN
PUSHJ P,SCNFIV ;GET THE SWITCH ID
TRZN T2,1B'='!1B':' ;SWITCH MUST BE TERMINATES BY AN =
JRST SWTDLM ;[237] ILLEGAL DELIMITER
MOVE T4,[XWD -OP.MAX,OP.SWT] ;GET THE SWITCH TABLE
JSP P1,SCNTBL ;SCAN THE TABLE
JRST SWTERR ;NOT AN UNIQUE TABLE ENTRY
MOVEI G3,(T4) ;GET THE SWITCH INDEX
CAIN G3,INXDIA ;[452] IS THIS ANOTHER DIALOG
JRST SWTERV ;[452] YES, CAN'T RECURSE VERY WELL
SCNSW5: LDB G2,[POINT 3,OP.DSP(G3),8] ;LOAD THE SCANNER TYPE
PUSHJ P,SCNNER(G2) ;GET THE ARGUMENT FOR THE SWITCH
SCNSW6: TLO P2,40000 ;[416] SET TEMP DIALOG MODE SWITCH
PUSHJ P,@OP.DSP(G3) ;[416] PROCESS THE ARGUMENT
TLZ P2,40000 ;[416] TURN OFF TEMP DIALOG SWITCH
JRST SCNSWT ;PROCESS NEXT SWITCH
PAGE
SUBTTL OPNXXX SWITCH PROCESSING ROUTINES
OPNDEV:
MOVEM T1,DD.DEV(P2) ;SAVE THE DEVICE NAME
POPJ P, ;RETURN TO THE SWITCH SCANNER
OPNBUF:
;**; [542] INSERT @ OPNBUF CLRH 6-MAY-76
SKIPLE T1 ;[542] DON'T USE IF INVALID
HRLM T1,DD.BUF(P2) ;SAVE THE BUFFER COUT
POPJ P, ;RETURN TO THE SWITCH SCANNER
OPNBLK:
;**; [542] INSERT @ OPNBLK CLRH 6-MAY-76
JUMPLE T1,.+3 ;[542] DON'T USE IF INVALID
ADDI T1,3 ;ALLOCATE SPACE FOR BUFFER HEADER
HRRM T1,DD.BUF(P2) ;SAVE THE BLOCK SIZE
POPJ P, ;RETURN TO THE SWITCH SCANNER
OPNNAM:
MOVEM T1,DD.NAM(P2) ;SAVE THE FILE NAME
MOVSI T1,(SIXBIT /DAT/);DEFAULT EXTENSION
TLZE T2,(1B'.') ;IS THERE AN EXTENSION FOLLOWING
PUSHJ P,SCNSIX ;YES, GET THE EXTENSION
TLNE P2,OP.OPN!OP.DIA ;[452] DIALOG MODE?
JRST OPNEXT ;[452] YES,STORE EXT
TLNN T2,(1B' ') ;[416] ANY OTHER DELIMITER IS WRONG
JRST OPNDLM ;[416] TELL USER HE BLEW IT
OPNEXT: HLLM T1,DD.EXT(P2) ;[416][453] SAVE THE EXTENSION
POPJ P, ;RETURN TO THE SWITCH SCANNER
OPNDLM: TLZE P2,40000 ;[416] ALREADY IN DIALOG MODE?
JRST OPNEXT ;[416] YES, GO BACK AND TRY AGAIN
SETZB T1,T1 ;[416] SET ILLEGAL DELIMITER
SETZB G3,G3 ;[416] SET SWITCH ERROR FOUND
TLO P2,OP.ERR ;[416] SET ERROR FOUND FLAG(ARGUMENT)
ERROR (OPN,11,7,.+1) ;[416] TELL ABOUT OPEN ARG ERROR
EXCH P2,P3 ;[416] SET UP TO TYPE THE DDB
PUSHJ P,TY%DDB ;[416] SHOW WHAT WE GOT SO FAR
EXCH P3,P2 ;[416] RESTORE THE I/O REGS
POPJ P, ;[416] RETURN TAKES US TO DIALOG MODE
OPNPPN:
TLNN P2,OP.OPN!OP.DIA ;DIALOG MODE
CAIN T5,TP%LIT ;LITERAL TYPE
JRST OPNPP2 ;YES, TREAT AS DIALOG MODE
SKIPN G2,T1 ;DEFAULT PPN
JRST OPNPP3 ;YES
TLNE G2,-1 ;PROJECT NUMBER IN THE LEFT
JRST OPNPP3 ;YES, PPN IS OK
HRL G2,T1 ;NO, PUT PROJ NUMBER IN LEFT
HRR G2,1(G1) ;PUT PROGRAMMER NUMBER IN RIGHT HALF
AOS G1 ;UPDATE POINTER
OPNPP3: SKIPE T2,1(G1) ;[443][456] ANY SFD
MOVEI T2,1 ;[443] YES, SET FOR SCAN
AOJA G1,OPNPP4 ;UPDATE POINTER
OPNPP2: TLZN T2,(1B',') ;[237] CHECK FOR A COMMA
PJRST SCNDLM ;[237] ILLEGAL DELIMITER
JUMPG T2,SCNDLM ;[237] ILLEGAL DELIMITER
HRLZ G2,T1 ;SAVE THE PROJECT NUMBER
PUSHJ P,SCNOCT ;GET THE PROGRAMMER NUMBER
TRZ T2,1B21 ;[237] CLEAR RIGHT BRACKET
TLNN T2,(1B','!1B'/');[237] ALLOW / OR , AFTER PPN
JUMPG T2,SCNDLM ;[237] ILLEGAL DELIMITER
HRR G2,T1 ;SAVE PROGRAMMER NUMBER
;**; [536] INSERT @ OPNPP4 CLRH 27-APR-76
;**; [667] INSERT @OPNPP4 SJW 5-AUG-77
OPNPP4: SKIPN G2 ;[667] IS PPN = 0 ?
JRST OPNPP6 ;[667] YES: LET MONITOR DEFAULT IT
PUSH P,T3 ;[536] GET A REGISTER
GETPPN T3, ;[536] GET THE USER'S PPN
JFCL ;[536] DON'T CARE ABOUT SKIP/NONSKIP RETURNS
TLNN G2,-1 ;[536] WAS PROJECT SPECIFIED ?
HLL G2,T3 ;[536] NO, SO USE DEFAULT
TRNN G2,-1 ;[536] WAS PROGRAMMER NUMBER SPECIFIED ?
HRR G2,T3 ;[536] NO, SO USE DEFAULT
POP P,T3 ;[536] RESTORE T3
;**; [667] INSERT @OPNPP4+8L SJW 5-AUG-77
OPNPP6: SKIPN T1,DD.PPN(P2) ;[667] GET THE POINTER WORD
HRLI T1,-1 ;CORE BLOCK NOT AVAILABLE
TLNN T2,(1B'/') ;[237] NO SFD AFTER /
JUMPG T2,OPNPP5 ;[237] NO, CHECK FOR SFD'S
;**; [705] INSERT @OPNPP6 + 3 1/2 SJW 16-SEP-77
PUSH P,T2 ;[705] SAVE SCAN FLAGS REG
TLNN T1,-1 ;PPN OR CORE POINTER
PUSHJ P,PMEM%% ;CORE POINTER DELETE CORE BLOCK
POP P,T2 ;[705] RESTORE T2 SINCE PMEM%% CLOBBERS IT
MOVEM G2,DD.PPN(P2) ;SAVE THE PPN
POPJ P, ;RETURN
;**; [707] @OPNPP5 SJW 16-SEP-77
OPNPP5: MOVEI T0,^D10 ;[707] 2 HEADERS + PPN + 5 SFDS + 2 NULLS (FOR SCNSTR)
PUSH P,T5 ;SAVE THE TYPE CODE
TLNE T1,-1 ;CHECK FOR A CORE POINTER OF PPN
PUSHJ P,GMEM%% ; PPN, GET DYNAMIC CORE
POP P,T5 ;RESTORE THE TYPE CODE
HRRZM T1,DD.PPN(P2) ;SAVE SFD POINTER
MOVEM G2,2(T1) ;SAVE PPN
MOVEI G2,3(T1) ;SET UP THE POINTER TO THE SFD LIST
HRLI G2,-^D5 ;[707] MAKE AN AOBJN PTR (5 SFDS MAX)
PJRST SCNSTR ;GET THE ID FIELD FORM SCNSTR
OPNPR1: PUSHJ P,SCNOCT
OPNPRV: SKIPGE P2 ;DIALOG MODE
JUMPE T2,SCNDLM ;[237] YES, NOT AN OCTAL NUMBER
DPB T1,[POINT 9,DD.PRV(P2),8] ;[322] SAVE PROTECTION CODE
TRZ T2,1B'>' ;CHECK THE TERMINATOR
POPJ P, ;JUST RETURN
OPNEST:
;**;[505] Insert @ OPNEST+1L JNG 23-Nov-75
ADDI T1,177 ;[505] ROUND UP TO BLOCK BOUND
LSH T1,-7 ;[505] CONVERT TO BLOCKS FOR FILSER
MOVEM T1,DD.EST(P2) ;SAVE ESTIMATED FILE SIZE
POPJ P, ;RETURN
OPNREC:
MOVNM T1,DD.LOG(P2) ;SAVE THE LOGICAL RECORD LENGTH
;SET NEGATIVE DON'T KNOW (CHAR/WORD)
POPJ P, ;RETURN
OPNVER:
MOVEM T1,DD.VER(P2) ;[343] STORE VERSION NUMBER
POPJ P, ;RETURN
OPNRLS:
MOVEI T0,^D12 ;NO, ASK FOR DYNAMIC CORE
PUSH P,T5 ;SAVE THE TYPE CODE
SKIPN T1,DD.RLS(P2) ;HAS SPACE BEEN ALLOCATED FOR REELS
PUSHJ P,GMEM%% ;GET DYNAMIC CORE FOR REELS ARRAY
POP P,T5 ;RESTORE THE TYPE CODE
HRRZM T1,DD.RLS(P2) ;SAVE THE ADDRESS OF THE ARRAY
OPNRL1: MOVEI G2,(T1) ;GET THE ADDRESS
HRLI G2,-^D10 ;MAKE AN AOBJN POINTER TO THE REELS BLOCK
PJRST SCNSTR ;GET THE ID FIELDS FOR SCNSTR
; T1 = THE FIRST REEL ID
OPNLIM:
MOVEM T1,DD.LIM(P2) ;SAVE IN DD BLOCK
POPJ P, ;RETURN
OPNASC:
HRRZM G1,DD.ASC(P2) ;SAVE THE ASSOCIATE VARIABLE ADDRESS
POPJ P, ;RETURN
OPNERV:
HRRZM G1,DD.ERV(P2) ;SAVE THE ERROR VARIABLE ADDRESS
POPJ P, ;RETURN
OPNUNT:
POPJ P, ;RETURN
OPNACC: ;DEFINE THE ACCESS METHOD
MOVE T4,[XWD -ACC.SZ,ACC.TB] ;GET THE TABLE ENTRY
JSP P1,SCNTBL ;FIND THE ENTRY
JRST SWTERV ;NOT FOUND
DPB T4,[POINT 4,DD.BLK(P2),9] ;STORE THE ACCESS POINTER
POPJ P, ;RETURN
OPNMOD: ;DEFINE THE FILE MODE AND ACCESS
MOVE T4,[XWD -MOD.SZ,MOD.TB] ;GET THE MODE TABLE
JSP P1,SCNTBL ;FIND THE ENTRY
JRST SWTERV ;NOT FOUND
DPB T4,[POINT 4,DD.BLK(P2),13] ;STORE THE MODE INDEX
POPJ P, ;RETURN
OPNDIS: ;DEFINE THE DISPOSE ARGUMENT
MOVE T4,[XWD -DIS.SZ,DIS.TB] ;GET THE TABLE ENTRY
JSP P1,SCNTBL ;FIND THE ENTRY
JRST SWTERV ;NOT FOUND
DPB T4,[POINT 4,DD.BLK(P2),17] ;STORE THE DISPOSE INDEX
POPJ P, ;RETURN
OPNPAR: ;MAG TAPE PARITY
MOVSI T3,(1B3) ;SET UP A MASK FOR PARITY
ANDCAM T3,DD.BLK(P2) ;CLEAR THE PARITY BIT
HLRZS T1 ;GET THE PARITY IN THE RIGHT HALF
CAIN T1,'ODD' ;/PARITY=ODD
POPJ P, ;YES, EXIT
CAIE T1,'EVE' ;/PARITY=EVEN
JRST SWTERV ;NO, ILLEGAL ARGUMENT
IORM T3,DD.BLK(P2) ;YES, SET EVEN PARITY
POPJ P, ;RETURN
OPNDEN: ;MAG TAPE DENSITY
;**; [615] REPLACE ROUTINE AT OPNDEN JMT 4-NOV-76
MOVE T0,T1 ;[615] GET DENSITY ARGUMENT IN T0
MOVEI T1,DENLEN ;[615] DENSITY TABLE LENGTH
STDEN0: CAMN T0,DENTAB(T1) ;[615] KNOWN DENSITY ?
JRST STDEN1 ;[615] YES--PROCEED
SOJGE T1,STDEN0 ;[615] NO--LOOP THROUGH TABLE
MOVE T1,T0 ;[615] PUT DENSITY ARGUMENT BACK
JRST SWTERV ;[615] GIVE SWITCH ERROR
STDEN1: MOVEM T1,DD.DEN(P2) ;[615] STORE DENSITY
POPJ P, ;[615] RETURN
;[615] DENSITY TABLE
DENTAB: SIXBIT /0/ ;[615] SYSTEM DEFAULT
SIXBIT /200/ ;[615] 200 BPI
SIXBIT /556/ ;[615] 556 BPI
SIXBIT /800/ ;[615] 800 BPI
SIXBIT /1600/ ;[615] 1600 BPI
;**; [670] Change @ DENTAB + 5, JMT, 10-Aug-77
SIXBIT /6250/ ;[670] [615] 6250 BPI (SOME DAY)
DENLEN==.-DENTAB ;[615] LENGTH OF DENSITY TABLE
OPNDIA: ;DIALOG ROUTINE TO CHANGE THE INPUT DEVICE
;FOR OPEN STATEMENT ARGUMENTS
JUMPE G1,OPNDI1 ;[452] IS IT DIALOG W/O =
;**; [521] INSERT @ OPNDIA+1/2 CLRH 10-MAR-76
JUMPE T1,OPNDI1 ; [521] DIALOG W/O = (FROM F40) ?
MOVEI T5,TP%LIT ;[452] NO, CHANGE ARG TYPE TO LITERAL STRING
SETZ T2, ;[452] CLEAR SCANNER FLAGS
TLO P2,OP.DIA ;[452] SAY WERE COMING FROM CORE
PJRST SCNSWT ;[452] AND GO READ HIS SWITCHES
OPNDI1: TLO P3,20 ;[452] SAY TO TALK TO USER AFTER ALL OTHER
POPJ P, ;[452] ARGS HAVE BEEN SCANNED
; ROUTINE TO ACCESS THE DIALOG DEVICE
DIALOG:
TLNN P3,IO.TTA ;USER'S TTY
JRST DIALO1 ;DON'T OUTPUT A MESSAGE
TLZE P2,OP.ERR ;ERROR CONDITION WITH TTY DEFAULT
JRST DIALO2 ;YES, DDB HAS BEEN TYPED
EXCH P2,P3 ;SET UP TO TYPE THE DDB
PUSHJ P,TY%DDB## ;TELL THE USER THE UNIT
EXCH P2,P3 ;RESTORE THE I/O REG'S
DIALO2:
OUTSTR [ASCIZ/
Enter new file specs. End with an $(ALT)
*/]
PUSHJ P,IBLOK2 ;FLUSH THE TTY INPUT BUFFER
DIALO1: SETZ T2, ;CLEAR THE DELIMITER SWITCH
TLZ P3,IO.INO ;FORCE INPUT MODE
PJRST SCNSWT ;GET THE ARGS
PAGE
SUBTTL SCANNER ROUTINE FOR PPN AND REELS
SCNSTR: ;SPECIAL STRING SCANNER FOR REELS/PPN ROUTINES
;**+[717] @SCNSTR SJW 27-OCT-77
JUMPL P2,SCNST0 ;[717] CHECK FOR DIALOG MODE
MOVEI G4,^D6 ;[717] ASSUME SINGLE PRECISION
CAIE T5,TP%DOR ;[717] DOUBLE PRECISION?
CAIN T5,TP%COM ;[717] OR COMPLEX?
MOVEI G4,^D11 ;[717] YES: SCAN 2 WORDS
CAIN T5,TP%LIT ;[717] LITERAL?
SCNST0: SETO G4, ;[717] YES: INFINITE SCAN
PUSHJ P,SCNSIX ;GET THE ID NAME
;**; [710] @SCNST1 SJW 20-SEP-77
MOVEM T1,(G2) ;[710] SAVE THE ID NAME
;**;[720] @SCNSTR + 1 SJW 21-OCT-77
TLNN P2,OP.OPN!OP.DIA ;[720] SCANNING DIALOG ?
CAIN T5,TP%LIT ;[720][710] SCANNING LITERAL ?
JRST SCNST1 ;[710] YES: CHECK FOR DELIMITERS
SKIPN (G1) ;[710] NO: NULL WORD ?
JRST SCNST3 ;[710] YES: STOP SCAN
JRST SCNST2 ;[710] NO: GET NEXT ID NAME
SCNST1: TLZN T2,(1B',') ;[710] IS DELIMITER A , ?
TRZA T2,1B21 ;[710] NO: EAT ] IF PRESENT AND STOP
SCNST2: AOBJN G2,SCNSTR ;[710] GET NEXT ID ARG
SCNST3: SETZM 1(G2) ;[710] SET END (OR +1) OF ARRAY FLAG
POPJ P, ;RETURN
;ROUTINE TO SCAN A TABLE FOR AN UNIQUE ENTRY ARG MAY BE ABR.
;ENTRY
; T0 SCRATCH
; T1= FIVE NAME TO SCAN FOR
; T2= NOT USED (CONTAINS FLAGS)
; T3= SCRATCH
; T4= -TABLE SIZE,,TABLE ADDRESS
; T5= SCRATCH
;RETURN
; T4= THE INDEX INTO THE TABLE (N,,N)
; NON-SKIP RETURN OF ENTRY NOT FOUND
; SKIP RETURN OF FOUND IN THE TABLE
SCNTBL:
PUSH P,T4 ;SAVE THE ARGUMENT
SETZ T0, ;CLEAR THE FLAG WORD
SETO T3, ;SET UP A MASK
LSH T3,-5 ;SHIFT MASK
TDNE T1,T3 ;CHECK MASK AGAINST SIGNIFICANT BYTES
JUMPN T3,.-2 ;RETRY THE MASK TEST
SCNTB1: MOVE T5,(T4) ;SEARCH TABLE FOR DEFINED SWITCHES
ANDCAM T3,T5 ;REDUCE THE SWITCH TO USER LENGTH
CAME T5,T1 ;IS THIS THE SWITCH
SCNTB2: AOBJN T4,SCNTB1 ;REDUCE COUNT AND CONTINUE SEARCH
JUMPGE T4,SCNTB3 ;END OF LIST CHECK RESULTS
SKIPE T0 ;HAVE WE SEEN A ABRIV. SWITCH
SETO T0, ;YES, SET MULTI SWITCH FLAG
HRRI T0,(T4) ;SAVE SWITCH INDEX IN ANY CASE
CAME T1,(T4) ;EXACT MATCH
JRST SCNTB2 ;NO CONTINUE
ANDI T0,-1 ;YES, CLEAR THE MULTI SWITCH FLAG
SCNTB3: MOVE T4,T0 ;GET THE ABS ADDRESS IN T4
POP P,T0 ;GET THE ARGUMENT BACK
JUMPLE T4,(P1) ;ERROR ARGUMENT NOT IN TABLE
SUB T4,T0 ;RELOCATE TO INDEX
ANDI T4,-1 ;RIGHT HALF ONLY
JRST 1(P1) ;RETUNRN
PAGE
SUBTTL TABLES FOR THE OPEN STATEMENT
OP.SWT::
FIVBIT (UNIT ) ;00 /UNIT=INTEGER
FIVBIT (DIALOG) ;01 /DIALOG=STRING
FIVBIT (ACCESS) ;02 /ACCESS=STRING
FIVBIT (DEVICE) ;03 /DEVICE=STRING
FIVBIT (BUFFCOU) ;04 /BUFFER=INTEGER
FIVBIT (BLOCKSI) ;05 /BLOCK SIZE=INTEGER
FIVBIT (FILE ) ;06 /FILE NAME=STRING.STRING
FIVBIT (PROTECT) ;07 /PROTECTION=OCTAL
FIVBIT (DIRECT) ;10 /DIRECTORY=OCTAL,OCTAL,STRING,,,
FIVBIT (LIMIT ) ;11 /LIMIT=INTEGER
FIVBIT (MODE ) ;12 /MODE=STRING
FIVBIT (FILESIZ) ;13 /FILE SIZE=INTEGER
FIVBIT (RECORDS) ;14 /RECORD SIZE=INTEGER
FIVBIT (DISPOSE) ;15 /DISPOSE=STARING
FIVBIT (VERSION) ;16 /VERSION=INTEGER
FIVBIT (REELS ) ;17 /REELS=STRING,STRING....
FIVBIT (MOUNT ) ;20 /MOUNT=STRING
OCT -1 ;21 ERROR VARIABLE
OCT -1 ;22 ASSOCIATE VARIABLE
FIVBIT (PARITY) ;23 /PARITY=STRING
FIVBIT (DENSITY) ;24 /DENSITY=STRING
OP.MAX==.-OP.SWT ;MAXIUM TABLE SIZE
DEFINE OPNARG(LABEL,CONTYP,TYPE)
<IFNDEF DD.'LABEL,<DDBINX==0>
IFDEF DD.'LABEL,<DDBINX==DD.'LABEL>
BYTE (6)DDBINX(3)<SCN'CONTYP-SCNNER>(4)TP%'TYPE(5)0(18)OPN'LABEL
INX'LABEL==.-OP.DSP-1>
OP.DSP::
OPNARG UNT,DEC,INT ;0 UNIT=
OPNARG DIA,NER,LIT ;1 DIALOG= /DIALOG=
OPNARG ACC,FIV,LIT ;2 ACCESS= /ACCESS=ILLEGAL
OPNARG DEV,SIX,LIT ;3 DEVICE= STRING:
OPNARG BUF,DEC,INT ;4 BUF COUNT= /BUF COUNT=
OPNARG BLK,DEC,INT ;5 BLOCK SIZE= /BLOCK SIZE=
OPNARG NAM,SIX,LIT ;6 FILE NAME= STRING.STRING
OPNARG PRV,OCT,OCT ;7 PROTECTION= /PROTECT= OR <NNN>
OPNARG PPN,OCT,OCT ;10 DIRECTORY= /DIRECTORY OR [N,N,STRING]
OPNARG LIM,DEC,INT ;11 LIMIT= /LIMIT=
OPNARG MOD,FIV,LIT ;12 MODE= /MODE=
OPNARG EST,DEC,INT ;13 FILE SIZE= /FILE SIZE=
OPNARG REC,DEC,INT ;14 RECORD SIZE= /RECORD=
OPNARG DIS,FIV,LIT ;15 DISPOSE= /DISPOSE=
OPNARG VER,OCT,OCT ;16 VERSION= /VERSION=
OPNARG RLS,NER,LIT ;17 REELS= /REELS=STRING,STRING,...
OPNARG MNT,SIX,LIT ;20 MOUNT= /MOUNT=
OPNARG ERV,OCT,UDF ;21 ERROR=
OPNARG ASC,OCT,UDF ;22 ASSOCIATE VARIABLE=
OPNARG PAR,SIX,LIT ;23 PARITY= /PARITY=STRING
OPNARG DEN,SIX,LIT ;24 DENSITY= /DENSITY=STRING
OPNMNT:
POPJ P,
; THE FOLLOWING MODES ARE NOT IMPLEMENTED
; (LINED,SIXBIT,EBCDIC,BCD)
MOD.TB:: ;/MODE=STRING
FIVBIT (ASCII) ;0 /MODE=ASCII
OCT -1; FIVBIT (LINED) ;1 /MODE=LINED,INTEGER
OCT -1; FIVBIT (SIXBIT) ;2 /MODE=SICBIT
OCT -1; FIVBIT (EBCDIC) ;3 /MODE=EBCDIC
OCT -1; FIVBIT (BCD) ;4 /MODE=BCD
FIVBIT (BINARY) ;5 /MODE=BINARY
FIVBIT (IMAGE) ;6 /MODE=IMAGE
FIVBIT (DUMP) ;7 /MODE=DUMP
MOD.SZ==.-MOD.TB
DEFINE MODARG(BYTSIZ,MODE)<
BYTE (6)0(6)BYTSIZ(2)0(4)MODE(18)0>
MOD.DP: ;DEFINE THE ACCESS MODE BITS
MOD.AS: MODARG 7,0 ;/ASCII
MODARG 7,0 ;/LINED
MODARG 6,14 ;/SIXBIT
MODARG 8,14 ;/EBCDIC
MODARG 6,14 ;/BCD
MOD.FM=.-MOD.DP ;DEFINE THE END OF THE FORMATED I/O MODES
MOD.BN: MODARG 44,14 ;/BINARY
MOD.IM: MODARG (0,10) ;/IMAGE
MOD.DU==.-MOD.DP ;DEFINE THE DUMP MODE NDEX
MODARG 44,17 ;/DUMP
ACC.TB:: ;ACCESS TABLE
ACC.S2==.-ACC.TB ;[404] DEFINE SEQINOUT ACCESS
FIVBIT (SEQINOU) ;SEQUENTIAL INPUT/OUTPUT(DEFAULT)
ACC.SI==.-ACC.TB ;[316] DEFINE SEQIN ACCESS
FIVBIT (SEQIN) ;SEQUENTAIL INPUT
ACC.SO==.-ACC.TB ;[404] DEFINE SEQOUT ACCESS
FIVBIT (SEQOUT) ;SEQUENTAIL OUTPUT
ACC.RO==.-ACC.TB ;[316] DEFINE RANDOM ACCESS
FIVBIT (RANDOM) ;RANDOM ACCESS
FIVBIT (RANDIN) ;RANDOM INPUT
ACC.AP==.-ACC.TB ;[402] DEFINE APPEND ACCESS
FIVBIT (APPEND) ;APPEND MODE
ACC.SZ==.-ACC.TB ;ACCESS TABLE SIZE
ACC.DP: ;ACCESS FLAG BITS
XWD IO.SIN!IO.SOU ;SEQ IN/OUT(DEFAULT)
XWD IO.SIN ;SEQ IN
XWD IO.SOU ;SEQ OUT
XWD IO.RAN!IO.SIN ;RANDOM INPUT.OUTPUT(IO.SOU GET SET
;AT THE FIRST ENTER
XWD IO.RAN!IO.SIN ;RANDOM INPUT
XWD IO.RAN!IO.SOU ;APPEND OUTPUT
DIS.TB:: ;DISPOSE TABLE
FIVBIT (SAVE) ;/DISPOSE=SAVE (DEFAULT)
FIVBIT (DELETE) ;/DISPOSE=DELETE
FIVBIT (RENAME) ;/DISPOSE=RENAME
QUE.DP==.-DIS.TB ;FOLLOWING ENTRIES REQUIRED QMANGR TO EXECUTE
FIVBIT (PRINT) ;/DISPOSE=PRINT
FIVBIT (PUNCH) ;/DISPOSE=PUNCH
DIS.LS==.-DIS.TB ;[344] CODE NUMBER OF LIST
FIVBIT (LIST) ;[344] /DISPOSE=LIST
DIS.SZ==.-DIS.TB ;TABLE SIZE
PAGE
SUBTTL SCANNER ROUTINE TO SCAN AND CONVERT ASCII STRINGS
SCNDLM: MOVEI T2,1 ;[237] SET ILLEGAL DELIMITER
SCNNER: POPJ P, ;DUMMY ENTRY POINT
SCNFIV: SKIPA T2,[POINT 5] ;SET FIVBIT SCAN MODE
SCNSIX: MOVSI T2,(POINT 6) ;SET SIXBIT BYTE POINTER
AOJA T2,SCNCON ;SET BYTE POINTER TO T1 ADDRESS
SCNOCT: SKIPA T2,[10] ;SET OCTAL SCAN MODE
SCNDEC: MOVEI T2,12 ;SET DECIMAL SCAN MODE
SCNCON: SETZ T1, ;CLEAR THE OUTPUT WORD
JUMPL P2,SCNSI0 ;CHECK FOR MEMORY SCAN(DIALOG)
;**; [706] @SCNCON + 2 SJW 16-SEP-77
;**; [717] @ SCNCON + 2 SJW 27-OCT-77
TLNE G1,-1 ;[717][706][217] IS G1 ALREADY A BYTE PTR?
JRST SCNSI1 ;[717]
HRLI G1,(POINT 7) ;NO - MAKE G1 A BYTE POINTER
MOVEI G4,^D6 ;[217] ASSUME SINGLE PRECISION (5 CHAR+NULL)
CAIE T5,TP%DOR ;CHECK FOR DOUBLE PRECISION
CAIN T5,TP%COM ;OR COMPLEX VARIABLE
MOVEI G4,^D11 ;[217] YES, DOUBLE PRECISION (10 CHAR + NULL)
CAIN T5,TP%LIT ;[217] CHECK FOR STRING VARIABLE
SCNSI0: SETO G4, ;[217] ALLOW INFINITE STRING
SCNSI1: SOJE G4,SCNSIZ ;END OF ALLOWABLE CHARACTER COUNT
JUMPGE P2,SCNSI8 ;G1=ARGUMENT ADDR FOR OPEN STATEMENT
; OR A POINTER TO THE DIALOG BLOCK (DIALOG)
TLNE P3,IO.EOL ;AT END OF LINE
;**[701] @SCNSI1 + 3 ETC SJW 11-SEP-77
SCNSIN: PUSHJ P,NXTLNI ;[701] YES, GET THE NEXT INPUT LINE
JSP P1,IBYTE. ;GET AN INPUT CHARACTER
TLNE P3,IO.EOF ;[701] IF EOF EVER GETS HERE
JRST SCNDON ;[701] TREAT EOF AS ALT
TLNE P3,IO.EOL ;[701] CRLF SEEN ?
JRST SCNSIN ;[701] YES: GET NEXT LINE
CAIE T0,176 ;CHECK FOR THE ALT MODES
CAIN T0,175 ;AGAIN
MOVEI T0,33 ;REPLACE WITH STANDARD ALT MODE
CAIE T0,33 ;IS THIS AN ALTMODE
JRST SCNSI9 ;NO CONTINUE
SCNDON: TLNE P3,IO.TTY!IO.TTA;[701] TTY TYPE DEVICE
OUTSTR [ASCIZ /
/] ;[342] TYPE CR-LF
SCNSIZ: TDZA T0,T0 ;CLEAR OUT THE CHARACTER
SCNSI8: ILDB T0,G1 ;LOAD ASCII CHARACTER (OPEN ARGS)
SCNSI9: JUMPE T0,SCNSI7 ;QUIT ON A NULL
TRC T0,140 ;INVERT CONTROL AND SHIFT BITS
TRNN T0,140 ;LOWER CASE ALPHA CHARACTER
IORI T0,40 ;YES, SET TO UPPER CASE
ANDCMI T0,100 ;SET TO SIXBIT AND CLEAR HIGH ORDER BIT
CAIL T0,'0' ;CHECK FOR CHARACTER RANGE
CAILE T0,'Z' ;IS THE A ALPHA NUMBERIC CHARACTER
JRST SCNSI2 ;NO, CHECK FOR DELIMITER
CAIGE T0,'A' ;CHECK FOR ALPHA CHARACTER
CAIG T0,'9' ;CHECK FOR NUMBERIC
JRST SCNSI3 ;YES ALPHA NUMBERIC CHARACTER
SCNSI2: JUMPN T0,SCNSI5 ;CHECK FOR A BLANK CHARACTER
TLNE P2,OP.DIA ;[452] IN DIALOG MODE?
JRST SCNSI5 ;[452] YES,STOP ON BLANKS
JUMPE T1,SCNSI1 ;DIGIT, IGNORE LEADING BLANKS
TLNE T2,-1 ;BLANK, CHECK FOR DIGIT OR ALPHA MODE
JRST SCNSI1 ;ALHA-DIALOG, IGNORE BLANKS ALWAYS
SCNSI5: CAILE T0,'Z' ;IS DELIMITER IN THE 7X GROUP
ANDCMI T0,50 ;YES PUT IN THE 2X GROUP
SCNSI7: MOVSI T2,400000 ;MAKE A 1 BIT FLAG FOR THE DELIMITER
SCNSI4: MOVN T3,T0 ;SET THE SHIFT COUNT
LSH T2,(T3) ;SET THE FLAG FOR THE DELIMITER
POPJ P, ;RETURN TO CALLER
SCNSI3: TLNN T2,-1 ;CHECK FOR DIGIT MODE
JRST SCNSI6 ;[217] YES, GO TO DIGIT ROUTINE
TLNE T2,760000 ;[217] ALPHA/DIGIT ANY ROOM FOR OUTPUT
IDPB T0,T2 ;YES, DEPOSITE BYTE
JRST SCNSI1 ;RETURN FOR NEXT
SCNSI6: CAIL T0,+20(T2) ;[217] IS DIGIT IN RANGE (OCTAL/DECIMAL)
JRST SCNDLM ;[237] RETURN IMPOSSIBLE DELIMITER
IMULI T1,(T2) ;IN RANGE MAKE ROOM FOR NEW DIGIT
ANDI T0,17 ;MAKE A BINARY DIGIT
ADD T1,T0 ;ACCUMULATE THE SUM
JRST SCNSI1 ;RETURN FOR NEXT DIGIT
PAGE
SUBTTL GENERAL ROUTINES TO SET,CLEAR AND SEARCH TABLES
;ROUTINE TO SEARCH THE FORTRAN LOGICAL UNIT TABLE AND RETURN IN
;(P3) THE CHANNEL CONTROL WORD.
;(L) AOBX POINTER -N,,ARGLST NEW CALLS
; 0,,ARGLST FOR VERSION 1 CALLS
SRCFLU: SETZ T3, ;CLEAR THE ERROR RETURN ADDRESS
PUSH P,P1 ;SAVE THE RETURN ADDRESS
JSP P1,EFCTV. ;[265] GET THE EFFECTIVE ADDRESS OF THE FLU
MOVSI T2,740 ;[247] IMMEDIATE MODE
TDNE T2,0(L) ;[247] CONSTANT?
JSP P1,RELOC% ;[247] NO - GET ACTUAL VALUE
MOVEI G2,(G1) ;SAVE THE FLU IN G2
IFN %V1,<
HLRZ T2,(L) ;GET THE OLD COUNT FIELD
LSH T2,-^D9 ;BITS 0-8 ONLY
JUMPN T2,SRCFL3 ;NEW CALL, CONTINUE BELOW
>
HLL L,-1(L) ;GET THE NEGATIVE ARG COUNT
AOBJP L,SRCFL3 ;END = ADDRESS
JSP P1,EFCTV. ;[265] GET THE ADDRESS
MOVEI T3,(G1) ;PUT IN THE RIGHT HALF
AOBJP L,SRCFL3 ;ERR= ADDRESS
JSP P1,EFCTV. ;[265] GET THE ADDRESS
HRLI T3,(G1) ;PUT IN THE LEFT HALF
SRCFL3: MOVEM T3,ERR.PC(P4) ;STORE THE RETURN ADDRESS
HRRZI T1,6(G2) ;CONVERT TO A POSITIVE FLU
JUMPN T1,SRCFL0 ;NOT A REREAD DEVICE
SKIPE P3,RER.SV(P4) ;[267] IS THERE A REREAD DEVICE
TLNE P3,IO.EOF ;[267] END OF FILE DETECTED
ERROR (DAT,12,10) ;[267] NO REREAD DEV. OR EOF
;[267] EXIT WITH MESSAGE
AOS (P) ;SET SKIP RETURN
MOVE G3,DD.STS(P3) ;GET THE DEVICE STATUS
PJRST BSREAD ;BACK UP A RECORD
SRCFL0: CAIE T1,6 ;[254] UNIT 0 SPECIFIED?
CAILE T1,FLU.MX+6 ;IS THE FLU IN RANGE
ERROR (OPN,13,10,) ;NO, DIE
SRCFL1: POP P,P1 ;RESTORE THE RETURN ADDRESS
IDIVI T1,^D6 ;YES, SIX ENTRIES /WORD
IMULI T2,^D6 ;NUMBER OF BITS LEFT
ROT T2,-^D6 ;POSITION FOR THE BYTE POINTER
IOR T2,[POINT 6,FLU.TB(P4),35];SET THE SIZE FIELD
ADDI T2,(T1) ;POINT TO THE WORD ENTRY
LDB T1,T2 ;LOAD THE CHANNEL INDEX
MOVEM T2,FLU.BP(P4) ;SAVE THE BYTE POINTER
ADDI T1,CHN.TB(P4) ;SET THE OFFSET FOR CHANNEL CONTROL WD
SKIPE P3,(T1) ;SETUP THE I/O REG
JRST 1(P1) ;CHANNEL ASSIGNED T1=STATIC CORE POINTER
JRST (P1) ;CHANNEL NOT ASSIGNED P3=0
FLUSIX: ;CONVERT FORTRAN LOGICAL UNIT TO SIXBIT
IDIVI T1,12 ;SEPERATE UNITS POSITION INTO T2
LSH T1,6 ;SHIFT TWO OCTAL DIGITS
ADDI T1,2020(T2) ;CONVERT TO SIXBIT IN T1
LSHC T1,-^D12 ;PUT SIXBIT FLU LEFT HALF ON T2
JRST (P1) ;RETURN T1=JUNK, T2=FLU IN SIXBIT
FILDFT: SKIPE T1,DD.NAM(P3) ;IS THERE A FILE NAME
POPJ P, ;YES, RETURN
HRRE T1,DD.UNT(P3) ;GET THE FORTRAN LOGICAL UNIT NUMBER
JUMPGE T1,.+2 ;JUMP IF A +FLU
SKIPA T2,DEVTB.(T1) ;NO GET THE DEVICE NAME FOR A FILE NAME
JSP P1,FLUSIX ;CONVERT TO SIXBIT
MOVSI T1,(SIXBIT/FOR/);SET UP T1 WITH DEFAULT FILE NAME
HLR T1,T2 ; AS FORXXX XXX=FLU
MOVEM T1,DD.NAM(P3) ;PUT FILE NAME IN DD.BLK
EXTDFT: SKIPE T1,DD.EXT(P3) ;IS THERE AN EXTENSION
POPJ P, ;YES, RETURN
MOVSI T1,(SIXBIT /DAT/);NO, USE DAT AS A DEFAULT
MOVEM T1,DD.EXT(P3) ;PUT EXTENSION IN DD.BLK
POPJ P, ;RETURN
SIXBIT /ALCHN./ ;SUBROUTINE NAME FOR TRACE
ALCHN%: PUSHJ P,SAVE. ;USER'S ENTRY TO GET A CHANNEL
JSP P1,EFCTV. ;[265] GET THE USERS ADDRESS
TRNN G1,-20 ;AC ARGUMENT
ADDI G1,ACC.SV(P4) ;YES, RELOCATE
;**; [551] INSERT @ ALCHN% + 3 1/2 CLRH 8-JUN-76
SKIPGE (G1) ;[551] REQUESTED CAHNNEL OK ?
JRST ALCHN1 ;[551] NEGATIVE -- ERROR RETURN
SKIPN T1,(G1) ;IS THERE A USER'S ARGUMENT
JSP P1,GT.CHN ;[265] NEW GET AN AVAILABLE CHANNEL
JFCL ;NO CHANNELS (GET THE ERROR LATER)
CAILE T1,17 ;MUST BE IN RANGE 1-17
JRST ALCHN1 ;ERROR RETURN AC0=-1
ADDI T1,CHN.TB(P4) ;POINT TO THE CHANNEL TABLE
SKIPE (T1) ;IS THE CHANNEL AVAILABLE
JRST ALCHN1 ;NO ERROR
SETOM (T1) ;YES, IN USE BY THE USER
SUBI T1,CHN.TB(P4) ;GET THE CHANNEL NUMBER BACK
ALCHN2: HRRZM T1,ACC.SV+T0(P4);STORE THE CHANNEL NUMBER
POPJ P, ;RETURN TO THE CALLER
ALCHN1: SETOB T1,ACC.SV+T0(P4);[214] NO CHANNELS AVAILABLE
POPJ P, ;[214] RETURN ERROR INDICATION
GT.CHN:: ;[265] FOROTS ENTRY TO ALLOCATE A CHANNEL
MOVSI T1,-17 ;SET CHANNEL SEARCH COUNT
HRRI T1,CHN.TB+1(P4) ;SET SOFTWARE CHANNEL ORGIN
SKIPE (T1) ;IS THIS CHANNEL AVAILABLE
AOBJN T1,.-1 ;END OF SEARCH ..... NO CHANNEL
JUMPGE T1,(P1) ;JUMP IF NO CHANNEL AVAILABLE
ANDI T1,-1 ;CLEAR THE LEFT HALF
SUBI T1,CHN.TB(P4) ;RELOACTE T1 TO CHANNEL NUMBER
JRST 1(P1) ;RETURN TO CALLER
SIXBIT /DECHN./ ;SUBROUTINE NAME FOR TRACE
DECHN%: PUSHJ P,SAVE. ;USER'S ENTRY TO RELEASE A CHANNEL
JSP P1,EFCTV. ;[265] GET THE ARGUMENT ADDRESS
TRNN G1,-20 ;AC ARGUMENT
ADDI G1,ACC.SV(P4) ;YES, RELOCATE
SKIPLE T1,(G1) ;LESS THAN OR EQUAL ZERO
CAILE T1,17 ;MUST BE BETWEEN 1-17
JRST ALCHN1 ;ERROR RETURN
ADDI T1,CHN.TB(P4) ;RELOCATE TO THE CHANNEL TABLE
SETCM T0,(T1) ;WAS THIS A USER'S CHANNEL
JUMPN T0,ALCHN1 ;NO, ERROR RETRUN
SETZB T1,(T1) ;[214] CLEAR CHANNEL ENTRY
JRST ALCHN2 ;RETURN AC0 = 0
PUTCHN: ;FOROTS ENTRY TO RELEASE A CHANNEL
ADDI T1,CHN.TB(P4) ;RELOACTE TO CHANNEL TABLE
SETZM (T1) ;CLEAR THE CHANNEL ENTRY
JRST (P1) ;RETURN
GETDV.: ;GET THE PHYSICAL DEVICE AND CHARASTICS
;T1 = SIXBIT DEVICE NAME
;OR THE FORTRAN LOGCIAL UNIT NUMBER
;RETURN
;G3 = DEVCHR BITS
;G2 = PHYSICAL DEVICE NAME
;G1 = LOGICAL DEVICE NAME
TLNE T1,-1 ;IS THIS A FLU
JRST GETDV2 ;NO, A LOGICAL DEVICE NAME
HRRES T3,T1 ;GET THE SIGN FOR DEFAULT DEVICES
JUMPL T1,GETDV1 ;IS THIS A NEGATIVE DEFAULT
JSP P1,FLUSIX ;CONVERT FLU TO SIXBIT
TLNN T2,170000 ;IS THE FLU LESS THAN 10
LSH T2,6 ;YES KILL THE LEADING ZERO
MOVE G3,T2 ;GET THE FLU FOR A LOGICAL DEVICE CHECK
MOVE G1,T2 ;SET UP DEVICE NAME FOR PHYSICAL NAME
DEVCHR G3, ;GET THE DEVICE CHARASTICS
JUMPN G3,GETDV3 ;THE DEVICE IS A LOGICAL NAME
GETDV1: CAIG T3,DEV.SZ ;IS THE FLU IN THE TABLE RANGE
SKIPN G1,DEVTB.(T3) ;GET THE DEVICE NAME
MOVSI G1,(SIXBIT /DSK/) ;NOT IN RANGE OR ZERO ENTRY
JRST .+2 ;CONTINUE
GETDV2: MOVE G1,T1 ;SET UP FOR A DEVCHR UUO
MOVE G3,G1 ;SET UP THE PHYSICAL NAME UUO
DEVCHR G3, ;GET THE DEVICE BITS IN G3
GETDV3: MOVE G2,G1 ;GET THE DEVICE NAME
;**; [634] DELETE TWO LINES AT GETDV3+1 CLRH 22-DEC-76
;[634] DEVNAM G2, ;GET THE PHYSICAL DEVICE NAME
;[634] JFCL ;IGNORE THE ERROR RETURN
POPJ P, ;RETURN
EFCTV.:: ;[265]
MOVE G1,(L) ;GET THE ARGUMENT POINTED TO BY (L)
EFCTV1: HLRZ T1,G1 ;GET THE INDEX AND INDIRECT BITS
ANDI T1,17 ;SAVE THE INDEX BITS
JUMPE T1,EFCTV2 ;NO INDEXING
ADDI T1,ACC.SV(P4) ;RELOCATE TO THE SAVE AREA
HRRZ T1,(T1) ;GET THE CONTENTS ON THE INDEX REG
ADDI G1,(T1) ;GET THE NEW EFFECTIVE ADDRESS
EFCTV2: TLZ G1,777757 ;CLEAR ALL EXCEPT THE INDIRECT BIT
TLZN G1,20 ;INDIRECT BIT ON
JRST (P1) ;NO G1 IS THE EFFECTIVE ADDRESS
TRNN G1,-20 ;IN THE AC SAVE AREA
ADDI G1,ACC.SV(P4) ;YES,RELOCATE
MOVE G1,(G1) ;YES, GO COMPUTE A NEW EFFECTIVE ADDRESS
JRST EFCTV1 ;DO IT AGAIN
;ROUTINE TO COMPUT A FOLDED CHECKSUM IN T1
;THE WORD TO BE CHECK SUMMED IS IN G3
;THE FOLDED CHECK SUM IS RETRUN IN T1 BITS( 27-35) 9 BITS
IFN CHKSUM,<
CHKSM.: HLRZ T1,G3 ;GET THE HIGH ORDER 18 BITS
XORB T1,G3 ;CHECK SUM THE HIGH AND LOW ORDER
LSH T1,-^D9 ;POSITION FOR A 9 BIT CHACKSUM
XOR T1,G3 ;GET THE 9 BIT CHECKSUM
ANDI T1,777 ;SAVE ONLY NINE BITS
JRST (P1) ;RETURN
>
PAGE
SUBTTL INBYTE GENERAL INPUT ROUTINES
INTERNAL IBYTE.,IBLOK.,IPEEK.
IPEEK.: TLNE P3,IO.EOF ;[431] EOF ALREADY
JRST IBYTE2 ;[431] YES, NO SENSE CONTINUING
SKIPG DD.HRI+2(P3) ;PEEK AT NEXT CHARACTER ANY LEFT
PUSHJ P,IBLOK. ;NO, GET NEXT BLOCK
TLNE P3,IO.EOF ;DID PEEK CAUSE AN EOF
JRST IBYTE2 ;YES, RETURN A BLANK
MOVE T0,DD.HRI+1(P3) ;GET THE BYTE POINTER
ILDB T0,T0 ;PEEK AT THE NEXT CHARACTER
JUMPN T0,(P1) ;RETURN WITH T0 = PEEKED CHARACTER
IBP DD.HRI+1(P3) ;SKIP THE NULL
SOS DD.HRI+2(P3) ;ACCOUNT FOR THE CHARACTER POS.
JRST IPEEK. ;TRY AGAIN
IBYTE.:
TLNE P3,IO.EOL!IO.EOF ;CHECK FOR END OF LINE
JRST IBYTE2 ;[244] YES, RETURN A BLANK
SKIPG DD.HRI+2(P3) ;REDUCE INPUT BYTE COUNT
PUSHJ P,IBLOK. ;NONE LEFT , GET A BUFFER
TLNE P3,IO.EOL!IO.EOF;[177] END OF FILE OR END OF CHUNK
JRST IBYTE2 ;[177] STOP THE INPUT
IBYTE0: SOS DD.HRI+2(P3) ;COUNT THIS DATA ITEM
TLNE P3,IO.FMT ;IS THIS FORMATED I/O
JRST IBYTE1 ;YES, DO THE ILDB
AOS DD.HRI+1(P3) ;NO, UPDATE THE BYTE POINTER
MOVE T0,@DD.HRI+1(P3);GET THE DATA ITEM
JRST (P1) ;RETURN
IBYTE1: ILDB T0,DD.HRI+1(P3) ;GET INPUT CHARACTER
JUMPE T0,IBYTE. ;IGNORE NULL CHARACTERS
CAIN T0,15 ;CHECK FOR A CARRAGE RETURN
JRST IBYTE. ;YES, IGNORE ALL CR'S
CAIG T0,15 ;CHECK FOR A LINE TERMINATOR CHACTER
CAIGE T0,12 ;VT, FF, LF
JRST (P1) ;NO, RETURN DATA CHARACTER
IBYTE2: MOVE T0,DD.HRI+1(P3) ;[414] GET THIS LINE INITIAL POSITION
MOVEM T0,POS.TB+1(P4) ;[414] SAVE IT IN CASE OF ERROR
TLO P3,IO.EOL ;YES SET END OF LINE FLAG
MOVEI T0," " ;[244] SET UP A BLANK FOR RETURN
JRST (P1) ;RETURN TO CALLER
IBLOK.: TLNE P3,IO.STR!IO.EDC;CHECK FOR A STRING
JRST IBLOKS ;YES, (SKIP UUO PROCESS)
TLNE P3,IO.TTA ;USER'S TTY
JRST IBLOK2 ;YES, USE A TTCALL
AOS DD.BLK(P3) ;COUNT THIS BLOCK
IBLOK0: HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T0,(IN) ;SETUP AN INPUT UUO
TLZE P3,IO.RNG ;CHANGING RINGS
HRR T0,DD.HRI(P3) ;GET THE NEW RING ADDRESS
XCT T0 ;EXECUTE THE UUO
POPJ P, ;GET THE NEXT CHARACTER FROM THE BLOCK
ERROR (DEV,0,5,IBLOK1);DO THE ERROR PROCESSING
IBLOK1: TLO P3,IO.EOL!IO.EOF;SET END OF LINE
POPJ P, ;RETURN
IBLOK2: PUSH P,T1 ;SAVE T1
IBLOK6: HRRZS T1,DD.HRI(P3) ;[177] GET THE BUFFER ADDRESS CLEAR USE BIT
AOSN -1(T1) ;END OF FILE SET LAST TIME (-1)
ERROR (DEV,4,5,IBLKT0);[307] CALL THE ERROR ROUTINE
TLNE P3,IO.EOF ;[307] EOF SEEN ALREADY?
JRST IBLOKT ;[307] YES- SET END OF LINE
HRLI T1,440700 ;SET UP AN ASCII BYTE POINTER
ADDI T1,2 ;POINT TO DATA
SETZM POS.TB+1(P4) ;[226] CLEAR INITIAL LINE POSITION
MOVEM T1,DD.HRI+1(P3) ;SET BYTE POINTER IN RING BUFFER
PUSH P,T2 ;SAVE AC 2
;**; [530] CHANGE @ IBLOK6 + 10L CLRH 31-MAR-76
MOVSI T2,-<<STRCNK*5>-1> ;[530] CLEAR THE BYTE COUNT
IBLOK3: INCHWL T0 ;[502] WAIT FOR A CHARACTER
IBLOK4: CAIN T0,32 ;^Z FOR EOF
JRST [MOVE T1,DD.HRI(P3) ;GET THE RING ADDRESS
SETOM -1(T1) ;SET EOF FLAG
TRNE T2,-1 ;[177] ANY CHARACTERS INPUT
JRST IBLOK5 ;YES, EXIT WITH EOF SET
POP P,T2 ;[177] REMOVE THE NULL ITEM COUNT
JRST IBLOK6] ;[177] CALL THE EOF ROUTINE
IDPB T0,T1 ;STORE CHARACTER IN BUFFER
AOBJP T2,IBLOK5 ;ANY ROOM LEFT .... NO
;**; [545] IBLOK4 + 8 1/2 L CLRH 12-MAY-76
CAIE T0,176 ; [545] NON-STANDARD ALTMODE ?
CAIN T0,175 ; [545]
MOVEI T0,33 ; [545] YES, USE STANDARD ONE
CAIN T0,33 ; [545] ALTMODE ?
JRST IBLOK5 ; [545] YES
CAIG T0,14 ;CHECK FOR A TERMINATOR
CAIGE T0,12 ;(LF,VT,FF)
JRST IBLOK3 ;GET THE NEXT CHARACTER
IBLOK5: HRRZM T2,DD.HRI+2(P3) ;YES, SAVE THE CHARACTER COUNT
TPOPJ2: POP P,T2 ;[353] RESTORE AC 2
TPOPJ: POP P,T1 ;RESTORE T1
CPOPJ: POPJ P, ;RETURN
IBLOKS: ;STRING INPUT
TLNE P3,IO.EDC ;ENCODE/DECODE REQUEST
JRST IBLOK1 ;SET THE END OF ARRAY FLAGS
PUSH P,T1 ;GET A TEMP
HRRZ T1,DD.HRI(P3) ;GET THE CURRENT CHUNK ADDRESS
HRRZ T1,(T1) ;GET THE NEXT ADDRESS
JUMPE T1,IBLOKT ;[177] SET END OF LINE ETC
;END OF STRING
HRLI T1,(POINT 7,0,34);ASCII BYTE POINTER
HRRM T1,DD.HRI(P3) ;STORE THE CURRENT CHUNK
MOVEM T1,DD.HRI+1(P3) ;STORE THE BYTE POINTER
MOVEI T1,STRCNK*5 ;CHARACTER COUNT
MOVEM T1,DD.HRI+2(P3) ;STORE
PJRST TPOPJ ;RESTORE T1 AND RETURN
IBLKT0: TLO P3,IO.EOF ;[307] SET EOF SEEN
IBLOKT: TLO P3,IO.EOL ;[177] SET END OF LINE
PJRST TPOPJ ;[177] RETURN
PAGE
SUBTTL END OF FORMATED LINE ROUTINES
;ADVANCE TO THE END OF THE CURRENT INPUT LINE
INTERNAL NXTLN.,ENDLN. ;[325]
NXTLN.:
NXTLNI: TLNE P3,IO.EDC ;ENDCODE/DECODE REQUEST
JRST NXTENC ;PROCESS SEPERATE
PUSHJ P,ENDLN. ;FINISH UP THE CURRENT LINE
;**; [530] INSERT @ NXTLNI + 2 1/2 CLRH 2-APR-76
TLNE P3,IO.STR ;[530] STRING REQUIRED?
PUSHJ P,SETSTR ;[530] YES, SET ONE UP
JUMPO NXTLN2 ;JUMP ON OUTPUT
JSP P1,IPEEK. ;PEEK AT THE NEXT CHARACTER
CAIG T0,14 ;IGNORE VT,FF,LF IN THE POS FIELD
CAIGE T0,12 ;IS THIS THE END OF THE POS FIELD
TLZA P3,IO.EOL ;YES, CLEAR EOL
NXTLN1: SOJA P1,IBYTE0 ;NO, EAT NEXT CHARACTER AND RETURN TO PEEK
;**; [530] DELETE @ NXTLN2 CLRH 2-APR-76
NXTLN2: POPJ P, ;POSITIONNED AT NEXT INPUT LINE
ENDLN.: SETZM CH.SAV(P4) ;[354] CLEAR SAVED DELIMITER
TLNN P3,IO.STR ;IS THIS A STRING
JRST ENDLN1 ;NO
;**;[650] CHANGE AT ENDLN.+3 SWG 21-MAR-77
PUSHJ P,DMPST. ;[650]YES, DUMP THE STRING
JUMPO .+2 ;CHECK IF OUTPUT
TLOA P3,IO.EOL ;INPUT SET EOL AND EXIT
PUSHJ P,ENDLN1 ;DO END OF LINE
TLO P3,IO.STR ;TURN THE STRING FLAG ON
POPJ P, ;RETURN
ENDLN1: JUMPO ENDLNO ;FINISH UP THE CURRENT LINE
ENDLNI: ;FINISH OF THE CURRENT INPUT LINE
JSP P1,IBYTE. ;EAT THE NEXT CHARACTER
TLNN P3,IO.EOL!IO.EOF;CHECK FOR END OF LINE FLAG
PJSP IBYTE. ;NO,EAT ANOTHER RETURN AT (.-1)
POPJ P, ;AT THE END OF THE CURRENT LINE OF INPUT
ENDLNO:
NXTLNO: TLNE P3,IO.INT ;OUTPUT, INTERACTIVE DEVICE?
PUSHJ P,OBLOK. ;YES, DUMP THE BUFFER
MOVEI T0,15 ;GET A CARRAGE RETURN
TLC P2,FT.FIN!FT.DOL;COMPLEMENT LAST RIGHT PAREN AND DOL FLAG
TLCN P2,FT.FIN!FT.DOL;IF BOTH ON SKIP THE CR AND RESTORE THE FLAGS
;**; [661] DELETE + INSERT @ NXTLNO+5 SWG 11-JUL-77
JRST NXTO1 ;[661] SKIP CR AND LF
JSP P1,OBYTEC ;OUTPUT THE CARRAGE RETURN
MOVEI T0,12 ;GET A LINE FEED
JSP P1,OBYTEC ;OUTPUT THE LINE FEED
;(THIS LINE FEED MAY BE CHANGED BY THE
; BY THE FORMAT CARRAGE CONTROL ROUTINE)
NXTO1: TLNE P3,IO.CCC ;[567]CHECK FOR FORMATTED OUTPUT
JRST NXTLNF ;WORD BOUNDRY NOT REQUIRED
MOVSI T0,760000 ;SET UP A BYTE POINTER MASK AND A
;PSEUDO NULL IN THE RIGHT
SKIPE DD.LOG(P3) ;FIXED LENGTH RECORDS
;**;[457] Insert @ ENDLNO+17L DPL
SKIPG POS.TB(P4) ;[457] FULL RECORD ALREADY
JRST .+5 ;[457] YES
TLZE P3,IO.EOL ;YES, AT END OF LINE
JRST .+3 ;YES, GO FILL OUT LAST WORD
JSP P1,OBYTE. ;NO, OUTPUT THE NULL
JRST .-3 ;CONTINUE UNTIL END OF FIXED RECORD
TDNN T0,DD.HRO+1(P3) ;MUST FILL OUT THE LAST WORD
JRST .+3 ;WORD FILLED OUT
JSP P1,OBYTEC ;OUTPUT A NULL
JRST .-3 ;CONTINUE FILLING
TSOA T0,DD.LOG(P3) ;GET THE LOGCIAL RECORD SIZE
NXTLNF: MOVEI T0,1 ;SET A FORMAT FLAG
HRRZM T0,POS.TB(P4) ;STORE IN THE POSITION TABLE
;**; [570] INSERT @ NXTLNF+1 1/2 CLRH 27-JUL-76
TLZ P3,IO.EOL ;[570] CLEAR END OF LINE FLAG
POPJ P, ;RETURN (AT END OF CURRENT OUTPUT)
NXTENC: ;END OF RECORD FOR ENCODE/DECODE
MOVEI T1,DD.HRI(P3) ;INPUT HEADER
JUMPI .+2 ;JUMP ON INPUT
MOVEI T1,DD.HRO(P3) ;OUTPUT HEADER
MOVEI P1,.+1 ;SET UP A RETURN FROM THE BYTE ROUTINE
NXTEN1: MOVSI T0,760000 ;SET UP AN END OF WORD MASK
TLNN P3,IO.EOL ;RETURN IF EOL SET
TDNN T0,1(T1) ;ON A WORD BOUNDRY
POPJ P, ;RETURN
JUMPI IBYTE. ;SKIP A CHARACTER
HRRI T0," " ;FILL WITH BLANKS
JUMPO OBYTE. ;OUTPUT A FILL CHARACTER
PAGE
SUBTTL OUT BYTE GENERAL OUTPUT ROUTINES
INTERNAL OBYTE.,OBLOK.
OBYTE.: TLNE P3,IO.EOL ;CHECK FOR END OF LOGICAL FIXED RECORD
JRST (P1) ;YES, CAN NOT OUTPUT CHARACTER
TLNE P3,IO.STR ;OUTPUT TO AN INCORE STRIN
JRST OBYTEC ;YES, DON'T COUNT
SOSN POS.TB(P4) ;COUNT THIS ITEM IN THE HORIZ. POS
PJRST OUTCCC ;FIRST CHARACTER, CHECK FOR CARRIAGE CONTROL
OBYTEC: SKIPG DD.HRO+2(P3) ;CHECK FOR A FULL BUFFER
PUSHJ P,OBLOK. ;BUFFER IS FULL
SOS DD.HRO+2(P3) ;REDUCE THE ITEM COUNT
IDPB T0,DD.HRO+1(P3) ;PUT THE CHARACTER IN THE OUTPUT BUFFER
JRST (P1) ;RETURN
OBLOK.: TLNE P3,IO.STR!IO.EDC;CHECK FOR ENCODE/DECODE/STRING
JRST OBLOKS ;YES, (SKIP UUO)
PUSH P,T0 ;SAVE THE OUTPUT WORD
TLNE P3,IO.TTA ;USER'S TTY
JRST OBLOK2 ;YES, USE A TTCALL
TLNE P3,IO.RAN ;RANDOM ACCESS OUTPUT
JRST [PUSH P,P1 ;SAVE THE JSP RETURN
PUSHJ P,WBLOK. ;WRITE THIS BLOCK
AOS DD.BLK(P3) ;STEP TO THE NEXT BLOCK
HRRZ T0,DD.HRO(P3) ;GET THE OUTPUT HEADER ADDRESS
MOVEM T0,DD.HRI(P3) ;REUSE THE SAME BUFFER FOR INPUT
PUSHJ P,RBLOK. ;READ THE NEXT BLOCK
POP P,P1 ;RESTORE THE JSP POINTER
JRST OBLOK3] ;COMMON EXIT
AOS DD.BLK(P3) ;COUNT THIS BLOCK
OBLOK0: HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T0,(OUT) ;NO, BUFFERED OUTPUT
TLZE P3,IO.RNG ;CHANGING RINGS
HRR T0,DD.HRO(P3) ;GET THE NEW RING ADDRESS
XCT T0 ;OUTPUT THE BUFFER
PJRST OBLOK3 ;EXIT FROM BLOCK ROUTINE
ERROR (DEV,0,5,OBLOK1);DO THE ERROR REPORT
OBLOK1: TLO P3,IO.EOL ;SET END OF LING FLAG
JRST OBLOK3 ;RESTORE AND EXIT
OBLOK2: MOVSI T0,440700 ;SET AN ASCII BYTE POINTER
IDPB T0,DD.HRO+1(P3) ;SET A NULL AT THE END
HRR T0,DD.HRO(P3) ;GET THE BUFFER ADDRESS
ADDI T0,2 ;POINT TO DATA
MOVEM T0,DD.HRO+1(P3) ;SET IN RING HEADER
;**; [530] CHANGE @ OBLOK2 + 5L CLRH 31-MAR-76
MOVEI T0,<STRCNK*5>-1 ; [530] GET BUFFER SIZE IN CHARACTERS
MOVEM T0,DD.HRO+2(P3) ;SAVE IN RING HEADER
OUTSTR @DD.HRO+1(P3) ;OUTPUT THE STRING
OBLOK3: POP P,T0 ;RETORE THE OUTPUT WORD
POPJ P, ;RETURN
OBLOKS: TLNN P3,IO.STR ;STRING CALL
JRST [PUSH P,T0 ;SAVE AS T0
PJRST OBLOK1] ;EXIT WITH END OF ARRAY SET
;APPEND A NEW CHUNK TO THE STRING
ADD P,[XWD T5+1,T5+1] ;SAVE THE TEMPS
MOVEM T5,(P) ;SAVE T5
MOVEI T5,-<T5>(P) ;BLT THE ACS
BLT T5,-1(P) ;SAVE THE TEMPS
HRRZ T2,DD.HRO(P3) ;LOOK FOR A LINK
HRRZ T1,(T2) ;FOR THE NEXT CHUNK
JUMPN T1,OBLOK5 ;YES, DO NOT ALLOCATE A NEW LINK
MOVEI T0,STRCNK ;GET THE CHUNK SIZE
PUSHJ P,GMEM%% ;ALLOCATE FROM THE HEAP
MOVEI T1,-1(T1) ;GET THE LINK ADDRESS
MOVE T2,DD.HRO(P3) ;GET THE STRING LINKS
HRRM T1,(T2) ;LINK THE NEW CHUNK
OBLOK5: HRLI T1,(POINT 7,0,34);ASCII BYTE POINTER
HRRM T1,DD.HRO(P3) ;STORE THE CURRENT CHUNK
MOVEI T2,STRCNK*5 ;GET THE CHARACTER COUNT
DMOVEM T1,DD.HRO+1(P3) ;STORE BYTE POINTER AND CHARACTEK COUNT
MOVSI T5,-<T5>(P) ;SET UP BLT POINTER TO RESTRE THE TEMPS
BLT T5,T5 ;RESTORE
SUB P,[XWD T5+1,T5+1];ADJUST THE STACK POINTER
POPJ P, ;RETURN AND STORE THE CHARACTR
PAGE
SUBTTL CARRAGE CONTROL ROUTINES
OUTCCC: TLNN P3,IO.CCC ;FORMS CONTROL REQUIRED
JRST [TLO P3,IO.EOL ;SET END OF LINE FLAG
JRST OBYTEC] ;OUTPUT THIS CHARACTER
PUSH P,P1 ;SAVE THE RETURN ADDRESS(POPJ ED)
PUSH P,T0 ;SAVE THE CONTROL CHARACTER
;**; [661] INSERT @ OUTCCC+5 SWG 11-JUL-77
PUSH P,T1 ;[661] TO BE USED TO CHECK BEG OF BUFFER
; CHECK CHAR VALUE - INVALID CHAR TREATED AS BLANK
SUBI T0,"*" ;RELOCATE CONTROL CHARACTER FOR INDEXING
;**; [661] CHANGE @ OUTCCC+6 SWG 11-JUL-77
JUMPL T0,OUTCC6 ;[661] BLANK OR CHARACTER NOT IN RANGE
CAILE T0,"3"-"*" ;CHECK THE HIGH END
;**; [661] DEL & INSERT @ OUTCCC+8 SWG 11-JUL-77
OUTCC6: MOVEI T0,12 ;[661] BLANK OR OUTOF RANGE -TREAT AS BLANK
ADDI T0,CCC.TB ;POINT TO THE TABLE
MOVE T0,@T0 ;GET THE CONTROL CHARACTERS
ROT T0,5 ;GET THE LOW ORDER 4 BITS
;**; [661] DEL & INSERT @ OUTCCC+12 SWG 11-JUL-77
; EMPTY BUFFER CHECK - DIFFERENT FOR TTY AND OTHER
TLNN P3,IO.TTA ;[661] USERS TELETYPE?
JRST OUTCC8 ;[661] NO
SKIPGE DD.HRO+1(P3) ;[661] DIFFERENT TEST FOR EMPTY
JRST OUTCCB ;[661] TTY BUFFER EMPTY
JRST OUTCC5 ;[661] NOT EMPTY - CHECK LAST CHAR
OUTCC8: HRRZ T1,DD.HRO+1(P3) ;[661] PICK UP BYTE POINTER
SUBI T1,1 ;[661] WANT TO CHECK AGAINST BUFFER PTR
;[661] IF BYTE POINTER IS 1 GTR
;[661] THEN BUFFER IS EMPTY
CAIE T1,@DD.HRO(P3) ;[661] EQUAL NOW?
SKIPA ;[661] NO - LOOK AT LAST CHAR
JRST OUTCCB ;[661] YES - NOTHING TO OVERWRITE
; NON-EMPTY BUFFER -CHECK IF LAST CHARACTER OUPUT WAS A LINE FEED
OUTCC5: LDB T1,DD.HRO+1(P3) ;[661] LETS LOOK AT LAST CHAR
CAIN T1,12 ;[661] IS IT LF?
JRST OUTCCA ;[661] YES
;BUFFER IS EMPTY OR LAST CHAR NOT LINE FEED
OUTCCB: SKIPE T0 ;[661] '+'? (0 FROM TABLE ENTRY)
JRST OUTCC3 ;[661] NO -DO OBYTE
JRST OUTCC2 ;[661] YES - DO NOTHING
;LAST CHAR WAS LINE FEED - DO NOTHING IF CC = BLANK
OUTCCA: CAIN T0,12 ;[661] ' '? (IF SO ROTATED WORD
;[661] FROM TABLE WILL LOOK LIKE 0,,12)
JRST OUTCC2 ;[661] YES - DO NOTHING
SKIPE T0 ;[661] +? (0 FROM TABLE ENTRY)
JRST OUTCC0 ;[661] NO - OVERRIDE FROM TABLE
IBP DD.HRO+1(P3) ;[661] TO OVERWRITE LF WITH NEXT CHAR
IBP DD.HRO+1(P3) ;[661] 4 BYTES FORWARD AND
IBP DD.HRO+1(P3) ;[661] 1 WORD BACK = 1 BYTE BACK
IBP DD.HRO+1(P3) ;[661]
SOS DD.HRO+1(P3) ;[661]
AOS DD.HRO+2(P3) ;[661] RESET ITEM COUNT
JRST OUTCC2 ;[661] ALL DONE
; OUTPUT CHAR
OUTCC0: DPB T0,DD.HRO+1(P3) ;OVER RIDE THE PRECIOUS CHARACTER
OUTCC1: ANDCMI T0,177 ;CLEAR THE LAST CHARACTER
JUMPE T0,OUTCC2 ;NONE LEFT EXIT
ROT T0,5 ;GET THE NEXT CHARACTER
;**; [661] INSERT LABEL @ OUTCC1+3 SWG 11-JUL-77
OUTCC3: JSP P1,OBYTEC ;[661]OUTPUT THE CHARACTER AND ADVANCE
JRST OUTCC1 ;CHECK FOR MORE CHARACTER
;**; CHANGE @ OUTCC2 SWG 11-JUL-77
OUTCC2: POP P,T1 ;[661]
POP P,T0 ;RESTORE THE CHARACTER
POP P,P1 ;RESTORE THE JSP POINTER
JRST (P1) ;RETURN
CCC.TB: ;CARRAGE CONTROL CHARACTER CONVERSION TABLES
BYTE (5)023(13)000 ;*;
BYTE (5)000(13)000 ;+;
BYTE (5)021(13)000 ;,;
BYTE (5)012(5)012(5)12(3)0 ;-;
BYTE (5)022(13)000 ;.;
BYTE (5)0024(13)000 ;/;
BYTE (5)012(5)012(8)000 ;0;
BYTE (5)014(13)000 ;1;
BYTE (5)020(13)000 ;2;
BYTE (5)013(13)000 ;3;
;**; INSERT NEW ENTRY TO CCC.TB+12 SWG 11-JUL-77
BYTE (5)012(13)000 ;[661] BLANK OR UNKNOWN
PAGE
SUBTTL INCORE STRING ROUTINES
;ACC USAGE DURING THE STRING COPY FUNCTIONS BELOW
; P= STACK POINTER
; L= NOT USED
; P4= LOW SEG POINTER
; P3= I/O REGISTER
; P2= NOT USED
; P1= JSP POINTER
; G4-G1 NOT USED
; T5= POINTER TO THE RING FOR PHYSICAL I/O
; T4= POINTER TO THE RING FOR STRING I/O
; T3= CHARACTER COUNT (BUILD A RING HEADER FOR STRING I/O)
; T2= BYTE POINTER " "
; T1= RING HEADER FOR STRINGS " "
; T0= CHARACTER REGISTER TO TRANSFER STRINGS
;**; [636] INSERT BEFORE SETSTR CLRH 7-JAN-77
;**;[650] CHANGE AT SETSTR-1 SWG 21-MAR-77
INTERNAL DMPST. ;[650][636] CALLED FROM FORERR (DAT7)
SETSTR:
MOVEI T0,STRCNK+3 ;GET THE STRING CHUNK SIZE (+RING HEADER)
PUSHJ P,GMEM%% ;ALLOCATE FROM THE HEAP
MOVEI T1,-1(T1) ;POINT TO THE LINK WORD
MOVEI T4,DD.HRO(P3) ;SAVE THE OUTPUT RING HEADER
JSP P1,STRRNG ;GO SET UP THE RING HEADERS
JUMPO SETST1 ;JUMP ON OUTPUT
TLZ P3,IO.STR ;CLEAR THE STRING FLAG
PUSHJ P,CPYSTR ;START THE COPY
HRLI T4,1(T1) ;[253] RESTORE
HRRI T4,DD.HRO(P3) ;[253] OUTPUT BUFFER
BLT T4,DD.HRO+2(P3) ;[253] RING HEADER
MOVSI T4,DD.HRI(P3) ;SAVE THE CURRENT INPUT HEADR
HRRI T4,1(T1) ;IN THE SAVE AREA
BLT T4,3(T1) ;SAVE IT
DMOVEM T1,DD.HRI(P3) ;REPACE WITH THE STRING POINTR
MOVEM T3,DD.HRI+2(P3) ;ETC
SETST1: TLO P3,IO.STR ;COMMON EXIT
POPJ P, ;EXIT
;**;[650] CHANGE LABEL DMPSTR TO DMPST. SWG 21-MAR-77
DMPST.: ;[650]ROUTINE TO DUMP STRINGS TO THE OUTPUT DEV
MOVEI T4,DD.HRI(P3) ;GET THE INPUT RING HEADER
JUMPI DMPST1 ;JUMP ON INPUT
HLRZ T1,DD.HRO(P3) ;GET THE FIRST CHUNK ADDRESS
MOVSI T2,1(T1) ;RESTORE THE OUTPUT RING HEADER
HRRI T2,DD.HRO(P3) ;FROM THE SAVE AREA
BLT T2,DD.HRO+2(P3) ;BLT
JSP P1,STRRNG ;SET UP THE RINGS
TLO P3,IO.STR ;SET THE STRING FLAG
PUSHJ P,CPYSTR ;COPY THE STRING TO THE DEVICE
DMPST1: ;REMOVE THE INPUT CHUNKS
HLRZ T1,(T4) ;GET THE STARTING CHUNK
MOVEI T5,(T4) ;GET THE HEADER ADDRESS
HRLI T5,1(T1) ;SET UP TO RESTORE THE RING HEADER
BLT T5,2(T4) ;RESTORE THE WITH THE ORGIONAL VALUE
TLZ P3,IO.STR ;CLEAR THE STRING BIT
MOVEI T1,1(T1) ;STEP PAST THE LINK WORD
PJRST PMEM%% ;RETURN THE HEAP SPACE
STRRNG: ;SET UP THE RING HEADERS
MOVEI T2,1(T1) ;SAVE THE RING HEADER
HRLI T2,(T4) ;SET UP THE BLT
BLT T2,3(T1) ;SAVE IT
HRLI T1,(T1) ;SET UP THE CONTROL WORDS
MOVEI T2,3(T1) ;SKIP THE HEADER
HRLI T2,(POINT 7,0,34);ASCII BYTE POINTER
MOVEI T3,STRCNK*5 ;AND THE CHARACTER COUNT
DMOVEM T1,(T4) ;STORE THE STRING HEADER FOR COPY
MOVEM T3,2(T4) ;AND THE CHARACTER COUNT
JRST (P1) ;RETURN
;**;[501] Insert @ CPYSTR JNG 23-Nov-75
CPYSTR: ;COPY DATA FROM THE INPUT TO OUTPUT
TLZ P3,IO.EOL ;[501] GET DATA FROM IBYTE.
CPYST1: JSP P1,IBYTE. ;[501] GET AN INPUT CHARACTER
;**; [530] CHANGE @ CPYST1 + 1 CLRH 31-MAR-76
TLZE P3,IO.EOL ; [530] END OF LINE ?
POPJ P, ; [530] YES, STOP THE COPY
TLNE P3,IO.EOF ; [530] END OF FILE ?
POPJ P, ; [530] YES, STOP THE COPY
TLC P3,IO.STR ;SET STRING FOR OUTPUT
JSP P1,OBYTE. ;OUTPUT
TLC P3,IO.STR ;COMPLEMENT
;**;[501] Change @ CPYSTR+7L JNG 23-Nov-75
JRST CPYST1 ;[501] CONTINUE
PAGE
SUBTTL FIND RANDOM ACCESS POSITIONING ROUTINES
SIXBIT /FIND./ ;NAME FOR TRACE
FIND%: ;ENTRY TO POSITION FOR THE NEXT RANDOM BLOCK
PUSHJ P,SAVE. ;SAVE THE USER'S AC'S
JSP P1,SRCFLU ;IS THE FLU DEFINED
POPJ P, ;NO, EXIT
MOVE G1,3(L) ;GET THE ASSOCATE VARIABLE ADDRESS
JSP P1,EFCTV1 ;GET THE EFFECTIVE ADDRESS
TRNN G1,-20 ;IN THE AC'S
ADDI G1,ACC.SV(P4) ;RELOCATE
MOVE T0,(G1) ;GET THE VALUE
MOVEM T0,DD.LIM(P3) ;[330] CURRENT LOGICAL RECORD
SKIPE T1,DD.ASC(P3) ;GET THE ASSOCIATE VARIABLE ADDRESS
MOVEM T0,(T1) ;STORE THE NEW VALUE
POPJ P, ;RETURN
FIND%%: JUMPGE P2,FIND6 ;JUMP ON INPUT
TLOE P3,IO.SOU ;ENTER BEEN DONE
JRST FIND6 ;YES, CONTINUE
LDB T1,[POINT 4,DD.BLK(P3),9];NO,GET THE ACCESS MODE
CAIE T1,ACC.RO ;RANDOM INPUT/OUTPUT
ERROR (OPN,2,10,) ;CAN NOT WRITE A READ ONLY FILE
JSP P1,ENTER. ;DO AN ENTER
ERROR (OPN,0,7,) ;CAN NOT ENTER
FIND6:
TLZ P3,IO.EOL!IO.EOF;[233] CLEAR EOL AND EOF
JSP P1,EFCTV1 ;GET THE ADDRESS
TRNN G1,-20 ;IN THE AC SAVE AREA
ADDI G1,ACC.SV(P4) ;YES, RELOCATE TO THE SAVE AREA
SKIPG T4,(G1) ;GET THE RECORD NUMBER
MOVEI T4,1 ;ILLEGAL RECORD NUMBERS GET A 1(ONE)
MOVEM T4,DD.LIM(P3) ;[330] CURRENT LOGICAL RECORD
SKIPE T1,DD.ASC(P3) ;GET THE ASSOCIATE VARIABLE ADDRESS
MOVEM T4,(T1) ;STORE THE CURRENT RECORD NUMBER
;UPDATED BY ("NXTLN.")
SUBI T4,1 ;START AT RELATIVE REOCRD 0
HRRZ T2,DD.LOG(P3) ;GET THE LOGICAL RECORD SIZE
IMULI T4,(T2) ;COMPUT THE NUMBER OF WORD FROM THE BOF.
IDIVI T4,200 ;GET THE BLOCK IN T4/ WORD IN T5
ADDI T4,1 ;BLOCK START AT 1 FOR FILSER
HRRZ T0,DD.BLK(P3) ;GET THE CURRENT BLOCK NUMBER
JUMPGE G4,[JUMPI FIND0 ;INPUT
JRST FIND00] ;OUTPUT
TLCE P3,IO.INO ;YES, OUTPUT LAST
FIND00: JUMPN T0,FIND3A ;NO INCORE BLOCKS
FIND0: CAILE T0,(T4) ;IS THE BLOCK CURRENT OR ADVANCING IN THE FILE
JRST FIND3 ;NO, BACKING UP
FIND1: SKIPA T1,DD.HRI(P3) ;GET THE INPUT HEADER
FIND2: HRRZI T1,(T2) ;STEP ALONG THE BUFFER CHAIN
SKIPL T2,(T1) ;GET THE BUFFER HEADER
JRST FIND3 ;NO, END OF ACTIVE BUFFERS
CAIN T0,(T4) ;IS THIS THE BLOCK WE WANT
JRST FIND5 ;YES, THIS IS THE BUFFER
TLZ T2,400000 ;CLEAR THE USE BIT
MOVEM T2,(T1) ;STORE THE BUFFER HEADER (USE=0)
AOJA T0,FIND2 ;NO, STEP TO THE NEXT BUFFER
FIND5: MOVEM T1,DD.HRI(P3) ;SET THIS AS THE CURRENT BUFFER
HRRM T4,DD.BLK(P3) ;STORE THE CURRENT BLOCK NUMBER
JRST FIND4 ;GO SET UP THE REST OF THE RING HEADER
FIND3A: PUSHJ P,WBLOK. ;GO DUMP THE INCORE BLOCK
FIND3: HRRM T4,DD.BLK(P3) ;SET UP THE BLOCK NUMBER
PUSHJ P,RBLOK. ;GET THE NEXT RANDOM BLOCK
HRRZ T1,DD.HRI(P3) ;GET THE CURRENT BUFFER
FIND4: MOVEM T1,DD.HRO(P3) ;SAVE IN THE OUTPUT RING HEADER
MOVE T2,1(T1) ;[233] LOAD BUFFER SIZE
SUBI T2,(T5) ;[233] MINUS THE WORDS SKIPPED
TLNE P3,IO.FMT ;[233] CHECK FOR ASCII I/O
IMULI T2,5 ;[233] CONVERT TO CHARACTERS
MOVEM T2,DD.HRI+2(P3) ;[233] SAVE IN THE INPUT RING HEADER
MOVEM T2,DD.HRO+2(P3) ;[233] AND THE OUTPUT RING HEADER
MOVEI T2,200 ;[233] LOAD DISK BUFFER SIZE
CAMN T2,1(T1) ;[233] FULL BUFFER?
JRST FIND7 ;[233] YES - OUTPUT COUNT IS RIGHT
;[233] RECOMPUTE OUTPUT COUNT
SUBI T2,0(T5) ;[233] COMPUTE WORDS REMAINING
TLNE P3,IO.FMT ;[233] FORMATTED I/O
IMULI T2,5 ;[233] CONVERT TO CHARACTERS
MOVEM T2,DD.HRO+2(P3) ;[233] RESET OUTPUT RING HEADER
FIND7: HLL T1,DD.HRI+1(P3) ;[233] GET THE BYTE INFO
TLZ T1,770000 ;[233] CLEAR THE POSITION FIELD
ADDI T1,1(T5) ;[233] POINT TO THE DATA WORD - 1
MOVEM T1,DD.HRI+1(P3) ;[233] STORE IN THE INPUT RING HEADER
MOVEM T1,DD.HRO+1(P3) ;[233] AND THE OUTPUT RING HEADER
TLNN P3,IO.FMT ;[427] CHECK FOR FORMATTED I/O
POPJ P, ;[427] NO, RETURN
JUMPO FINRET ;[424] JUMP ON OUTPUT
TLNE P3,IO.EOF ;[447] DID RBLOK. CAUSE EOF
JRST [POP P, ;[447] YES-SET UP RETURN TO USER
JRST FIN%%] ;[447] CLEAN UP FILE JUNK
SETZB T2,T2 ;[424] CLEAR AC FOR TEST
ILDB T2,T1 ;[424] LOOK AT FIRST CHAR IN RECORD
CAIE T2,0 ;[424] IS IT A NULL?
FINRET: POPJ P, ;[424] NO--VALID CHAR RETURN
HRRZ T1,DD.HRI(P3) ;[427] GET CURRENT BUFFER AGAIN AND
;[427] SEE IF NULL IS BEFORE OR AFTER
;[427] EOF
MOVEI T2,200 ;[427] LOAD FULL DISK BUFFER
CAMN T2,1(T1) ;[427] IS CURRENT BUFFER FULL?
ERROR (DAT,2,7,) ;[427] YES--REQUESTED REC NEVER WRITTEN
CAMGE T5,1(T1) ;[427][447] REQUESTED OFFSET WITHIN BUF SIZE
ERROR (DAT,2,7,) ;[427] YES-- RECORD NEVER WRITTEN
HLLZ T0,DD.UNT(P3) ;[447] GET CHANNEL NUMBER
IOR [SETSTS 0,20000] ;[447] SET UP EOF FOR FORER%
XCT T0 ;[447] DO IT
TLO P3,IO.EOL!IO.EOF ;[447] MAY NOT BE NECESSARY
POP P, ;[447] SET UP TO RETURN TO USER
ERROR (DEV,0,5,FIN%%) ;[447] GIVE ERROR MSG IF NECESSARY
RBLOK.: ;GET THE NEXT RANDOM BLOCK IN CORE
JSP P1,WAIT. ;STOP THE DEVICE
JSP P1,CLRUSE
MOVE T0,DD.BLK(P3) ;GET THE BLOCK NUMBER
HLL T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T0,(USETI) ;TELL FILSER THE BLOCK WE WANT
XCT T0 ;DO IT
PUSH P,T0 ;SAVE THE USETI BLK#
HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
IOR T0,[STATO 0,20000] ;CHECK FOR EOF
XCT T0 ;DO IT
JRST RBLOK1 ;OK, NO EOF
JUMPI RBLOK1 ;ALLOW EOF TO STAND ON INPUT
HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
IOR T0,[SETSTS 0,@DD.OPN(P3)] ;RESET THE THE DEVICE STATS
XCT T0 ;DO IT
POP P,T0 ;RESTORE THE USETI BLK#
TLO T0,(USETO) ;CHANGE THE USETI TO USETO
XCT T0 ;ALLOCATE THE DISK SPACE
HRRZ T1,DD.HRI(P3) ;[233] LOCATE BUFFER
HRLI 1(T1) ;[233][454] SET UP BLT POINTER
HRRI 2(T1) ;[233][454] SET UP BLT POINTER
SETZM 1(T1) ;[233][454] CLEAR THE
BLT 201(T1) ;[304] [233] BUFFER
POPJ P, ;RETURN
RBLOK1: TLO P3,IO.RNG ;CHANG RINGS FLAG
POP P,T0 ;RESTORE THE STACK
PJRST IBLOK0 ;INPUT THE BLOCK
WBLOK.: ;WRITE THE CURRENT BLOCK
PUSH P,T1 ;[353]
PUSH P,T2 ;[353]
JSP P1,WAIT. ;STOP THE DEVICE
PUSH P,@DD.HRO(P3) ;SAVE THE CURRENT BUFFER
JSP P1,CLRUSE ;CLEAR THE USE BITS
POP P,@DD.HRO(P3) ;RESTORE THE CURRENT BUFFER
MOVE T0,DD.BLK(P3) ;NO, GET THE CURRENT BLOCK NUMBER
HLL T0,DD.UNT(P3) ;NO, GET THE CHANNEL NUMBER
TLO T0,(USETO) ;SET UP A USETO TO THE LAST BLOCK
XCT T0 ;DO IT
TLO P3,IO.RNG ;SET CHANGE RING FLAG
HRRZ T0,DD.HRO+1(P3) ;[332] GET BYTE POINTER
HRRZ T1,DD.HRO(P3) ;[332] ADDR OF BUFFER
SUBI T0,1(T1) ;[332] WORDS WITH DATA
CAMGE T0,1(T1) ;[332] LESS THAN WORDS READ?
PUSHJ P,STASET ;[332] YES-FORCE COUNT
MOVEI T0,.+3 ;[332]
PUSH P,T0 ;[332]
PUSHJ P,OBLOK0 ;[332] OUTPUT THE BLOCK
PUSHJ P,STACLR ;[353] CLEAR IO.UWC IF WAS SET
PJRST TPOPJ2 ;[353] RESTORE AND RETURN
STACLR: TRZA T2,-1 ;[332] TO CLEAR THE BIT
STASET: MOVEI T2,1 ;[332] THE BIT = IO.UWC
HLLZ T0,DD.UNT(P3) ;[332] GET CHANNEL NUMBER
TLO T0,(GETSTS) ;[332] WHAT TO DO
HRRI T0,T1 ;[332] WILL GO INTO T1
XCT T0 ;[332] GET STATUS
DPB T2,[POINT 1,T1,31] ;[332] SET OR CLEAR
HLLZ T0,DD.UNT(P3) ;[332] CHANNEL
TLO T0,(SETSTS (T1));[332] FUNCTION
XCT T0 ;[332] SET STATUS
POPJ P, ;[332] END
WAIT.: ;WAIT FOR THE DEVICE TO STOP
HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
IOR T0,[WAIT] ;SET UP A WAIT UUO
XCT T0 ;STOP THE DEVICE FROM FILLINGG BUFFERS
JRST (P1) ;RETURN TO THE CALLER
CLRUSE: ;ROUTINE TO CLEAR THE USE BITS IN A RING
PUSH P,T1 ;SAVE T1
MOVSI T0,400000 ;SET UP A USE BIT MASK
IORM T0,DD.HRI(P3) ;*****"RI514H"***********
MOVE T1,DD.HRI(P3) ;GET THE RING BUFFER POINTER
PUSH P,T2 ;[%440] SAVE T2
HRRZ T2,T1 ;[%440] SAVE STARTING POINT
CLRUS2: ANDCAM T0,(T1) ;[%440] CLEAR THE USE BIT
MOVE T1,(T1) ;GET THE NEXT BUFFER
CAIE T2,(T1) ;[%440] DONE THEM ALL YET?
JRST CLRUS2 ;[%440] NO, CONTINUE
POP P,T2 ;[%440] YES, RESTORE T2
POP P,T1 ;[%440] YES, RESTORE T1
JRST (P1) ;RETURN
PAGE
SUBTTL ENCODE/DECODE SETUP ROUNTINES
SIXBIT /ENC./
ENC%: PUSHJ P,SAVE. ;SAVE THE USER'S AC'S
MOVSI P3,IO.INO!IO.EDC!IO.FMT!IO.SOU ;ENCODE/OUTPUT/FORMAT
MOVEI P2,ENC.TB(P4) ;ADDRESS OF THE ENCODE HEADER
JRST ENCDEC ;GO TO COMMON CODE
SIXBIT /DEC./
DEC%: PUSHJ P,SAVE. ;SAVE THE USER'S AC'S
MOVSI P3,IO.EDC!IO.FMT!IO.SIN ;DECODE/INPUT/FORMAT
MOVEI P2,DEC.TB(P4) ;ADDRESS OF THE DECODE HEADER
ENCDEC: HRRI P3,DEC.TB-DD.HRI(P4) ;GET A DUMMY DD POINTER
JSP P1,EFCTV. ;[265] GET EFFECTIVE ADDRESS (E)
MOVSI T1,740 ;[276] IMMEDIATE MODE CONSTANT
TDNE T1,0(L) ;[276] IMMEDIATE MODE CONSTANT
JSP P1,RELOC% ;[276] NO - LOAD REAL VALUE
MOVEM G1,2(P2) ;SAVE CHARACTER COUNT IN HEADER BLOCK
MOVEM G1,POS.TB(P4) ;STORE THE MAX COLUMN POS.
;**; [616] INSERT @ ENCDEC + 6 1/2 CLRH 8-NOV-76
MOVEM G1,EDC.LN(P4) ;[616] SAVE TOTAL LENGTH
SETZB T3,ERR.PC(P4) ;CLEAR THE ERROR RETURN
IFN %V1,<
HLRZ T1,(L) ;GET THE ARG COUNT
TRNN T1,777000 ;CHECK FOR OLD CALL
JRST ENCDE2 ;JUMP IF A NEW CALL
MOVE T3,1(L) ;GET THE RETURN ADDRESS
MOVE G1,3(L) ;GET THE ARRAY ADDRESS
AOJA L,ENCDE3 ;COMMON ROUTINE
ENCDE2:
>
HLL L,-1(L) ;GET THE NEW ARG COUNT
AOBJP L,[ERROR (SYS,2,10)] ;ILLEGAL ARGUMENT BLOCK
JSP P1,EFCTV. ;[265]
MOVEI T3,(G1) ;PUT IN THE RIGHT HALF
AOBJP L,[ERROR (SYS,2,10)] ;ILLEGAL ARGUMENT BLOCK
JSP P1,EFCTV. ;[265] GET THE ADDRESS
HRLI T3,(G1) ;PUT IN THE LEFT HALF
MOVE G1,3(L) ;GET THE ARRAY ADDRESS
ENCDE3: MOVEM T3,ERR.PC(P4) ;STORE THE ERROR RETURN
JSP P1,EFCTV1 ;GET THE ARRAY ADDRESS
TRNN G1,-20 ;[224] IN AC SAVE AREA
ADDI G1,ACC.SV(P4) ;[224] YES - RELOCATE TO AC SAVE AREA
HRLI G1,(POINT 7) ;MAKE A BYTE POINTER
MOVEM G1,1(P2) ;PUT IN HEADER BLOCK
MOVEI T1,-2(G1) ;SET UP A DUMMY BUFFER HEADER
MOVEM T1,(P2) ;STORE IN THE RING HEADER
JUMPI SETIO3 ;SKIP ON INPUT
MOVE T0,[ASCII / /];FILL THE ARRAY WITH BLANKS
MOVE T1,2(P2) ;GET THE CHARACTER COUNT
IDIVI T1,5 ;FIVE CHARACTERS/WORD
SOJL T1,.+3 ;ONLY FULL WORDS
MOVEM T0,(G1) ;BLANK THE ARRAY
AOJA G1,.-2 ;CONTINUE
MOVEI T0," " ;GET A BLANK
JUMPE T2,SETIO3 ;NO PARTICAL WORDS TO FILL
IDPB T0,G1 ;YES, STORE A BLANK
SOJA T2,.-2 ;CONTINUE
PAGE
SUBTTL I/O INITIALIZATION ROUTINES
SIXBIT /NLO./ ;NAME FOR TRACE
NLO%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.INO!IO.FMT!IO.SOU!FT.NML ;SET NAMELIST OUTPUT
JRST SETIO ;GO TO SETUP
SIXBIT /NLI./ ;NAME FOR TRACE
NLI%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.FMT!IO.SIN!FT.NML ;SET NAMELIST INPUT
JRST SETIO
SIXBIT /IN./ ;NAME FOR TRACE
IN%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.FMT!IO.SIN ;SET FORMATED INPUT
JRST SETIO
SIXBIT /OUT./ ;NAME FOR TRACE
OUT%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.INO!IO.FMT!IO.SOU ;SET FORMATED OUTPUT
JRST SETIO
SIXBIT /RTB./ ;NAME FOR TRACE
RTB%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.SIN ;SET UN-FORMATED INPUT
JRST SETIO
SIXBIT /WTB./ ;NAME FOR TRACE
WTB%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
MOVSI P2,IO.INO!IO.SOU ;SET UN-FORMATED OUTPUT
; JRST SETIO
SETIO:
;**; [715] DELETE @SETIO + 1 SJW 28-SEP-77 (CODE MOVES TO SAVE.)
MOVEI T0,SKPRET ;[564] CLEANUP == SKIP RETURN
MOVEM T0,ERR.RT(P4) ;[564]
IFN %V1,< ;VERSION 1 CODE
HLRZ T2,(L) ;GET THE ARG COUNT FIELD
LSH T2,-^D9 ;BITS 0-8 ONLY
JUMPN T2,SETIO0 ;SKIP IF OLD CALL
>
HLRZ T2,-1(L) ;GET THE ARG LIST COUNT
IFN %V1,<
SETIO0: CAIE T2,4 ;RANDOM ACCESS CALL
>
CAIN T2,-6 ;RANDOM ACCESS CAL VERSION 2
TLO P2,IO.RAN ;YES, SET RANDOM ACCESS FLAG
JSP P1,SRCFLU ;SEE IF THE UNIT IS DEFINED
PUSHJ P,SETOPN ;DO A DEFAULT OPEN
HRRM G2,DD.UNT(P3) ;[255] SET THE FLU
MOVEI T0,SKPRET ;[564] ERR.RT = OPENER IF DID OPEN%%
MOVEM T0,ERR.RT(P4) ;[564] FROM SETOPN
IFN %V1,<
JUMPL L,.+4 ;SKIP IF A NEW CALL
SKIPE T3,1(L) ;GET THE RETURN ADDRESS
MOVEM T3,ERR.PC(P4) ;STORE
ADDI L,1 ;POINT TO THE FMT WORD
>
LDB T1,[POINT 4,DD.BLK(P3),9];[404] [316] GET ACCESS SPECIFIED
JUMPGE P2,SETIOC ;[404] [316] JUMP IF INPUT REQUIRED
CAIN T1,ACC.SI ;[316] SEQUENTIAL INPUT?
;[316] RANDIN IS TESTED LATER
ERROR (OPN,2,10,) ;[316] YES - ERROR
JRST SETIOB ;[404]
SETIOC: CAIN T1,ACC.SO ;[404] IS ACCESS SEQOUT
ERROR (OPN,2,10,) ;[404] YES-THEN INPUT NOT ALLOWED
SETIOB: ;[316]
MOVE G3,DD.STS(P3) ;GET THE DEVCHR BITS
TLNN P3,IO.OPN ;IS THE FILE OPEN
PUSHJ P,SETDIR ;NO, SET UP THE DIRECTORY
LDB G4,[POINT 4,DD.BLK(P3),9] ;[402] GET ACCESS
HLL T1,P2 ;[402] GET ACCESS REQUIRED
CAIL G4,ACC.RO ;[402] SEQUENTIAL ACCESS
CAIN G4,ACC.AP ;[402] AND APPEND
TLCE T1,IO.RAN ;[402] MUST NOT REQUIRE RANDOM ACCESS
TLNE T1,IO.RAN ;[402] RANDOM AND RANDIN REQUIRE IT
JRST SETIOA ;[402] OK
TLNE P2,IO.RAN ;[375] RANDOM REQUIRED ?
ERROR (DAT,13,10,) ;[375] YES-CAN NOT RANDOM A SEQUENTIAL FILE
ERROR (DAT,17,10,) ;[375] CAN NOT DO SEQUENTIAL TO RANDOM
SETIOA: MOVE G4,P2 ;COPY THE FLAGS
XOR G4,P3 ;CHECK FOR MODE CHANGES
JUMPGE G4,SETIO1 ;SWITCHING FROM IN/OUT OR OUT/IN
TLNN P3,IO.RAN ;UNLESS RANDOM ACCESS MODE
PUSHJ P,SETRWR ;YES, DO A MODE SWITCH
;**; [523] INSERT @ SETIOA + 4 1/2 CLRH 15-MAR-76
JRST SETIO1 ; [523] NON-SKIP IS NORMAL RETURN
ERROR (SYS,4,16,) ; [523] FATAL ERROR
SETIO1: TLNE G4,IO.FMT ;SWITCHING FROM FORMATED/UN-FORMATED
PUSHJ P,SETMOD ;DO A MODE SWITCH
SKIPL T1,DD.LOG(P3) ;ARE THERE FIXED LENGTH RECORDS
JRST SETIO2 ;ALREADY DEFINED
MOVNS T5,T1 ;YES, GET THE USER'S RECORD SIZE
LDB T2,[POINT 6,DD.HRI+1(P3),11] ;GET THE BITS/CHARACTER
LDB T4,[POINT 4,DD.BLK(P3),13] ;GET THE MODE TYPE POINTER
CAIE T4,MOD.IM-MOD.DP;IMAGE MODE
ADDI T1,2 ;NO, ALLOW FOR (LSCW OR CR-LF)
MOVEI T3,44 ;GET THE NUMBER OF BITS PER WORD
IDIVI T3,(T2) ;GET THE ITEMS PER WORD
IDIVI T1,(T3) ;GET THE NUMBER OF WORD/RECORD
SKIPE T2 ;IS THERE A PARTICAL WORD
ADDI T1,1 ;YES, ALLOCATE ANOTHER WORD
HRLI T1,(T5) ;GET THE ITEMS/RECORD (USER VALUE)
MOVEM T1,DD.LOG(P3) ;STORE THE LOG REC SIZE
SETIO2: TLNE P3,IO.CCC ;IS THE OUTPUT FORMATED
MOVSI T1,1 ;SET UP A FLAG FOR "OUTCCC"
HLRZM T1,POS.TB(P4) ;SET UP THE POSITION TABLE
TLNN P2,IO.RAN ;RANDOM ACCESS REQUEST
JRST SETIO5 ;SEQUENTIAL I/O
IFN %V1,<
MOVE G1,2(L) ;ASSUME AN OLD CALL
SKIPG L ;TEST
>
MOVE G1,3(L) ;GET THE ADDRESS OF THE RECORD NUMBER
PUSHJ P,FIND%% ;GO SET UP THE BUFFERS
;**; [561] INSERT @ SETIO5-1 CLRH 29-JUN-76
CAIA ;[561] NON-SKIP RETURN IS NORMAL
ERROR (SYS,4,16,) ;[561] SKIP RETURN IS FATAL ERROR
SETIO5: MOVEI T0,ERRBS ;[564] CLEANUP == BACKSPACE RECORD
MOVEM T0,ERR.RT(P4) ;[564]
TLNN P3,IO.FMT ;IS THIS FORMATED I/O
JRST BINIO ;NO, GO TO BINARY ROUTINES
TLNN P2,FT.NML ;YES, NAME LIST I/O
JRST SETIO3 ;NO,
IFN %V1,<
SKIPL L ;OLD CALL
AOSA L ;YES, UPDATE THE POINTER WORD
>
AOBJP L,[ERROR (SYS,2,10,CPOPJ)];ILLEGAL ARG BLOCK
JSP P1,EFCTV. ;[265] GET THE EFFECTIVE ADDRESS
PUSHJ P,NMLST%## ;GO PROCESS THE NAME LIST REQUEST
PJRST FINF1 ;GO TO FIN% TO CLEAN UP
SETIO3: MOVE T1,DD.HRO+1(P3) ;OUTPUT GET THE OUTPUT HEADER
JUMPO SETIO4 ;JUMP ON INPUT
TLNE P3,IO.EOL ;AT END OF LAST LINE
PUSHJ P,NXTLNI ;YES, GET THE NEXT INPUT LINE
MOVE T1,DD.HRI+1(P3) ; GET THE BEGINNNG BYTE POINTER
SETIO4: TLZ P3,IO.EOL ;CLEAR THE END OF LINE
MOVEM T1,POS.TB+1(P4) ;SAVE FOR AN ERROR PRINT (T FORMAT)
SETZM SCL.SV(P4) ;CLEAR THE SCALING FACTOR
JRST FMTSRC ;GO TO THE FORMAT SCANNER
PAGE
SUBTTL ACCESS MODE CHANGE ROUTINES
SETDIR: HLLZS DD.BLK(P3) ;CLEAR THE BLOCK COUNT
TLNN G3,DV.DIR ;DIRECTORY DEVICE
JRST SETDI1 ;NO, DO NOT LOOKUP/ENTER
SETZM DD.ALC(P3) ;***** CLEAR BLOCKS ALLOCATED
MOVEI P1,LOOKU. ;ASSUME INPUT
JUMPGE P2,SETDI0 ;JUMP ON INPUT
MOVEI P1,ENTER. ;SET OUTPUT
SETDI0: JSP P1,(P1) ;SET UP THE FILE
ERROR (OPN,0,7,) ;FILE NOT FOUND
SETDI1: JUMPGE P2,SETDI2 ;JUMP ON OUTPUT
LDB T4,[POINT 4,DD.BLK(P3),13] ;[236] GET THE MODE TYPE
CAIE T4,MOD.DU ;[236] DUMP MODE OUTPUT
PUSHJ P,OBLOK. ;[236] NO - DUMMY OUTPUT
TLOA P3,IO.INO ;SET OUTPUT
SETDI2: TLZ P3,IO.INO ;SET INPUT
TLO P3,IO.OPN ;SET FILE OPEN
POPJ P, ;RETURN
SETMOD: MOVEI T0,MOD.AS-MOD.DP;ASSUME ASCII MODE SWITCH
TLZE P3,IO.FMT ;CHECK THE PREVIOUS I/O MODE
MOVEI T0,MOD.BN-MOD.DP;SET BINARY MODE
DPB T0,[POINT 4,DD.BLK(P3),13] ;SAVE THE NEW MODE INDEX
TLNN P3,IO.NON ;NON STANDARD MODE (ERROR IF SO)
JSP P1,OPENDM ;MAKE THE MODE SWITCH
ERROR (OPN,1,10) ;ILLEGAL MODE
HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T0,(SETSTS) ;SET UP A STATUS UUO
HRR T0,DD.OPN(P3) ;GET THE STATUS ADDRESS
XCT T0 ;TELL THE MONITOR ABOUT THE MODE CHANGE
HLRZ T0,MOD.DP(T5) ;GET THE BYTE SIZE
ANDI T0,7700 ;CLEAR OUT ALL BUT BYTE SIZE
HRLM T0,DD.HRI+1(P3) ;SET UP THE NEW BYTE POINTER
HRLM T0,DD.HRO+1(P3) ;BOTH INPUT AND OUTPUT
MOVE T1,DD.HRI+2(P3) ;GET THE INTPUT ITEM COUNT
JUMPI .+2 ;SKIP ON INPUT
MOVE T1,DD.HRO+2(P3) ;GET THE OUTPUT ITEM COUNT
JUMPE T1,CPOPJ ;EXIT IF THE BUFFER IS EMPTY/FULL
TLNE P3,IO.FMT ;SWITCHING TO FORMAT
IMULI T1,5 ;YES, CHANGE ITEM COUNT TO CHARACTER
TLNN P3,IO.FMT ;SWITCHING TO BINARY
IDIVI T1,5 ;YES, CHANGE CHARACTERS TO WORDS
MOVEM T1,DD.HRI+2(P3) ;SAVE THE NEW ITEM COUNT
MOVEM T1,DD.HRO+2(P3) ;FOR BOTH INPUT/OUTPUT
POPJ P, ;RETUNR
PAGE
SUBTTL SETWRT ROUTINE TO SWITCH THE FILE FROM READ TO WRITE MODE
SETRWR: TLNN G3,DV.TTY!DV.TTA!DV.PTY ;USER'S TTY
JRST SETRW1 ;NO, CONTINUE
TLCE P3,IO.INO ;YES, OUTPUT LAST
PJRST OBLOK. ;YES, DUMP THE LAST BLOCK
JRST SETRW7 ;EXIT RETURN
SETRW1: HRRZ T2,DD.BLK(P3) ;GET THE BLOCK COUNT
JUMPE T2,SETRW0 ;BEGINNING OF FILE ANY SWITCH OK
JUMPI SETRW2 ;SWITCH TO OUTPUT IS LEGAL
ERROR (DAT,10,10,) ;KILL THE JOB READ_WRITE
;; SUPERCEDING SEQINOUT FILE
;; LOOKUP BUT NOT ENTER PERFORMED BY FILOPN
;; CLOSE FILE AND ENTER TO EFFECT SUPERCEDE
SETRW0: HLLZ T1,DD.UNT(P3) ;[240] GENERATE CLOSE UUO
TLO T1,(CLOSE) ;[205] GENERATE CLOSE UUO
XCT T1 ;[205] UNDO LOOKUP - KEEP OUT OF UPDATE MODE
PJRST SETDIR ;[205] ENTER THE FILE INSTEAD
;; SWITCH TO OUTPUT
;**; [560] INSERT BEFORE SETRW2 CLRH 28-JUN-76
SETRWA: PUSH P,T2 ;[560] GET TWO REGISTERS
PUSH P,T3 ;[560]
MOVE T2,T1 ;[560] BUFFER LINK IN T2
SETRWB: MOVE T2,0(T2) ;[560] ADVANCE ONE BUFFER
HRRZ T3,0(T2) ;[560] GET ITS LINK TO NEXT BUFFER
CAME T1,T3 ;[560] POINTING TO "CURRENT" BUFFER ?
JRST SETRWB ;[560] NO, KEEP LOOKING
POP P,T3 ;[560] RESTORE T3
;**; [614] CHANGE IN EDIT 560 @ SETRWB+5 CLRH 3-NOV-76
HRRZM T2,DD.HRI(P3) ;[614] [560] YES, MAKE CURRENT BUFFER
POP P,T2 ;[560] RESTORE T2
SOJ T2, ;[560] LOWER BLOCK COUNT FOR USETO
;**; [613] INSERT @ SETRW2-2 IN PATCH 560 CLRH 27-OCT-76
SOS DD.BLK(P3) ;[613] AND LOWER SAVED BLOCK COUNT
POP P,T1 ;[560] RESTORE T1
JRST SETRW9 ;[560] TRY AGAIN
SETRW2: JSP P1,WAIT. ;STOP THE DEVICE
TLNN G3,DV.OUT ;CAN THE DEVICE DO OUTPUT
ERROR (OPN,2,7,) ;NO, KILL THE JOB WITH A MESSAGE
;**; [557] INSERT @ SETRW2 + 4 1/2 CLRH 28-JUN-76
HRRZ T4,DD.HRI+1(P3) ;[557] IF ZERO, THIS WAS A NULL FILE
JUMPE T4,[HRRZ T4,DD.HRI(P3) ;[557] BUFFER ADDRESS
AOJ T4, ;[557] PLUS ONE (TO DATA)
HRRM T4,DD.HRI+1(P3) ;[557] TO BYTE POINTER
HLRZ T4,0(T4) ;[557] GET BUFFER LENGTH
TRZ T4,400000 ;[557] IGNORE USE BIT
TLNE P3,IO.FMT ;[557] IF ASCII, TIMES FIVE
IMULI T4,5 ;[557] FOR BYTE COUNT
MOVEM T4,DD.HRI+2(P3) ;[557] STORE BYTE COUNT
JRST SETRW9 ] ;[557] PROCESS
SETRW9: HRRZ T4,DD.HRI(P3) ;[557] [362] GET ADDRESS OF CURRENT BUFFER
HLRZ G1,(T4) ;[362] GET "SIZE+1" FROM THE BUFFER
TRZ G1,400000 ;[362] USE BIT IS NOT PART OF SIZE
ADDI G1,(T4) ;[362] COMPUTE ADDRESS OF LAST BUF WORD
HRRZ T4,DD.HRI+1(P3) ;[362] GET CURRENT BUF WORD ADDRESS
;**; [560] INSERT @ SETRW9 + 4 1/2 CLRH 28-JUN-76
PUSH P,T1 ;[560] GET A REGISTER
HRRZ T1,DD.HRI(P3) ;[560] "CURRENT" BUFFER ADDRESS
CAML T4,T1 ;[560] BYTE POINTER IN THIS BUFFER ?
CAMLE T4,G1 ;[560]
JRST SETRWA ;[560] NO, BACK UP ONE DUE TO EOF
POP P,T1 ;[560] YES, RESTORE T1 AND PROCEED
SUBI G1,(T4) ;[362] DIFF IS NUMBER OF UNUSED WORDS
TLNN P3,IO.FMT ;[362] IF FORMAT (ASCII), THEN 5*...
JRST SETRW6 ;[362] FINISHED COMPUTING IF WORD MODE
IMULI G1,5 ;[362] NUMBER OF BYTES IN UNUSED WORDS
LDB T4,[POINT 6,DD.HRI+1(P3),5] ;[362] GET "P"
IDIVI T4,7 ;[362] UNUSED BYTES IN CURRENT WORD
ADDI G1,(T4) ;[362] TOTAL UNUSED BYTES
SETRW6: DMOVE T4,DD.HRI(P3) ;[362] GET 1ST 2 WORDS OF INPUT HEADER
TLNN G3,DV.DSK ;IS THIS A DSK TYPE DEVICE
JRST SETRW4 ;NO
;**; [525] INSERT @ SETRW6 + 2 1/2 (BEFORE PATCH 523) CLRH 19-MAR-76
MOVEI T0,0 ; [525] PREPARE TO ZERO REST OF BUFFER
PUSH P,DD.HRI+1(P3) ; [525] SAVE POINTER
PUSH P,DD.HRI+2(P3) ; [525] SAVE COUNT
SETRW8: SOSGE DD.HRI+2(P3) ; [525] DECREASE COUNT
JRST .+3 ; [525] IF DONE, LEAVE LOOP
IDPB T0,DD.HRI+1(P3) ; [525] ZERO A BYTE
JRST SETRW8 ; [525] LOOP THROUGH BUFFER
POP P,DD.HRI+2(P3) ; [525] RESTORE COUNT
POP P,DD.HRI+1(P3) ; [525] RESTORE POINTER
;**; [523] INSERT @ SETRW6 + 2 1/2 CLRH 15-MAR-76
JSP P1,LOOKU. ; [523] LOOKUP THE FILE FIRST
JRST SETRW3 ; [523] ERROR
HRRZM T2,DD.ALC(P3) ;STORE THE CURRENT BLOCK NUMBER
JSP P1,RENAM. ;TRUNCATE THE FILE
JRST SETRW3 ;ERROR
JSP P1,LOOKU. ;LOOKUP THE FILE AGAIN
JRST SETRW3 ;ERROR
JSP P1,ENTER. ;GO TO UPDATE MODE
SETRW3: ERROR (OPN,0,7,) ;FAILURE TRYING TO TRUNCATE THE FILE
HLL T2,DD.UNT(P3) ;YES, GET THE CHANNEL NUMBER
TLO T2,(USETO) ;SET OUTPUT THE THE CURRENT BLOCK NUMBER
XCT T2 ;SET FILSER TO THE BLOCK FOR A REWRITE
TLO P3,IO.RNG ;SET RING CHANGE FLAG
JRST SETRW5 ;COMMON EXIT
SETRW4: TLNN G3,DV.MTA ;IS THIS A MAGE TAPE
ERROR (OPN,2,10,) ;BLOCK CAN NOT BE REWRITTEN
MOVEI T3,1 ;CURRENT BUFFER HAS USE BIT SET
;GET COUNTED BY "BSRMTA"
JSP P1,BSRMTA ;BACK UP THE MAGTAPE
SETRW5: JSP P1,CLRUSE ;[460] CLEAR USE BITS
DMOVEM T4,DD.HRO(P3) ;SET UP THE OUTPUT RING HEADER
MOVEM G1,DD.HRO+2(P3) ;PUT IN THE OUTPUT RING HEADER
TLO P3,IO.INO ;SET OUTPUT MODE
SETRW7: TLZ P3,IO.EOL ;CLEAR END OF LINE
POPJ P, ;RETURN
PAGE
SUBTTL BINXX BINARY FORMATED DATA TRANS INIT ROUTINES
BINIO: SETZB P2,G4 ;CLEAR THE FORMAT REGISTER
TLZ P3,IO.EOL!IO.FMT;CLEAR END OF LINE AND FORMAT FLAG
TLNE P3,IO.NON ;NON STANDARD I/O MODE
JRST [LDB T1,[POINT 4,DD.BLK(P3),13];GET THE MODE
CAIN T1,MOD.DU ;DUMP MODE
JRST DMPIO. ;GO TO DUMP MODE ROUTINES
;**; [621] INSERT @ BINIO + 5 1/2L (IN LITERAL) CLRH 11-NOV-76
HLRZ G4,DD.LOG(P3) ;[621] GET FIXED RECORD LENGTH
;**;[672] INSERT @BINIO + 6 1/2 (INSIDE LITERAL INSIDE [621]) SJW 15-AUG-77
TLNE P3,IO.INO ;[672] IGNORE REC LENGTH ON INPUT
SKIPN G4 ;[621] IF ANY
MOVEI G4,-1 ;SET LARGEST RECORD SIZE
MOVEM G4,POS.TB(P4) ;STORE IN POSITION TABLE
JRST BINXIT] ;EXIT TO I/O LIST
JUMPI BINRD. ;JUMP ON INPUT
BINWR.: MOVSI T0,(1B8) ;SET UP THE BEGIN OF RECORD CONTROL WORD
AOS G4,T0 ;COUNT THIS RECORD LSCW=G4
MOVS T1,DD.LOG(P3) ;FIXED LENGTH OUTPUT
JUMPE T1,BINWR1 ;JUMP IF VARIABLE LENGTH
ADDI T0,(T1) ;ADD THE USER'S RECORD SIZE
AOS POS.TB(P4) ;DO NOT COUNT CONTROL WORDS
BINWR1: JSP P1,OBYTE. ;OUTPUT THE LSCW
HRRZ P2,DD.HRO+1(P3) ;SAVE THE LSCW POSITION CLEAR FLAGS
SETZM POS.TB+2(P4) ;CLEAR THE RECORD COUNTER
JRST BINXIT ;TAKE THE COMMON EXIT
BINRD.: JSP P1,IBYTE. ;GET A CONTROL WORD
TLNN P3,IO.RAN ;[231] TAKE ANY LSCW ON RANDOM ACCESS
JUMPE T0,IBYTE. ;FIND AN INPUT RECORD
MOVEM T0,POS.TB+2(P4) ;SAVE THE LSCW
;**;[543] INSERT @BINRD. + 3 1/2 CLRH 7-MAY-76
TLNE P3,IO.EOF ;[543] EOF?
JRST [TLO P3,IO.EOL ;[543]YES, SET EOL
JRST FINBIN] ;[543] GO THROUGH FIN CODE
HLRZ T1,T0 ;GET THE HIGH ORDER NINE BIT
LSH T1,-^D9 ;POSITION THE RECORD TYPE
CAIN T1,1 ;FOROTS TYPE 1 LSCW
SOJA T0,BINRD1 ;YES, COUNT THE LSCW
TLNE P3,IO.RAN ;[231] RANDOM ACCESS
JUMPE T1,[TLO P3,IO.EOL ;[231] YES - UNINTIALIZED RECORD
JRST BINRD1] ;[231] SET END OF LINE
IFN FORSE,<
JUMPE T1,BINFSE ;IS IT A FORSE CONTROL WORD
>
;**;[657] BINRD1 - 3 SJW 20-MAY-77
JRST LSCWNF ;[657] NO, ILLEGAL DATA = ERROR (DAT,2,7,)
IFN FORSE,<
BINFSE: HLRZ G4,T0 ;GENERATE A FOROTS TYPE 1 LSCW
TLOA P2,FT.FSE ;SET FORSE BINARY RECORD SEEN
>
BINRD1: HRRZ G4,T0 ;GET THE SEGMENT COUNT
BINXIT:
IFN CHKSUM,<
SETZB G3,POS.TB+1(P4) ;CLEAR THE CHECK SUM COUNTERS
>
; PJRST BINCON ;DROP INTO THE BINARY I/O ROUTINES
PAGE
SUBTTL BINARY INPUT/OUTPUT ROUTINES SYNC DATA WITH THE I/O LIST
BINCON: ;ENTRY FOR THE NEXT LIST ITEM FROM IOLST%
JSP P1,IOLS%% ;GET THE NEXT LIST ITEM
JUMPI BINRED ;[301]JUMP ON INPUT
TLNE P3,IO.EOL ;END OF RECORD
JRST BINCON ;YES IGNORE THE LIST ITEM
SKIPG T5,DD.HRO+2(P3) ;IS THE BUFFER FULL/EMPTY
PUSHJ P,LSCWW2 ;YES, OUTPUT A TYPE 2 LSCW
TLZE P2,FT.SLT ;IS THE A SLIST
CAME G2,[XWD 1,1] ;IS THE INCREMENT ASSENDING BY 1
AOJA G4,BINWRW ;NO DO A WORD TRANSFER
;ROUTINE TO TRANSFER BLOCK OF ARRAYS TO THE OUTPUT BUFFER
;T0= I/O DATA ITEM
;T1= THE BLT POINTER WORD
;T2= NOT USED
;T3= NOT USED
;T4= THE NUMBER OF WORDS IN THE CURRENT SEGMENT
;T5= THE NUMBER OF WORDS LEFT IN THE CURRNT BUFFER
;G1= IOWD -SIZE,,ADR
;G2= WORDS LEFT TO BE TRANSFERED
;G3= CHECK SUM WORD
;G4= LSCW
;P2 ADDRESS OF THE LAST LSCW
;P3 I/O REGISTER
HLRE G2,G1 ;GET THE NEGATIVE ARRAY SIZE
ADDM G2,POS.TB(P4) ;UPDATE THE COLUMN COUNTER
SKIPE DD.LOG(P3) ;FIXED LENGTH OUTPUT
SKIPLE POS.TB(P4) ;AND EXCEEDING RECORD SIZE
JRST BINSLW ;NO, G2=ARRAY SIZE
SUB G2,POS.TB(P4) ;YES, REDUCE THE ARRAY SIZE TO FIT
TLO P3,IO.EOL ;LITE THE END OR RECORD FLAG
BINSLW: MOVE T5,DD.HRO+2(P3) ;GET THE NUMBER OF REMAINING WORDS
MOVMS T4,G2 ;CONVERT TO POSITIVE IN T4 AND G2
CAILE T4,(T5) ;WILL THE ARRAY FIT IN THE BUFFER
MOVEI T4,(T5) ;NO, GET THE SPACE LEFT IN THE BUFFER
SUBI G2,(T4) ;REDUCE THE ARRAY SIZE BY THE BUFFER SPACE
ADDI G4,(T4) ;UPDATE THE LSCW WORD COUNT
MOVE T1,DD.HRO+1(P3) ;GET THE BYTE POINTER TO THE BUFFER
HRLI T1,(G1) ;GET THE ARRAY ADDRESS (BLT POINTER)
ADDM T4,DD.HRO+1(P3) ;UPDATE THE BYTE POINTER
SUBI T5,(T4) ;REDUCE THE BYTE COUNTER
MOVEM T5,DD.HRO+2(P3) ;STORE THE NEXT BYTE POINTER
ADDI T1,1 ;POINT TO THE FIRST AVAILABLE BUFFER WORD
BLT T1,@DD.HRO+1(P3);TRANSFER THE ARRAY BLOCK
IFN CHKSUM,<
XOR G3,(G1) ;ACCUMULATE THE CHECK SUM
ADDI G1,1 ;UPDAT THE ARRAY POINTER
SOJG T4,.-2 ;CHECK SUM THE NUMBER OF WORD TRANSFERED
>
IFE CHKSUM,<
ADDI G1,(T4) ;UPDATE THE ARRAY ADDRESS
>
JUMPN T5,.+3 ;IS THE BUFFER FULL
PUSHJ P,LSCWW2 ;YES, OUTPUT THE BUFFER AND A TYPE 2 LSCW
JUMPN G2,BINSLW ;IS THE ARRAY DONE
JRST BINCON ;YES, GET NEXT IOLST ITEM
;SINGLE WORD DATA TRANSFER ROUTINE (OUTPUT)
BINWRW: MOVE T0,(G1) ;GET THE DATA WORD
IFN CHKSUM,<
XOR G3,T0 ;ACCUMULATE THE CHECK SUM
>
JSP P1,OBYTE. ;OUTPUT THE WORD
SKIPG T5,DD.HRO+2(P3) ;IS THE OUTPUT BUFFER FULL
PUSHJ P,LSCWW2 ;YES OUTPUT A CONTROL WORD
ADD G1,G2 ;COMPUTE THE NEXT VARIABLE ADDRESS
TLNE P3,IO.EOL ;CHECK FOR END OF LINE
JRST BINCON ;YES, IGNORE THE LIST ITEMS
JUMPGE G1,BINCON ;GET THE NEXT IOLST ITEM
AOJA G4,BINWRW ;ADD THIS WORD AND CONTIUE
; BINARY READ ROUTINES
BINRED: ;BINARY INPUT ROUTINES
TLNE P3,IO.EOL ;[301] EOL SEEN?
JRST BINEO2 ;[301] YES - FILL WITH NULLS
JUMPN G4,BINRE1 ;IS THE SEGMENT EMPTY
PUSHJ P,LSCWR2 ;YES READ A TYPE 2 LSCW
JRST BINEO2 ;[334] READ TYPE 3 FILL WITH NULLS
BINRE1: TLZE P2,FT.SLT ;IS THERE A SLIST CALL
CAME G2,[XWD 1,1] ;AND ASSENDING BY 1
SOJA G4,BINRDW ;NO, DO A WORD BY WORD TRANSFER
HLRE G2,G1 ;GET THE NEGATIVE ARRAY SIZE
BINSLR: SKIPG DD.HRI+2(P3) ;GET THE BUFFER ITEM COUNT
PUSHJ P,IBLOK. ;BUFFER IS EMPTY
TLNE P3,IO.EOF ;[201] END OF FILE SEEN
JRST [MOVSI T1,(1B0) ;[334] SET A FLAG
TLNN P3,IO.NON ;[334] IF FORMATTED BINARY
HLLM T1,ALT.PC(P4) ;[334] AS ILLEGAL EOF
JRST BINEO1] ;[334] FILL AND PROCESS EOF
MOVE T5,DD.HRI+2(P3) ;GET THE ITEM COUNT
MOVMS T4,G2 ;GET A POSITIVE COPY IN G2 AND T4
CAILE T4,(T5) ;FIND THE SMALLEST VALUE OF
MOVEI T4,(T5) ;NUMBER OF WORDS IN THE BUFFER
CAILE T4,(G4) ;NUMBER OF WORD IN THE SEGMENT
MOVEI T4,(G4) ;AND THE ARRAY SIZE PUT IN T4
SUBI G2,(T4) ;REDUCE THE ARRAY SIZE BY THE TRANS.
SUBI G4,(T4) ;REDUCE THE LSCW COUNT BY TRANS.
HRLO T1,DD.HRI+1(P3) ;GET THE FROM ADDR. (-1)
;SET RIGHT HALF TO -1 TO FORCE A CARRY
;ONTO THE LEFT ON THE NEXT INSTRUCTION
;ADDS 1 TO LEFT
ADDI T1,1(G1) ;GET THE TO ADDR (ADD 1 TO THE LEFT HALF)
SUBI T5,(T4) ;REDUCE THE BUFFER ITEM COUNT
ADDM T4,DD.HRI+1(P3) ;UPDATE THE BYTE POINTER
MOVEM T5,DD.HRI+2(P3) ;PUT IN THE RING HEADER
ADDI G1,(T4) ;UPDATE THE ARRAY ADDRESS
BLT T1,-1(G1) ;MOVE THE ARRAY INTO MEMORY
IFN CHKSUM,<
MOVNS T4 ;NEGATE THE ARRAY SIZE
HRLI T4,-1(T4) ;MAKE AN AOBJN POINTER
ADDI T4,(G1) ;GET THE ARRAY ADDRES BACK
BINSL1: XOR G3,(T4) ;ACCUMULATE THE CHECK SUM
AOBJN T4,BINSL1 ;CHECK SUM THE ARRAY
>
JUMPE G2,BINCON ;END OF ARRAY GET NEXT LIST ITEM
JUMPN G4,BINSLR ;IS THE SEGMENT EMPTY
PUSHJ P,LSCWR2 ;YES, READ A LSCW TYPE 2
;**;[655] REPLACE @ BINRDW-2 SJW 4-MAY-77
JRST BINEO1 ;[655][334] FILL WITH NULLS USING BLT
JRST BINSLR ;CONTINUE THE ARRAY
BINRDW: ;ENTRY TO DO A WORD BY WORD DATA TRANSFER
JSP P1,IBYTE. ;GET A DATA ITEM
TLNE P3,IO.EOF ;[201] END OF FILE
;**;[655] DELETE @ BINRDW + 2 SJW 4-MAY-77
JRST [MOVSI T1,(1B0) ;[655][334] SET A FLAG
TLNN P3,IO.NON ;[334] IF FORMATTED BINARY
HLLM T1,ALT.PC(P4) ;[334] ILLEGAL EOF
JRST BINEO3] ;[655][301] LOOP FILLING WITH NULLS
MOVEM T0,(G1) ;STORE THE DATA IN MEMORY
IFN CHKSUM,<
XOR G3,T0 ;ACCUMULATE THE CHECK SUM
>
ADD G1,G2 ;[261] UPDATE THE MEMORY ADDRESS
JUMPGE G1,BINCON ;END OF LIST GET NEXT LIST ITEM
BINRD2: SOJGE G4,BINRDW ;IS THE SEGMENT EMPTY
PUSHJ P,LSCWR2 ;READ A TYPE 2 LSCW
;**;[655] REPLACE @BINRD2 + 2 SJW 4-MAY-77
JRST BINEO3 ;[655][334] LOOP FILLING WITH NULLS
JRST BINRD2 ;MAY BE A NULL SEGMENT
;END OF FILE WHILE READING BINARY DATA
BINEO1: MOVMS G2 ;[371] MAKE SURE LENGTH IS POSITIVE
SETZM (G1) ;[301] CLEAR FIRST WORD
HRLZI T1,(G1) ;[301] SOURCE FOR BLT TRANSFER
HRRI T1,1(G1) ;[301] DESTINATION
ADDI G1,(G2) ;[301] END OF TRANSFER
BLT T1,-1(G1) ;[301] CLEAR END OF BLOCK
JRST BINEOF ;[301] CONTINUE
BINEO2: TLZ P2,FT.SLT ;[655] CLEAR SLIST FLAG
BINEO3: SETZM (G1) ;[655] CLEAR THIS ELEMENT
ADD G1,G2 ;[301] UPDATE ITEM ADDRESS
JUMPL G1,BINEO3 ;[655] END OF LIST?
BINEOF: TLNN P3,IO.NON ;[334] NON FORMATTED BINARY
TLNN P3,IO.EOF ;[334] OR NO EOF
JRST BINCON ;[334] YES - FINISH I/O LIST
SKIPL ALT.PC(P4) ;[334] ILLEGAL EOF
JRST BINCON ;[334] NO CONTINUE
JRST LSCWNF ;[334] MISSING OR ERRONEOUS LSCW
PAGE
SUBTTL LSCWXX ROUTINE TO PROCESS THE LOGICAL SEGMENT CONTROL WORDS
; ROUTINE TO OUTPUT A TYPE 2 LSCW ON THE CURRENT DEVICE
; CALL
; PUSHJ P,LSCWW2
; (RETURN)
LSCWW2:
TLNN P3,IO.NON ;SKIP CONTOL WORD FOR NON STANDARD
SKIPE DD.LOG(P3) ;FIXED LENGTH OUTPUT (RANDOM)
PJRST OBLOK. ;YES, DUMP THE BLOCK (DON'T RETURN)
IFN CHKSUM,<
JSP P1,CHKSM. ;DO A FOLDED CHECK SUM ON G3 RESULT IN T1
TLO G4,(T1) ;INSERT THE CHECK SUM IN THE LSCW
XORM G4,POS.TB+1(P4) ;ACCUMULATE THE RECORD CHECKSUM
SETZ G3, ;INITIALIZE THE CHECK SUM WORD
>
MOVEM G4,(P2) ;STORE THE LSCW IN THE BUFFER
ADD G4,POS.TB+2(P4) ;GET THE REOCRD COUNT
HRRZM G4,POS.TB+2(P4) ;KEEP THE WORD COUNT FOR THE RECORD
MOVSI T0,(2B8) ;SET UP A NEW CONTROL WORD
AOS G4,T0 ;GET THE CONTINUE LSCW IN G4
JSP P1,OBYTE. ;OUTPUT THE LSCW
HRR P2,DD.HRO+1(P3) ;SAVE THE POSITION OF THE LSCW
POPJ P, ;RETURN
; ROUTINE TO READ THE NEXT LSCW TYE 2
; CALL
; PUSHJ P,LSCWR2
; (RETURN) ;TYPE 3 LSCW FOUND
; (RETURN) ;TYPE 2 LSCW FOUND
; ;CALLS THE ERROR MACRO ON ERROR
LSCWR2: ;READ A TYPE 2 LSCW
IFN FORSE,<
TLNN P2,FT.FSE ;IS THIS A FORSE RECORD
JRST LSCWFSE ;NO, GO TO FOROTS ROUTINE
SETZM DD.HRI+2(P3) ;CLEAR THE ITEM COUNT(FORSES NEXT BLOCK)
HRRZ T0,POS.TB+2(P4) ;GET THE CURRENT CONTROL WORD COUNT
JUMPE T0,.+3 ;IS IT A CONTINUE LSCW
ERROR (DAT,4,2,) ;NO, I/O LIST GREATER THAN RECORD
JSP P1,IBYTE. ;GET THE CONTROL WORD
HLRZ G4,T0 ;SIMULATE A FOROTS CONTROL WORD
MOVEM T0,POS.TB+2(P4) ;SAVE THE FORSE CONTROL WORD
AOS (P) ;SKIP
POPJ P, ;RETURN
LSCWFSE:>
IFN CHKSUM,<
JSP P1,CHKSM. ;COMPUTE THE CHECK SUM ON G3
HLRZ T0,POS.TB+2(P4) ;MATCH UP THE CHECK SUMS
ANDI T0,777 ;ONLY NINE BITS
JUMPE T0,.+5 ;NO CHECK SUM ON INPUT
XORI T0,(T1) ;XOR THE CHECK SUMS
JUMPE T0,.+3 ;YES MATCHING CHECK SUMS
ERROR (DAT,3,7,) ;NO SEGMENT ERROR
MOVE T1,POS.TB+2(P4) ;INSERT THE CONTROL INFO
DPB T0,[POINT 9,T1,17] ;PUT THE CHECK SUM IN THE RECORD
XORM T1,POS.TB+1(P4) ;ACCUMULATE THE REOCRD CHECK SUM
SETZ G3, ;CLEAR THE CHECKSUM
>
LSCWRN: JSP P1,IBYTE. ;GET THE NEXT CONTROL WORD
MOVEM T0,POS.TB+2(P4) ;SAVE THE LSCW
HLRZ T1,T0 ;GET THE CONTROL BITS + CHKSUM
LSH T1,-^D9 ;POSITION THE CONTROL BITS
CAIE T1,2 ;IS THIS A TYPE 2 LSCW
JRST LSCWR3 ;NO, CKECK ON TYPE 3
ANDI T0,-1 ;CLEAR THE LEFT HALF
SOSG G4,T0 ;COUNT THE LSCW IN THE SEGMENT COUNT
JRST LSCWRN ;READ A NULL SUGMENT
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN
LSCWR3: ;CHECK ON TYPE 3 LSCW
CAIE T1,3 ;IS THIS A TYPE 3 CONTROL WORD
;**;[657] LSCWR3 + 2 SJW 20-MAY-77
JRST LSCWNF ;[657] NO, ERROR IN DATA = ERROR (DAT,2,7,)
IFN CHKSUM,<
JSP P1,CHKSM. ;FOLD THE CHECK SUMB
HLRZ T0,POS.TB+1(P4) ;GET THE REOCRD CHECK SUM WORD
ANDI T0,777 ;ONLY NINE BITS
JUMPE T0,.+5 ;SKIP IF NO INPUT CHECK SUM
XORI T0,(T1) ;COMPARE THE CHECK SUMS
JUMPE T0,.+3 ;EQUAL IF ZERO
ERROR (DAT,3,7,) ;NO CHECK SUM ERROR
>
TLO P3,IO.EOL ;SET END OF LINE FLAG
POPJ P, ;RETURN FOR TYPE 3 LSCW FOUND
PAGE
SUBTTL LSCW ERROR AND RECOVERY
;**;[657] DMPIO. - 3L SJW 20-MAY-77
LSCWNF: MOVEI T0,LSCWER ;[657] CHANGE ERROR RECOVERY ROUTINE
MOVEM T0,ERR.RT(P4) ;[657]
ERROR (DAT,2,7,) ;[657] ILLEGAL LSCW
; ON LSCW ERROR: IF FORSE. BINARY, RECOVERY FAILS
; IF RANDOM INPUT, DO NOTHING
; ELSE SCAN FORWARD UNTIL FIND A WORD WHICH
; LOOKS LIKE AN LSCW, IE, LH = 001...
; CALLED BY PUSHJ P, IN ERROR RECOVERY
; SKIP RETURN ON SUCCESS
LSCWER:
IFN FORSE,<
TLNE P2,FT.FSE ;[657] FORSE. BINARY RECORD SEEN ?
POPJ P, ;[657] YES = RECOVERY FAILS = NON-SKIP RETURN
>
TLNE P3,IO.RAN ;[657] RANDOM IO?
JRST LSCWE1 ;[657] YES = DO NOTHING
JSP P1,IPEEK. ;[657] CHECK NEXT WORD
TLNE P3,IO.EOF ;[657] EOF SENSED ?
JRST LSCWE1 ;[657] YES = CAN DO NO MORE
HLRZ T1,T0 ;[657] GET CONTROL BITS + CHKSUM
LSH T1,-^D9 ;[657] POSITION THE CONTROL BITS
CAIE T1,1 ;[657] IS IT BEGINNING OF RECORD = TYPE 1 LSCW ?
SOJA P1,IBYTE0 ;[657] NO = EAT WORD & RETURN TO IPEEK. CALL
LSCWE1: AOS (P) ;[657] ALWAYS SUCCEED
PJRST FINXI0 ;[657] DO FIN CLEANUP & RETURN
PAGE
SUBTTL DUMPIO DUMP MODE I/O ROUTINES
DMPCNK==^D20 ;CHUNK SIZE FOR IOWD'S
DMPIO.:
;**[702] @DMPIO. SJW 11-SEP-77
MOVEI T0,CPOPJ ;[702] NO RECOVERY ON DUMP MODE ERRORS
MOVEM T0,ERR.RT(P4) ;[702] BUT THEY ARE TRAPPABLE
TLO P3,IO.RNG!IO.NON ;SET DUMP MODE AS NONSTANDARD
MOVEI T0,DMPCNK ;ALLOCATE A CHUNK FOR THE IOWD LIST
PUSHJ P,GMEM%% ;ALLOCATE
MOVEM T1,DD.HRI(P3) ;STORE IN THE RING HEADER
MOVEM T1,DD.HRO(P3) ;DON'T CARE IF INPUT/OUTPUT
DMPIO1: MOVEI G4,(T1) ;BUILD AN AOBX POINTER
HRLI G4,-<DMPCNK-1> ;ALLOCATE ALL BUT LAST WORD TO TERMINATE
DMPIO2: JSP P1,IOLS%% ;GET THE I/O LIST
TLZ P2,FT.SLT ;CLEAR THE SLIST FLAG
TLNN G1,-1 ;CHECK FOR A SINGLE VARIABLE
TLO G1,-1 ;SET THE COUNT
SOS G1 ;IOWD -N,,LOC-1
MOVEM G1,(G4) ;STORE IN THE IOWD LIST
AOBJN G4,DMPIO2 ;CONTINUE
MOVE T1,DD.HRI(P3) ;END OF IOWD ALLOCATION GET THE START
PUSHJ P,LMEM%% ;LINK A NEW CHUNK ON THE END
;**; [656] CHANGE @ DMPIO2+9 SWG 5-MAY-77
HRRZM T1,(G4) ;[656] STORE A JUMP WORD IOWD 0,,ADR
JRST DMPIO1 ;GO AGAIN
PAGE
SUBTTL IOLST% INPUT/OUTPUT LIST PROCESSING ROUTINE
SIXBIT /IOLST./ ;NAME FOR TRACE
IOLST%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
SKIPN P3,IOL.P3(P4) ;RELOAD THE I/O REG
POPJ P, ;I/O NOT ACTIVE
MOVSI T1,IOL.SV(P4) ;GET THE ADRESS OF THE STATE TABLE
HRRI T1,G3 ;AND BLT INTO THE AC'S
BLT T1,P2 ;RESTORE
TLO P2,FT.LST ;SET IOLIST SEEN FLAG
IOLST1: SKIPN G1,(L) ;GET THE NEXT IOLIST ARGUMENT
PJRST IOLSAV ;SAVE THE I/O LIST STATE
MOVEM P1,IOL.P1(P4) ;SAVE THE CALLER'S ADDRESS
HLRZ G2,(L) ;GET THE IO LIST ARG TYPE
LSH G2,-^D9 ;LEFT 9 BITS ONLY
;**; [533] CHANGE @ IOLST1+5L CLRH 14-APR-76
TLZ P2,FT.SLT!FT.ELT!FT.EXT!FT.PRC ;[500] [533] NEW LIST...NEW FLAGS
CAIGE G2,IOL.MX ;CHECK FOR AN IMPLIED FIN CALL
JRST @IOLST(G2) ;GO TO THE CORRECT ROUTINE
IOLST2: ERROR (SYS,2,10,FIN%%) ;NO,IOLST ARGUMENT ERROR
IOLST: JRST IOLST2 ;(0) ERROR, ZERO NOT ALLOWD
JRST DATA% ;(1) DATA ARGUMENT
JRST SLIST% ;(2) SLIST ARUMNET
JRST ELIST% ;(3) ELIST ARGUMENT
JRST FIN%% ;(4) IO FINISHED
IOL.MX==.-IOLST ;IOLST TABLE SIZE
;REENTRY POINT TO THE IOLST% ROUTINE FOR NEXT VARIABLE
IOLS%%::TLNN P2,FT.LST ;HAS AN I/O LIST BEN SEEN
PJRST IOLSAV ;NO, SAVE THE STATE TABLES
;**; [604] REMOVE EDIT [575] @ IOLS%% + 2 CLRH 8-OCT-76
;**; [575] CHANGE @ IOLSS%% + 2 CLRH 24-AUG-76
TLNN P2,FT.SLT!FT.EXT ;[604] [575] [260] IS A LIST IN PROGRESS
AOJA L,IOLST1 ;NO, GET NEXT ARGUMENT
TLNE P2,FT.SLT ;[247] YES, GO TO CORRECT LIST ROUTINE
JRST SLISTX ;SLIST LIST IN PROCESS
JRST ELISTX ;ELIST LIST IN PROCESS
; ROUTINE TO SAVE THE STATE OF THE I/O LIST
IOLSAV:
MOVEI T1,IOL.SV(P4) ;GET THE SAVE AREA ADDRESS
HRLI T1,G3 ;BLT TO SAVE THE AC'S FOR A USER'S RETURN
BLT T1,IOL.P3(P4) ;SAVE AC'S G3-P3
POPJ P, ;RETURN FOR THE NEXT LIST ITEM
PAGE
SUBTTL DATA/SLIST/ELIST INPUT/OUTPUT ROUTINES
SLIST%: TLOA P2,FT.SLT ;[247] SET SLIST FLAG
ELIST%: TLO P2,FT.ELT ;[247] SET ELIST FLAG
TLZ P2,FT.EXT ;[247] CLEAR EXTENDED LIST
JSP P1,EFCTV. ;[265] COMPUTE # OF ELEMENTS
MOVSI T2,740 ;[247] IMMEDIATE MODE
TDNE T2,0(L) ;[247] CONSTANT?
JSP P1,RELOC% ;[247] NO - LOAD ACTUAL VALUE
MOVNM G1,DAT.TP(P4) ;[247] SAVE THE COUNT
HRRI L,2(L) ;[247] POINT TO THE FIRST ARRAY ADDRESS
DATA%:
JSP P1,EFCTV. ;[265] GET THE ADDRESS
TRNN G1,-20 ;IN THE AC SAVE AREA
ADDI G1,ACC.SV(P4) ;YES, RELOCATE TO THE SAVE AREA
HLRZ T5,(L) ;GET THE ARG TYPE CODE
LSH T5,-5 ;POSITION
ANDI T5,17 ;FOUR BITS ONLY
TLNN P2,FT.SLT!FT.ELT ;[247] SLIST OR ELIST I/O
JRST DATA0 ;NO, GO TO THE DATA ROUTINE
HRLZ G2,DAT.TP(P4) ;[247] SET ARRAY SIZE
CAIE T5,TP%DOR ;[247] DOUBLE PRECISION
CAIN T5,TP%COM ;[247] OR COMPLEX?
ASH G2,1 ;[247] YES - DOUBLE THE ARRAY SIZE
HRRI G2,(G1) ;[247] BUILD A IOWD WORD - SIZE,,ARRAY
TLNE P2,FT.EXT ;[247] EXTENDED LIST
TLNN P2,FT.SLT ;[247] EXTENDED SLIST
SKIPA G1,-1(L) ;[247] LOCATE INCREMENT
JRST SLIST0 ;[247] USE PREVIOUS INCREMENT
JSP P1,EFCTV1 ;[247] LOCATE INCREMENT
MOVSI T2,740 ;[247] IMMEDIATE MODE
TDNE T2,-1(L) ;[247] CONSTANT?
JSP P1,RELOC% ;[247] NO - LOAD ACTUAL VALUE
TRNN G1,400000 ;CHECK FOR A NEGATIVE INCREMENT
;IF THE INCREMENT IS <0 WE GET A FREE
;CARRY IN BIT 17. THEREFORE DO NOT ADD
;IN THE DECREMENT CONSTANT 1. THE HARDWARE
;DOES IT FREE.
HRLI G1,1 ;ADD IN A 1 FOR THE DECREMENT CONSTANT
;ON A POSITIVE OR ZERO INCREMENT
MOVEM G1,DAT.TP+1(P4) ;[247] SAVE THE INCREMENT
SLIST0: MOVE G1,DAT.TP+1(P4) ;[247] RESTORE THE INCREMENT
EXCH G1,G2 ;[247] EXCHANGE THE ITEM COUNT AND INCREMENT
CAIE T5,TP%COM ;[275] DOUBLE WORD
CAIN T5,TP%DOR ;[275] TRANSFER
ASH G2,1 ;[275] YES - DOUBLE INCREMENT
TLNE P2,FT.EXT ;[275] EXTENDED LIST
JRST SLIST1 ;[275] YES - LINK NEW VARIABLE
SKIPE T2,1(L) ;[275] LOOK AHEAD ON ARGBLK
TLNE T2,777000 ;[275] EXTENDED LIST?
JRST SLIST3 ;[275] POST PROCESS SLIST ARGUMENT
SLIST1: MOVEI T0,3 ;[275] NEED A 3 WORD BLOCK
PUSH P,T5 ;[247] REMEMBER ARG TYPE
PUSHJ P,GMEM%% ;[247] ALLOCATE THE BLOCK
DMOVEM G1,0(T1) ;[247] STORE THE INFORMATION
POP P,2(T1) ;[247] STORE THE ARGTYPE
TLON P2,FT.EXT ;[275] FIRST LINK?
JRST [HRLM T1,LST.TP(P4) ;[275] REMEMBER LIST ORIGIN
JRST SLIST2] ;[275] CONTINUE
MOVE T5,LST.TP(P4) ;[275] LOAD LIST POINTER
MOVEI T2,-1(T1) ;[341] GET ADDRESS OF LINK
HRRM T2,-1(T5) ;[341] CREATE FORWARD LINK
SLIST2: HRRM T1,LST.TP(P4) ;[275] REMEMBER CURRENT LIST ELEMENT
HLLZS -1(T1) ;[275] CLEAR LINK
SKIPE T2,1(L) ;[275] ANOTHER LINK
TLNE T2,777000 ;[275] ANOTHER LINK
JRST ELISTC ;[275] NO - START UP ELIST
TLNE P2,FT.ELT ;[275] EXTENDED ELIST?
HRRI L,1(L) ;[275] YES - PUSH ARGBLK POINTER
AOJA L,DATA% ;[275] REPEAT FOR NEXT ITEM
;POST PROCESSING FOR DOUBLE WORD ARGUMENTS
SLIST3: CAIE T5,TP%COM ;[275] COMPLEX
CAIN T5,TP%DOR ;[275] OR DOUBLE PRECISION
CAIA ;[275] YES
;**; [671] @SLIST3+3 ETC SJW 12-AUG-77
JRST SLIST4 ;[671] NO
;**; [575] INSERT @ SLIST3+3 1/2 CLRH 20-AUG-76
TLNE P2,FT.LSD ;[575] LIST-DIRECTED ?
JRST SLIST4 ;[671] YES, DON'T NEED TO MAKE ELIST
CAME G2,[2,,2] ;[275] SLISTABLE
JRST SLIST1 ;[275] NO - GENERATE ELIST
TLZ P2,FT.ELT ;[671] TURN OFF ELIST SINCE NOW AN SLIST
CAIN T5,TP%DOR ;[275] FORMATTED
TLNN P3,IO.FMT ;[275] DOUBLE PRECISION
JRST DATA4 ;[275] NO - CHANGE INCR TO 1,,1
SLIST4: TLZ P2,FT.ELT ;[671] TURN OFF ELIST SINCE NOW AN SLIST
JRST DATA2 ;[275] YES - LEAVE INCR AS 2,,2
SLISTX: ;ENTRY FOR THE NEXT ITEM FROM SLIST
MOVE G1,DAT.TP+1(P4) ;GET THE INCREMENT
ADDB G1,DAT.TP(P4) ;GET THE NEXT ADDRESS IN G1/DAT.TP
JUMPL G1,(P1) ;YES, RETURN TO FORMAT STATEMENT
TLZ P2,FT.SLT ;CLEAR SLIST FLAG
TLNN P2,FT.EXT ;[256] EXTENDED IN PROGRESS?
AOJA L,IOLST1 ;END OF SLIST GET NEXT ARG
ELISTX: MOVEM P1,IOL.P1(P4) ;[247] SAVE RETURN ADR
MOVE T1,LST.TP(P4) ;[247] LOCATE CURRENT ITEM
MOVE G1,1(T1) ;[247] LOAD THE INCREMENT
ADDB G1,0(T1) ;[247] GET THE NEXT ADDRESS READY
HRRZ T2,-1(T1) ;[247] FIND NEXT ELEMENT
SKIPE T2 ;[341] SKIP IF END OF CHAIN
AOJA T2,ELISTG ;[341] GO ON NEXT ITEM
JUMPL G1,ELISTB ;[247] ANOTHER ROUND
TLZ P2,FT.SLT!FT.ELT!FT.EXT
HLRZ T1,LST.TP(P4) ;[247] LOCATE LIST
PUSHJ P,PMEM%% ;[247] RETURN THE CORE
AOJA L,IOLST1 ;[247] DONE WITH ELIST
;DATA INPUT/OUTPUT LIST ROUTINE
ELISTC: TLZ P2,FT.SLT!FT.ELT;[275] CLEAR SLIST AND ELIST FLAGS
ELISTB: HLRZ T2,LST.TP(P4) ;[247] START AT BEGINNING OF LIST
ELISTG: HRRM T2,LST.TP(P4) ;[247] RESET POINTER
MOVE T5,2(T2) ;[247] LOAD ARG TYPE
HRRO G1,0(T2) ;[247] LOAD ADDRESS
CAIN T5,TP%DOR ;[247] DOUBLE WORD
SKIPA G2,[2,,2] ;[247] FILL IN INCREMENT
SKIPA G2,[1,,1] ;[247] FILL IN INCREMENT
HRLI G1,-2 ;[247] TWO WORD ARGUMENT
DATA0: CAIN T5,TP%COM ;IS THE VARIABLE COMPLEX
;**; [575] CHANGE @ DATA0+1 CLRH 20-AUG-76
JRST [TLNE P2,FT.LSD ;[575] LIST-DIRECTED?
JRST [MOVE G2,[2,,2] ;[575] YES
HRLI G1,-2 ;[575]
JRST DATA2 ] ;[575]
JRST DATA1 ] ;[575] NO--SLIST
CAIN T5,TP%DOR ;IS VARIABLE DOUBLE REAL
TLNE P3,IO.FMT ;AND FORMATED
;OR SINGLE PRECISION
JRST DATA3 ;YES, EXIT I/O PROCESSIN ROUTINE
DATA1: HRLI G1,-2 ;BUILD AN SLIST CONTROL WORD
DATA4: MOVE G2,[1,,1] ;[275] SET INCR TO 1,,1
DATA2: TLO P2,FT.SLT ;SET THE SLIST FLAG
DATA3: DMOVEM G1,DAT.TP(P4) ;SAVE THE SLIST CONTROL WORDS
MOVEM T5,DAT.TP+2(P4) ;SAVE THE VARIABLE TYPE FOR G FORMAT
MOVE P1,IOL.P1(P4) ;GET THE RETURN ADDRESS
JRST (P1) ;RETURN TO THE CALLER
;RELOC% - CONVERT IMMEDIATE MODE CONSTANT TO VALUE
RELOC%: TRNN G1,-20 ;[247] IN AC SAVE AREA
ADDI G1,ACC.SV(P4) ;[247] YES, RELOCATE
HRRZ G1,0(G1) ;[276] LOAD VALUE
JRST 0(P1) ;[247] RETURN VALUE
PAGE
SUBTTL FIN INPUT/OUTPUT LIST TERMINATION ROUTINE
SIXBIT /FIN./ ;NAME FOR TRACE
FIN%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
SKIPN P3,IOL.P3(P4) ;GET THE SYSTEM AC'S
POPJ P, ;NO, I/O IN PROCESS (RETURN)
MOVE P2,IOL.P2(P4) ;GET THE OTHER AC
DMOVE G3,IOL.G3(P4) ;RELOAD THE SYSTEM G REG'S (G3,G4)
FIN%%: ;ENTRY FROM THE IO LIST ROUTINE (FIN IMPLIED)
TLO P2,FT.FIN ;SET THE FIN FLAG FOR ENDLN.
TLNN P3,IO.FMT ;IS THIS FORMATED I/O
JRST FINBIN ;NO, BINARY I/O
TLNE P2,FT.LSD ;LIST DIRECTED I/O
JRST FINF1 ;YES, SKIP THE FORMAT STATEMENT CLEAN UP
;**;[471] Replace @ FIN%%+5L JNG 18-Nov-75
SKIPN T1,FST.DY(P4) ;[471] PICK UP THE FORMAT STATMENT POINTER
JRST FINF0 ;[471] NONE SET UP YET
HRRZI T1,-1(T1) ;GET THE POINTER TO THE ENCODED FMT STACK
SKIPGE (T1) ;CHECK FOR DELETION OF ENCODED STACK
PUSHJ P,PMEM%% ;YES, DEALLOCATE THE ENCODED STACK
;**;[666] INSERT @ FINF0 -1/2 SJW 2-AUG-77
SETZM T1,FST.DY(P4) ;[666] CLEAR CURRENT FORMAT STATEMENT
FINF0: TLNE P3,IO.EDC ;[471] ENCODE/DECODE REQUEST
JRST FINXI1 ;EXIT ON ENCODE/DECODE
FINF1: PUSHJ P,ENDLN. ;FINISH UP THIS LINE
TLZ P3,IO.STR ;CLEAT THE STRING BIT
JUMPO FINXIT ;JUMP ON OUTPUT
MOVEM P3,RER.SV(P4) ;SAVE THE REREAD DEVICE
TLNE P3,IO.TTA ;[307] USER TERMINAL?
TLZ P3,IO.EOF ;[307] YES-CLEAR EFFECT OF CONTROL-Z
FINXIT: PUSHJ P,UPDASC ;[330] UPDATE ASSOCIATE VARIABLE
FINXI0: PUSHJ P,UPDCHN ;[240] UPDATE THE CHANNEL TABLE
FINXI1: SETZM IOL.P3(P4) ;CLEAR THE I/O REGISTER
SETZM ALT.PC(P4) ;[225] CLEAR ALT RETURN PC
;**;[473] Insert @ FINXI1+2L JNG 20-Nov-75
SETZM CH.SAV(P4) ;[473] CLEAR SAVED CHAR AT END OF RECORD
POPJ P, ;RETURN TO THE USER
UPDASC: TLNN P3,IO.EDC!IO.EOF ;[330] ENCODE/DECODE IN PROGRESS
;[425] OR AN END OF FILE CONDITION
TLNN P3,IO.RAN ;[330] OR NOT RANDOM ACCESS
POPJ P, ;[330] YES - RETURN
SKIPE T1,DD.ASC(P3) ;[330] IS THERE AN ASSOCIATE VARIABLE
AOS (T1) ;[330] YES UPDATE IT
AOS DD.LIM(P3) ;[330] UPDATE RECORD NUMBER
POPJ P, ;[330] RETURN
FINBIN: TLNE P3,IO.NON ;NON-STANDARD I/O
JRST FINNON ;DO NON-STANDARD FIN
JUMPI FINBI1 ;JUMP ON INPUT
SKIPN DD.LOG(P3) ;CHECK FOR FIXED LENGTH RECORD
JRST .+5 ;NO, JUMP
SETZ T0, ;CLEAR THE OUTPUT WORD
MOVEI P1,.+1 ;SET UP A RETURN FROM OBYTE.
TLNN P3,IO.EOL ;AT END OF LINE
AOJA G4,OBYTE. ;NO, OUTPUT A PADDING WORD
IFN CHKSUM,<
JSP P1,CHKSM. ;DO A FOLDED CHECK SUM ON G3
TLO G4,(T1) ;INSERT IN THE CONTROL WORD
>
SKIPN DD.LOG(P3) ;NO TYPE CONTROL WORD FOR FIXED LENGTH
MOVEM G4,(P2) ;INSERT THE LSCW IN THE BUFFER
IFN CHKSUM,<
XORM G4,POS.TB+1(P4) ;ACCUMULATE THE TOTAL RECORD CHECK SUM
MOVE G3,POS.TB+1(P4) ;GET THE TOTAL CHECK SUM
JSP P1,CHKSM. ;COMPUTE THE RECORD CHECK SUM
>
MOVSI T0,(3B8) ;SET UP THE END OF RECORD LSCW
HRR T0,POS.TB+2(P4) ;GET THE TOTAL RECORD COUNT (WORDS)
ADDI T0,1(G4) ;SET WORD COUNT TO PREVIOUS RECORD OF BOF
IFN CHKSUM,<
TLO T0,(T1) ;INSERT THE RECORD CHECKSUM
>
TLZ P3,IO.EOL ;CLEAR END OF LINE FLAG
JSP P1,OBYTE. ;OUTPUT THE TERMINING LSCW
PJRST FINXIT ;RETURN
FINBI1: TLZE P3,IO.EOL ;END OF LOGICAL RECORD
JRST FINXIT ;YES, EXIT(NEXT RECORD READ LATER)
IFN FORSE,<
TLNN P2,FT.FSE ;PROCESSING FORSE RECORD
JRST FINFS1 ;NO, GO TO FOROTS
SETZM DD.HRI+2(P3) ;CLEAR THE ITEM COUNT
MOVE T1,DD.HRI(P3) ;GET THE ADDRESS OF THE BUFFER
HRRZ T0,2(T1) ;GET THE FORSE CONTROL WORD
JUMPN T0,FINXIT ;POSTIONED AT NEXT RECORD
PUSHJ P,IBLOK. ;NO GET THE NEXT INPUT BLOCK
JRST .-4 ;CHECK THIS RECORD
FINFS1:>
JUMPE G4,FINBI4 ;IS THE CURRENT SEGMENT DEPLEATED
FINBI2: JSP P1,IBYTE. ;NO, GET THE NEXT WORD
IFN CHKSUM,<
XOR G3,T0 ;ACCUMULATE THE CHECKSUM
>
FINBI3: SOJG G4,FINBI2 ;CONTINUE THIS SEGMENT
FINBI4: PUSHJ P,LSCWR2 ;READ ANOTHER LSCW TYPE 2
JRST FINBI1 ;EXIT, "LSCWR2" CLEANS UP THE RECORD
AOJA G4,FINBI3 ;CONTINUE SCANNING TYPE 2 FOUND
;PROTECT AGAINST A NULL SEGMENT BY ADDING 1
;**; [621] INSERT BEFORE FINNON CLRH 11-NOV-76
FINNN1: SKIPN DD.LOG(P3) ;[621] FIXED-LENGTH RECORDS?
JRST FINXIT ;[621] NO, EXIT
JUMPI FINXIT ;[621] INPUT?
SETZ T0, ;[621] NO, SO CLEAR OUTPUT WORD
MOVEI P1,.+1 ;[621] SET UP RETURN FROM OBYTE.
TLNN P3,IO.EOL ;[621] END OF LINE?
JRST OBYTE. ;[621] NO, OUTPUT A WORD
TLZ P3,IO.EOL ;[621] YES, CLEAR END OF LINE
JRST FINXIT ;[621] AND EXIT
FINNON: ;NON-STANDARD FIN ROUTINE
LDB T1,[POINT 4,DD.BLK(P3),13];GET THE MODE
CAIE T1,MOD.DU ;DUMP MODE
;**; [621] CHANGE @ FINNON +2 CLRH 11-NOV-76
JRST FINNN1 ;[621] NO, GO PROCESS
JUMPI .+2 ;SKIP IF INPUT
PUSHJ P,OBLOK. ;DUMP THE OUTPUT BLOCK
JUMPO .+2 ;SKIP IF OUTPUT
PUSHJ P,IBLOK. ;READ THE INPUT BLOCK
MOVE T1,DD.HRI(P3) ;GET THE I/O LIST ADDRESS
PUSHJ P,PMEM%% ;PLACE BACK IN THE HEAP
JRST FINXIT ;EXIT
PAGE
SUBTTL FMTXXX ROUTINE TO INITIALIZE THE FORMAT SCANNER
INTERNAL O.PNTR,W.PNTR,D.PNTR ;[265]
INTERNAL O.MASK,W.MASK,D.MASK ;[266]
O.PNTR: POINT 5,G4,4 ;[265] BYTE POINTER TO THE OP CODE IN THE FS STACK
D.PNTR: POINT 6,G4,10 ;[265] BYTE POINTER TO THE D FIELD IN THE FS STACK
W.PNTR: POINT 7,G4,17 ;[265] BYTE POINTER TO THE W FIELD IN THE FS STACK
O.MASK==37B22 ;[266] RIGHT HALF MASK FOR OPCODE FIELD
D.MASK==77B28 ;[266] RIGHT HALF MASK FOR DECIMAL FIELD
W.MASK==177B35 ;[266] RIGHT HALF MASK FOR WIDTH FIELD
FMTSRC: SKIPN G4,1(L) ;LIST DIRECT I/O
PJRST LSTDR%%## ;YES, PROCESS THE LIST DIRECTED I/O
IFN %V1,<
JUMPG L,FMTSR2 ;JUMP IF OLD CALL SEQUENCE
>
AOBJP L,[ERROR (SYS,2,10)] ;ILLEGAL ARGUMENT BLOCK
JSP P1,EFCTV. ;[265] GET THE ADDRESS
MOVEI G4,(G1) ;SAVE THE FORMAT ADDRESS
HLRZ T1,(L) ;GET THE TYPE CODE
ANDI T1,(17B12) ;ISOLATE IT
CAIE T1,(<TP%LBL>B12);IS IT A LABEL FIELD
TLO G4,400000 ;SET THE DECODE FLAG
AOBJP L,[ERROR (SYS,2,10)] ;ILLEGAL ARGUMENT BLOCK
JSP P1,EFCTV. ;[265] GET THE SIZE
TLO G4,(G1) ;SAVE THE SIZE IN THE LEFT HALT
FMTSR2: SKIPGE G1,G4 ;STATEMENT NOT TO BE RETAINED
JRST FMTSR0 ;DO NOT RETAIN THE ENCODED LIST
MOVEI G3,FMT.DY(P4) ;GET THE START OF THE ENCODED LIST
HRRZ T1,(G3) ;LOAD POSSIBLE FMT POINTER TO LIST
JUMPE T1,FMTSR0 ;CHAIN DOES NOT EXIST
FMTSR3: CAMN G1,1(T1) ;SEARCH FOR A MATCHING ENCODED FMT
JRST [ADDI T1,2 ;STEP PAST THE CONTROL INFO.
HRRZM T1,FST.DY(P4) ;STORE THE CURRENT ENCODED LIST
JRST FSXXEQ] ;DISPATCH ON THE LIST
HRRZ G3,T1 ;NO - STEP POINTER TO NEXT ENTRY
HRRZ T1,(T1) ;LOAD NEXT FMT POINTER IN LIST
JUMPN T1,FMTSR3 ;IF NOT AT THE ENTRY, GET NEXT POINTER
FMTSR0: HRRZI G2,-1(G1) ;GET THE LOCATION OF THE FORMAT STAT.
HRLI G2,(POINT 7,0,34) ;BUILD AN ASCII BYTE POINTER
MOVEM G2,FBG.BP(P4) ;SAVE THE BYTE POINTER TOT THE FORMAT STATEMENT
HLRZ T0,G1 ;FETCH THE SIZE OF THE FORMAT STATEMENT
ANDI T0,377777 ;CLEAR THE ENCODING FLAG
MOVEM G2,FEN.BP(P4) ;STORE THE BEGINNING OF THE FMT
ADDM T0,FEN.BP(P4) ;UPDATE TO THE END OF THE FMT
;**;[467] Replace @ FMTSR0+7L JNG 17-Nov-75
IMULI T0,5 ;[467] LARGEST CAN POSSIBLY GET
ADDI T0,3 ;[467] PLUS 2 OVERHEAD AND A SPARE
PUSHJ P,GMEM%% ;GET MEMORY FOR THE ENCODING
MOVEI T1,-1(T1) ;SET THE POINTER TO THE LINK WORD
JUMPL G1,FMTSR1 ;DO NOT LINK UNWANTED ENCODED BLOCKS
HRRZ T2,FMT.DY(P4) ;LOAD THE START OF THE LIST
HRRM T1,FMT.DY(P4) ;STORE THIS LIST FIRST
HRRM T2,(T1) ;LINK THE REST OF THE LIST
FMTSR1: SETCM P2,(T1) ;GET THE STACK SIZE
HRRI P2,(T1) ;AND THE ADDRESS
ADD P2,[XWD 2,2] ;SKIP THE CONTROL INFORMATION
MOVEM G1,1(T1) ;STORE THE FORMAT STATEMENT ADDRESS
HRRZM P2,FST.DY(P4) ;SAVE THE ENCODED LIST ADDRESS
MOVSI G1,1 ;SET INITIAL LEFT PAREN POINTER
MOVEM G1,LPN.BP(P4) ;SAVE THE INITIAL LEFT PAREN POINTER
SETZB G1,G3 ;CLEAR THE PAREN COUNTERS
; JRST FMTINE ;CONVERT ASCII FORMAT TO ENCODED LIST
PAGE
SUBTTL FMTXXX JUMP TABLES FOR THE FORMAT SCANNER
FMTINE: SETZB G4,T5 ;ZERO THE FORMAT DESCRIPTOR WORD
FMTRIN: SETZ T1, ;ZERO THE DIGIT COUNTER
FMTIN: ILDB T2,G2 ;NEXT FORMAT CHARACTER
CAIN T2,11 ;CHECK FOR A <TAB>
JRST FMTIN ;IGNORE ALL TABS AS DESCRIPTORS
;**; [620] INSERT @ FMTIN + 2 1/2 CLRH 10-NOV-76
CAILE T2,140 ;[620] BELOW LOWER CASE A ?
CAIL T2,173 ;[620] BELOW LOWER CASE Z ?
SKIPA ;[620] NOT LOWER CASE, SO LEAVE ALONE
SUBI T2,40 ;[620] OTHERWISE, CONVERT TO UPPER CASE
TRZ T2,100 ;CLEAR THE HIGH ORDER BIT OF THE ASCII
TRC T2,40 ;CONVERT THE ASCII TO SIXBIT
MOVE T3,T2 ;SAVE THE CHARACTER IN B
IDIVI T3,6 ;SET UP FOR A TABLE INDEX
LDB T3,FMTPTR(T4) ;LOAD TABLE INDEX
HRRZ T4,FMTDIS(T3) ;LOAD DISPATCH ADDRESS
JRST (T4) ;GO TO THE ROUTINE
FMTPTR: REPEAT 6,<POINT 6,FMTDIR(T3),35-<.-FMTPTR>*6> ;INDEX POINTER
FMTDIR:
; %, $, #, ", !,SPACE
BYTE (6) EE,%DL,EE,EE,EE,%S
; +, *, ) , ( , ', &
BYTE (6) %S,EE,%RP,%LP,%Q,EE
; 1, 0, /, ., -, ,,
BYTE (6) %N,%N,%Z,%W,%M,%C
; 7, 6, 5, 4, 3, 2
BYTE (6) %N,%N,%N,%N,%N,%N
; =, <, ;, :, 9, 8
BYTE (6) EE,EE,EE,EE,%N,%N
; C, B, A, @, ?, >
BYTE (6) EE,%B,%A,EE,EE,EE
; I, H, G, F, E, D
BYTE (6) %I,%H,%G,%F,%E,%D
; O, N, M, L, K, J
BYTE (6) %O,EE,EE,%L,EE,EE
; U, T, S, R, Q, P
BYTE (6) EE,%T,EE,%R,EE,%P
; [, Z, Y, X, W, V
BYTE (6) EE,EE,EE,%X,EE,EE
; _, ^, ], \
BYTE (6) EE,EE,EE,EE,EE,EE
FMTDIS:
PHASE 0 ;SET TABLE ORGIN TO 0
EE:! XWD 0,FMTERR ; ; ILLEGAL CHARACTER IN FORMAT STATEMENT
%B:! XWD FSXI,FMTERR ;I; INTEGER I/O(DEFAULT FOR UNDEFINED)
%L:! XWD FSXL,FMTOPS ;L; LOGICAL VARIABLE I/O
%I:! XWD FSXI,FMTOPS ;I; INTEGER VARIABLE
%A:! XWD FSXA,FMTOPS ;A; ALPHA I/O
%F:! XWD FSXF,FMTOPS ;F; FLOATING POINT I/O
%E:! XWD FSXE,FMTOPS ;E; POWERS OF 10 FLOATING POINT I/O
%O:! XWD FSXO,FMTOPS ;O; OCTAL I/O
%G:! XWD FSXG,FMTOPS ;G; VARIABLE OUTPUT FORMAT I/O
%D:! XWD FSXD,FMTOPS ;D; DOUBLE PRECISION FLOATING POINT I/O
%R:! XWD FSXR,FMTOPS ;R; ALPHA RIGHT JUSTIFIED
%DAT:! ; THE ABOVE DESCRIPTORS REQUIRE DATA
%T:! XWD FSXT,FMTT ;T; TABBING TO COLUMNS
%Z:! XWD FSXZ,FMTZ ;/; END OF LINE
%DL:! XWD FSXDL,FMTDL ;$; C-R CONTROL FUNCTION
%IC:! ; FOLLOWING DESCRIPTOR DO NOT HAVE AN
; INTERATION COUNT IN THE RIGHT HALF
%LP:! XWD FSXLRP,FMTLP ;(; LEFT PAREN GROUP START
%RP:! XWD FSXRP,FMTRP ;); RIGHT PAREN GROUP END
%X:! XWD FSXX,FMTX ;X; SPACING OF COLUMNS
%H:! XWD FSXH,FMTH ;H; HOLLERITH STRING I/O
%Q:! XWD FSXQ,FMTQ ;'; QUOTE STRING I/O
%P:! XWD FSXP,FMTP ;P; FLOATING POINT SCALLING
%V:! XWD 0,FMTV ; ; DYNAMIC VARIABLE
; FOLLOWING DESCRIPTORS DO NOT
; GENERATE FS STACK CODES.
%S:! XWD 0,FMTIN ;+; SPACE OF PLUS IGNORE
%M:! XWD 0,FMTM ;-; NEGATIVE SCALE FACTOR
%N:! XWD 0,FMTN ;0-9; ASCII DIGITS
%W:! XWD 0,FMTW ;.; SEPERATE W AND D FIELD FOR FLOATING
%C:! XWD 0,FMTC ;,; BASIC FIELD SEPERATOR
DEPHASE ;RETURN TO RELOCATABLE ADDRESSING
FMTERR: HRLS G1 ;REMOVE ( FROM STACK
SUB P,G1 ;ADJUST STACK POINTER
ERROR (DAT,1,5,) ;ILLEGAL CHARACTER IN FORMAT
PAGE
SUBTTL FMTXXX CONVERSION ROUNTINES (FS STACK _ ASCII FORMAT)
;CHARACTER IS A DIGIT 0,1,2,3,4,5,6,7,8,9
FMTN: IMULI T1,12 ;MULT SUMS BY 10
ADDI T1,-20(T2) ;CONVERT SIXBIT TO BINAY AND ADD
JRST FMTIN ;RETURN TO FORMAT SCAN
;CHARACTER IS A P P
FMTP: TLZE T5,FT.SCL ;NEGATIVE SCALING FACTOR
MOVNS T1 ;YES, NEGATE
;**; [607] INSERT @ FMTP+1 1/2 CLRH 21-OCT-76
TLNE G4,O.MASK ;[607] UNBOUND FORMAT ELEMENT?
JSP P1,FMTPSH ;[607] YES, DO PUSH
MOVEI G4,(T1) ;[607] GET SCALING FACTOR
DPB T3,O.PNTR ;[607] STORE OP CODE
JRST FMTC ;[607] PUSH
;CHARACTER IS A X
;**; [565] INSERT @ FMTX CLRH 21-JUL-76
FMTX: TLNE G4,O.MASK ;[565] UNBOUND FORMAT ELEMENT?
JSP P1,FMTPSH ;[565] YES, DO PUSH
;**; [573] INSERT @ FMTX AFTER EDIT 565 CLRH 2-AUG-76
SKIPN T1 ;[573] ANY REPEAT COUNT SEEN ?
MOVEI T1,1 ;[573] NO, FORCE A ONE
MOVEI G4,(T1) ;SET SCALING FACTOR IN E OR SPACE COUNT
DPB T3,O.PNTR ;[265] SET OP CODE IN E
; JRST FMTC ;PUSH FS ON THE STACK
;CHARACTER IS A COMMA ,
FMTC: JSP P1,FMTPSH ;PUSH DOWN FS IF THERE IS A OP CODE
JRST FMTINE ;RETURN TO FORMAT SCAN
;CHARACTER IS A LEFT PAREN (
FMTLP: HRLI T1,1(P2) ;SAVE ABS LOC OF LEFT PAREN ON STACK
PUSH P,T1 ;SAVE ON SYS STACK FOR RIGHT PAREN
CAIGE G3,1(G1) ;HAS NESTING DEPTH INCREASED
MOVEI G3,1(G1) ;YES, SAVE THE NEW DEPTH
AOJA G1,FMTRIN ;UPDATE () COUNT AND RETURN
;CHARACTER IS A RIGHT PAREN )
FMTRP: JUMPE G1,FMTERR ;[212] NO INITIAL LEFT PAREN
JSP P1,FMTPSH ;PUSH DOWN FS STACK IF NECESSARY
POP P,G4 ;PICK UP LEFT PAREN POINTER AND GROUP
HLRZ T4,G4 ;LOAD THE ABS LOC OF LEFT PAREN
SUB T4,FST.DY(P4) ;CALCUATE THE REL POSITION IN THE FS STACK
HRL G4,T4 ;BUILD THE RIGHT PAREN STACK WORD
CAIN G1,2 ;LEVEL 1 PAREN ? COUNTING FROM 1
MOVEM G4,LPN.BP(P4) ;LEVEL 1 PAREN SAVE FOR AUTO REPEAT
SOJLE G1,FSXEE ;EXIT IF A LEVEL 0 RIGHT PAREN
DPB T3,O.PNTR ;[265] INSERT RIGHT PAREN OP CODE
TRNE G4,777776 ;IS THERE A REPEAT COUNT
PUSH P2,G4 ;YES SAVE THIS POINTER
JRST FMTINE ;RETURN TO FORMAT SCAN
;CHARACTER IS A SLASH /
FMTZ:
;CHARACTER IS A DOLLAR SIGN $
FMTDL: JSP P1,FMTPSH ;PUSH DOWN FS STACK
MOVEI G4,1 ;SET THE INTERATION COUNT
DPB T3,O.PNTR ;[265] STORE THE OP CODE
JRST FMTC ;SIMULATE A FOLLOWING COMMA
;CHARACTER IS A TEE T
FMTT: MOVSI T0,400000 ;SET UP A T FLAG
IORM T0,@FST.DY(P4) ;SET THE FLAG FOR A LINE BUFFER
TLO T5,FT.TXX ;SET T SEEN IN FORMAT
;CHARACTER IS A BASIC FIELD DESCRIPTOR A,B,D,E,F,G,I,L,O
FMTOPS: TLNE G4,O.MASK ;[272] UNBOUND FORMAT ELEMENT?
JSP P1,FMTPSH ;[272] YES - PUSH FORMAT STACK
SKIPN G4,T1 ;IS THE REPEAT COUNT SUPPLIED
MOVEI G4,1 ;NO, DEFAULT TO 1
DPB T3,O.PNTR ;[265] SAVE OPCODE IN E
JRST FMTRIN ;RETURN TO FORMAT SCAN
;CHARACTER IS A MINUS -
FMTM: TLOA T5,FT.SCL ;SET NEGATIVE SCALE FACTOR FLAG
;CHARACTER IS A PERIOD .
FMTW: DPB T1,W.PNTR ;[265] PLACE THE W FIELD IN E
JRST FMTRIN ;RETURN TO FORMAT SCAN
;CHARACTER IS A SINGLE QUOTE '
FMTQ: JSP P1,FMTPSH ;[271] STORE ELEMENT IF ANY
HRRZ T1,FEN.BP(P4) ;LOAD THE END OF FORMAT POINT TO CHECK
SUBI T1,-1(G2) ;SUB THE CURRENT POSITION
IMULI T1,5 ;CONVERT TO CHARACTER
; JRST FMTH ;CONTINUE AS A HOLLERITH SCAN
;CHARACTER IS A H H
FMTH: PUSH P2,G2 ;SAVE THE BYTE POINTER TO THE FORMAT STRING
FMTH1: SOJL T1,FMTH3 ;IS THIS THE END
ILDB T2,G2 ;NO, GET THE NEXT HOLLERITH CHARACTER
CAIN T2,"'" ;IS THE CHARACTER A SINGLE QUOTE
CAIE T3,%Q ;AND IN SINGLE QUOTE MODE
FMTH2: AOJA G4,FMTH1 ;NO, COUNT THE CHARACTER
MOVEM G2,1(P) ;YES, SAVE POINTER ON THE STACK
ILDB T2,G2 ;GET LOOK AHEAD CHARACTER
CAIN T2,"'" ;DOUBLE SQUOTE CHARACTERS
AOJA G4,FMTH2 ;YES COUNT BOTH SQUOTES
MOVE G2,1(P) ;NO, RELOAD THE CORRECT POINTER
FMTH3: HRLZS G4 ;PUT THE CHARACTER COUNT IN LEFT
DPB T3,O.PNTR ;[265] DEPOSITE THE OP CODE
HLRZ T1,(P2) ;GET THE BYTE POINTER TO THE STRING
IDIVI T1,70000 ;COMPUTE THE CHARACTER POSITIION
DPB T1,[POINT 3,G4,7] ;SAVE THE RELATIVE CHARACTER POSITION
HLLM G4,(P2) ;PUT THE STRING INFO ON THE STACK
JRST FMTINE ;RETURN TO THE FORMAT SCAN
;CHARACTER IS A DYNAMIC POINTER V
FMTV: PUSH P2,(G2) ;SAVE THE ADDRESS OF THE VARIABLE
HRLI G2,10700 ;FORCE THE POINTER TO THE NEXT WORD
JRST FMTRIN ;RETURN TO THE FORMAT SCAN
;ROUTINE TO PUSH THE FS STACK ;ENTER VIA JSP P1,FMTPSH
FMTPSH: TLNN G4,760000 ;IS THERE AN OP IN E
JRST (P1) ;NO RETURN
TLZE T5,FT.TXX ;IS THIS A T FORMAT
JRST [TSO G4,T1 ;SET THE COLUMN COUNT IN W AND D
JRST FMTPS3] ;STORE THE DESCRIPTOR
TLNE G4,177 ;IS THERE A W FIELD
JRST FMTPS1 ;YES, STORE THE D FIELD
CAILE T1,^D127 ;GREATER THE 127
SETO T1, ;SET 127
DPB T1,W.PNTR ;[265] STORE THE W FIELD
JRST FMTPS3 ;CONTINUE
FMTPS1: CAILE T1,^D63 ;W>63
SETO T1, ;SET TO 63
DPB T1,D.PNTR ;[265] STORE THE D FIELD
FMTPS3: HLRZ T1,(P) ;PICK UP POINTER TO LAST LEFT PAREN
MOVEM G4,1(P2) ;ASSUME DESCRIPTOR IS NOT BOUNDED
XOR G4,(P2) ;COMPARE OPS,W,E ARE EQUAL
CAIE T1,1(P2) ;IS E BOUNDED BY A LEFT PAREN
TLNE G4,-1 ;ARE THE DESCRIPTORS EQUAL
;**;[467] Replace @ FMTPS3+5L JNG 17-Nov-75
JRST [PUSH P2,1(P2) ;[467] GIVE ERROR IF OVERFLOW
JRST .+3] ;[467] AND CONTINUE
HRRZ G4,1(P2) ;YES, UPDATE THE INTERATION COUNT
ADDM G4,(P2) ;INCREMENT THE IC FOR NEW E
SETZB G4,T1 ;CLEAR THE OPS,W,E AND IC FIELDS
JRST (P1) ;RETURN
;ROUTINE TO CLEAN UP THE ENCODED FORMAT LIST AND RETURN TO THE USER
FSXEE: MOVE T1,LPN.BP(P4) ;SETUP LAST LEFT PAREN FOR RESCAN
TLO T1,(<%LP>B4) ;SET THE OP CODE
PUSH P2,T1 ;PUT ON THE STACK
HLRZ T1,FMT.DY(P4) ;GET THE PAREN STACK ADDRESS
;**;[464] Insert @ FSXEE+3L JNG 31-Oct-75
LSH G3,1 ;[464] 2 WORDS/PAREN DEPTH NEEDED
JUMPE T1,FSXEE1 ;PAREN STACK NOT DEFINED
HLRZ T2,-1(T1) ;GET THE SIZE OF THE PAREN STACK
;**;[464] Delete @ FSXEE+6L JNG 31-Oct-75
CAIG G3,-4(T2) ;MUST THE STACK BE EXPANDED
JRST FSXEE2 ;NO, THE STACK IS OK
PUSHJ P,PMEM%% ;YES, REMOVE THE OLD STACK
FSXEE1: MOVEI T0,4(G3) ;GET THE NEW STACK SIZE
PUSHJ P,GMEM%% ;ALLOCATE A NEW STACK
HRLM T1,FMT.DY(P4) ;SAVE THE STACK ADDRESS
FSXEE2: MOVE T1,FST.DY(P4) ;GET THE ENCODED LIST ADDRESS BACK
SKIPGE -1(T1) ;IS THE FMT ENCODED LIST TO BE RETAINED
JRST FSXXEQ ;NO, DON'T RELEASE UNUSED ARRAY SPACE
ADD P2,[XWD 2,2] ;BUILD A NEW CONTROL WORD
HLLZ T2,P2 ;GET THE REMAINING SIZE
JUMPGE T2,FSXXEQ ;[370] NO UNUSED CORE SPACE
ADDM T2,-2(T1) ;REDUCE THE CORE BLOCK COUNT BY UNUSED SPACE
MOVNS T2 ;MAKE POSITIVE
HLLZM T2,-1(P2) ;BUILD A NEW CORE BLOCK POINTER
HRRZI T1,(P2) ;MAKE A POINTER TO THE FREE BLOCK
PUSHJ P,PMEM%% ;DELETE THE UNUSED CORE SPACE
FSXXEQ: HLRZ T1,FMT.DY(P4) ;GET THE PAREN STACK POINTER ADDRESS
ADDI T1,2 ;STEP PAST THE POINTER AND BOTTOM
SETZM -1(T1) ;SET A ZERO ON THE BOTTOM OF THE STACK
MOVEM T1,-2(T1) ;INITIALIZE THE POINTER
HRRZ P2,FST.DY(P4) ;SET THE ENCODE LIST POINTER
AOSL (P2) ;[223] UPDATE THE ACTIVITY COUNT
;[223] AND CHECK THE SIGN FOR THE STRING FLAG
AOJA P2,FSXNXT ;[223] NO STRING
;**;[510] Replace @ FSXXEQ+8L JNG 5-Dec-75
ADDI P2,1 ;[510] POINT TO THE FIRST DESCRIPTOR
TLNE P3,IO.EDC ;[223] [510] ENCODE/DECODE?
JRST FSXNXT ;[510] YES, GO DISPATCH ON FORMAT
PUSHJ P,SETSTR ;NO - SET UP A STRING BUFFER
SKIPN ALT.PC(P4) ;[510] DID SETSTR GET EOF?
JRST FSXNXT ;[510] NO, GO DISPATCH ON FORMAT
SETZM ALT.PC(P4) ;[510] ONLY ONCE
;**;[650] CHANGE AT FSXXEQ+15L SWG 21-MAR-77
PUSHJ P,DMPST. ;[650][510] FIXUP RING HEADER FOR EOF RETURN
; JRST FSXNXT ;[510] IOLS%% WILL POPJ TO EOF RETURN
PAGE
SUBTTL FSXXXX ROUTINES TO DISPATCH OF THE ENCODED STACK
FSXNXT: MOVE G4,(P2) ;LOAD E WITH STACK ELEMENT FOR DISPAT
HRRZM G4,LPN.BP(P4) ;SAVE A POSSIBLE INTERATION COUNT
FSXREP: LDB T3,O.PNTR ;[265] GET OP CODE FOR TABLE DISPATCH
HLRZ G3,FMTDIS(T3) ;GET DISPATCH ADDRESS
TLZ P2,FT.ETP!FT.GTP!FT.PRC!FT.LSD ;YES, CLEAR THE CONVERSION TYPE
CAIL T3,%DAT ;IS DATA REQUIRED FOR THIS FIELD DISC.
JRST (G3) ;NO, GO TO CONVERSION ROUTINE
TLZN P2,FT.LRP ;LAST RIGHT PAREN SEEN
JSP P1,IOLS%% ;NO, GET THE NEXT I/O LIST ITEM
PUSHJ P,(G3) ;NO, DO THE CONVERSION
FSXRTN: SOSG LPN.BP(P4) ;REDUCE INTERATION COUNT
AOJA P2,FSXNXT ;GET NEXT DESCRIPTOR FROM FS
MOVE G4,(P2) ;RELOAD THE SAVE DESCRIPTOR
JRST FSXREP ;REEXECUTE THE SAME DESCRIPTOR
FSXRP: ;ROUTINE TO PROCESS THE RIGHT PAREN
HLRZ G3,FMT.DY(P4) ;GET THE PAREN STACK POINTER
MOVE P1,(G3) ;GET THE CURRENT STACK ADDRESS
HRRZ T4,-1(P1) ;LOAD THE FS POINTER OF THE LAST PAREN
CAIE T4,(P2) ;IS THIS THE SAME PAREN OR NESTING
JRST FSXRP2 ;NESTING OF PARENS
FSXRP0: SOSLE (P1) ;SAME PAREN REDUCE THE INTERATION COUNT
JRST FSXRP1 ;NOT THE END OF INTERATION
SUB P1,[XWD 2,2] ;END OF INTERATION, REMOVE POINTERS
MOVEM P1,(G3) ;SAVE THE NEW STACK POINTER
AOJA P2,FSXNXT ;RETURN FOR NEXT DESCRIPTOR
FSXRP1: HLR P2,-1(P1) ;MODIFY FS TO LEFT PAREN POSITION RELAT.
FSXRP3: TRZ P2,760000
ADD P2,FST.DY(P4) ;ADJUST RELATIVE TO THE ENCODED LIST ORGIN
JRST FSXNXT ;RETURN
FSXRP2: PUSH P1,G4 ;PUT THE RELATIVE POSITION ON THE STACK
HRRM P2,(P1) ;PUT THE FS POSITION ON THE STACK
PUSH P1,LPN.BP(P4) ;PUT THE INTERATION COUNT ON
MOVEM P1,(G3) ;SAVE THE NEW PAREN STACK POINTER
JRST FSXRP0 ;PROCESS THIS LEFT PAREN
FSXLRP: ;LAST RIGHT PAREN FOR AUTO REPEAT
TLNN P2,FT.LST ;I/O LIST SEEN
JRST FSXLR1 ;GO SEEN IF A LIST EXISTS
JSP P1,IOLS%% ;SEE IF ANOTHER LIST ITEM
TLO P2,FT.LRP ;YES, SET THE LAST RIGHT PAREN FLAG
PUSHJ P,NXTLN. ;MORE IO LIST AND LAST RIGHT PAREN
; GET THE NEXT RECORD
;**; [530] INSERT @ FSXLRP + 4 1/2 CLRH 2-APR-76
TLNN P3,IO.STR ;[530] STRING?
JRST .+5 ;[530] NO -- SKIP THIS
SKIPN ALT.PC(P4) ;[530] DID SETSTR GET EOF?
JRST .+3 ;[530] NO
;**;[650] CHANGE AT FSXLRP+10 SWG 21-MAR-77
PUSHJ P,DMPST. ;[650][530] YES -- GET RID OF STRING
PUSHJ P,UPDASC ;[330] GO UPDATE ASSOCIATE VARIABLE
HLR P2,G4 ;GET THE REL POS OF THE LAST LEVEL 2 PAREN
JRST FSXRP3 ;GET THE NEXT DESCRITPOR
FSXLR1: ;LAST RIGHT PAREN WITH OUT AN I/O LIST
JSP P1,IOLS%% ;SEE IF A VARIABLE EXISTS IN THE LIST
ERROR (DAT,6,2,FIN%%);INPUT OUTPUT WITHOUT DATA CONVERSION
PAGE
SUBTTL FSXXXX CONVERSION ROUTINE NOT REQUIRING UUO DATA
FSXX: MOVEI T4,OBYTE. ;LOAD OUTPUT ROUTINE ADDRESS
SKIPL P3 ;INPUT OR OUTPUT
MOVEI T4,GFDEL%## ;[422] INPUT, PICK UP SAVED CHARACTER
HRLI G4,0 ;CLEAR THE OPS FIELD RT= COUNT
MOVEI T0," " ;LOAD A BLANK
JSP P1,(T4) ;OUTPUT A SPACE OR SKIP AN INPUT COLUMN
SOJG G4,.-2 ;CONTINUE UNTIL COUNT =0
AOJA P2,FSXNXT ;RETURN FOR NEST DESCRIPTOR
FSXP: HRREM G4,SCL.SV(P4) ;SAVE THE CURRENT SCALE FACTOR
AOJA P2,FSXNXT ;RETURN FOR NEXT DESCRIPTOR
FSXH: ;H CONVERSION
FSXQ: ;SINGLE QUTOE CONVERSION
HLRZ T4,(P2) ;LOAD THE NUMBER OF CHARACTER IN THE STR
ANDI T4,1777 ;CLEAR OUT THE JUNK
JUMPE T4,FSXIQ3 ;EXIT ON ZERO LENGTH
LDB T1,[POINT 3,G4,7];LOAD THE RELATIVE CHARACTER POSITION
IMULI T1,70000 ;COMPUTE THE NUMBER OF BITS TO THE RIGHT
HRLI G4,10700(T1) ;INSERT THE BYTE SIZE AND POSITION
JUMPO FSXOQ1 ;JUMP ON OUTPUT
FSXIQ1: JSP P1,IBYTE. ;GET THE NEXT INPUT BYTE
CAIE T3,%Q ;SINGLE QUOTE MODE
JRST FSXIQ2 ;NO, H CONVERSION
CAIN 0,"'" ;SINGLE QUOTE MODG4, QUOTE IN INPUT
MOVEI 0,42;" ;YES, REPLACE WITH DOUBLE QUOTE
FSXIQ2: IDPB 0,G4 ;PUT THE BYTE IN THE FORMAT STATEMENT
SOJG T4,FSXIQ1 ;REDUCE COUNT AND RETURN FOR NEXT CHAR
FSXIQ3: AOJA P2,FSXNXT ;RETURN FOR NEXT DESCRIPTOR
FSXOQ1: ILDB 0,G4 ;LOAD NEXT OUTPUT CHARACTER
CAIE T3,%Q ;SINGLE QUOTE MODE
JRST FSXOQ2 ;NO, H CONVERSION
CAIE 0,"'" ;SINGLE QUOTE IN OUTPUT
JRST FSXOQ2 ;NO, CONTINUE
IBP G4 ;YES, IGNORE
SUBI T4,1 ;REDUCE COUNT FOR SINGLE QUOTE
FSXOQ2: JSP P1,OBYTE. ;OUTPUT THIS STRING CHARACTER
SOJG T4,FSXOQ1 ;REDUCE COUNT AND CONTINUE
AOJA P2,FSXNXT ;RETURN FOR NEXT FIELD DESCRIPTOR
FSXZ: ;END OF LINE ROUTINE
PUSHJ P,NXTLN. ;DO END OF LINE STUFF
PUSHJ P,UPDASC ;[330] GO UPDATE ASSOCIATE VARIABLE
SOSLE LPN.BP(P4) ;COUNT THE INTERATIONS
JRST FSXZ ;DO IT AGAIN
AOJA P2,FSXNXT ;GET THE NEXT DESCRIPTOR
FSXDL: JUMPI FSXDL1 ;IGNORE ThE $ ON ONPUT
TLNE P3,IO.CCC ;[417] IS THIS FORMS CNTRL DEVICE
;**; [664] CHANGE @FSXDL1-2 AND DELETE FSXDL1-1 SWG 28-JUL-77
TLO P2,FT.DOL ;[664] YES, TTY DOING OUTPUT
FSXDL1: AOJA P2,FSXNXT ;GET THE NEXT DESCRIPTOR
PAGE
SUBTTL FSXT T FORMAT ROUTINE
FSXT:
;**;[503] Insert @ FSXT+1L JNG 23-Nov-75
SETZM CH.SAV(P4) ;[503] ZAP SAVED CHARACTER
MOVEI G3,DD.HRI(P3) ;INPUT HEADER
JUMPI FSXT1 ;JUMP ON INPUT
MOVEI G3,DD.HRO(P3) ;OUTPUT HEADER
FSXT1: TLNE P3,IO.EDC ;[223] ENCODE/DECODE?
JRST FSXTA ;[223] YES - USE USER STRING
SETZ T4, ;FIND THE CURRENT CHUNK NUMBER
HLRZ T5,(G3) ;GET THE STARTING CHUNK NUMBER
HRRZ T1,(G3) ;AND THE CURRENT CHUNK ADDRESS
FSXT2: CAIN T5,(T1) ;IS THIS THE CHUNK
AOJA T4,FSXT3 ;YES, COUNT AND EXIT
HRRZ T5,(T5) ;GET THE NEXT CHUNK ADDRESS
JUMPE T5,FSXT3 ;END OF CHUNKS EXIT
AOJA T4,FSXT2 ;COUNT THE CHUNK AND CONTINUE
;**; [616] CHANGE @ FSXTA CLRH 8-NOV-76
FSXTA: SKIPA T4,EDC.LN(P4) ;[616] [223] LOAD LINE WIDTH
FSXT3: IMULI T4,STRCNK*5 ;#CHUNKS TIMES CHARACTER/CHUNK
SUB T4,2(G3) ;MINUS THE UNUSED CHARACTER POS.
HLRZS G4 ;GET THE T FORMAT COLUMN NUMBER
ANDI G4,17777 ;ONLY THIRTEEN BITS
SOSGE T3,G4 ;MAKE RELATIVE TO COLUMN 0
SETZB T3,G4 ;DON'T ALLOW NEGATIVE COLUMNS
SUBI G4,(T4) ;COMPUTE THE RELATIVE OFFSET FROM HERE
JUMPE G4,FSXT9 ;ON THE COLUMN EXIT
JUMPL G4,FSXT6 ;GOING BACKWARDS
JUMPI FSXX ;GO FORWARD ON INPUT USE X FORMAT
;**; [616] DELETE TWO LINES AT FSXT4 CLRH 8-NOV-76
FSXT4:
SKIPG DD.HRO+2(P3) ;STEP THRU THE OUTPUT BUFFER CHUNKS
PUSHJ P,OBLOKS ;END OF CHUNK GET THE NEXT CHUNK
SOS DD.HRO+2(P3) ;REDUCE THE ITEM COUNT
ILDB T0,DD.HRO+1(P3) ;LOOK AT THIS CHARACTER
JUMPE T0,FSXT5 ;NULL BLANK WITH X FORMAT
SOJG G4,FSXT4 ;NON-NULL CONTINUE LOOKING
FSXT5: SKIPN T0 ;[420] IS IT A NULL?
MOVEI T0," " ;[420] YES - GET A BLANK
DPB T0,DD.HRO+1(P3) ;REPLACE THE NULL
SOJG G4,FSXX ;CONTINUE WITH FORMAT X OUTPUT
AOJA P2,FSXNXT ;RETURN FOR THE NEXT DESCRIPTOR
FSXT6: TLZ P3,IO.EOL ;[273] CLEAR END OF LINE
TLNE P3,IO.EDC ;[223] ENCODE/DECODE?
JRST [MOVE T2,0(G3) ;[223] LOAD BUFFER ADDRESS
MOVEI T4,0(T3) ;[223] COPY NEW POSITION
MOVE T3,POS.TB(P4) ;[223] LOAD STRING LENGTH
AOJA T2,FSXTB] ;[223] POINT TO BUFFER
IDIVI T3,STRCNK*5 ;CONVERT TO CHUNKS AND CHARACTERS
HLRZ T1,(G3) ;GET THE STARING CHUNK
JUMPE T3,[MOVEI T2,3(T1) ;FIRST CHUNK SKIP SAVE AREA
JRST FSXT7] ;CONTINUE
HRRZ T1,(T1) ;STEP ALONG THE CHUNK LIST
SOJG T3,.-1 ;LOOK FOR THIS CHUNK
MOVEI T2,0(T1) ;GET THE CHUNK ADDRESS
FSXT7: MOVEI T3,STRCNK*5 ;[223] NON ENCODE/DECODE
FSXTB: HRLI T2,(POINT 7,0,34);[223] SET UP AN ASCII BYTE POINTER
SUBI T3,(T4) ;REMOVE THE CHARACTERS USED
IDIVI T4,5 ;FIND THE NUMBER OF WORDS AND CHAR.
ADDI T2,(T4) ;UPDATE THE BYTE POINTER BY WORDS
JUMPE T5,FSXT8 ;ANY EXTRA BYTE
IBP T2 ;YES, UPDATE THE BYTE POINTER
SOJG T5,.-1 ;CONTINUE
FSXT8: TLNN P3,IO.EDC ;[223] ENCODE/DECODE?
HRRM T1,(G3) ;NO - STORE THE CURRENT CHUNK ADDRESS
DMOVEM T2,1(G3) ;STORE THE BYTE POINTER AND ITEM COUNT
FSXT9: AOJA P2,FSXNXT ;GET THE NEXT DESCRIPTOR
PAGE
SUBTTL FSXXXX CONVERSION ROUNTINES REQUIRING MEMORY DATA
FSXR=RIGHT%## ;ALPHA CONVERSION RIGHT JUSTIFIED
FSXA=ALPHA%## ;ALPHA CONVERSION LEFT JUSTIFIED
FSXI=INTEG%## ;INTEGER CONVERSION
FSXL=LOGIC%## ;LOGICAL VARIABLE CONVERSION
FSXO=OCTAL%## ;OCTAL CONVERSION
FSXG: TLO P2,FT.GTP ;GET G FORMAT FLAG
MOVE T5,DAT.TP+2(P4) ;GET THE VARIABLE TYPE
CAIGE T5,TP%DOR ;IS VARIABLE DOUBLE PREC. OR COMPLEX
JRST [HLRZ G3,FMTDIS+1(T5) ;NO, GET DISPATCH ADDRESS
PJRST (G3)] ;GO TO CONVERSION ROUTINE
CAIN T5,TP%DOR ;DOUBLE PREC REAL=D, COMPLEX =F
FSXD: TLO P2,FT.PRC ;SET DOUBLE PRECISION FLAG
FSXF: TLZA P2,FT.ETP ;CLEAR E TYPE CONVERSION AND
FSXE: TLO P2,FT.ETP ;SET E TYPE CONVERSION
PJRST REAL%## ;GO TO FLOATING POINT CONVERSION
PAGE
SUBTTL MTOP MAGE TAPE SIMULATION ROUTINES
; ;FLAGS DEFINED IN P2 FOR MAG TAPE SIM.
MG.CLS==040000 ;FILE MUST BE CLOSED
MG.ILL==020000 ;FUNCTION IS ILLEGAL FOR AN OUTPUT DEVICE
MG.SIM==010000 ;FUNCTION CAN BE SIMULATED FOR DEVICES OTHER THAN MAG TAPE
SIXBIT /MTOP./ ;NAME FOR TRACE
MTOP%: ;ENTRY POINT
PUSHJ P,SAVE. ;SAVE THE USER'S ACS
IFN %V1,<
HLRZ G1,(L) ;CHECK FOR A VERSION 1 CALL
LSH G1,-5 ;SHIFT OUT THE INDEX AND INDIRECT
TRZN G1,777760 ;OLD CALL
>
MOVE G1,3(L) ;NO, F10 CALL GET THE FUNCTION CODE
JSP P1,EFCTV1 ;EVALUATE IT
CAILE G1,MAG.SZ ;IS THE FUNCTION DEFINED
ERROR (SYS,3,1,CPOPJ) ;NO,IGNORE THE REQUEST
MOVEI P2,(G1) ;MOVE THE FUNCTION CODE
HLL P2,MAGTBL(G1) ;GET THE FLAGS
JSP P1,SRCFLU ;IS THE UNIT DEFINED
JRST [MOVEI T1,(G2) ;GET THE FLU
PUSH P,G2 ;SAVE THE FLU
PUSHJ P,GETDV. ;GET THE ASSOCATED DEVICE
POP P,G2 ;RESTORE THE FLU
TRNN P2,777774 ;REWIND/UNLOAD/BACKSPACE
JRST [TLNE G3,DV.AVL ;IS THE DEVICE AVAILABLE
TLNE G3,DV.DTA!DV.MTA;DECTAPE/MAGTAPE
JRST MTOPEN
POPJ P,] ;NO, RETURN
JRST MTOPEN] ;OPEN THE DEVICE
TLNE P3,IO.RAN ;RANDOM ACCESS FILE
PJRST RELE%% ;RELEASE THE RANDOM FILE
MTOP%%: MOVE G3,DD.STS(P3) ;GET THE DEVICE STATUS
TLNN P3,IO.OPN ;CHECK FOR OPEN FILE
JRST [PUSHJ P,SETDIR ;SET UP THE DIRECTORY
JRST MTOP1] ;CONTINUE
JUMPI MTOP1 ;JUMP ON INPUT
TLNE P2,MG.ILL ;IS THIS AN ILLEGAL OUTPUT FUNCTION
ERROR (DAT,10,10,CPOPJ) ;ILLEGAL FUNCTION
MTOP1: MOVE P2,MAGTBL(P2) ;GET THE FLAGS
TLNE P2,MG.CLS ;MUST FILE BE CLOSED FIRST
PUSHJ P,CLOS%F ;[175] YES CLOSE THE FILE
TLNN G3,DV.MTA ;IS THIS A MAG TAPE DEVICE
TLNE P2,MG.SIM ;NO, IS PROCESSING REQUIRED FOR OTHER DEVICES
PJRST (P2) ;YES, DO THE SPECIAL PROCESSING
PJRST FINXIT ;RETURN TO THE USER
MTOPEN: PUSHJ P,SETOPN
JRST MTOP%%
MAGTBL:
XWD MG.CLS!MG.SIM!IO.SIN!IO.SOU,MAGREW ;REWIND
XWD MG.CLS!MG.SIM!IO.SIN!IO.SOU,MAGUNL ;REWIND/UNLOAD
XWD MG.SIM! IO.SIN,MAGBSR ;BACKSPACE RECORD
XWD IO.SIN,MAGBSF ;[361] BACKSPACE FILE
XWD IO.INO!MG.CLS!IO.SOU,MAGEOF ;ENDFILE
XWD MG.ILL!MG.SIM!IO.SIN,MAGSKR ;SKIP RECORD
XWD IO.INO! IO.SOU,MAGBLK ;WRITE 3" BLANK TAPE
XWD MG.SIM!MG.ILL!IO.SIN,MAGSKF ;SKIP FILE
MAG.SZ==.-MAGTBL ;FUNCTION TABLE SIZE
PAGE
SUBTTL MTOP DEVICE DEPENDENT FUNCTIONS
MAGEOF: JUMPO FINXIT ;JUMP ON OUTPUT
PUSHJ P,SETRWR ;INPUT, SWITCH TO OUTPUT
PUSHJ P,CLOSO. ;CLOSE THE FILE
PJRST FINXIT ;RETURN TO USER
MAGBSR: ;OPEN OUTPUT TO BACKSPACE
TLNN G3,DV.MTA!DV.DSK;MUST BE DSK OR MAGTAPE
ERROR (DAT,14,10) ;CALL THE ERROR ROUTINE
JUMPI MAGBSI ;JUMP ON INPUT
PUSH P,DD.HRO+2(P3) ;SAVE THE ITEM COUNT
PUSH P,DD.HRO+1(P3) ;SAVE THE BYTE POINTER
PUSH P,DD.HRO(P3) ;SAVE THE BUFFER ADDRESS
PUSH P,DD.BLK(P3) ;SAVE THE BLOCK NUMBER
PUSHJ P,OBLOK. ;DUMP THE BLOCK
PUSHJ P,CLOSO. ;CLOSE THE FILE
MOVSI P2,IO.SIN ;SET UP INPUT MODE
PUSHJ P,SETDIR ;OPEN THE FILE
POP P,DD.BLK(P3) ;RESTORE THE BLOCK NUMBER
POP P,DD.HRI(P3) ;SETUP THE INPUT BUFFER
MOVNI T3,1 ;BACKSPACE TWO RECORDS
PUSHJ P,BSRMTB ;GET THE BLOCK JUST WRITTEN
MAGBS1: POP P,DD.HRI+1(P3) ;RESTORE THE BYTE POINTER
POP P,DD.HRI+2(P3) ;AND ITEM COUNT
BSREAD: ;RE-READ ENTRY POINT TO BACK UP
MAGBSI:
SKIPG T5,DD.HRI(P3) ;GET THE CURRENT BUFFER ADDRESS
JRST FINXIT ;NO, INPUT
MOVE T4,DD.HRI+1(P3) ;GET THE BYTE POINTER
CAIGE T5,-1(T4) ;AT THE BEGINNING OF THE BUFFER
JRST .+3 ;NO
PUSHJ P,BSRAS3 ;BACKSPACE A BLOCK
JRST FINXI0 ;BEGINNING OF FILE
MOVE T1,(T4) ;GET THE LAST WORD OF THE RECORD
HLRZ T2,T1 ;GET THE LEFT HALF
LSH T2,-^D9 ;SHIFT OUT THE CHECK SUM (IF BINARY)
TLZ P3,IO.FMT!IO.EOL!IO.EOF ;CLEAR THE FORMAT FLAG
CAIN T2,3 ;TYPE 3 BINARY CONTROL WORD
JRST BSRBIN ;YES, BINARY RECORD TO BACKSPACE
TLNE T4,3300 ;ASCI BYTE POINTER
JRST BSRAS0 ;YES, AN ASCII BYTE POINTER
HRLI T4,(POINT 7,0,34);SET UP AN ASCII BYTE POINTER
MOVEI T1,5 ;FIVE CHARACTER/WORD
IMULM T1,DD.HRI+2(P3) ;CONVERT CHARACTERS TO WORDS
MOVEM T4,DD.HRI+1(P3) ;STORE THE BYTE POINTER
JRST BSRAS0 ;CONT TNE FIRST CHARACTER
BSRASC: MOVSI T3,470000 ;CONSTANT TO DECREMENT THE BYTE POINTER
ADD T4,T3 ;STEP BACK ONE CHARACTER
TLCE T4,400000 ;CHECK FOR OVERFLOW
JRST BSRAS0 ;SAME WORD
ADD T4,[XWD 347777,-1] ;YES , MOVE BACK ONE WORD
CAIGE T5,-1(T4) ;BEGINNING OF THE BUFFER
JRST BSRAS1 ;NO
PUSHJ P,BSRAS3 ;YES, READ A NEW BLOCK
JRST BSRAS2 ;BEGINNING OF FILE
BSRAS1: HLRZ T1,(T4) ;GET THAT WORD'S LEFT HALF
LSH T1,-^D9 ;IT COULD BE THE END OF A
CAIN T1,3 ;BINARY RECORD LSCW=3
JRST BSRAS2 ;YES, BINARY EXIT
BSRAS0: AOS DD.HRI+2(P3) ;INCREMENT THE ITEM COUNT
LDB T0,T4 ;GET THIS CHARACTER
CAIG T0,14 ;[403] IS IT A DELIMITER
CAIGE T0,12 ;[403] ...
JRST BSRASC ;[403] NO
;**; [610] INSERT @ BSRAS0+4 1/2 AND BSRAS0+6 1/2 SJW 26-OCT-76
TLNE P3,IO.BSE ;[610] BS ON ERR= ?
JRST BSRAS4 ;[610] YES => STOP AT THIS DELIMITER
TLON P3,IO.FMT ;[403] FIRST DEL SET FMT FLAG
JRST BSRASC ;NO, TRY AGAIN
BSRAS4: ;[610]
MOVE T3,T4 ;[403] GET A COPY OF THE POINTER
ILDB T0,T3 ;[403] LOOK NEXT CHARACTER
CAIG T0,14 ;[403] WAS IT ALSO A DELIMITER
CAIGE T0,12 ;[403] ...
CAIA ;[403] NO CONSECUTIVE DELIMITERS
JRST BSRASC ;[403] IGNORE CONSECUTIVE DELIMITERS
SOS DD.HRI+2(P3) ;DONT'T COUNT THE DELIMITER
BSRAS2: TLO P3,IO.FMT ;SET THE FORMAT FLAG ON
MOVEM T4,DD.HRI+1(P3) ;SAVE THE BYTE POINTER
JRST FINXI0 ;RETURN
BSRAS3: TLNE G3,DV.DSK!DV.MTA;REREAD OF DEVICE
PUSHJ P,BSRPHY ;NO, DO A PHYSICAL BACKSPACE
POPJ P, ;BEGINNING OF FILE
MOVE T5,DD.HRI(P3) ;GET THE RING HEADER
HRRZ T4,DD.BUF(P3) ;GET THE BUFFER SIZE
ADDI T4,-2(T5) ;POINT THE END OF THE BUFFER
HRLI T4,(POINT 7,0,34);SET UP THE BYTE POINTER
SETZM DD.HRI+2(P3) ;CLEAR THE ITEM COUNT(BUFF FULL)
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN
BSRBIN: ;BACKSPACE ONE BINARY RECORD
ANDI T4,-1 ;CLEAR THE BYTEM POINTER
SUBI T4,(T5) ;GET THE WORDS IN THE BUFFER
SUBI T4,(T1) ;MINUS THE WORD IN THE RECORD
JUMPG T4,BSRBI2 ;START OF RECORD IN THE BUFFER
HRRZ T2,DD.BUF(P3) ;GET THE BUFFER SIZE
MOVE T3,T4 ;GET THE WORD TO GO BACK
IDIVI T3,-3(T2) ;CONVERT TO BUFFERS
ADDI T4,-3(T2) ;WORD FROM THE START OF THE BUFFER
PUSHJ P,BSRPH1 ;DO A BACKSPACE T3 = THE COUNT
JFCL ;BOF RETURN (NOT USED)
BSRBI2: HRRZ T3,DD.BUF(P3) ;GET THE BUFFER SIZE
SUBI T3,2(T4) ;GET THE WORDS LEFT IN THE BUFFER
MOVEM T3,DD.HRI+2(P3) ;SAVE THE ITEM COUNT
ADD T4,DD.HRI(P3) ;GET THE BUFFER ADDRESS
HRLI T4,(POINT 36,0,35);GET A BINARY BYTE POINTER
MOVEM T4,DD.HRI+1(P3) ;STORE THE BYTE POINTER
HLRZ T1,1(T4) ;GET THE CONTOL WORD
LSH T1,-^D9 ;SHIFT OUT THE CHECK SUM
CAIE T1,1 ;TYPE 1 CONTROL WORD
ERROR (DAT,2,7,) ;ILLEGAL LSCW: NO RECOVERY
JRST FINXI0 ;RETURN
PAGE
SUBTTL BSRXXX PHYSICAL BACKSPACE ROUTINES
BSRPHY: ;READ IN A PHYSICAL BLOCK
SETZ T3, ;BACKSPACE ONLY ONE BLOCK
BSRPH1: HRRZ T1,DD.BLK(P3) ;GET THE CURRENT BLOCK COUNT
SOJLE T1,CPOPJ ;BOF
ADD T1,T3 ;NUMBER OF BLOCK TO GO BACK PLUS 1
AOS (P) ;SET SKIP RETURN (NOT BOF)
HRRM T1,DD.BLK(P3) ;STORE THE BLOCK NUMBER
BSRMTB: TLNN G3,DV.MTA ;IS THIS A MAG TAPE
PJRST RBLOK. ;READ A RANDOME ACCESS BLOCK
JSP P1,WAIT. ;STOP THE MAGTAPE FROM BUFFERING
JSP P1,BSRMTA ;BACK UP THE MAG TAPE
SOS DD.BLK(P3) ;RETARD THE BLOCK COUNT (IBLOCK. AOS ES)
PJRST IBLOK. ;READ THE RECORD IN
BSRMTA: TLO P3,IO.RNG ;SET RING CHANGE FLAG
MOVSI T0,400000 ;SET UP A USE BIT MASK
MOVE T1,DD.HRI(P3) ;GET THE RING HEADER (BUFFER ADDRESS)
IORM T0,DD.HRI(P3) ;CHANGING RINGS FLAG
SKIPL (T1) ;IS THE USE BIT SET
JRST BSRMT1 ;NO, THRU THE RING BUFFER
ANDCAM T0,(T1) ;YES CLEAR THE USE BIT
MOVE T1,(T1) ;GET THE NEXT BUFFER ADDRESS
SOJA T3,.-4 ;COUNT THIS BUFFER
BSRMT1: MOVE T0,-1(T1) ;GET THE STATUS BITS
SETZM -1(T1) ;CLEAR THE STATUS (MTASRX) DOES NOT
TLNE T0,40 ;IS END OF FILE SET ON LOOK AHEAD
SUBI T3,1 ;YES, MUST BACK OVER EOF ALSO
HLLZ T0,DD.UNT(P3) ;GET THE CHANNEL NUMBER
IOR T0,[MTAPE 0,7] ;SET UP A PHYSICAL BACKSPACE UUO
XCT T0 ;BACKSPACE THE TAPE UNIT
AOJLE T3,.-1 ;AGAIN
ANDCMI T0,-1 ;SET UP A NO OP
XCT T0 ;WAIT UNTIL DEVICE STOPS
JRST (P1) ;RETURN
MAGBSF: MOVEI T3,2 ;[361] MAY BE THREE TIMES
TLNE P3,IO.INO ;[361] YES IF OUTPUT LAST
PUSHJ P,CLOS%F ;[361] CLOSE FILE FIRST
TLNE P3,IO.INO!IO.EOF ;[361] EOF FOUND BY USER
JRST MAGBF4 ;[361] YES
JSP P1,WAIT. ;[361] BECAUSE WILL LOOK BUFFERS
MOVE T1,DD.HRI(P3) ;[361] CURRENT BUFFER
MAGBF1: SKIPL (T1) ;[361] END OF CHAIN
JRST MAGBF2 ;[361] YES
MOVE T1,(T1) ;[361] NEXT BUFFER
JRST MAGBF1 ;[361] CONTINUE
MAGBF2: MOVE T0,-1(T1) ;[361] THE STATUS
SETZM -1(T1) ;[361] CLEAR STATUS
TLNE T0,40 ;[361] EOF SET
ADDI T3,1 ;[361] YES , ONE MORE TIME
MAGBF4: MOVEI T1,17 ;[361] GET THE BACKSPACE FILE FUNCTION
PUSHJ P,MAGXCT ;DO THE BACKSPACE OPERATION
ANDCMI T1,-1 ;SET UP A WAIT
XCT T1 ;WAIT
SOJG T3,MAGBF4 ;[361] AGAIN
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
IOR T1,[STATZ 0,4000];CHECK FOR BEGINNING OF TAPE
XCT T1 ;EXECUTE THE UUO
JRST MAGBF5 ;[361] CLOSE FILE AND RETURN TO USER
MOVEI T1,16 ;GET A MAGTAPE SKIP RECORD COMMAND
PUSHJ P,MAGXCT ;DO IT
MAGBF5: PUSHJ P,CLOSI. ;[361]
PJRST FINXIT ;RETURN TO THE USER
MAGSKR: TLNN P3,IO.OPN ;IS THE FILE OPEN
PUSHJ P,SETDIR ;NO, OPEN THE FILE
JSP P1,IPEEK. ;LOOK AT THE NEXT ITEM
MOVE T1,DD.HRI+1(P3) ;GET THEBYTE POINTER
TLNN T1,760000 ;END OF A WORD
SKIPA T1,1(T1) ;YES, GET THE NEXT WORD
MOVE T1,(T1) ;NO, USED THIS WORD
MAGSK2: TLNN T1,774000 ;IS THIS AN ASCII RECORD
JRST MAGSK3 ;BINARY SKIP
TLNN P3,IO.FMT ;INITED IN ASCII
PUSHJ P,SETMOD ;NO, DO A MODE SWITCH
TLNE P3,IO.EOL ;AT END OF A LINE
PUSHJ P,NXTLNI ;YES, GET THE NEXT INPUT LINE
PJRST FINF1 ;SCAN TO THE END OF LINE
MAGSK3: TLNN P3,IO.FMT ;[361] INITED IN BINARY MODE
JRST MAGSK4 ;[361] YES, NO CHANGE
SOS DD.HRI+1(P3) ;[361] CORRECT ADDR
AOS DD.HRI+2(P3) ;[361] CORRECT COUNT
PUSHJ P,SETMOD ;[361] GO SET BINARY MODE
MAGSK4: PUSHJ P,BINIO ;[361] BINARY, GO TO BINARY I/O ROUTINE
PJRST FINBIN ;FINISH UP BINARY I/O
; ON DATA ERROR: BACKSPACE RECORD IF POSSIBLE
; CALLED BY PUSHJ P,
; SKIP RETURN ON SUCCESS
; NEVER FAILS DIRECTLY: BSREAD CAN HIT ERROR
; NOTE: SKPRET ALSO USED FOR ERROR CLEANUP
; IO.BSE TELLS BSREAD TO STOP BACKING UP WHEN HIT 1ST CRLF SINCE
; ERROR IS BEFORE END OF REC
; IF STRING BUFFERS IN USE, THEN REAL BUFFER PTR IS ALREADY PAST
; END OF REC, SO RESET IO.BSE SO BSREAD WILL STOP BACKING UP
; AFTER 2ND CRLF
ERRBS: ;[564]
;**; [610] INSERT @ ERRBS AND ERRBS+1 1/2 SJW 26-OCT-76
TLO P3,IO.BSE ;[610] FLAG ERRBS IN PROGRESS (FOR BSREAD)
;**; [636] INSERT @ ERRBS+1 1/2 (IN EDIT 610) CLRH 10-JAN-77
MOVE G3,DD.STS(P3) ;[636] GET DEVCHR WORD
TLNN P3,IO.STR ;[636] STRING BUFFERS?
JRST .+3 ;[636] NO, SKIP THIS
TLZ P3,IO.BSE ;[636] TURN OFF FLAG
;**; [650] CHANGE AT SKPRET-2 SWG 21-MAR-77
PUSHJ P,DMPST. ;[650][636] GET RID OF STRING
PUSHJ P,BSREAD ;[564] DO BACKSPACE
TLZ P3,IO.BSE ;[610] RESET FLAG
;**; [663] @SKPRET-1 SJW 19-JUL-77
PUSHJ P,UPDCHN ;[663] UPDATE CHANNEL TABLE SO IO.BSE RESET
SKPRET: AOS (P) ;[564] ALWAYS SUCCEEDS DIRECTLY
POPJ P, ;[564] RETURN
PAGE
SUBTTL MAGXXX MAG TAPE UTILITY ROUTINES
MAGBLK: JRST FINXIT ;RETURN TO THE USER
MAGSKF: TLNN G3,DV.DSK ;IS THIS A DSK TYPE DEVICE
JRST .+4 ;NO
HLLO T1,DD.UNT(P3) ;[361] GET THE CHANNEL NUMBER
TLO T1,(USETI) ;A QUICK WAY TO EOF FOR DSK
XCT T1 ;AT EOF NO GET A BLOCK TO SET EOF FLAG
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(IN) ;INPUT UUO
XCT T1 ;READ A BLOCK
AOSA DD.BLK(P3) ;COUNT THIS BLOCK
JRST [HRRZ T1,DD.HRI(P3) ;[361] CURRENT BUFFER
SETZM -1(T1) ;[361] CLEAR STATUS
PUSHJ P,CLOSI. ;[361] CLOSE FILE
PJRST FINXIT] ;[361] RETURN TO USER
JRST .-3 ;CONTINUE TO EOF OR ERROR
MAGUNL: SKIPA T1,[11] ;UNLOAD FUNCTION
MAGREW: MOVEI T1,1 ;REWIND FUNCTION
TLNN G3,DV.MTA!DV.DTA;REWIND/UNLOAD LEGAL FOR MTA/DTA
PJRST FINXIT ;RETURN TO THE USER
PUSHJ P,MAGXCT ;XCT MAGTAPE OPERATION
TRNN T1,10 ;[210] UNLOAD REQUEST?
PUSHJ P,MAGPAS ;[210] NO - WAIT FOR REQUEST
PJRST FINXIT ;RETURN TO USER
MAGPAS: MOVEI T1,0 ;[210] SET UP WAIT REQUEST
MAGXCT: ;EXECUTE THE MAG TAPE FUNCTION
HLL T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(MTAPE) ;SET UP THE MTAPE UUO
XCT T1 ;DO IT
POPJ P, ;RETURN
PAGE
SUBTTL CLOSE ROUTINE TO CLOSE THE FILE
SIXBIT /CLOSE./ ;NAME FOR TRACE
CLOSE%: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
;**; [715] INSERT @CLOSE% + 1/2 SJW 28-SEP-77
MOVEI T0,SKPRET ;[715] CLEANUP == SKIP RETURN
MOVEM T0,ERR.RT(P4) ;[715]
JSP P1,SRCFLU ;IS THE UNIT DEFINED
POPJ P, ;NO, RETURN
MOVE G3,DD.STS(P3) ;[336][421] GET DEV CHAR STATUS
TLNN G3,DV.DSK ;[336][204][421] RANDOM ACCESS OR RING CHANGE
JRST CLOS%0 ;[336] NO
PUSHJ P,CLOS%1 ;YES CLOSE THE FILE FIRST
JSP P1,LOOKU. ;[336] LOOKUP THE FILE AGAIN BECAUSE
;[336] RENAME MAY FAIL
;**;[507] Replace @ CLOSE%+9L JNG 4-Dec-75
JRST CLOS%R ;[507] FILE GONE - JUST CLEAN UP & QUIT
;**; [633] MOVE EDIT 605; DELETE 3 LINES ADDED AT CLOS%0
;**; [633] CLRH 22-DEC-76
;**; [605] INSERT BEFORE CLOS%0 CLRH 15-OCT-76
;[633] SETZM DD.PRV(P3) ;[605] CLEAR PROTECTION CODE (AND DATES)
;[633] HLLZ T0,DD.EXT(P3) ;[605] TO USE CURRENT PROTECTION CODE
;[633] HLLZM T0,DD.EXT(P3) ;[605] UNLESS USER CHANGES IT
CLOS%0: MOVEI P2,(P3) ;[336] GET THE DD.BLK POINT FOR AN ARG SCAN
;**; [647] INSERT @ CLOS%0 + 1/2 SJW 21-MAR-77
MOVE T0,DD.DEV(P3) ;[647] SAVE DEVICE FROM OPEN TO SEE IF
MOVEM T0,DEV.SV(P4) ;[647] DEVICE= WAS SPECIFIED ON CLOSE
;**; [522] INSERT @ CLOS%0 + 1/2 CLRH 12-MAR-76
MOVEI T0,<DD.VER-DD.PPN+1> ; [522] SAVE RELEVANT VALUES
PUSHJ P,GMEM%% ; [522] IN EXTENDED BLOCK
MOVE T2,T1 ; [522] WHICH IF CHANGED WILL
HRLI T2,DD.PPN(P3) ; [522] FORCE A RENAME TO
BLT T2,<DD.VER-DD.PPN>(T1) ; [522] BE DONE
PUSH P,T1 ; [522] AND KEEP THE ADDRESS
PUSH P,P3 ;SAVE THE I/O REG
PUSHJ P,OPNARG ;USER CHANGED HIS MIND FIND OUT WHY
POP P,P3 ;RESTORE THE I/O REG
;**; [676] INSERT @ CLOS%0+11 1/2L SWG 22-AUG-77
MOVE T0,DEV.SV(P4) ;[676] PICK UP OPEN DEV SAVED ABOVE
SETZM DEV.SV(P4) ;[676] CLEAR FOR USE AS FLAG WORD
CAMN T0,DD.DEV(P3) ;[676] DID DEVICE CHANGE??
JRST CLOS01 ;[676] NO; LEAVE FLAG WORD ZEROED
HRLZI T0,CH.DEV ;[676] TURN ON BIT TO SAY DEV CHANGED
MOVEM T0,DEV.SV(P4) ;[676] STORE IN FLAG WORD DEV.SV
CLOS01: MOVE G3,DD.STS(P3) ;[676] GET THE DEV CHAR STATUS
TLNN G3,DV.DSK!DV.DTA;[204] DISK OR DECTAPE?
;**; [522] CHANGE @ CLOS%0 + 6 CLRH 12-MAR-76
JRST [SETZ T0, ;[204][522] NO CLOSE VIA CLOSE UUO
POP P,T1 ; [522] PREPARE TO RETURN CORE
PUSHJ P,PMEM%% ; [522] RETURN IT
JRST CLOS%%] ; [522] SKIP TO CLOSE CODE
SETZM DD.ALC(P3) ;CLEAR BLOCKS ALLOCATED
;**; [522] INSERT @ CLOS%0 + 7 1/2 CLRH 12-MAR-76
MOVE T1,(P) ; [522] GET ADDRESS OF SAVED STUFF
SETZ T0, ; [522] CLEAR RENAME-NECESSARY FLAG
MOVEI T2,DD.PPN(P3) ; [522] GET NEW VALUES IN EXTENDED BLOCK
MOVE T3,T1 ; [522] GET SAVED VALUES
;**; [633] INSERT IN EDIT 522 BEFORE CLOS%3 CLRH 22-DEC-76
MOVEI T5,1 ;[633] ARGUMENT CHANGED COUNTER
CLOS%3: MOVE T4,0(T2) ; [522] GET CURRENT VALUE
CAME T4,0(T3) ; [522] AND COMPARE WITH VALUE AFTER LOOKUP
;**; [633] CHANGE IN EDIT 522 @ CLO%3+2 CLRH 22-DEC-76
TRO T0,0(T5) ;[633] SET RENAME FLAG
AOJ T2, ; [522] INCREASE CURRENT POINTER
AOJ T3, ; [522] INCREASE OLD POINTER
;**; [633] INSERT IN EDIT 522 @ CLOS%3+4 1/2 CLRH 22-DEC-76
AOJ T5, ;[633] UPDATE COUNTER
CAIG T2,DD.VER(P3) ; [522] STOP WHEN ALL RELEVANT STUFF CHECKED
JRST CLOS%3 ; [522] LOOP UNTIL THEN
POP P,T1 ; [522] PREPARE TO RETURN CORE
PUSH P,T0 ; [522] SAVE THE FLAG
SETZ T0, ; [522] SET TO RETURN
PUSHJ P,PMEM%% ; [522] RETURN CORE
POP P,T0 ; [522] RESTORE THE FLAG
;**; [633] MOVE EDIT 605 TO CLOS%%-4 1/2 (IN EDIT 522) CLRH 22-DEC-76
TRNN T0,DD.PRV-DD.PPN+1 ;[633] PROTECTION CHANGED?
JRST [SETZM DD.PRV(P3) ;[633] CLEAR PROTECTION CODE
HLLZ T5,DD.EXT(P3) ;[633] AND DATES
HLLZM T5,DD.EXT(P3) ;[633] SO PROTECTION WONT CHANGE
TRZ T0,DD.PRV-DD.PPN+1 ;[633] TURN OFF FLAG BIT
JRST .+1 ] ;[633] OUT
SKIPE T0 ; [522] DON'T RENAME IF NO NEED
JSP P1,RENAM. ;CLOSE VIA RENAME UUO
JFCL ;FORGET IT
TLZA P3,IO.OPN!IO.INO;SET THE FILE CLOSED
CLOS%%: PUSHJ P,CLOS%1 ;CLOSE VIA CLOSE UUO
MOVE G3,DD.STS(P3) ;GET THE DEVICE CHARACTERISTICS
LDB G4,[POINT 4,DD.BLK(P3),17];GET THE DISPOSE INDEX
CAIL G4,DIS.SZ ;LEGAL ARGUMENT
PJRST CLOS%R ;[331] [240] GO RELEASE THE DEVICE
CAIGE G4,QUE.DP ;QMANGR REQUIRED
PJRST @DIS.DP(G4) ;NO, PROCESS THE DISPOSE ARGUMENT
IFE QUEUER,<
PJRST CLOS%R ;[331] [240] GO RELEASE THE DEVICE
>
IFN QUEUER,<
PUSHJ P,CLOS.Q ;[331] GO PROCESS THE QUEUE REQUEST
PJRST CLOS%R ;[331] AND GO RELEASE THE DEVICE
>
DIS.DP: ;/DISPOSE='STRING' DISPATCH LIST
XWD CLSSAV ;/DISPOSE=SAVE
XWD CLSDEL ;/DISPOSE=DELETE
XWD CLSREN ;/DISPOSE=RENAME
PAGE
SUBTTL CLOSE QUEUEING ROUTINES (CALL QMANGR VIA FORQUE)
CLSDEL: ;DELETE THE FILE
SETZM DD.NAM(P3) ;CLEAR THE FILE NAME
TLNN G3,DV.DTA!DV.DSK;[314] MUST BE A DISK OR DECTAPE
PJRST CLOS%R ;[331] NO, GO RELEASE THE DEVICE
PUSH P,.+2 ;[314] IN CASE OF ERROR
JSP P1,RENAM. ;DELETE THE FILE
JFCL .+2 ;[314] IGORE IF FILE NOT FOUND
POP P,(P) ;[314] CLEAR JUNK OF STACK
PJRST CLOS%R ;[331] [240] NO,GO RELEASE THE DEVICE
;**; [630] INSERT BEFORE CLOS.Q CLRH 6-DEC-76
PJRST CLOS%R ;[630] IF THE RENAME LOST AND
;[630] NOT BECAUSE FILE WAS NOT FOUND,
; ;[630] OPENER WILL DO A SKIP RETURN
;[630] SO THE PUSH ABOVE WILL CAUSE US
;[630] TO END UP IN CLOS.Q
IFN QUEUER,<
.GTNM1==31 ;FIRST HALF OF USER'S NAME
.GTNM2==32 ;LAST HALF OF USER'S NAME
CLOS.Q:
TLNE G3,DV.DSK ;MUST BE A DISK TO SPOOL
JSP P1,LOOKU. ;LOOKUP THE FILE AGAIN
POPJ P, ;FILE IS GONE FORGET IT
MOVEI T0,Q.END ;GET THE ARGUMNET BLOCK SIZE
PUSHJ P,GMEM%% ;ALLOCATE
MOVEI P2,(T1) ;PUT THE POINTER IN A SAVE PLACE
MOVE T1,QUE.TB-QUE.DP(G4) ;GET THE QUEUE CODES
HRRZM T1,Q.OPR(P2) ;STORE THE QUEUE CODE
;**; [647] INSERT @ CLOS.Q+10(8) SJW 21-MAR-77
MOVE T2,DD.DEV(P3) ;[647] GET DEVICE
MOVEM T2,Q.DEV(P2) ;[647] STORE DEVICE AS QUEUE NAME
;**; [676] INSERT + CHANGE @ CLOS.Q+12(8) SWG 23-AUG-77
MOVE T2,DEV.SV(P4) ;[676] PICK UP FLAG WORD FOR CHANGES
TLZN T2,CH.DEV ;[676] WAS DEVICE= CHANGED ON CLOSE?
HLLZM T1,Q.DEV(P2) ;[647] NO, USE DEFAULT Q NAME AS DEVICE
MOVEM T2,DEV.SV(P4) ;[676] RESET LOW CORE FLAG WORD FOR NEXT TIME
MOVE T1,[BYTE (9)Q.FF-Q.ZER-1,Q.FLEN(18)1];GET THE QUE SIZE
MOVEM T1,Q.LEN(P2) ;SAVE THE LENGTH CODES
MOVE T1,DD.SIZ(P3) ;GET THE NUMBER OF WORD IN THE FILE
HRRM T2,Q.OSIZ(P2) ;SAVE
GETPPN T1, ;GET THE USER'S PPN
JFCL ;
MOVEM T1,Q.PPN(P2) ;STORE
MOVEI T1,12 ;STANDARD PRIORITY
MOVEM T1,Q.PRI(P2) ;STORE IT
HRROI T1,.GTNM1 ;GET THE USER'S NAME
HRROI T2,.GTNM2 ;PART 2
GETTAB T1, ;GET IT
JRST .+2 ;NOT THERE
GETTAB T2, ;GET PART 2
SETZB T1,T2 ;NO USER NAME
DMOVEM T1,Q.USER(P2) ;STORE
MOVE T1,DD.SIZ(P3) ;GET THE FILE SIZE IN WORDS
ADDI T1,177+^D20B28 ;ADD OFFSET AND ROUND TO BLOCKS
LSH T1,-^D7 ;GET THE BLOCKS + OFFSET IN THE FILE
HRLZM T1,Q.OSIZ(P2) ;STORE THE FILE SIZE
ADDI T1,-11 ;REMOVE OFFSET AND ROUND TO UNITS OF 8
LSH T1,-^D3 ;FILE SIZE IN UNITS OF 8
HRRM T1,Q.OSIZ(P2) ;STORE
;**;[646] @ CLOS.Q+40(8) SJW 18-MAR-77
SKIPN T1,DD.PPN(P3) ;[646][537] PPN OR PATH SPECIFIED ?
JRST CLOSQ2 ;[646] NO, GET FULL PATH
TLNE T1,-1 ;[537] YES, WAS IT PATH ?
JRST [MOVEM T1,Q.FDIR(P2) ;[537] NO, STORE PPN
JRST CLOSQ1 ] ;[537] AND SKIP SFD'S
HRLI T1,2(T1) ;[537] GET PPN ADDRESS IN PATH
HRRI T1,Q.FDIR(P2) ;[537] PUT PATH INTO QUEUE BLOCK
BLT T1,Q.FDIR+5(P2) ;[537]
;**; [646] INSERT @ CLOSQ1 (MOVED FROM CLOS.Q+40) SJW 18-MAR-77
CLOSQ1: MOVE T1,DD.STR(P3) ;[646][240] GET THE FILE DEVICE NAME
MOVEM T1,Q.FSTR(P2) ;[646]STORE
MOVE T1,DD.NAM(P3) ;[537] GET THE FILE NAME
MOVEM T1,Q.FNAM(P2) ;STORE
MOVEM T1,Q.JOB(P2) ;USE THE FILE NAME AS A JOB NAME
HLRZ T1,DD.EXT(P3) ;GET THE EXTENSION
HRLZM T1,Q.FEXT(P2) ;STORE
AOS Q.FBIT(P2) ;STARTING POINT IN THE FILE
CAIN G4,DIS.LS ;[344] IF /DISPOSE=LIST
SKIPA T2,[1B5!1B20!2B29!1B35] ;[344] SET DISPOSE=RENAME
MOVE T2,[1B5!1B20!1B29!1B35] ;SET THE SPOOLER FLAGS
LDB T3,[POINT 4,DD.BLK(P3),13];GET THE FILE TYPE
CAIN T3,3 ;SIXBIT COBOL STYLE
TROA T2,3B26 ;YES, SET COBOL DATA TYPE
CAIN T1,(SIXBIT /DAT/) ;EXTENSION DAT FORTRAN STYLE
TLNE P3,IO.CCC ;NAD CARRIAGLE CONTROL CHARACTERS
TROA T2,1B26 ;YES, SET NORMAL ASCII
IORI T2,2B26 ;FORTRAN DATA SET MODE
MOVEM T2,Q.FMOD(P2) ;STORE THE FILE MODE
MOVEI T1,(P2) ;SET THE ARG BLOCK FOR QMANGR
HRLI T1,Q.END ;SET UP THE PARAMETER AREA SIZE
PUSH P,.JBHRL## ;[346] SAVE HIGH SEGMENT LENGTH
PUSHJ P,FORQU%## ;CALL QMANGR VIA FORQUE
POP P,.JBHRL ;[346] RESTORE
PUSHJ P,PMEM%% ;[240] RETURN THE ARG BLOCK TO THE HEAP
PJRST UPDCHN ;[240] UPDATE CHANNEL TABLE
;**;[646] INSERT BEFORE QUE.TB SJW 18-MAR-77
CLOSQ2: ;[646] GET PATH OF FILE
LDB T1,[POINT 4,DD.UNT(P3),12] ;[646] GET CHANNEL #
MOVEM T1,Q.PATH(P2) ;[646] JOB # = 0,,CHANNEL #
;[646] REST OF Q BLOCK CLEARED BY GMEM%%
MOVEI T1,Q.PATH(P2) ;[646] PATH. ARG POINTER
HRLI T1,^D8 ;[646] PATH. LENGTH OF ARG BLOCK
PATH. T1, ;[646] GET THE PATH
POPJ P, ;[646] ERROR: FORGET IT
SETZM Q.PATH(P2) ;[646] CLEAR Q.PATH = Q.ONOT+1
JRST CLOSQ1 ;[646] FILL IN Q.FSTR = Q.PATH+1
QUE.TB: ;TABLE OF QUEUE CODES
XWD 'LPT',1B23!10B29!1B35 ;[344] /DISPOSE=PRINT
XWD 'PTP',1B23!10B29!1B35 ;[344] /DISPOSE=PUNCH
XWD 'LPT',1B23!10B29!1B35 ;[344] /DISPOSE=LIST
PAGE
SUBTTL QMANGR ARG BLOCK DEFNS.
LOC 0 ;DEFINE QUEUE AREA (RELOCATABLE)
Q.ZER:! ;START OF QUEUE PARAMETER AREA
Q.MEM:! BLOCK 1 ;USED FOR CHARACTER TYPER
Q.OPR:! BLOCK 1 ;OPERATION CODE
Q.LEN:! BLOCK 1 ;LENGTHS IN AREA
Q.DEV:! BLOCK 1 ;DESTINATION DEVICE
Q.PPN:! BLOCK 1 ;PPN ORIGINATING REQUEST
Q.JOB:! BLOCK 1 ;JOB NAME
Q.SEQ:! BLOCK 1 ;JOB SEQUENCE NUMBER
Q.PRI:! BLOCK 1 ;EXTERNAL PRIORITY
Q.PDEV:!BLOCK 1 ;PROCESSING DEVICE
Q.TIME:!BLOCK 1 ;PROCESSING TIME OF DAY (PPN MASK ON MODIFY)
Q.CREA:!BLOCK 1 ;CREATION TIME (JOB NAME MASK ON MODIFY)
Q.AFTR:!BLOCK 1 ;AFTER PARAMETER
Q.DEAD:!BLOCK 1 ;DEADLINE TIME
Q.CNO:! BLOCK 1 ;CHARGE NUMBER
Q.USER:!BLOCK 2 ;USER'S NAME
Q.O:! ;START OF OUTPUT QUEUE AREA
Q.OFRM:!BLOCK 1 ;FORMS REQUEST
Q.OSIZ:!BLOCK 1 ;LIMIT WORD
Q.ONOT:!BLOCK 2 ;ANNOTATION
;**;[646] INSERT AFTER Q.ONOT SJW 18-MAR-77
Q.PATH==Q.ONOT+1 ;[646] PATH. ARG BLOCK
Q.FF:!
Q.F:! ;DUPLICATED AREA FOR EACH REQUESTED FILE
Q.FSTR:!BLOCK 1 ;FILE STRUCTURE
Q.FDIR:!BLOCK 6 ;ORIGINAL DIRECTORY
Q.FNAM:!BLOCK 1 ;ORIGINAL NAME
Q.FEXT:!BLOCK 1 ;ORIGINAL EXTENSION
Q.FRNM:!BLOCK 1 ;RENAMED FILE NAME (0 IF NOT)
Q.FBIT:!BLOCK 1 ;BIT 0=PRESERVED BY QUEUE, REST=STARTING BIT
Q.FMOD:!BLOCK 1 ;FILE SWITCHES
Q.FLEN==.-Q.F
Q.FRPT:!BLOCK 2 ;/REPORT KEY
Q.FRPL==.-Q.F
Q.FDRM:!BLOCK 6 ;DIRECTORY MASK
Q.FNMM:!BLOCK 1 ;FILE NAME MASK
Q.FEXM:!BLOCK 1 ;FILE EXT MASK
Q.FMDM:!BLOCK 1 ;MODIFIER MASK
Q.FLNM==.-Q.F
Q.END:!
RELOC
>;END IFN QUEUER,
CLOS%1: TLNN P3,IO.OPN ;[204] IS THE UNIT OPEN?
POPJ P, ;UNIT DEFINED BUT NOT OPEN RETURN
CLOS%F: TLNN P3,IO.RAN!IO.RNG;[175] RANDOM ACCESS OR RING CHANGE?
JRST CLOSB. ;[175] NO, NORMAL CLOSE WILL WORK
TLNE P3,IO.INO ;OUTPUT LAST
SKIPG DD.HRO(P3) ;YES, IS THE RING BUFFERS SET UP
JRST CLOS%2 ;NO, OUTPUT RING OR INPUT
PUSHJ P,WBLOK. ;DUMP THE BLOCK
CLOS%2: JSP P1,WAIT. ;STOP THE DEVICE AFTER THE LAST BLOCK
MOVSI T0,400000 ;SET UP A USE BIT
IORM T0,DD.HRO(P3) ;SET THE RING NOT IN USE
IORM T0,DD.HRI(P3)
JRST CLOSB. ;CLOSE THE FILE
CLOSO.::MOVEI T1,2 ;CLOSE OUTPUT
JRST CLOS.. ;[204] COMMON ROUTINE
;**; [540] CHANGE @ CLOSB. CLRH 4-MAY-76
CLOSB.::MOVEI T1,0 ;[540] CLOSE INPUT/OUTPUT
JSP P1,WAIT. ;[540] WAIT FOR BUFFERS TO SETTLE DOWN
JRST CLOS.. ;[540] GO CLOSE
CLOSI.::MOVEI T1,1 ;CLOSE INPUT ONLY
CLOS..::TLZ P3,IO.EOF ;[204] CLEAR EOF FLAG
HLRZ T2,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLNE P3,IO.TTA ;[204] USER'S TTY?
JRST UPDCHN ;[240] YES - NOOP CLOSE
TLO T1,<(CLOSE)>(T2);OTHERWISE SET UP THE UUO
XCT T1 ;CLOSE THE FILE
;**; [677] INSERT @ CLOS..+6 SWG 29-AUG-77
HLLZ T1,DD.UNT(P3) ;[677] GET THE CHANNEL NUMBER
TLO T1,(GETSTS) ;[677] GET A STATUS UUO
XCT T1 ;[677] GET THE DEVICE STATUS
TRNE T0,740000 ;[677] ARE ANY ERROR BITS ON?
JRST [MOVEI T1,CLSERR ;[677] YES - SET UP ERROR RETURN
MOVEM T1,ERR.RT(P4) ;[677] IN CASE ERR= SUPPLIED
ERROR (DEV,0,5,CLOS.1) ;[677] DO THE ERROR REPORT
] ;[677] END OF LITERAL
CLOS.1: TLZ P3,IO.OPN ;[677][204] CLEAR THE OPEN BIT
SETZM DD.HRI+2(P3) ;CLEAR THE ITEM COUNTS
SETZM DD.HRO+2(P3) ;ETC
UPDCHN: HLRZ T1,DD.UNT(P3) ;[240] LOAD CHANNEL NUMBER
LSH T1,-5 ;[240] POSITION THE CHANNEL NUMBER
ADDI T1,CHN.TB(P4) ;[240] POINT TO THE CHANNEL ENTRY
MOVEM P3,(T1) ;[240] UPDATE THE CHANNEL TABLE
POPJ P, ;EXIT
; ON DEVICE ERROR ON CLOSE NEED TO MAKE SURE
; UNIT IS CLOSED SO WILL NOT GET ERRO
; ON EXITING.
; CALLED BY PUSHJ,P
; SKIP RETURN VIA SKPRET ON SUCCESS
;**; [677] INSERT @ UPDCHN+5 SWG 30-AUG-77
CLSERR: TLZ P3,IO.OPN ;[677] CLOSE THE FILE
SETZM DD.HRI+2(P3) ;[677] CLEAR THE ITEM COUNTS
SETZM DD.HRO+2(P3) ;[677] ETC
PUSHJ P,UPDCHN ;[677] UPDATE CHANNEL TABLE
PJRST SKPRET ;[677] DO A SKIP RETURN
PAGE
SUBTTL RELEASE ROUTINE TO RELEASE A SOFTWARE CHANNEL AND DD.BLK
SIXBIT /RELEA./ ;NAME FOR TRACE
RELEA%: ;ENTRY TO RELEASE A FORTRAN LOGICAL UNIT
PUSHJ P,SAVE. ;SAVE THE USER'S ACS
JSP P1,SRCFLU ;IS THE UNIT ASSIGNED
POPJ P, ;NO, RETURN UNIT IS RELEASED
;**;[635] CHANGE AT RELE%% SWG 30-DEC-76
RELE%%::SKIPE P3 ;[635][331] IS THE CHANNEL OPEN
PJRST CLOS%% ;[331] YES CLOSE AND RELEASE
;**; [676] CHANGE @ CLOS%R SWG 23-AUG-77
CLOS%R: SETZB T0,DEV.SV(P4) ;[676][331] [204] CLEAR THE CHANNEL POINTER
;[676] AND FLAG WORD FOR SAFETY SAKE
;[676] SO WILL ALWAYS BE ZERO AT BEG OF CLOSE
DPB T0,FLU.BP(P4) ;[204] IN THE FLU TABLE
TLNE P3,IO.TTA ;[204] USER'S TELETYPE?
POPJ P, ;[204] YES RELEASE IS A NOOP
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(RELEAS) ;SET UP THE RELEASE UUO
XCT T1 ;RELEAE THE SOFTWARE CHANNEL
HLRZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
LSH T1,-5 ;POSITION
JSP P1,PUTCHN ;DEALLOCATE THE CHANNEL
HRRZ T1,RER.SV(P4) ;[267] GET REREAD INFO
CAIN T1,(P3) ;[267] SAME AS RELEASED?
SETZM RER.SV(P4) ;[267] YES, CLEAR REREAD INFO
; ;ENTER HERE TO REMOVE A DDB IN P3
RELE%1: SKIPE T1,DD.RLS(P3) ;IS THERE A REELS ARRAY ASSIGNED
PUSHJ P,PMEM%% ;YES, DEALLOCATE THE REELS ARRAY
SKIPN T1,DD.PPN(P3) ;CHECK FOR A PPN
JRST RELE%2 ;[204] NO, PPN
TLNN T1,-1 ;IS THERE A SFD ARRAY
PUSHJ P,PMEM%% ;YES, DEALLOCATE THE SFD ARRAY
RELE%2: HRRZI T1,(P3) ;[204] GET THE DD.BLK POINTER
PJRST PMEM%% ;DEALLOCATE THE DD.BLK (RETURN)
CLSSAV==CLOS%R ;[240] [331] FILE IS SAVED BY DEFAULT
CLSREN==CLOS%R ;[240] [331] FILE ALREADY RENAMED AT CLOS%%-2
PAGE
SUBTTL EXIT CLOSE OUT THE I/O CHANNEL AND EXIT VIA FORERR
SIXBIT /EXIT./ ;NAME FOR TRACE
EXIT%:: PUSHJ P,SAVE. ;SAVE THE USER'S ACS
;**;[606] @EXIT%% SJW 18-OCT-76
;**; [711] @EXIT%% SJW 23-SEP-77
EXIT%%: SETZM ERR.V2(P4) ;[711] CLEAR OLD ERROR NUMBER SO ER%SYS 1
;[711] WON'T FIND ERROR IN PROGRESS
SETZM ERR.PC(P4) ;[606] CLEAR ERR=,,END= SO ER%SYS 1
;[606] WON'T TRAP AN ERR=
;**; [676] INSERT @ EXIT%%+1/2 SWG 23-AUG-77
SETZM DEV.SV(P4) ;[676] CLEAR FLAG WORD IN CASE LEFT OVER
MOVEI P2,CHN.TB+1(P4) ;GET THE CHANNEL TABLE ADDRESS
HRLI P2,-17 ;SCAN ONLY 15 CHANNELS
EXIT.1: SETCM P3,0(P2) ;[214] USER'S CHANNEL
JUMPE P3,EXIT.2 ;[214] DON'T RELEASE USER CHANNELS
;**; [675] CHANGE + INSERT @ EXIT.1 + 2 SWG 22-AUG-77
SETCA P3, ;[675] IS THIS CHANNEL
JUMPE P3,EXIT.2 ;[675] DEFINED??
PUSH P,P2 ;[675] SAVE AOBJN PTR IN CASE CLOS.Q IS CALED
PUSHJ P,RELE%% ;YES, RELEASE THE CHANNEL
;**; [675] INSERT @ EXIT.2 SWG 22-AUG-77
POP P,P2 ;[675] RESTORE P2
EXIT.2: AOBJN P2,EXIT.1 ;CONTINUE THRU ALL CHANNELS
SKIPE P3,CHN.TB+20(P4);GET THE TTY CHANNEL
PUSHJ P,OBLOK. ;DUMP THE LAST LINE
ERROR (SYS,1,0,0) ;EXIT VIA FORERR FOR MESSAGE
PAGE
SUBTTL GMEM%% PMEM%% SMEM%% MEMORY MANAGEMENT ROUTINES
; ON ENTRY,
; IF T0 < 0, A DEFRAGMENTATION IS PERFORMED, AND THE MAXIMUM
; CONTIGUOUS AREA RETURNED
; IF T0 = 0, T1 IS THE ADDRESS OF THE SECOND WORD OF A SPACE,
; OR A CHAIN OF SPACES TO BE RETURNED TO THE INACTIVE HEAP CHAIN
; (THE FIRST WORD IS THE CONTROL WORD DESCRIBED BELOW)
; IF T0 > 0, T0 IS THE NUMBER OF WORDS OF SPACE REQUIRED
; IF CORE IS UNAVAILABLE, EXIT VIA FORER
; IF CORE IS AVAILABLE, RETURN THE ADDRESS OF THE SECOND WORD
; OF A SPACE ONE WORD GREATER THAN THE SPACE REQUIRED IN T1
; (THE FIRST WORD IS THE CONTROL WORD DESCRIBED BELOW)
; THE INACTIVE HEAP CHAIN IS ADDRESSED BY FRE.DY, AND CONSISTS
; OF A CHAIN OF SPACES WHOSE FIRST WORD IS FORMATTED AS FOLLOWS:
; LH: NUMBER OF WORDS IN SPACE (INCLUDING THIS ONE)
; RH: POINTER TO NEXT SPACE (ZERO IF NONE)
SIXBIT /DECOR./ ;NAME FOR TRACE
DECOR%: PUSHJ P,SAVE. ;SAVE THE USER'S AC'S
JSP P1,EFCTV. ;[265] GET THE ARGUMENT ADDRESS
TRNN G1,-20 ;AC ARGUMENT
ADDI G1,ACC.SV(P4) ;YES, RELOCATE
SKIPGE T1,(G1) ;GET THE VALUE
POPJ P, ;NOT VALID
PJRST PMEM%% ;RELEASE THE CORE BLOCK
SIXBIT /ALCOR./ ;NAME FOR TRACE
ALCOR%: PUSHJ P,SAVE. ;ENTRY FROM USER PROGRAMS
JSP P1,EFCTV. ;[265] GET THE ARGUMENT ADDRESS
TRNN G1,-20 ;AC ARGUMENT
ADDI G1,ACC.SV(P4) ;YES, RELOCATE
MOVE T0,(G1) ;GET THE VALUE
;**;[514] Change @ ALCOR1 JNG 11-Feb-76
;[514] ENTER HERE FROM FORFUN F.COR ROUTINE (SO WILL GET GMEM%% ERRORS)
;**;[650] CHANGE LABEL AT ALCOR1 TO FMEM%% SWG 21-MAR-77
FMEM%%::PUSHJ P,GMEM%% ;[650][351] GET THE CORE BLOCK
;[351] SKIP RETURN IF FAILS
HRRZM T1,ACC.SV+T0(P4);SAVE CORE ADDRESS IN USER'S ACS
POPJ P, ;RETURN TO USER
GMEM%%:: ;INTERNAL ROUTINE TO GET MEMORY FROM THE HEAP
JUMPE T0,PMEM%% ; JUMP IF SPACE TO BE RETURNED
GMEM0: JUMPL T0,SMEM%% ; SUPER-GMEM%%
GMEM1: MOVEI T2,FRE.DY(P4) ; PREPARE FOR SEARCH
HRRZ T1,(T2) ;[234] ANY HEAP LEFT
JUMPE T1,GMEM2B ;[234] NO, GET SOME
GMEM2: HLRZ T3,(T1) ; GET SIZE OF THIS SPACE
;**; [547] CHANGE @ GMEM2 + 1 CLRH 19-MAY-76
SKIPN T3 ;[547] VALID ?
ERROR (SYS,6,17,) ;[547] NO, GIVE A FATAL ERROR
CAMLE T3,T0 ; BIG ENOUGH?
AOJA T0,GMEM9 ; YES
MOVE T2,T1 ; NO -
HRRZ T1,(T2) ; SELECT NEXT SPACE
JUMPN T1,GMEM2 ; AND CONTINUE UNLESS NONE LEFT
GMEM2A: PUSHJ P,GMEM3 ;TAKE A GARBA