Directory of image this file is from
This file as a plain text file
TITLE IOFUN - PPL INPUT/OUTPUT SYSTEM FUNCTIONS /EAT/ 31-MAY-73 HISEG SEARCH PPL ;SEE COMMENTS AT BEGINNING OF SYSFUN FOR SYSTEM FUNCTION CALLING ; CONVENTIONS. SUBTTL OUTPUT CONVERSION FUNCTIONS ;PRINT(A,B,C,......) - PRINT THE VALUES OF ALL THE ARGS, ON ONE LINE SPRINT: XWD 0,-1 ;HAS VARIABLE NUMBER OF ARGS MOVEI AC1,PRINT0 ;SET UP ADDR FOR REPEATED CALL ;HERE TO DISTRIBUTE CALLS TO ROUTINE WHOSE ADDRESS IS IN AC1 OVER ; THE ENTIRE ARGLIST, THEN RETURN NULL. RPTARG: CALL ARGSEQ ;SEQUENCE DOWN ARGLIST CALLING PRINT EACH TIME JFCL ;(ARGSEQ MIGHT SKIP IF NULL ARGLIST) JRST RETNUL ;RETURN NULL AS VALUE OF CALL
;FORMAT(S1,A,B,S2,C, ... ) - FORMATTED NUMERIC OUTPUT ;S1,S2 ARE STRINGS GIVING FORMAT SPECIFICATIONS ;A,B,C ARE VALUES OF TYPE INT,REAL, OR DBL TO BE PRINTED ;IN THE MOST RECENTLY-SPECIFIED FORMAT ;SPECIAL FLAGS FOR CONSTRUCTING FORMAT WORD ;SEE PRINT.MAC FOR DEFINITIONS FMFLF== 1B0 FMFLP== 1B1 FMFLX== 1B2 FMFLD== 1B3 SFORMA: XWD 0,-1 ;TAKES VARIABLE NUMBER OF ARGS JSP AC1,RPTARG ;DO FOLLOWING FOR ALL ARGS SFORM1: CALL ARGPRP ;COERCE IT JRST SFORM2 ;NON-ATOMIC, SEE IF STRING CAILE T,U.DBL/2 ;ATOMIC. MAKE SURE IT IS ARITHMETIC ILLTYPE MOVE AC7,FORMWD ;OK. LOAD FORMAT WORD MOVE AC1,R ;LOAD (R,R2) AS ARGS MOVE AC2,R2 JRST FORMPR ;PRINT IN CURRENT FORMAT ;HERE TO CONSTRUCT, IN FORMWD, A FORMAT WORD, GIVEN THE PZ ADDR ;OF A STRING IN R BP== AC10 ;DEFINITIONS FROM TEXT.MAC C== AC11 N== AC12 CT== AC13 SFORM2: CAIE T,U.STRING ;A STRING? ILLTYPE ;NO, IMPROPER ARG FOR FORMAT MOVEM CAR,SAVCAR ;NEEDED IF ERROR IN FMTSPC SAVE <BP,C,N,CT> ;SAVE AC'S USED FOR CHARACTER PROCESSING HRRZ BP,(R) ;GET DZ ADDR OF STRING ADD BP,[POINT 7,1,35] ;PREPARE TO UNPACK CHARACTERS HRRE N,(BP) ;RETRIEVE CHARACTER COUNT SETZ AC7, ;INITIALIZE FORMAT WORD
CALL GPASST ;GET FIRST NONBLANK CHARACTER CAIE C,"F" ;F FOR FREE FORMAT? CAIN C,"F"+40 JRST FREFMT ;YES, PERFORM SPECIAL PROCESSING CAIE C,"E" ;NO. START WITH AN E? CAIN C,"E"+40 JRST FRMWE ;YES, SET E FLAG FOR EXPONENT CAIE C,"D" ;NO. START WITH A D? CAIN C,"D"+40 TLOA AC7,(FMFLD) ;YES, SET "D" FLAG AND SKIP JRST MKFRML ;NO, NOT "D" OR "E" FRMWE: TLO AC7,(FMFLX) ;SET EXPONENT FLAG FOR "D" OR "E" CALL GPASST ;PASS "D" OR "E" AND SPACES MKFRML: TLO AC7,(FMFLF) ;INDICATE FORMATTING TO TAKE PLACE MKFRM1: JUMPE C,MKFRMX ;DONE IF OUT OF CHARACTERS CAIN C,"." ;PERIOD? JRST MKFRMP ;YES, HANDLE IT TRNN CT,DIGIT ;MUST SEE DIGIT FIRST JRST ERRFMT TDZA R,R ;OK. INITIALIZE RESULT WORD FMTSP1: CALL GETSTC ;GET STRING CHARACTER TRNN CT,DIGIT ;A DIGIT? JRST FMTSP2 ;NO IMULI R,^D10 ;YES. ADD IT ON ADDI R,-60(C) CAIGE R,200 ;CHECK SIZE JRST FMTSP1 ;OK JRST ERRFMT ;FORMAT SPEC TOO LARGE FMTSP2: CALL PASSTS ;PASS SPACES TABS AFTER NUMBER CAIE C,"D" ;THE LETTER "D"? (UPPER OR LOWER CASE) CAIN C,"D"+40 JRST DFMT ;YES, MAKING NON-0-SUPPR ENTRY CAIE C,"Z" ;NO, THE LETTER "Z"? CAIN C,"Z"+40 JRST ZFMT ;YES, MAKING 0-SUPPR ENTRY ERRFMT: MOVE CAR,SAVCAR ;ERROR. RESTORE CAR SO ERROR RECOVERY WORKS SFNERR MSG(ERFMT) ;ERROR IN FORMAT SPECIFICATION
ZFMT: TDZA C,C ;"Z" SEEN, LD ZERO DFMT: MOVEI C,1 ;"D" SEEN, LD ONE TLNE AC7,(FMFLP) ;"." BEEN SEEN? ADDI C,2 ;YES, INCR BY 2 DPB R,FMLZ(C) ;STORE PROPER FIELD IN FORMAT WORD MKFRM2: CALL GPASST ;PASS "D" OR "Z" AND SPACES JRST MKFRM1 ;TRY FOR MORE FIELDS MKFRMP: TLON AC7,(FMFLP) ;HERE WHEN "." SEEN; SET AND TEST "." FLAG JRST MKFRM2 ;CONTINUE PROCESSING JRST ERRFMT ;UGH, TOO MANY DECIMAL POINTS MKFRMX: RESTORE <CT,N,C,BP> ;RESTORE CLOBBERED AC'S MOVEM AC7,FORMWD ;STORE CURRENT FORMAT WORD RETURN FREFMT: CALL GETSTC ;SAW "F", IS IT "FF"? CAIE C,"F" CAIN C,"F"+40 JRST .+2 ;YES JRST ERRFMT ;NO, AN ERROR CALL GPASST ;PASS THE SECOND F CAIE C,"." ;A PERIOD? JRST .+3 ;NO TLO AC7,(FMFLP) ;YES, FREE FORMAT BUT ALWAYS DECIMAL POINT CALL GPASST ;PASS THE PERIOD JUMPE C,MKFRMX ;NOW SPECIFICATION MUST END JRST ERRFMT
SUBTTL READ/WRITE/SAVE/RESTORE AND ASSOCIATED SUBROUTINES ;WRITE ;SYSTEM FUNCTION TO WRITE OUT ALL DEFINED OPS,DDEFS AND FNS ON EITHER ;TTY OR A USER-SPECIFIED FILE. SWRITE: XWD 0,-1 ;TAKES VARIABLE NUMBER OF ARGS HLRZ AC2,S ;FETCH NUMBER OF ARGS JUMPE AC2,WRTGO ;PRINT ON CONSOLE IF NO ARGS SOJN AC2,WRNGNB ;MUST BE 0 OR 1 ARG TLNE FF,RDFLG ;ERROR IF READ CURRENTLY IN PROGRESS SFNERR MSG(WRDRD) ;CAN'T WRITE DURING READ MOVEI AC1,RWFCB ;SETUP ADR OF READ/WRITE FILE CONTROL BLOCK CALL PPLFIL ;GET FILE SPECIFICATION CALL ASCCHK ;ENSURE DEVICE CAN DO ASCII MODE I/O CALL OPNOUT ;OPEN FILE FOR OUTPUT CALL OUTBFX ;EXECUTE OUTBUF UUO TO SETUP BUFFERS MOVEM AC1,OFILE ;STORE AS CURRENT OUTPUT FILE WRTGO: TTOA [BYTE(7) CR,LF,CR,LF] CALL OUTOPS ;WRITE OUT ALL USER-DEFINED OPS TTOS [SIXBIT/#/] MOVEI AC1,ENUDDF ;ENUMERATE ALL THE DATA DEFINITIONS IN IDT CALL ENUIDT TTOS [SIXBIT/#/] MOVEI AC1,ENUFNS ;ENUMERATE ALL THE USER-DEFINED FNS CALL ENUIDT WRTEND: SKIPE AC1,OFILE ;DONE. WAS OUTPUT TO A FILE? CALL CLSFIL ;YES, CLOSE OUTPUT FILE SETZM OFILE ;CLEAR OUTPUT FILE FCB JRST RETNUL ;RETURN NULL AS VALUE OF WRITE ;ROUTINES TO CHECK AND SETUP FILE MODE (ASCCHK=ASCII, BINCHK=BINARY) ;CALL: AC1 = ADR OF FCB ; R = DEVCHR WORD ;RETURNS: ; AC2 = DATA MODE ; AC3 = DEVCHR WORD ASCCHK: TDZA AC2,AC2 ;ASCII, FILE MODE _ 0 BINCHK: MOVEI AC2,14 ;BINARY, FILE MODE _ 14 MOVE AC3,R ;GET DEVCHR WORD JRST MODCHK ;CALL MODE CHECK ROUTINE
;ROUTINES CALLED FROM ENUIDT ENUDDF: HLRZ R,(AC2) ;CHECK ID TYPE CAIE AC1,U.STRING ;OMIT LISTING OF DEF FOR STRING CAIE R,I.DDEF RETURN ;NOT A DDEF CAIN AC1,U.TUPLE ;OMIT LISTING OF DEF FOR TUPLE RETURN SAVE AC1 ;ENUMERATE A DATA DEFINITION HRLI AC1,(LXM(STAK,ID)) ;FAKE UP AN ID LEXEME CALL PRINT ;PRINT THE DDEF TTOS [SIXBIT/#/] JRST X1 ;RESTORE AC1 AND RETURN ENUFNS: HLRZ R,(AC2) ;CHECK ID TYPE FOR FN CAIE R,I.FN RETURN ;NO, IGNORE SAVE AC1 ;ENUMERATE A FUNCTION HRRZ AC1,(AC2) ;GET POINTER TO FN HLRZ R,(AC1) ;GET TYPE CAIE R,SB+B.FN ;A FUNCTION? JRST .+3 ;NO, A LSB HRRZ AC1,(AC1) ;YES, GET LSB ENTRY HRRZ AC1,2(AC1) CALL TYFN ;TYPE OUT THE WHOLE FN JRST X1 ;RESTORE AC1 AND RETURN
;GIVEN ARGP POINTING AT A LEXEME, DECODE A CHAR OR STRING AS A ; FILE SPECIFICATION AND SET UP THE FILE CHANNEL BLOCK WHOSE ADDRESS ; IS IN AC1. ADVANCE ARGP TO NEXT ARGUMENT. BP== AC10 ;CONVENTIONS FROM TEXT.MAC C== AC11 N== AC12 CT== AC13 PPLFIL: MOVSI R,'PPL' ;DEFAULT EXTENSION FOR READ/WRITE AND I/O JRST .+2 ENVFIL: MOVSI R,'ENV' ;DEFAULT EXTENSION FOR SAVE/RESTORE SAVE <BP,CT,N> ;SAVE AC'S NEEDED DURING TEXT EDITING MOVEM CAR,SAVCAR ;REMEMBER CURRENT AR HRR R,FILEXT(AC1) ;PICK UP CHANNEL # AND STATUS BITS TRZ R,777760 ;CLEAR STATUS BITS MOVEM R,FILEXT(AC1) ;STORE DEFAULT EXTENSION AND CHANNEL# MOVSI R,'DSK' ;SETUP DEFAULT DEVICE MOVEM R,FILDEV(AC1) SETZM FILNAM(AC1) ;NO DEFAULT NAME OR PPN SETZM FILPPN(AC1) CALL MKCNST ;REDUCE ARG TO A CONSTANT ILLTYP ;ERROR HRRZ R,@ARGP ;GET RESULTING PZ ADR HLRZ T,(R) ;GET LH OF PZ WORD CAIE T,U.STRING ;A STRING? ILLTYPE ;NOPE HRRZ BP,(R) ;YES, GET ABS ADDR IN BP HRLI BP,(POINT 7,0,35) ;CONSTRUCT A BYTE POINTER ADDI BP,1 ;POINT TO 2ND WORD OF BLOCK HRRZ N,(BP) ;GET UPPER BOUND = LENGTH CALL SIXIN ;RETURN FIRST SIXBIT FIELD IN R CAIE C,":" ;A DEVICE SPECIFICATION? JRST DEPFNM ;NO, GO STORE AS FILENAME JUMPE R,ILLFNM ;YES. ERROR IF FIELD WAS BLANK IFN FDATA!HARVN,< CAME R,[SIXBIT/LIB/] ;ASKED FOR LIB: ? JRST STDVN ;NO MOVE R,LIBPPN ;YES, MAKE IT DSK:[3400,102] MOVEM R,FILPPN(AC1) MOVSI R,'DSK' STDVN:> MOVEM R,FILDEV(AC1) ;STORE DEVICE NAME CALL SIXIN ;READ NEXT FIELD
DEPFNM: MOVEM R,FILNAM(AC1) ;STORE IT CAIE C,"." ;EXPLICIT EXTENSION? JRST RDPPN ;NO, SKIP THIS CALL SIXIN ;YES, READ EXTENSION FIELD HLLM R,FILEXT(AC1) ;STORE IT IN FILE BLOCK RDPPN: CAIE C,"[" ;PROJ-PROG NUMBER SPECIFIED? JRST ENDFNM ;NO, USE USER'S OWN IFE TELCMP,< CALL PPNIN ;YES, READ PROJECT NUMBER HRLZM R,FILPPN(AC1) ;STORE IT CAIE C,"," ;CHECK SYNTAX JRST ILLFNM CALL PPNIN ;GET PROGRAMMER NUMBER HRRM R,FILPPN(AC1) ;STORE IT > IFN TELCMP,< CALL GPASST ;PASS LEADING BLANKS CALL PPNIN ;CONVERT 1ST 3 CHARACTERS TO RADIX50 HRLZM R,FILPPN(AC1) ;STORE IN LH OF PPN WORD CALL PPNIN ;CONVERT LAST 3 CHARACTERS TO RADIX50 HRRM R,FILPPN(AC1) ;STORE IN RH CALL PASSTS ;PASS TABS AND SPACES > CAIE C,"]" ;CHECK FOR PROPER TERMINATOR JRST ILLFNM CALL GPASST ;OK, PASS ] AND SPACES ENDFNM: JUMPN C,ILLFNM ;ERROR IF END OF STRING NOT REACHED STRFLX: RESTORE <N,CT,BP> ;RESTORE AC'S MOVE CAR,SAVCAR MOVE R,FILDEV(AC1) ;GET DEVICE CHARACTERISTICS DEVCHR R, JUMPE R,ERDVNX ;ERROR IF DEVCHR RETURNS ZERO MOVEI R2,FS.TTY ;SETUP BIT FOR "IS A TELETYPE" TLNE R,(DV.DSK) ;BUT IS IT A DISK? MOVEI R2,FS.DSK ;YES, SETUP DIFFERENT BIT TLNE R,(DV.DSK!DV.TTY) ;DISK OR TELETYPE? IORM R2,FILEXT(AC1) ;YES, SET FLAG IN FCB SKIPN FILNAM(AC1) ;WAS A FILENAME GIVEN? TLNN R,(DV.DIR) ;NO, IS ONE NECESSARY? AOJA ARGP,CPOPJ ;YES OR NOT NECESSARY; ADVANCE ARGP AND RETURN SFNERR MSG(FNREQ) ;FILENAME OMITTED BUT REQUIRED ERDVNX: DEVERR AC1,MSG(DNXST) ;DOES NOT EXIST
IFE TELCMP,< ;ROUTINE TO RETURN AN OCTAL PROJECT OR PROGRAMMER NUMBER PPNIN: CALL GPASST ;PASS LEADING DELIMITER AND SEPARATORS TDZA R,R ;CLEAR RESULTS INPPN1: CALL GETSTC ;GET A CHARACTER FROM THE STRING TRNN CT,DIGIT ;A DIGIT? JUMPN R,PASSTS ;NO. RETURN IFF NONZERO PPN (0=ERROR) TRNE CT,ODIGIT ;FOUND DIGIT. IT HAS TO BE OCTAL CAILE R,37777 ;AND WE MUST NOT GET TOO BIG JRST ILLFNM ;OTHERWISE ERROR LSH R,3 ;OK, STORE A NEW DIGIT IORI R,-60(C) JRST INPPN1 > ILLFNM: MOVE CAR,SAVCAR SFNERR MSG(ERFNS) ;ERROR IN FILENAME STRING IFN TELCMP,< ;ROUTINE TO DECODE THREE CHARACTERS AND RETURN A FUNNY RADIX50 ;HALFWORD FOR TELCOMP'S INCOMPATIBLE ID'S PPNIN: MOVEI R2,3 ;KEEP COUNT TDZA R,R ;INITIALIZE TO ZERO INPPN1: CALL GETSTC ;GET A CHARACTER IMULI R,50 ;MULT PREVIOUS RESULT BY 50(8) TRNN CT,DIGIT ;A DIGIT? JRST INPPN2 ;NO ADDI R,-60(C) ;YE,ADD ITS RADIX50 VALUE JRST INPPN3 INPPN2: TRNE CT,SMLLET ;SMALL LETTER? TRZ C,40 ;YES, CONV TO CAP TRNN CT,LETTR ;A LETTER? JRST ILLFNM ;NO, ILLEGAL CHARACTER ADDI R,-66(C) ;YES, ADD IN RADIX50 VALUE INPPN3: SOJG R2,INPPN1 JRST GETSTC ;GO BACK FOR MORE >
;ROUTINE TO RETURN SIXBIT PACKED ALPHANUMERIC CHARACTERS IN R SIXIN: CALL GPASST ;GET CHARACTER AND PASS LEADING SEPARATORS MOVE R2,[POINT 6,R] ;SET UP BYTE POINTER TDZA R,R ;ZERO RESULT TO INITIALIZE SIXIN1: CALL GETSTC ;GET A STRING CHARACTER TRNN CT,LETTR+DIGIT ;A FILENAME CONSTITUENT? JRST PASSTS ;NO, GO TO EXIT TRNN CT,SMLLET ;YES. CONVERT TO SIXBIT SUBI C,40 TRNN R,77 ;ROOM TO PACK ANOTHER CHARACTER? IDPB C,R2 ;YES, DO IT JRST SIXIN1 ;GO BACK FOR MORE ;ROUTINE TO GET THE NEXT CHARACTER FROM THE STRING BLOCK BEING ;UNPACKED, OR NULL IF NONE REMAIN. GETSTC: SOJGE N,SCAN ;CALL ROUTINE IF ANY CHARACTERS REMAIN SETZB C,CT ;OTHERWISE, SET TO ZERO AND RETURN RETURN ;ROUTINES GPASST (GET STRING CHARACTER AND PASS SEPARATORS) ;PASSTS (PASS STRING SEPARATORS, STARTING WITH CURRENT C) GPASST: CALL GETSTC ;GET CHARACTER PASSTS: TRNE CT,SEPRTR ;A SEPARATOR CHARACTER? JRST GPASST ;YES, GET ANOTHER RETURN ;NO, EXIT WITH CHARACTER UNDER SCAN
;ROUTINE TO PRINT OUT ALL USER-DEFINED OPERATORS AS CALLS TO ;THE UNARY AND BINARY FUNCTIONS. ;UPDATED 10-AUG-74 FOR PREC SCHEME -- ESR OUTOPS: SAVE <AC1,AC2,AC3,AC4,B> HRRZ B,@OPTP ;GET DZ ADR OF OPT HLL B,(B) ;COMPUTE AOBJN POINTER FOR OPT TLC B,-1 ADD B,[XWD 2,1] ;POINT TO FIRST OP OUTOP1: HRRZ AC1,@OPTP ;COMPUTE REL ADDR (INTERNAL NAME) SUBM B,AC1 HLLI AC1, HRRZ AC2,1(B) ;GET VALUES FOR BINARY DEFINITION HRRO AC3,2(B) ;GET PREC FOR BINARY (-1 IN LH = BINARY) CAIL AC1,OPTLEN ;IS THIS IN INITIAL TABLE JRST PIFX ;GO PRINT OPS IF THEY EXIST HRRZ AC4,BEGOPT(AC1) ;GET INITIAL DEFINITION CAIE AC4,(AC2) ;SEE IF SAME AS INITIALLY JRST OUTBD HRRZ AC4,BEGOPT+1(AC1) ;ALSO CHK PARAMETERS CAIE AC4,(AC3) ;SAME? OUTBD: CALL BDFOUT ;NO, WRITE NEW DEFINITION HLRZ AC2,1(B) ;SAME FOR UNARY DEFS HLRZ AC3,2(B) HLRZ AC4,BEGOPT(AC1) CAIE AC4,(AC2) JRST OUTUD HLRZ AC4,BEGOPT+1(AC1) CAIE AC4,(AC3) OUTUD: CALL UDFOUT JRST NEXTOP PIFX: JUMPE AC2,.+2 ;DOES A BINARY DEF EXIST? CALL BDFOUT ;YES, PRINT IT HLRZ AC2,1(B) ;GET UNARY NAME HLRZ AC3,2(B) ;AND PRECEDENCE JUMPE AC2,.+2 ;FORGET IT IF NOT THERE CALL UDFOUT ;PRINT IT NEXTOP: ADD B,[3,,3] ;INDEX TO NEXT OP JUMPL B,OUTOP1 ;AND LOOP OUTOPX: RESTORE B ;RESTORE OLD AR DZ ADR JRST X4321 ;RESTORE AC3,2,1 AND RETURN ;ROUTINES FOR PRINTING THE ACTUAL DEFINITIONS BDFOUT: TTOA [ASCIZ/ BINARY("/] CAIA UDFOUT: TTOA [ASCIZ/ UNARY("/] CALL OPPR ;PRINT THE OP RELATIVELY ADDRESSED BY AC1 EXCH AC1,AC2 ;GET DISPATCH ENTRY TTOS [SIXBIT/",!/] JUMPN AC1,.+3 ;PRINT NULL STRING IF OP ERASED TTOS [SIXBIT /""!/] ; ONLY PRINTS FOR OPS IN INITIAL JRST FINOPO ; OP TABLE. CALL IDPR ;PRINT NAME OF FN DISPATCHED TO TTOS [SIXBIT /,!/] ;COMMA BEFORE PRECEDENCE FIELD HRRZI AC1,(AC3) ;GET PRECEDENCE TRZ AC1,400000 ;GET RID OF ASSOCIATIVITY BIT CALL INTPR ;PRINT AS AN INT JUMPGE AC3,FINOPO ;ALL DONE IF UNARY TTOS [SIXBIT /,"!/] ;PREPARE TO PRINT ASSOCIATIVITY TRNE AC3,400000 ;WAS ASSOCIATIVITY BIT ON? SKIPA AC1,[SIXBIT /RIGHT!/] ;YES, RIGHT ASSOC. MOVE AC1,[SIXBIT /LEFT!/] ;NO, LEFT TTOS AC1 TTOS [SIXBIT /"!/] ;WRITE FINAL QUOTE FINOPO: MOVE AC1,AC2 ;RESTORE AC11 TTOS [SIXBIT/)#/] ;TERMINATE LINE ODFOUX: RETURN
;READ(F) - OPEN FILE F FOR READING AS FOR TTY INPUT SREAD: EXP 1 ;TAKES ONE ARG TLOE FF,RDFLG ;ERROR IF ALREADY READING SFNERR MSG(RECRD) ;RECURSIVE READ NOT ALLOWED MOVEI AC1,RWFCB ;SETUP READ/WRITE FILE CHANNEL BLOCK CALL PPLFIL ;GET FILE SPECIFICATION CALL ASCCHK ;ENSURE DEVICE CAN DO ASCII I/O CALL OPNIN ;OPEN FILE FOR INPUT CALL INBFX ;EXECUTE INBUF TO SETUP I/O BUFFERS JRST ADV1ST ;ADVANCE 1ST BYTE OF FILE, THEN RETURN NULL ;FROM NOW ON, ALL TTY INPUT COMES FROM FILE. MODE GOES BACK TO TTY ;ON END OF FILE OR ANY ERROR. ;ROUTINE TO EXECUTE INBUF UUO FOR RWFCB INBFX: MOVEI R,FILBLK ;TELL MONITOR ADR OF FIXED BUFFER AREA HRRM R,JOBFF INBUF RD,2 ;SETUP 2 BUFFERS RETURN ;ROUTINE TO EXECUTE OUTBUF UUO FOR RWFCB OUTBFX: MOVEI R,FILBLK ;TELL MONITOR ADR OF FIXED BUFFER AREA HRRM R,JOBFF OUTBUF WR,2 ;SETUP 2 OUTPUT BUFFERS RETURN
;SAVE(S) ;WRITE OUT THE CURRENT ENVIRONMENT ONTO FILE S SSAVE: EXP 1 ;TAKES ONE ARG MOVEI AC1,RWFCB ;SETUP ADR OF SAVE/RESTORE FCB CALL ENVFIL ;GET FILE SPECIFICATION CALL BINCHK ;ENSURE DEVICE CAN DO BINARY I/O CALL OPNOUT ;OPEN FILE FOR OUTPUT CALL OUTBFX ;EXECUTE OUTBUF UUO MOVEM AC1,OFILE ;STORE FCB ADDRESS CALL GARCOL ;GARBAGE COLLECT TO SHORTEN FILE MOVE AC1,VERCHK ;WRITE VERSION CHK WORD AS FIRST WORD OF CALL OUTBYT ; FILE, AS A CHECK FOR CORRECT FORMAT ; AND PPL VERSION MOVE AC1,DZEND ;WRITE CURRENT CORE SIZE CALL OUTBYT MOVE AC2,[XWD MDMSIZ,PPLLOW] CALL WBLOCK ;WRITE COMPRESSED IMAGE OF LOW SEG VARIABLES MOVE AC2,PZBEG ;COMPUTE BLOCK POINTER FOR WRITING PZ,DZ SUB AC2,NEXT ;= -SIZE HRLZ AC2,AC2 ;PUT IN LH HRR AC2,PZBEG ;BEGINS AT PZ START CALL WBLOCK ;WRITE OUT BLOCK SETZ AC1, ;WRITE A ZERO TO MARK END CALL OUTBYT JRST WRTEND ;GO CLOSE OUTPUT AND RETURN NULL ;ROUTINE TO WRITE OUT A BLOCK WHOSE AOBJN POINTER IS IN AC2 WBLOCK: SKIPN (AC2) ;FIND FIRST NONZERO WORD AOBJN AC2,.-1 ;LOOP BACK UNTIL NONZERO JUMPGE AC2,CPOPJ ;JUMP IF BLOCK DONE HRLZ AC3,AC2 ;INITIALIZE REVERSE IOWD ; FIRST SOS WILL DECREMENT LH BY 1 WBLK1: SKIPN (AC2) ;NONZERO WORD? JRST WBLKW ;NO. GO WRITE ACCUMULATED IOWD SUBI AC3,1 ;YES. INCREMENT SWAPPED IOWD AOBJN AC2,WBLK1 ;GO BACK IF ANY WORDS LEFT ;HERE TO WRITE OUT IOWD AND REFERRED DATA WBLKW: MOVSS AC1,AC3 ;SWAP TO MAKE NORMAL IOWD CALL OUTBYT ;WRITE OUT IOWD WBLKW1: MOVE AC1,1(AC3) ;GET AN ADDRESSED WORD CALL OUTBYT ;WRITE IT OUT AOBJN AC3,WBLKW1 ;BACK FOR MORE JRST WBLOCK ;IOWD DONE. CONTINUE BLOCK
;RESTORE(S) ;RESTORE ENVIRONMENT FROM FILE S SRESTO: EXP 1 ;TAKES ONE ARG MOVEI AC1,RWFCB ;SETUP ADR OF SAVE/RESTORE FCB CALL ENVFIL ;GET FILE SPECIFICATION CALL BINCHK ;ENSURE DEVICE CAN DO BINARY I/O CALL OPNIN ;OPEN FILE FOR INPUT CALL INBFX ;EXECUTE INBUF UUO MOVEM AC1,IFILE ;STORE ADR OF INPUT FCB CALL INBYR ;GET FIRST WORD XOR R,VERCHK ;CHECK FORMAT AND VERSION JUMPE R,RESTOK ;FINE TLNE R,-1 ;NO. WAS IT AT LEAST A PPL SAVE FILE? SFNERR MSG(NPSAV) ;NOT A PPL SAVE FILE SFNERR MSG(OVSAV) ;SORRY, FILE SAVED FROM DIFFERENT PPL VERSION RESTOK: CALL INBYR ;READ NEXT WORD (CORE SIZE) CORE R, ;ATTEMPT TO SET THAT SIZE SFNERR MSG(ICENV) ;INSUFFICIENT CORE FOR SAVED ENVIRONMENT SETZM @PZBEG ;OK. CLEAR PZ AND DZ AOS R,PZBEG ;SETUP BLT POINTER HRLI R,-1(R) BLT R,@JOBREL SETZM PPLLOW ;CLEAR VARIABLE AREA MOVE R,[XWD PPLLOW,PPLLOW+1] BLT R,LSTZER-1 ;DON'T CLEAR FILE BLOCK! TLO FF,RSTFLG ;FLAG RESTORE IN PROGRESS RBLOCK: CALL INBYR ;GET A WORD JUMPGE R,RSTXIT ;ASSUME EOF IF NOT AN IOWD AOS AC1,R ;SAVE POINTER WORD RBLOK1: CALL INBYR ;GET DATA WORD MOVEM R,(AC1) ;STORE IT AOBJN AC1,RBLOK1 ;SAME FOR REST OF BLOCK JRST RBLOCK ;DO ANOTHER BLOCK RSTXIT: RELEAS RD, ;END OF INPUT, RELEASE DEV MOVE CAR,SAVCAR ;SETUP NEW CAR FROM ENVIRONMENT TLZ FF,RSTFLG ;CLEAR RESTORE FLAG SETZM IFILE ;CLEAR INPUT FILE PTR JRST RETNUL ;RETURN NULL TO CALLER INBYR: CALL INBYTE ;READ NEXT BYTE OF FILE BEING RESTORED SKIPA R,IFILE ;PREMATURE END-OF-FILE RETURN ;OK FILERR R,MSG(ENDOF) ;END OF FILE
SUBTTL SYSTEM FUNCTIONS FOR USER I/O PROGRAMMING ;INPUT(C,S,M) OR INPUT(C,S) ;OPEN CHANNEL C FOR INPUT FROM FILE S, USING MODE M (DEFAULT = CHAR) SINPUT: XWD 0,-1 ;TAKES 2 OR 3 ARGS CALL GETOPN ;GET PARAMETERS PUSH P,R ;SAVE BYTE SIZE CALL OPNIN ;OPEN FILE FOR INPUT MOVSI AC2,(INBUF) ;SETUP INBUF UUO POP P,AC3 ;GET BACK BYTE SIZE CALL SETBUF ;SETUP I/O BUFFER BLOCK ;ROUTINE TO ADVANCE THE FIRST BYTE OF THE FILE WHOSE FCB ADR IS IN AC1. ; THIS IS SO THAT "NXTBYT" WILL GET THE RIGHT BYTE. NULL IS RETURNED ADV1ST: HRRZ R2,FILEXT(AC1) ;REMEMBER STATUS BITS EXCH AC1,IFILE ;STORE FCB ADR, SAVING OLD TRNN R2,FS.TTY ;IF NOT A TELETYPE, CALL INBYTE ; ADVANCE FIRST BYTE JFCL ;UNUSUALLY SHORT FILE! MOVEM AC1,IFILE ;RESTORE OLD IFILE JRST RETNUL ;RETURN NULL AS VALUE OF CALL ;OUTPUT(C,S,M) OR OUTPUT(C,S) ;OPEN CHANNEL C FOR OUTPUT TO FILE S, USING MODE M (DEFAULT = CHAR) SOUTPU: XWD 0,-1 ;TAKES 2 OR 3 ARGS CALL GETOPN ;GET PARAMETERS PUSH P,R ;SAVE BYTE SIZE CALL OPNOUT ;OPEN FILE FOR OUTPUT MOVSI AC2,(OUTBUF) ;SETUP OUTBUF UUO POP P,AC3 ;GET BACK BYTE SIZE CALL SETBUF ;SETUP I/O BUFFER BLOCK JRST RETNUL ;RETURN NULL AS VALUE OF CALL
;ROUTINE TO SETUP I/O BUFFER BLOCK ; AC1 = ADR OF FCB ; AC2 = INBUF OR OUTBUF UUO ; AC3 = BYTE SIZE SETBUF: ROT AC3,-^D12 ;INIT BYTE POINTER BY SETTING UP MOVEM AC3,FILPTR(AC1) ; BYTE SIZE FIELD AND CLEARING REST MOVEI R,LXMBUF ;USE LXMBUF AS DUMMY BUFFER HRRM R,JOBFF ;TELL MONITOR WHERE IT IS HRRI AC2,1 ;DO INBUF 1 OR OUTBUF 1 CALL UXCT HRRZ R,JOBFF ;FIND OUT HOW MUCH SPACE WAS USED SUBI R,LXMBUF HRLI AC1,-3(R) ;REMEMBER # OF DATA WORDS ASH R,1 ;DOUBLE TO MAKE 2 BUFFERS CALL MKBLK ;MAKE A BLOCK BLKARG SYSBIT+B.IOB,2(R) ;2 HEADER WORDS + 2 BUFFERS HRRM R,FILPZA(AC1) ;STORE PZADR OF BUFFER BLOCK MOVEM AC1,1(R2) ;STORE SIZE AND BACK PTR IN BLOCK ADDI R2,2 ;POINT TO START OF FIRST BUFFER HRRM R2,JOBFF ;STORE FOR MONITOR AOJA AC2,UXCT ;EXECUTE INBUF 2 OR OUTBUF 2 AND RETURN
;ROUTINE TO PICK UP ARGUMENTS TO INPUT AND OUTPUT SYSTEM FNS. ; RETURNS WITH THE FOLLOWING AC'S SETUP: ; AC1 = FCB ADDRESS ; AC2 = DATA MODE ; AC3 = DEVICE CHARACTERISTICS ; R = BYTE SIZE GETOPN: HLRZ AC2,S ;GET NUMBER OF ARGUMENTS TO CALL CAIGE AC2,2 ;MUST BE AT LEAST 2 JRST WRNGNB ;NOPE CALL CHNARG ;OK, CONVERT 1ST ARG TO FCB ADR JUMPE R,ALROPN ;CONTROLLING TTY IS ALWAYS OPEN SKIPE FILPZA(R) ;IS FILE ALREADY OPEN? ALROPN: SFNERR MSG(FAOCH) ;FILE ALREADY OPEN ON CHANNEL MOVE AC1,R ;NO, AC1_FCB ADR CALL PPLFIL ;CONVERT 2ND ARG TO FILE SPECIFICATION MOVE AC3,R ;SAVE BYTE SIZE MOVEI T,U.CHAR/2 ;ASSUME DATA TYPE = CHAR CAIN AC2,2 ;JUST 2 ARGS? JRST STOTYP ;INDEED, USE CHAR AS DEFAULT CAIE AC2,3 ;NO, MUST BE 3 ARGS JRST WRNGNB ; ELSE ERROR CALL EVALID ;EVAL 3RD ARG TO AN ID JRST NOTID3 ;NOT POSSIBLE HRRZ T,@ARGP ;AN ID, GET INTERNAL NAME LSH T,-1 ;COMPUTE ID INDEX/2 CAIG T,U.CHAR/2 ;LEGAL ID FOR I/O MODE? JRST STOTYP ;YES, USE IT NOTID3: CALL GRAB1 ;NO, TRY TO COERCE ARG TO CONSTANT CAIE T,U.INT/2 ;RESULT AN INT? ILLTYP ;NO, ERROR CAIL R,1 ;YES, IN RANGE 1-36? CAILE R,^D36 SFNERR MSG(BYOUR) ;BYTE SIZE OUT OF RANGE JRST STOTY1 ;YES, USE IT STOTYP: HLRZ R,FILMDS(T) ;GET BYTE SIZE FOR DATA TYPE STOTY1: HRLZM T,FILPZA(AC1) ;STORE DATA TYPE /2 IN FCB HRRZ AC2,FILMDS(T) ;GET I/O DATA MODE FOR PPL DATA TYPE TLNE AC3,(DV.TTY) ;IS THE DEVICE A TTY? TRZN AC2,4 ;YES, TRYING TO OPEN IN BINARY MODE? JRST .+3 ;NO MOVEI R2,FS.TTY ;YES, DISABLE SPECIAL TTY HANDLING ANDCAM R2,FILEXT(AC1) ; AND USE IMAGE MODE INSTEAD ;FALL INTO MODCHK AND RETURN
;ROUTINE TO CHECK FOR CORRECT DATA MODE ; AC1 = FCB ADR ; AC2 = DATA MODE ; AC3 = DEVICE CHARACTERISTICS MODCHK: MOVEI R2,1 ;SETUP BIT FOR TEST LSH R2,(AC2) ;SHIFT INTO POSITION FOR MODE TRNN AC3,(R2) ;THIS MODE LEGAL? DEVERR AC1,MSG(IMPDM) ;IMPROPER DATA MODE RETURN ;TABLE OF BYTE SIZES AND I/O DATA MODES FOR PPL DATA TYPES FILMDS: ^D36 ,, 14 ;INT ^D36 ,, 14 ;REAL ^D36 ,, 14 ;DBL (2ND WORD HANDLED BY SPECIAL CODE) ^D 1 ,, 14 ;BOOL ^D 7 ,, 0 ;CHAR
;ROUTINE TO OPEN A GIVEN FILE FOR INPUT ; AC1 = PTR TO FCB ; AC2 = DATA MODE ; AC3 = DEVICE CHARACTERISTICS OPNIN: TLNN AC3,(DV.IN) ;CAN DEVICE DO INPUT DEVERR AC1,MSG(NOTIN) ;CANNOT DO INPUT MOVEI AC5,FILHDP(AC1) ;SETUP PTR TO 3-WD RING HEADER CALL DVOPEN ;PERFORM OPEN UUO LOOKUP AC3 ;LOOKUP UUO PERFORMED BY DVOPEN JRST ELOOK ;WHERE TO GO IF LOOKUP FAILS RETURN ;ROUTINE TO OPEN A GIVEN FILE FOR OUTPUT ; ARGS SAME AS FOR OPNIN OPNOUT: TLNN AC3,(DV.OUT) ;CAN DEVICE DO OUTPUT? DEVERR AC1,MSG(NOTOU) ;CANNOT DO OUTPUT MOVEI AC5,FS.OUT ;SETUP OUTPUT BIT FOR STATUS WORD IORM AC5,FILEXT(AC1) MOVSI AC5,FILHDP(AC1) ;SETUP PTR TO 3-WD RING HEADER CALL DVOPEN ;PERFORM OPEN AND ENTER ENTER AC3 ;ENTER UUO EXECUTED BY DVOPEN JRST EENTR ;WHERE TO GO IF ENTER FAILS RETURN ;CENTRAL OPEN ROUTINE. CALL: ; AC1 = PTR TO FCB ; AC2 = DATA MODE ; AC5 = 3RD WORD FOR OPEN UUO (FILHDP ADDRESS IN LH OR RH) ; CALL DVOPEN ; LOOKUP AC3 OR ENTER AC3 (IN-LINE ARG) ; ERROR RETURN FROM LOOKUP OR ENTER ; NORMAL RETURN DVOPEN: HLLZS FILPOS(AC1) ;SET CURRENT BLOCK NUMBER TO ZERO SETZM FILHDP(AC1) ;ENSURE NO OLD POINTERS GET TRACED HRRZ AC3,AC2 ;GET DATA MODE INTO AC3 MOVE AC4,FILDEV(AC1) ;GET DEVICE NAME INTO AC4 MOVE AC2,[OPEN AC3] ;SETUP UUO TO BE EXECUTED CALL UXCT ;EXECUTE OPEN UUO DEVERR AC1,MSG(NOTAV) ;NOT AVAILABLE MOVE AC2,@(P) ;GET THE LOOKUP OR ENTER UUO AOS (P) ;ADVANCE PAST THE UUO MOVE AC3,FILNAM(AC1) ;AC3_FILENAME HLLZ AC4,FILEXT(AC1) ;AC4_EXTENSION SETZ AC5, ;CLEAR DATE, ETC. MOVE AC6,FILPPN(AC1) ;AC6_PPN JRST UXCT ;EXECUTE LOOKUP/ENTER FOR CHANNEL AND RETURN
;ROUTINE TO EVALUATE A CHANNEL NUMBER ARGUMENT, ENSURE FILE IS OPEN, ; ADVANCE TO NEXT ARGUMENT, AND RETURN FILE CHANNEL BLOCK ADDRESS ; OR 0 (FOR CONTROLLING TTY) IN R. CHNGET: CALL CHNARG ;CONVERT CHANNEL # TO FCB ADR JUMPE R,CPOPJ ;CHANNEL 0 IS ALWAYS OPEN SKIPN FILPZA(R) ;SEE IF FILE IS OPEN SFNERR MSG(NOPEN) ;FILE CHANNEL NOT OPEN RETURN ;ROUTINE TO EVALUATE CHANNEL NUMBER ARGUMENT, ADVANCE TO NEXT ARG, AND ; RETURN FCB ADR IN R. CHNARG: CALL GRAB1 ;EVAL ARG TO AN ATOM CAIE T,U.INT/2 ;MAKE SURE IT'S AN INT ILLTYP JUMPE R,CHNRET ;RETURN NOW IF ZERO SOJL R,.+2 ;ERROR IF NON-POSITIVE CAIL R,NFCBLK ;OR IF GREATER THAN HIGHEST LEGAL USER CHANNEL SFNERR MSG(FCNOR) ;FILE CHANNEL NUMBER OUT OF RANGE IMULI R,FCBSIZ ;CONVERT TO FCB POINTER ADDI R,FCBLST CHNRET: AOJA ARGP,CPOPJ ;ADVANCE TO NEXT ARG AND RETURN
;CLOSE(C1, C2, ... , CN) ;CLOSE FILES ON SPECIFIED CHANNELS. IF CALLED WITH NO ARGS, CLOSE ; ALL OPEN FILES. SCLOSE: XWD 0,-1 ;TAKES ANY NUMBER OF ARGS JUMPE ARGP,CLSALL ;JUMP IF NO ARGS JSP AC1,RPTARG ;ELSE CALL THE FOLLOWING FOR EACH ARG CALL CHNARG ;GET CHANNEL ARGUMENT SKIPN AC1,R ;MAY NOT BE CONTROLLING TTY SFNERR MSG(CLCH0) ;CHANNEL 0 MAY NOT BE CLOSED PUSHJ P,CLSOPN ;CLOSE THE FILE IF IT IS OPEN SOJA ARGP,CPOPJ ;COMPENSATE FOR INCREMENT IN CHNARG AND RETURN ;HERE TO CLOSE ALL OPEN FILES CLSALL: MOVEI AC1,CLSOPN ;SETUP ADR OF ROUTINE TO CALL FOR EACH FCB PUSHJ P,ALLFCB ;DO IT FOR ALL FCB'S JRST RETNUL ;RETURN NULL AS VALUE OF FN CALL ;EOF(C) ;RETURN TRUE IF EOF REACHED ON CHANNEL C, ELSE FALSE. SEOF: XWD 0,1 ;TAKES 1 ARG CALL CHNGET ;EVAL ARG TO AN FCB ADR JUMPE R,BRETRN ;RETURN FALSE FOR CHANNEL 0 HRRZ R,FILEXT(R) ;GET STATUS BITS LSH R,-<^D35-^L<FS.EOF>> ;RIGHT-JUSTIFY EOF BIT ANDI R,1 ;MASK IT OUT JRST BRETRN ;RETURN RESULT AS A BOOL ;OPENED(C) ;RETURN TRUE IF A FILE IS OPENED ON CHANNEL C, ELSE FALSE SOPENE: XWD 0,1 ;TAKES ONE ARG CALL CHNARG ;GET CHANNEL ARG, EVAL TO FCB ADR SKIPE R ;IS IT CHANNEL ZERO? SKIPE R,FILPZA(R) ;NO, IS THE SPECIFIED CHANNEL IN USE? MOVEI R,1 ;YES TO EITHER, RETURN TRUE JRST BRETRN ;RETURN RESULT AS A BOOL ;FREE.CHANNEL ;RETURN THE FIRST FREE CHANNEL NUMBER, OR NULL IF THERE ARE NONE. SFREE.: XWD 0,0 ;PARAMETERLESS PROCEDURE SETZB AC1,R ;CLEAR RESULT AND DISPLACEMENT MOVEI T,U.INT/2 ;INITIALIZE RESULT TYPE TO INT SFREE1: SKIPN FCBLST+FILPZA(AC1) ;IS THIS CHANNEL FREE? AOJA R,SRETRN ;YES, RETURN ITS CHANNEL NUMBER ADDI AC1,FCBSIZ ;NO, ADVANCE TO NEXT FCB CAIGE R,NFCBLK-1 ;WAS THAT THE LAST FCB? AOJA R,SFREE1 ;NO, KEEP LOOKING JRST RETNUL ;YES, NO FREE CHANNELS, SO RETURN NULL
;ROUTINE TO CLOSE THE FILE WHOSE FCB ADDRESS IS IN AC1, IF THAT FILE ; IS OPEN. CLSOPN: SKIPN FILPZA(AC1) ;IS A FILE OPEN ON THIS CHANNEL? POPJ P, ;NO, FORGET IT ;ROUTINE TO CLOSE THE FILE WHOSE FCB ADR IS IN AC1 CLSFIL: MOVSI AC2,(CLOSE) CALL UXCT ;EXECUTE CLOSE UUO MOVE AC2,[STATZ 740000] CALL UXCT ;CHECK FOR ANY ERRORS JRST FIOERR ;ROUTINE TO RELEASE THE CHANNEL WHOSE FCB IS GIVEN IN AC1 RELCHN: MOVSI AC2,(RELEAS) ;SETUP UUO TO BE EXECUTED SETZM FILPZA(AC1) ;CLEAR FCB ENTRY, MAKING IT FREE ;FALL INTO UXCT ;ROUTINE TO EXECUTE AN I/O UUO FOR THE CHANNEL WHOSE FCB IS GIVEN ; IN AC1. THE UUO IS IN AC2. THE SKIP OR NON-SKIP RETURN IS ; TAKEN DEPENDING ON WHETHER OR NOT THE UUO ITSELF SKIPS UXCT: HRRZ R,FILEXT(AC1) ;GET STATUS BITS AND CHANNEL # DPB R,[POINT 4,AC2,12] ;STORE CHANNEL # IN UUO XCT AC2 ;EXECUTE THE UUO RETURN ;NON-SKIP RETURN JRST CPOPJ1 ;SKIP RETURN ;ROUTINE TO DO SOMETHING FOR EVERY FILE CONTROL BLOCK. ; MOVEI AC1,ADR OF ROUTINE TO BE CALLED FOR EVERY FCB ; PUSHJ P,ALLFCB ; THE ROUTINE SO CALLED IS PROVIDED WITH THE FCB POINTER IN AC1. ALLFCB: PUSH P,AC1 ;SAVE ARG ON STACK MOVE AC1,[-NFCBLK,,FCBLST] ;SETUP POINTER TO START OF FCB LIST PUSHJ P,@(P) ;CALL THE GIVEN ROUTINE ADDI AC1,FCBSIZ-1 ;ADVANCE TO NEXT FCB AOBJN AC1,.-2 ;GO DO IT IF NOT END OF FCB'S JRST X1 ;RESTORE AC1 AND RETURN
;INBYTE(C) ;INPUT NEXT BYTE FROM CHANNEL C. THE DATA TYPE IS THAT ESTABLISHED ; IN THE PREVIOUS CALL TO INPUT. SINBYT: XWD 0,1 ;TAKES 1 ARG CALL ISETUP ;SETUP FOR FILE INPUT MOVEI T,U.CHAR/2 ;ASSUME DATA TYPE IS CHAR JUMPE R,.+2 ;TRUE IF I/O TO CONTROLLING TTY HLRZ T,FILPZA(R) ;ELSE GET DATA TYPE FROM FCB CALL NXTBYT ;GET NEXT BYTE ERROR MSG(BDEOF) ;BAD EOF CAIE T,U.DBL/2 ;IS DATA TYPE DBL? JRST SINBY9 ;NO SAVE <R> ;YES, SAVE HIGH-ORDER WORD CALL NXTBYT ;GET NEXT WORD SETZ R, ;WHAT HAPPENS IF ODD # OF WORDS IN FILE MOVE R2,R ;FETCH LOW-ORDER RESULT RESTOR <R> ;RESTORE HIGH-ORDER WORD SINBY9: SETZM IFILE ;CLEAR INPUT FCB PTR JRST SRETRN ;RETURN VALUE JUST INPUT ;OUTBYTE(C,D1,D2, ... ) ;OUTPUT ON CHANNEL C THE DATA OBJECTS D1,D2, ETC., WHICH MUST BE OF ; THE TYPE SPECIFIED IN THE PREVIOUS CALL TO OUTPUT SOUTBY: XWD 0,-1 ;TAKES VARIABLE # OF ARGS HLRZ AC2,S ;GET # OF ARGS SOJLE AC2,WRNGNB ;REMEMBER # -1, ERROR IF NOT AT LEAST 2 CALL OSETUP ;SETUP FOR FILE OUTPUT MOVEI AC3,U.CHAR/2 ;ASSUME CHAR MODE OUTPUT JUMPE R,.+2 ;TRUE IF CHANNEL # IS 0 HLRZ AC3,FILPZA(R) ;ELSE GET DATA TYPE FROM FCB MOVEI AC1,SOUTB1 ;CALL ROUTINE FOR EACH ARG CALL ARGENU SETZM OFILE ;CLEAR OUTPUT FILE FCB JRST RETNUL ;RETURN NULL TO CALLER ;ROUTINE CALLED FOR EACH ARG SOUTB1: CALL ARGPRP ;COERCE ARG TO CONSTANT JRST DTMERR ;NOT ATOMIC CAIE T,(AC3) ;RIGHT DATA TYPE? JRST DTMERR ;NO MOVE AC1,R ;YES, GET DATUM TO OUTPUT CAIE T,U.DBL/2 ;DBL? JRST OUTBYT ;NO, JUST OUTPUT 1 BYTE AND RETURN SAVE <R2> ;YES, SAVE LOW-ORDER WORD CALL OUTBYT ;OUTPUT HIGH-ORDER WORD RESTORE <AC1> ;RESTORE LOW-ORDER WORD JRST OUTBYT ;AND OUTPUT IT DTMERR: MOVE R,OFILE ;HERE ON MISMATCH WITH CHANNEL DATA TYPE FILERR R,MSG(DTMIS) ;DATA TYPE MISMATCH
;PRINTF(C,D1,D2, ... ) ;OUTPUT ASCII REPRESENTATIONS OF DATA ITEMS D1, D2, ETC. ON CHANNEL C, ; AS FOR PRINT SYSTEM FN TO TTY. SPRNTF: XWD 0,-1 ;TAKES VARIABLE NUMBER OF ARGUMENTS MOVEI AC1,PRINT0 ;ROUTINE TO CALL FOR EACH DATUM JRST RPTRGF ;REPEAT CALLS OVER ARGLIST, OUTPUTTING TO FILE ;FORMATF(C,S1,A,B,S2,...) ;FORMATTED NUMERIC OUTPUT THROUGH CHANNEL C, AS FOR FORMAT. SFRMTF: XWD 0,-1 ;TAKES VARIABLE NUMBER OF ARGUMENTS MOVEI AC1,SFORM1 ;ROUTINE TO CALL FOR EACH DATUM ;DISTRIBUTE CALLS TO ROUTINE POINTED TO BY AC1 OVER ARGLIST, AFTER ; EVALUATING FIRST ARG AS CHANNEL NUMBER AND DIRECTING OUTPUT ; TO THE SPECIFIED FILE. RPTRGF: HLRZ AC2,S ;GET NUMBER OF ARGUMENTS SOJLE AC2,WRNGNB ;MUST BE AT LEAST 2 CALL OSETUP ;PROCESS CHANNEL # AND SETUP OFILE JUMPE R,RPTRG1 ;JUMP IF OUTPUT TO CHANNEL 0 HLRZ R,FILPZA(R) ;FETCH CHANNEL DATA TYPE CAIE R,U.CHAR/2 ;MUST BE CHARACTER MODE JRST DTMERR ;NO, IMPROPER DATA MODE RPTRG1: CALL ARGENU ;CALL (AC1) FOR REMAINING ARGUMENTS SETZM OFILE ;CLEAR OUTPUT FILE POINTER JRST RETNUL ;RETURN NULL AS VALUE OF CALL
;INSTMT(C) ;INPUT A STATEMENT THROUGH CHANNEL C (EQUIVALENT TO ? FUNCTION FOR TTY) SINSTM: XWD 0,1 ;TAKES ONE ARG SETZ L, ;MAKE LOOK LIKE NON-STRING DEMAND SYMBOL JRST SINLIN ;GO SIMULATE ? ;INSTRING(C) ;INPUT A STRING THROUGH CHANNEL C (EQUIVALENT TO ?" FUNCTION FOR TTY) SINSTR: XWD 0,1 ;TAKES ONE ARG MOVEI L,1 ;MAKE LOOK LIKE STRING DEMAND SYMBOL SINLIN: CALL ISETUP ;EVAL AND CHECK CHANNEL NUMBER JUMPE R,SINLN1 ;CHANNEL 0 ALWAYS CHAR MODE HLRZ T,FILPZA(R) ;GET CHANNEL DATA TYPE CAIE T,U.CHAR/2 ;ERROR IF NOT CHAR MODE FILERR R,MSG(DTMIS) ;DATA TYPE MISMATCH SINLN1: HRRZ B,(CAR) ;RESTORE AR BASE GET CPM,PMF ;RESTORE STUFF FOR INTERP POP P,R ;THROW AWAY RETURN TO DOSFN CODE SOJA TOP,DMDX ;TAKE DEMAND EXIT FROM INTERPRETER SEXECU: EXP 1 ;TAKES 1 ARG CALL MKCNST ;MAKE IT A CONSTANT ILLTYPE HRRZ R,@ARGP ;GET PZ ADDR HLRZ T,(R) ;GET TYPE OF CONSTANT CAIE T,U.STRING ;IS IT A STRING ? ILLTYPE SETZ L, ;MAKE LOOK LIKE INSTMT HRRZ T,(R) ;YES, GET ADDRESS OF DATA HRLI T,(POINT 7,0,35) ;SET UP BYTE PTR ADDI T,1 ;POINT TO FIRST CHAR MOVEM T,EVALBP ;SAVE BP HRRZ T,(T) ;CALCULATE LENGTH ADDI T,1 ;ADD ONE TO LENGTH MOVEM T,IFILE ;USED TO STORE LENGTH HRRZ B,(CAR) ;SAVE THINGS FOR INTERP GET CPM,PMF POP P,R ;GET RID OF RETURN TO DOSFN CODE SOJA TOP,DMDX ;TAKE DEMAND EXIT TO INTERP
;POSITION(C,P) ;POSITION INPUT DISK FILE ON CHANNEL C TO POSITION P IN THE FILE, WHERE ; 1 STANDS FOR THE FIRST BYTE OF THE FILE. NOTE: EOF(C) WILL BECOME ; TRUE IF THE FILE IS POSITIONED PAST THE LAST BYTE. SPOSIT: EXP 2 ;TAKES 2 ARGS CALL CHNGET ;EVAL CHANNEL # ARG TO FCB PTR SKIPN AC1,R ;COPY TO AC1, ENSURE NON-TTY SFNERR MSG(NTDSK) ;LEGAL ONLY FOR DISK INPUT HRRZ R2,FILEXT(AC1) ;FETCH STATUS BITS FOR THIS FILE TRNN R2,FS.OUT ;FILE OPEN FOR INPUT? TRNN R2,FS.DSK ;YES, IS IT A DISK? SFNERR MSG(NTDSK) ;LEGAL ONLY FOR DISK INPUT MOVEI R2,FS.EOF ;YES. CLEAR EOF BIT IN CASE SET ANDCAM R2,FILEXT(AC1) MOVEM AC1,IFILE ;STORE AS INPUT FILE POINTER CALL GRAB1 ;FETCH SECOND ARG, EVAL TO ATOM CAIE T,U.INT/2 ;MAKE SURE IT'S AN INT ILLTYP ;NO, ERROR SOSGE AC2,R ;OK, BUT WE COUNT FROM ZERO, NOT ONE SFNERR MSG(POSNP) ;POSITION ARGUMENT NON-POSITIVE HLRZ T,FILPZA(AC1) ;FETCH DATA MODE FOR THIS FILE MOVEI AC4,^D36 ;AC4_# OF BITS PER WORD LDB R,[POINT 6,FILPTR(AC1),11] ;R_# OF BITS PER BYTE IDIVB AC4,R ;AC4,R _ # OF BYTES PER WORD ASH R,7 ;R _ # OF BYTES PER DISK BLOCK CAIN T,U.DBL/2 ;BUT IF THE DATA MODE IS DBL ASH R,-1 ; THEN ONLY HALF THAT NUMBER OF "BYTES" IDIV AC2,R ;AC2 _ # OF BLOCKS FROM START OF FILE; ;AC3 _ RELATIVE POSITION IN BLOCK HRRZ R,FILPOS(AC1) ;GET BLOCK NUMBER OF CURRENT BUFFER CAIN AC2,(R) ;ARE WE ASKING FOR A BYTE IN THE NEXT BLOCK? JRST POSIT4 ;YES, JUST GO GET IT (MIGHT BE IN CORE) CAIE R,1(AC2) ;NO, IS BYTE IN CURRENT BLOCK? JRST POSIT1 ;NO, HAVE TO GO READ NEW BLOCK PUSHJ P,BYCALC ;YES, RESET TO TOP OF CURRENT BUFFER JRST POSIT5 ;GO POSITION DOWN FROM TOP ;HERE WHEN FILE MUST BE REPOSITIONED POSIT1: HRRM AC2,FILPOS(AC1) ;STORE NEW BLOCK NUMBER -1 MOVE AC2,[WAIT] ;AVOID SYNCHRONIZATION PROBLEMS PUSHJ P,UXCT ; BY STOPPING I/O ACTIVITY HRRZ AC2,FILPOS(AC1) ;FETCH NEW BLOCK # -1 ADD AC2,[USETI 1] ;FORM USETI TO NEW BLOCK PUSHJ P,UXCT ;EXECUTE USETI FOR CHANNEL MOVE R,@FILHDP(AC1) ;FETCH PTR TO NEXT BUFFER SKIPL (R) ;HAS NEXT BUFFER BEEN FILLED? JRST POSIT4 ;NO SETZM FILCTR(AC1) ;YES, FORCE INBYTE TO READ NEXT BUFFER PUSHJ P,INBYTE ;ADVANCE POINTERS TO NEXT BUFFER JFCL ;UNLIKELY EOF RETURN SOS FILPOS(AC1) ;COMPENSATE FOR AOS DONE IN INBYTE POSIT4: SETZM FILCTR(AC1) ;FORCE NEXT INBYTE TO READ A BLOCK
;CONTINUATION OF POSITION CODE POSIT5: PUSHJ P,INBYTE ;ADVANCE FIRST BYTE OF SELECTED BLOCK JRST POSIT9 ;RETURN AT ONCE IF END-OF-FILE JUMPE AC3,POSIT9 ; OR IF FIRST BYTE IS IT CAIN T,U.DBL/2 ;IS DATA MODE DBL? ASH AC3,1 ;YES, BUT WE READ ONLY 1 WORD AT A TIME AOS R,FILCTR(AC1) ;FETCH BYTE COUNT SUB R,AC3 ;UPDATE BY DISPLACEMENT INTO BLOCK MOVEM R,FILCTR(AC1) ;STORE UPDATED BYTE COUNT IDIVI AC3,(AC4) ;AC3 _ WORD DISPLACEMENT, AC4_BYTE IN WORD ADDM AC3,FILPTR(AC1) ;UPDATE RH OF BYTE PTR LDB R,[POINT 6,FILPTR(AC1),11] ;R _ # OF BITS PER BYTE IMULI AC4,(R) ;AC4_POSITION OF LEFTMOST BIT OF SELECTED BYTE MOVEI AC3,^D36 ;AC3_# OF BITS PER WORD SUBI AC3,(AC4) ;AC3 _ # OF BITS TO RIGHT OF SELECTED BYTE DPB AC3,[POINT 6,FILPTR(AC1),5] ;STORE IN POSITION FIELD OF PTR PUSHJ P,INBYTE ;ADVANCE A BYTE JFCL ;EOF RETURN (FLAG ALREADY SET) POSIT9: SETZM IFILE ;NORMAL RETURN, CLEAR INPUT FCB PTR JRST RETNUL ;RETURN NULL AS VALUE OF CALL
;ROUTINE TO RETURN THE NEXT INPUT BYTE, WITH EOF CHECKED IMMEDIATELY ; UPON ENTRY. EXCEPT FOR TTY, THE FOLLOWING BYTE IS ADVANCED SO ; THE USER IS FORWARNED OF IMPENDING EOF IF HE BOTHERS TO TEST. ; CALL NXTBYT ; EOF RETURN ; NORMAL RETURN - BYTE IN R NXTBYT: SKIPE EVALBP JRST NXTBY2 SKIPN R,IFILE ;GET FCB POINTER JRST NXTBY1 ;CONTROLLING TTY IF ZERO HRRZ R2,FILEXT(R) ;TEST FOR EOF TRNE R2,FS.EOF RETURN ;TAKE EOF RETURN TRNE R2,FS.TTY ;IS DEVICE A TELETYPE? JRST NXTBY1 ;YES, SPECIAL HANDLING LDB R,FILPTR(R) ;NO, PICK UP CURRENT BYTE SAVE <R> ;SAVE IT CALL INBYTE ;ADVANCE THE NEXT BYTE JFCL ;EOF RETURN - STATUS BIT ALREADY SET RESTOR <R> ;RESTORE THIS BYTE JRST CPOPJ1 ;TAKE NORMAL RETURN ;HERE WHEN INPUT DEVICE IS A TELETYPE NXTBY1: CALL INBYTE ;GET NEXT BYTE ERROR MSG(BDEOF) ;BAD EOF SKIPE IFILE ;CONTROLLING TTY NEVER GETS EOF CAIE R,32 ;CONTROL-Z? JRST CPOPJ1 ;NO, TAKE NORMAL RETURN MOVEI R2,FS.EOF ;YES, SET EOF STATUS BIT EXCH R,IFILE IORM R2,FILEXT(R) EXCH R,IFILE JRST CPOPJ1 ;BUT TAKE NORMAL RETURN WITH CONTROL-Z ;HERE WHEN DOING EVAL NXTBY2: SOSN IFILE ;DECR COUNT RETURN ;IF ZERO, DO EOF RETURN ILDB R,EVALBP ;GET CHARACTER JRST CPOPJ1 ;DO NORMAL RETURN
;ROUTINE TO ACTUALLY READ IN THE NEXT BYTE. ; CALL INBYTE ; EOF RETURN ; NORMAL RETURN - BYTE IN R INBYTE: SKIPN R,IFILE ;GET ADR OF INPUT FCB JRST ITTY ;TTY INPUT IF ZERO SOSGE FILCTR(R) ;DECREMENT AND TEST BYTE COUNT JRST INXTBF ;NONE LEFT, NEED A NEW BUFFER ILDB R,FILPTR(R) ;OK, GET NEXT BYTE JUMPN R,CPOPJ1 ;SKIP RETURN IF NOT NULL BYTE HLRZ R,@IFILE ;NULL BYTE, GET FILE DATA MODE CAIN R,U.CHAR/2 ;CHARACTER MODE? JRST INBYTE ;YES, GET THE NEXT CHARACTER TDZA R,R ;NO, JUST RETURN NULL BYTE AS IS ;HERE IF INPUT DEVICE IS CONTROLLING TELETYPE ITTY: TTI R ;PUT NEXT CHAR IN R JRST CPOPJ1 ;SKIP RETURN
;HERE WHEN ANOTHER BUFFERFUL MUST BE READ. INXTBF: SAVE <AC1,AC2> ;SAVE SOME AC'S AOS FILPOS(R) ;UPDATE CURRENT BLOCK NUMBER MOVEI R2,-1 ;HAS BYTE PTR EVER BEEN USED? TDNE R2,FILPTR(R) SKIPL FILHDP(R) ;YES, BUFFER BEEN MOVED BY GARBAGE COLLECTOR? JRST IXCTIN ;NO, JUST DO IN UUO MOVSI R2,400000 ;YES, HAVE TO DO SPECIAL HANDLING ANDCAB R2,@FILHDP(R) ;FREE CURRENT BUFFER AND GET PTR TO NEXT SKIPL (R2) ;IS IT FULL? JRST IXCTIN ;NO, JUST GO DO IN UUO ;WE HAVE TO RECOMPUTE THE BYTE POINTER AND COUNT OURSELVES. FAILURE TO ; DO SO LEADS TO INTERMITTENT "ILLEGAL UUO" MESSAGES ON THE INPUT UUO. HRRM R2,FILHDP(R) ;UPDATE CURRENT BUFFER POINTER MOVE AC1,R ;COPY FCB PTR INTO AC1 PUSHJ P,BYCALC ;SET BYTE PTR TO TOP; CALCULATE COUNT INXT2: RESTOR <AC2,AC1> ;RESTORE SAVED AC'S JRST INBYTE ;GO GET NEXT BYTE NOW ;HERE TO EXECUTE IN UUO IXCTIN: MOVE AC1,R ;GET FCB ADR MOVSI AC2,(IN) ;EXECUTE IN UUO FOR CHANNEL CALL UXCT JRST INXT2 ;OK RETURN, NOW GO GET BYTE MOVE AC2,[STATZ 740000] ;ERROR RETURN, CHECK FILE STATUS CALL UXCT JRST FIOERR ;ERROR, GO HANDLE IT MOVEI R,FS.EOF ;END-OF-FILE, SET EOF BIT IN FCB IORM R,FILEXT(AC1) JRST X21 ;RESTORE AC'S AND ERROR RETURN
;ROUTINE TO COMPUTE BYTE PTR AND COUNT FOR CURRENT BUFFER OF FILE WHOSE ; FCB IS ADDRESSED BY AC1 BYCALC: PUSH P,AC2 ;SAVE ANOTHER WORK REGISTER MOVSI R2,7700 ;EXTRACT BYTE SIZE FIELD IN BYTE PTR ANDB R2,FILPTR(AC1) ; AND CLEAR REST OF BYTE PTR ROT R2,^D12 ;RIGHT-JUSTIFY BYTE SIZE HRRZ AC2,FILHDP(AC1) ;FETCH PTR TO CURRENT BUFFER MOVSI R,(POINT 0,) ;SET POINTER TO FIRST BYTE HRRI R,2(AC2) ;POINT TO FIRST DATA WORD IORM R,FILPTR(AC1) ;STORE NEW BYTE PTR MOVEI R,^D36 ;COMPUTE # OF BYTES PER WORD IDIVI R,(R2) IMUL R,1(AC2) ;COMPUTE # OF BYTES IN BUFFER HRRZM R,FILCTR(AC1) ;STORE NEW BYTE COUNT POP P,AC2 ;RESTORE WORK REGISTER POPJ P, ;RETURN
;ROUTINE TO OUTPUT A BYTE TO THE CURRENTLY-SELECTED OUTPUT FILE ; AC1 = BYTE TO BE OUTPUT ; CALL OUTBYT ; ALWAYS RETURN HERE OUTBY0: RESTORE <AC2,AC1> ;HERE FROM OUT UUO PROCESSING OUTBYT: SKIPN R,OFILE ;GET FILE BLOCK POINTER JRST OTTY ;OUTPUT TO CONTROLLING TTY IF ZERO SOSGE FILCTR(R) ;ANY ROOM IN BUFFER? JRST ONXTBF ;NO, HAVE TO FORCE OUT OUTPUT IDPB AC1,FILPTR(R) ;YES, STORE BYTE RETURN ;HERE TO OUTPUT TO CONTROLLING TTY OTTY: TTOI (AC1) RETURN ;HERE TO FORCE OUT A BUFFERFUL ONXTBF: SAVE <AC1,AC2> ;SAVE SOME AC'S MOVE AC1,R ;GET FCB ADDRESS MOVSI AC2,(OUT) ;EXECUTE OUT UUO FOR CHANNEL CALL UXCT JRST OUTBY0 ;OK RETURN - RESTORE AC'S AND STORE BYTE ;ERROR RETURN - FALL INTO FIOERR ;I/O ERROR PROCESSING - ADR OF FCB IN AC1 FIOERR: MOVE AC2,[GETSTS AC2] ;EXECUTE GETSTS UUO FOR CHANNEL CALL UXCT ANDI AC2,760000 ;EXTRACT STATUS BITS JFFO AC2,.+2 ;DETERMINE WHICH BIT WAS ON JRST IOERR2 ;YIPES!!!! SAY "UNKNOWN" MOVEI AC4,-^D18+NLOOK(AC3) ;CONV TO CODE FROM NLOOK TO NLOOK+4 JRST IOER1A ;REST OF PROCESSING SAME AS LOOKUP/ENTER ERROR
;ROUTINE TO SETUP FOR INBYTE SYSTEM FUNCTION ; RETURNS FCB ADDRESS IN IFILE AND IN R. ISETUP: CALL CHNGET ;EVAL ARG TH FCB ADR, ADVANCE TO NEXT ARG JUMPE R,ISETU9 ;JUMP IF ZERO HRRZ R2,FILEXT(R) ;GET STATUS BITS FOR FILE TRNE R2,FS.OUT ;OPEN FOR INPUT? SFNERR MSG(CHNIN) ;CHANNEL NOT OPEN FOR INPUT TRNE R2,FS.EOF ;END-OF-FILE SEEN ALREADY? FILERR R,MSG(ENDOF) ;END OF FILE ISETU9: MOVEM R,IFILE ;ALL OK, STORE FCB ADR IN IFILE AND RETURN RETURN ;ROUTINE TO SETUP FOR OUTBYTE SYSTEM FN. ; RETURNS FCB ADDRESS IN OFILE AND IN R. OSETUP: CALL CHNGET ;EVAL ARG TO FCB ADDRESS JUMPE R,OSETU9 ;JUMP IF ZERO HRRZ R2,FILEXT(R) ;CHECK FOR RIGHT DIRECTION TRNN R2,FS.OUT SFNERR MSG(CHNOU) ;CHANNEL NOT OPEN FOR OUTPUT OSETU9: MOVEM R,OFILE ;OK, STORE FCB ADR IN OFILE RETURN
SUBTTL I/O ERROR PROCESSING ;HERE ON LOOKUP/ENTER ERROR. FCB ADR IN AC1, ERROR CODE IN AC4[RH] ELOOK: EENTR: HRRZS AC2,AC4 ;CLEAR LH CAIL AC4,NLOOK ;ENSURE WITHIN RANGE OF OUR TABLES JRST IOERR2 ;NO, SAY "UNKNOWN" WITH NUMERIC CODE ;HERE FROM INPUT/OUTPUT ERROR HANDLING IOER1A: MOVEI AC3,FS.OUT ;IS FILE INPUT OR OUTPUT VARIETY? TDNN AC3,FILEXT(AC1) SKIPA AC3,IOMTAB(AC4) ;INPUT, USE RH OF TABLE MOVS AC3,IOMTAB(AC4) ;OUTPUT, USE LH OF TABLE MOVE R,FILDEV(AC1) ;FETCH DEVICE NAME DEVCHR R, ;RETURN DEVICE CHARACTERISTICS TLNE R,(DV.DTA) ;IS IT A DECTAPE? LSH AC3,-6 ;YES, POSITION DECTAPE ENTRY TLNE R,(DV.DSK) ;IS IT A DISK? LSH AC3,-^D12 ;YES, POSITION DISK ENTRY ANDI AC3,77 ;MASK OFF OTHER JUNK ROT AC3,-1 ;DIVIDE BY 2 SAVING REMAINDER SKIPGE AC3 ;EVEN OR ODD? SKIPA AC3,IOMPTS(AC3) ;ODD, USE RH ENTRY MOVS AC3,IOMPTS(AC3) ;EVEN, USE LH ENTRY TRNE AC3,-1 ;IS THE ERROR DEFINED? FILERR AC1,(AC3) ;YES, PRINT IT AND QUIT ;HERE FOR UNRECOGNIZED ERRORS IOERR2: FILERP AC1,[SIXBIT/UNEXPECTED ERROR !/] HRRZ AC1,AC2 ;GET ERROR CODE AGAIN CALL OCTPRT ;CONVERT TO SIXBIT OCTAL STRING HRLI R,(SIXBIT/#/) ;APPEND TERMINATOR MOVSS R TTOS R ;PRINT ERROR NUMBER JRST RESTRT ;FINISH SFNERR PROCESSING
;FIRST LEVEL ERROR MESSAGE TABLE, INDEXED BY LOOKUP/ENTER ERROR NUMBER ; (0-15) OR INPUT/OUTPUT ERROR NUMBER (16-22). ENTRIES ARE 1 WORD ; FOR EACH NUMBER, WITH 6 6-BIT BYTES ARRANGED AS: ; DSK OUT, DTA OUT, OTHER OUT, DSK IN, DTA IN, OTHER IN ; AND EACH 6-BIT FIELD IS AN INDEX INTO THE IOMPTS TABLE. DEFINE IOMES(DO,TO,OO,DI,TI,OI) < BYTE(6) ER'DO,ER'TO,ER'OO,ER'DI,ER'TI,ER'OI > IOMTAB: IOMES (ILF,ILF,ILF,FNF,FNF,FNF) ;CODE 0 (LOOKUP/ENTER) IOMES (IPP,UNX,IPP,IPP,UNX,IPP) ; 1 IOMES (PRT,DIR,PRT,PRT,DIR,PRT) ; 2 IOMES (FBM,FBM,FBM,UNX,UNX,UNX) ; 3 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 4 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 5 IOMES (TRN,UNX,UNX,TRN,UNX,UNX) ; 6 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 7 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 10 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 11 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 12 IOMES (UNX,UNX,UNX,UNX,UNX,UNX) ; 13 IOMES (NRM,UNX,UNX,UNX,UNX,UNX) ; 14 IOMES (WLK,WLK,WLK,UNX,UNX,UNX) ; 15 NLOOK== .-IOMTAB IOMES (WLK,WLK,WLK,UNX,UNX,UNX) ;BIT 18 (INPUT/OUTPUT) IOMES (DEV,DEV,DEV,DEV,DEV,DEV) ; 19 IOMES (CKP,CKP,CKP,CKP,CKP,CKP) ; 20 IOMES (NRM,BTL,UNX,UNX,UNX,UNX) ; 21 IOMES (UNX,UNX,UNX,EOF,EOF,EOF) ; 22
;SECOND-LEVEL TABLE - HALFWORD POINTERS TO THE MESSAGES THEMSELVES ; (WHICH ARE IN THE ERROR FILE IF FTEMF=1) DEFINE IOMESP(E,L) < ER'E== ZZ IFE ZZ&1,< IOMLH== L > IFN ZZ&1,< IOMLH,, L > ZZ== ZZ+1 > ZZ== 0 IOMPTS: IOMESP (FNF,MSG(FILNF)) ;NOT FOUND IOMESP (ILF,MSG(ILFIL)) ;ILLEGAL FILENAME IOMESP (IPP,MSG(NSUSR)) ;NO SUCH USER AREA IOMESP (PRT,MSG(PROTV)) ;PROTECTION VIOLATION IOMESP (DIR,MSG(DIRFL)) ;DIRECTORY FULL IOMESP (FBM,MSG(ALRBM)) ;ALREADY BEING MODIFIED IOMESP (TRN,MSG(UFDER)) ;UFD OR RIB ERROR IOMESP (NRM,MSG(DFOQE)) ;DISK FULL OR QUOTA EXCEEDED IOMESP (WLK,MSG(WRLKE)) ;WRITE-LOCK ERROR IOMESP (DEV,MSG(DEVER)) ;DEVICE ERROR IOMESP (CKP,MSG(CHOPE)) ;CHECKSUM OR PARITY ERROR IOMESP (BTL,MSG(TAPFL)) ;TAPE FULL IOMESP (EOF,MSG(ENDOF)) ;END-OF-FILE IOMESP (UNX,0) ;UNEXPECTED ERROR IOMESP (ZZZ,0) ;(FINISH LIST IF ODD #)
SUBTTL CONFIGURATION-DEPENDENT I/O ROUTINES IFN ARDS,< ;###################### SPECIAL ARDS OUTPUT FUNCTIONS ################# ;SERPOINT(X,Y) - SET BEAM ON ABSOLUTE ARDS COORDINATES SSETPO: EXP 2 ;TAKES 2 ARGS CALL SETARD ;ENCODE DATA INTO ASCII CHARACTERS ARDMODE 35 ;GO INTO SET POINT MODE JRST OUTARD ;OUTPUT ENCODED INFORMATION ;SOLIDVEC(X,Y) - DRAW A SOLID VECTOR USING X AND Y AS DISPLACEMENTS SSOLID: EXP 2 CALL SETARD ;ENCODE DATA ARDMODE 36 ;ENTER VECTOR MODE JRST OUTARD ;OUTPUT ENCODED INFORMATION ;DOTTEDVEC(X,Y) - DRAW A DOTTED VECTOR SDOTTE: EXP 2 CALL SETARD ;ENCODE DATA ARDMODE 36 ;ENTER VECTOR MODE TRO AC2,20000 ;SET DOTTED LINE CONTROL ;HERE TO OUTPUT ENCODED CHARACTERS TO THE ARDS. ; ASCIZ STRING IS IN AC2. OUTARD: SKIPE IMGFLG ;IMAGE MODE OUTPUT LEGAL? JRST OUTRDI ;YES, DO IT TTCALL 3,AC2 ;NO, OUTPUT IT REGULAR WAY. ; NOTE*** THIS WILL LOSE ON STANDARD ; 4S72 AND 501 MONITORS BECAUSE OF ; THE FREE CARRIAGE RETURNS INSERTED ; BY THE MONITOR. HOWEVER, THE HARVARD ; 4S72 MONITOR HAS A SPECIAL DIDDLE IN IT. JRST RETNUL ;RETURN NULL AS VALUE OF FUNCTION ;HERE (5.02 MONITOR OR LATER) TO OUTPUT IN IMAGE MODE. OUTRDI: SETZ AC1, ;CLEAR ADJACENT AC LSHC AC1,7 ;SHIFT IN A CHARACTER TO BE OUTPUT MOVE R,AC1 ;DUPLICATE CHARACTER IMULI AC1,200401 ;COMPUTE PARITY AND AC1,[11111111] IMUL AC1,[11111111] TLNE AC1,10 ;IS PARITY ODD? TRO R,200 ;YES, SET PARITY BIT TO MAKE IT EVEN TTCALL 15,R ;OUTPUT CHAR IN IMAGE MODE JUMPN AC2,OUTRDI ;GO BACK FOR MORE IF ANY JRST RETNUL ;RETURN NULL AS VALUE OF FUNCTION
;ARDMODE() - ENTER SPECIAL ARDS OUTPUT MODE (NO TRANSLATION) SARDMO: EXP 0 IFE MITS,< MOVEI R,700 ;SETUP STATUS BITS: NO ECHO,FCS,NO ALTMODE ECHO SKIPN IMGFLG ;IMAGE MODE OUTPUT LEGAL? MOVEI R,1700 ;NO, INVOKE HARVARD 4S72 IMAGE KLUDGE SETSTS TT,(R) ;SET TTY STATUS SKIPE T37 ;ALREADY IN ARDS MODE? JRST RETNUL ;YES, RETURN NULL SETOM T37 ;GET TTY CHARACTERISTICS TTCALL 6,T37 MOVSI R,20 ;SHIFT TO LOWER-CASE INPUT MODE IOR R,T37 ; SO THAT STYLUS POSITIONS ARE NOT TTCALL 7,R ; TRANSLATED TO UPPER CASE!!! MOVSI R,400000 ;SET A BIT TO ENSURE WORD IS NONZERO IORM R,T37 ;(THIS IS PTY BIT, WHICH THE MONITOR ; SURELY WON'T LET US SET!) > JRST RETNUL ;RETURN NULL RESULT ;TTYMODE() - LEAVE SPECIAL ARDS MODE STTYMO: EXP 0 IFE MITS,< SETSTS TT,500 ;CLEAR SPECIAL ARDS BIT SKIPE T37 ;ALREADY OUT OF ARDS MODE? TTCALL 7,T37 ;NO, RESTORE OLD TTY CHARACTERISTICS SETZM T37 ;SIGNAL TTY MODE > JRST RETNUL
;ROUTINE TO CONVERT X AND Y SPECIFICATIONS TO AN ASCIZ STRING ;FOR THE ARDS. AC1,AC2 ARE CLOBBERED SETARD: MOVE AC1,[POINT 7,AC2] ;PREPARE TO ENCODE DATA SETZ AC2, CALL ARDCHR ;OK, CONVERT LEFT ARG TO 2 CHARACTERS ADDI ARGP,1 ;MOVE TO RH ARG CALL ARDCHR ;CONVERT RIGHT ARG TO 2 CHARACTERS MOVE R,AC2 ;RECOVER RESULT AND EXIT RETURN ARDCHR: CALL ARGPRP ;COERCE TO AN ATOM ILLTYPE ;NOT ATOMIC CAILE T,U.DBL/2 ;CHECK FOR ARITHMETIC RESULT ILLTYPE ;ERROR XCT .+1(T) ;OK, PERFORM CONVERSION TO INT JRST .+3 ;INT CALL FIX ;REAL CALL DFIX ;DBL ASH R,1 ;MAKE SPACE FOR SIGN JUMPGE R,.+3 ;SKIP AROUND IF POSITIVE MOVM R,R ;NEGATIVE, TAKE MAGNITUDE. TRO R,1 ;SET FUNNY ARDS SIGN BIT IDIVI R,100 ;SPLIT OFF LOW 6 BITS TRO R,100 ;ALL DATA CHARACTERS HAVE THIS BIT SET TRO R2,100 TRZ R,40 ;CLEAR BACKWARDS INTENSITY BIT IDPB R2,AC1 ;STORE LOW ORDER IDPB R,AC1 ;STORE HIGH ORDER RETURN ;COME HERE ON ARDMODE UUO - SET MODE TO EFFECTIVE ADDR. UNLESS IT IS ;ALREADY SO. XARDM: SAVE R HRRZ R,JOBUUO ;GET NEW MODE EXCH R,AMODE ;STORE IT AND LOOK AT OLD CAME R,AMODE ;NEW SAME AS OLD? TTO AMODE ;NO, SET THE NEW RESTORE R RETURN ;DISMISS UUO CALL > ; END IFN ARDS CONDITIONAL
IFN SYLVN,< ;###### SYLVANIA TABLET INPUT ###### ;READSTYLUS() - READ SYLVANIA STYLUS X,Y,Z POSITIONS. ;SET THE VARIABLES XSTYLUS,YSTYLUS,ZSTYLUS TO HAVE INTEGER VALUES SREADS: EXP 0 ;NO ARGS TTOI 5 ;SIGNAL ARDS TO READ TABLET MOVEI R,34 ;ASCII 5 SEEMS TO SET ARDS TO CHAR MODE MOVEM R,AMODE ; SO REMEMBER CURRENT MODE AS CHARACTER CALL READS1 ;GET FIRST DATA CHARACTER LSHC R,-6 ;SAVE IT CALL READS1 ;GET SECOND DATA CHARACTER LSHC R,5 ;CONCATENATE AND DIVIDE BY 2 XORI R,3777 ;UNCOMPLEMENT HRREI AC1,-<^D512+600>(R) ;(0,0) IS MIDDLE; ALSO A FUDGE FACTOR CALL PACKV ;STORE X POSITION AS AN INT HRRM R,%XSTYL(B) CALL READS1 ;GET THIRD DATA CHARACTER LSHC R,-6 ;SAVE IT AND GET FOURTH CALL READS1 LSHC R,5 ;CONCATENATE AND DIVIDE BY 2 XORI R,3777 ;UNCOMPLEMENT DATA HRREI AC1,-<^D512+400>(R) CALL PACKV ;STORE Y POSITION AS AN INT HRRM R,%YSTYL(B) CALL READS1 ;READ Z DATA ANDI R,7 ;0 IS DOWN, 7 IS UP MOVE AC1,R ;STORE Z POSITION CALL PACKV HRRM R,%ZSTYL(B) JRST RETNUL ;FUNCTION RETURNS NO VALUE ITSELF ;RETURN 6 BITS OF DATA FROM THE TABLET READS1: TTCALL 0,R ;GET CHARACTER TRZN R,100 ;A VALID BINARY DATA CHARACTER? JRST READS1 ;NO, GET ANOTHER RETURN ;ROUTINE TO PACK THE INTEGER IN AC1 AS A BLOCK OF TYPE INT PACKV: CALL MKBLK ;CONSTRUCT INT BLKARG U.INT,2 MOVEM AC1,1(R2) ;STORE VALUE HRRZ B,@IDTP ;ALSO SET UP IDT POINTER RETURN > ;END IFN SYLVN CONDITIONAL LIT END