ASMB,R,L HED ** ASCIN - ASCII INPUT SUBROUTINE ** JDR NAM ASCIN,7 ENT ASCIN EXT EXEC,.ENTR SPC 2 * ASCIN IS A SUBROUTINE TO INPUT ASCII CHARACTERS FROM A LOGICAL * UNIT DEVICE TO A USER SPECIFIED BUFFER. CHARACTERS ARE PACK TWO * PER WORD AND IF THE INPUT IS LESS THAN THE REQUEST, THE REMAIN- * ING WORDS ARE FILLED WITH ASCII BLANKS. * * CALLING SEQUENCE * FORTRAN - * CALL ASCIN (IBUFR,LUN,LEN,NUM,ISTAT) * ALGOL - * PROCEDURE ASCIN (IBUFR,LUN,LEN,NUM,ISTAT); * INTEGER IBUFR,LUN,LEN,NUM,ISTAT; * CODE; * ASSEMBLY * JSB ASCIN * DEF *+6 * DEF IBUFR * DEF LUN * DEF LEN * DEF NUM * DEF ISTAT * WHERE: * IBUFR = 1ST WORD OF BUFFER FOR ASCII INPUT * LUN = LOGICAL UNIT NUMBER OF INPUT DEVICE. * IF POSITIVE PRINT A ? BEFORE INPUT & ECHO INPUT. * IF NEGATIVE DO NOT PRINT ? AND DO NOT SET ECHO BIT. * LEN = INPUT REQUEST LENGTH - POSITIVE = WORDS, NEGATIVE = * CHARACTERS. * NUM = ACTUAL INPUT ON RETURN, EITHER WORDS OR CHARACTERS * AS SPECIFIED IN PARAMETER LEN. * ISTAT = EQT WD 5, STATUS OF DEVICE UPON RETURN. SPC 1 * J.D. REED HAC-TEL 2/2/74 SPC 2 IBUFR NOP BUFFER ADDRESS LUN NOP INPUT LOGICAL UNIT ADDRESS LEN NOP INPUT REQUEST LENGTH ADDRESS NUM NOP ACTUAL INPUT LENGTH REQUEST ISTAT NOP DEVICE STATUS ADDRESS SPC 1 ASCIN NOP JSB .ENTR FETCH THE DEF IBUFR PARAMETER ADDRESSES SPC 1 * FILL USER'S BUFFER WITH ASCII BLANKS SPC 1 LDA LEN,I FETCH REQUEST LENTH SSA,RSS LENGTH IN WORDS OR CHARACTERS? CMA,INA,RSS WORDS - MAKE COUNT NEGATIVE ARS CHARACTERS - CHANGE TO WORDS STA CNTR SAVE BUFFER WORD SIZE LDA IBUFR FETCH BUFFER ADDRESS LDB SPACE AND AN ASCII BLANK STB A,I STORE BLANK IN BUFFER INA INDEX BUFFER ADDRESS ISZ CNTR BUFFER FILLED WITH SPACES? JMP *-3 NO - LOOP SPC 1 * CONFIGURE LOGICAL UNIT NUMBER SPC 1 LDA LUN,I FETCH LOGICAL UNIT SSA SET ECHO BIT? CMA,INA,RSS NO - MAKE LOGICAL UNIT POSITIVE IOR ECHO YES - OR IN ECHO BIT STA UNIT SAVE CONFIGURE LOGICAL UNIT. SPC 1 * OUTPUT QUESTION MARK IF IT WAS REQUESTED SPC 1 LDA LUN,I WAS QUESTION SSA MARK REQUESTED? JMP INPUT NO - GO DIRECTLY TO INPUT SECTION JSB EXEC YES - DEF *+5 DO DEF D2 AN DEF UNIT EXEC DEF ?? WRITE DEF N3 REQUEST SPC 1 * INPUT ASCII STRING SPC 1 INPUT JSB EXEC DO DEF *+5 AN DEF D1 EXEC DEF UNIT INPUT DEF IBUFR,I REQUEST DEF LEN,I TO USER'S BUFFER STA ISTAT,I RETURN STATUS AND STB NUM,I WORD OR CHARACTER COUNT TO USER SPC 1 JMP ASCIN,I RETURN SPC 1 * CONSTANTS & CORE ALLOCATION SPC 1 A EQU 0 CNTR NOP D1 DEC 1 D2 DEC 2 ECHO OCT 400 N3 DEC -3 SPACE ASC 1, UNIT NOP ?? ASC 1,? OCT 57400 SPC 1 END ASMB,R,B,L HED ** FILE MANAGER ERROR PROCESSOR ** JDR NAM IFMGR,7 ENT IFMGR EXT EXEC,.ENTR SPC 1 * THIS FUNCTION CHECKS FOR FILE MANAGER ERRORS. IF THE ERROR * CODE IS < 0, THE ERROR MESSAGE IS PRINTED ON THE LOCAL TTY. * * IF ID IS >= 0, THE ERROR CODE IS RETURNED AS THE FUNCTION * VALUE. * * IF ID IS < 0 AND THE ERROR CODE IS < 0, THEN THE PROGRAM IS * ABORTED. SPC 1 * FORTRAN USEAGE EXAMPLE: * IF (IFMGR (IERR,ID,LTTY,NAME)100,200 SPC 1 * ASSEMBLY CALL SEQUENCE * JSB IFMGR * DEF *+4 * DEF IERR * DEF ID * DEF LTTY * DEF NAME * ON RETURN A = IERR SPC 1 * WHERE: * IERR = ERROR PARAMETER RETURNED FROM FILE MANAGER CALL. * ID = CALL IDENTITY CODE (NEGATIVE TO ABORT IF ERROR EXSISTS) * AS FOLLOWS. * 1 = APOSN * 2 = CLOSE * 3 = CREAT * 4 = FCONT * 5 = FSTAT * 6 = LOCF * 7 = NAMF * 8 = OPEN * 9 = POSNT * 10 = PURGE * 11 = READF * 12 = RWNDF * 13 = WRITF * LTTY = LOGICAL UNIT NUMBER OF DEVICE TO LIST ERROR SPC 2 * PARAMETER ADDRESSES SPC 1 IERR NOP ERROR CODE ID NOP FILE MANAGER CALL ID LTTY NOP LOGICAL UNIT TO OUTPUT ERROR MESS NAME NOP NAME OF FILE FILE MANAGER FILE ADDS. SPC 1 * ENTRY POINT SPC 1 IFMGR NOP JSB .ENTR USE .ENTR TO GET DEF IERR ADDRESSES OF PARAMETERS LDA IERR,I GET ERROR CODE SSA,RSS FILE MANAGER ERROR? JMP IFMGR,I NO, RETURN TO USER SPC 1 * ERROR! CONVERT ERROR TO ASCII AND PUT IT INTO OUTPUT BUFFER SPC 1 MPY M1 MULTIPLY ERROR BY -1 & THEN DIV .10 DIVIDE BY TEN TO GET TENS DIGIT. STA ERROR SAVE TEMPORARILY MPY .10 MULTIPLY BY 10 AND DIVIDE BY DIV .1 1 TO GET TENS VALUE ONLY ADA IERR,I ADD ERROR CODE, RESULT = - UNITS CMA,INA MAKE UNITS POSITIVE LDB ERROR GET TENS DIGIT BLF,BLF ROTATE IT TO HIGH HALF OF WORD IOR B OR IT WITH UNITS IOR ASC00 OR IN ASCII CONSTANT STA ERROR PUT ASCII ERROR CODE IN MESS BUF SPC 1 * ADD CALL ID AND FILE NAME TO BUFFER SPC 1 LDA ID,I GET ID CODE SSA IS IT NEGATIVE? CMA,INA YES - MAKE POSITIVE STA B IS CODE ADB M14 GREATER SSB,RSS THAN 13? CLA YES - OUTPUT $$$$$ FOR ID STA B SAVE ERROR CODE ALS MULTIPLY BY 2 AND ADA B ADD IT TO ITSELF (X3) ADA CALL ADD BUFR STARTING ADDS TO OFFSET LDB EMES SET POINTER TO STB PNTR ID NAME CLB SET FLAG TO INDICATE NAME STB FLAG BUFFER HAS TO BE TRANSFERRED. NFILE LDB M3 SET COUNTER TO STB CNTR TRANSFER 3 WORDS LOOP LDB A,I GET ID WORD & PUT IT STB PNTR,I IN ERROR MESSAGE BUFFER INA INDEX ID AND ISZ PNTR ERROR MESSAGE POINTERS ISZ CNTR TRANSFER COMPLETE? JMP LOOP NO - TRANSFER NEXT WORD LDB FLAG SZB NAME ARRAY TRANSFERRED? JMP OUT YES - OUTPUT MESSAGE ISZ FLAG NO - SET FLAG TO SAY YES LDA NAME GET ADDRESS OF ARRAY IN A LDB NAMEB PUT OUTPUT BUFFER STB PNTR ADDRESS IN B JMP NFILE TRANSFER FILE NAME SPC 1 * OUTPUT ERROR MESSAGE SPC 1 OUT JSB EXEC DEF *+5 DEF WRITE DEF LTTY,I EMES DEF ERMES DEF M32 SPC 1 * CHECK FOR ABORT PROGRAM SPC 1 LDA IERR,I PUT ERROR CODE IN CASE WE RETURN LDB ID,I GET ID CODE SSB,RSS DO WE ABORT? JMP IFMGR,I NO - RETURN SPC 1 * ABORT PROGRAM SPC 1 JSB EXEC WRITE DEF *+5 "PROGRAM ABORTED!" DEF WRITE ON DEF LTTY,I THE DEF ABORT LOCAL DEF M16 TTY JSB EXEC ASK DEF *+2 RTE TO DEF .6 TERMINATE PROGRAM JMP *-3 JUST IN CASE RTE DOES NOT LISTEN SPC 1 * CONSTANTS, STORAGE ALLOCATION, AND MESSAGES SPC 1 A EQU 0 A REGISTER B EQU 1 B REGISTER SPC 1 * CONSTANTS SPC 1 .1 DEC 1 .6 DEC 6 .10 DEC 10 M1 DEC -1 M3 DEC -3 M14 DEC -14 M16 DEC -16 M32 DEC -32 SPC 1 * MISC. CONSTANTS SPC 1 ASC00 ASC 1,00 WRITE DEC 2 SPC 1 * NOP'S SPC 1 CNTR NOP UTILITY COUNTER FLAG NOP ID/NAME TRANSFER FLAG PNTR NOP TRANSFER POINTER TO MESSAGE BUFFR SPC 1 * FILE MANAGER CALLS SPC 1 CALL DEF *+1 SUP 1 SPC 1 ASC 3,$$$$$ ID1 ASC 3,APOSN ID2 ASC 3,CLOSE ID3 ASC 3,CREAT ID4 ASC 3,FCONT ID5 ASC 3,FSTAT ID6 ASC 3,LOCF ID7 ASC 3,NAMF ID8 ASC 3,OPEN ID9 ASC 3,POSNT ID10 ASC 3,PURGE ID11 ASC 3,READF ID12 ASC 3,RWNDF ID13 ASC 3,WRITF SPC 1 * ERROR MESSAGE SPC 1 ERMES BSS 3 ASC 4,ERROR - ERROR NOP ASC 5, IN FILE NAM. BSS 3 NAMEB DEF NAM. SPC 1 * ABORT PROGRAM MESSAGE SPC 1 ABORT ASC 8,PROGRAM ABORTED! SPC 1 END ASMB,R,L HED ** FETCH - ALGOL'S RMPAR ** JDR NAM FETCH,7 ENT FETCH SPC 2 * FETCH IS AN ALGOL PROCEDURE TO TRANSFER THE PARAMETERS PASSED * WHEN A PROGRAM IS SCHEDULED BY RTE. * * CALLING PROCEDURE - * PROCEDURE FETCH (A,B,C,D,E); * INTEGER A,B,C,D,E; * CODE; * * WHERE A THRU E ARE THE FIVE PARAMETERS PASSED BY RTE. * NOTE: IF LESS THAN 5 PARAMETERS ARE REQUIRED, ONLY THE ACTUAL * PARAMETER LIST NEED BE SUPPLIED AND DEFINED IN THE PRO- * CEDURE DECLARATION. SPC 1 * J.D. REED HAC-TEL 1/5/74 SPC 2 FETCH NOP LDA FETCH,I SAVE STA RETRN RETURN ADDRESS LOOP ISZ FETCH INCREMENT POINTER LDA FETCH AND LOAD VALUE. CPA RETRN POINTER = RETURN ADDRESS? JMP RETRN,I YES - RETURN LDA FETCH,I NO - FETCH THE VARIABLE ADDRESS STA ADDRS IN THE USER'S PROG. AND SAVE LDA B,I FETCH RTE PARAMETER & STA ADDRS,I RETURN IT TO USER. INB INDEX RTE PARAMETER POINTER JMP LOOP CHECK FOR ANOTHER PARAMETER SPC 1 B EQU 1 ADDRS NOP RETRN NOP SPC 1 END ASMB,L,R HED ** LSTKS - ROUTE TO REQUEST & WRITE LS TRACKS ** JDR NAM LSTKS,7 ENT LSRQ,LSWRT,LSEOF,LSINT,LSRED,LSREL EXT .ENTR,%WRIN,%WRIS,%WEOF,$LIBR,$LIBX EXT %JFIL,%READ,EXEC SPC 1 * SUBROUTINE TO REQUEST, WRITE TO, WRITE EOF, INITIALIZE FOR * A READ, READ AND RELEASE LS TRACKS. * * J. D. REED HAC-TEL 7/1/74 * * CALLING SEQUENCES: * 1. REQUEST LS TRACKS * CALL LSRQ (LUN,ITAK) * WHERE ON RETURN LUN = LOGICAL UNIT OF LS TRACK OR 0 * IF NO TRACKS AVAILABLE. * ITAK = STARTING TRACK NUMBER. * 2. WRITE TO LS TRACK * CALL LSWRT (IBUFR,NWDS,IERR) * WHERE IBUFR = 1ST WORD OF BUFFER TO BE WRITTEN. * NWDS = NUMBER OF WORDS TO BE WRITTEN. * IERR = ERROR FLAG - 0 NO ERROR, -1 ERROR. * 3. WRITE EOF IN LS TRACK * CALL LSEOF * 4. INITIALIZE LS TRACKS FOR READING * CALL LSINT (IERR) * WHERE IERR = 0 IF TRACKS INITIALIZE. * = 1 IF LS TRACKS ARE EMPTY. * 5. READ A RECORD FROM LS TRACKS * CALL LSRED (IBUFR,LEN,IWDS) * WHRER IBUFR = BUFFER ADDRESS * LEN = MAXIUM WORDS TO BE READ OR - FOR CHARACTERS * IWDS = ON RETURN = ACTUAL WORDS/CHARACTERS READ OR * = 0 = EOF * 6. RELEASE LS TRACKS ASSIGNED TO PROGRAM * CALL LSREL SPC 1 * REQUEST LS TRACK(S) SPC 1 LUN NOP ADDRESS TO STORE LS LOGICAL UNIT TRACK NOP ADDRESS TO STORE TRACK # SPC 1 LSRQ NOP JSB .ENTR FETCH THE PARAMETER DEF LUN ADDRESSES. CLA SET LUN TO 0 TO SAY NO TRACKS STA LUN,I ARE AVAILABLE. JSB %WRIN REQUEST A TRACK. JMP LSRQ,I RETURN - DISC FULL. STA B SAVE LUN/TRACK WORD. ALF,ALF ISOLATE AND B377 LOGICAL UNIT AND RETURN STA LUN,I IT TO THE USER. LDA B ISOLATE AND B377 TRACK NUMBER AND STA TRACK,I RETURN IT TO USER. STB NCHAR SAVE LUN-TRACK JSB $LIBR TURN MEMORY NOP PROTECT OFF. LDA NCHAR GET LUN-TRACK LSL 7 REFORMAT IT AND STA SFCUN STORE IN BASE PAGE. JSB $LIBX TURN MEMORY PROTECT DEF LSRQ ON AND RETURN. SPC 1 * WRITE TO LS TRACKS SPC 1 BUFFR NOP ADDRESS OF BUFFER WORDS NOP ADDRESS OF WORD COUNT ERROR NOP ADDRESS OF ERROR FLAG SPC 1 LSWRT NOP JSB .ENTR FETCH THE DEF BUFFR PARAMETER ADDRESSES. LDA WORDS,I CONVERT ALS WORD COUNT CMA,INA TO -CHARACTERS STA NCHAR AND SAVE. JSB %WRIS REQUEST DEF *+4 A WRITE DEF BUFFR,I TO LS DEF NCHAR TRACKS. CCA,RSS ERROR RETURN. CLA NORMAL RETURN. STA ERROR,I RETURN ERROR FLAG JMP LSWRT,I RETURN. SPC 1 * WRITE AN EOF IN THE LS TRACK SPC 1 LSEOF NOP ISZ LSEOF ADJUST RETURN ADDRESS JSB %WEOF WRITE EOF JMP LSEOF,I AND RETURN. SPC 1 * INITIALIZE LS TRACKS FOR READING SPC 1 ERR NOP ERROR PARAMETER RETURN ADDRESS SPC 1 LSINT NOP JSB .ENTR FETCH ERROR PARAMETER DEF ERR ADDRESS. CLA,INA SET A FOR ERROR JUST IN CASE. LDB SFCUN ARE LS SZB,RSS TRACKS DEFINE? JMP NOLS NO - EXIT WITH ERROR = 1. JSB %JFIL YES - INITIALIZE TRACKS. CLA CLEAR ERROR RETURN. NOLS STA ERROR,I RETURN ERROR TO USER JMP LSINT,I AND RETURN. SPC 1 * READ A RECORD FROM LS TRACKS SPC 1 BUF NOP BUFFER ADDRESS LEN NOP BUFFER LENGTH ADDRESS IWDS NOP NUMBER OF WORDS READ ADDRESS SPC 1 LSRED NOP JSB .ENTR FETCH THE DEF BUF PARAMETER ADDRESSES. LDB LEN,I FETCH THE BUFFER LENGTH. SSB WORDS OR CHARACTERS? JMP *+3 CHARACTERS - CONTINUE. BLS WORDS - CHANGE TO CMB,INB NEGATIVE CHARACTERS. STB LSEOF SAVE -CHARACTER COUNT. JSB %READ REQUEST DEF *+5 A DEF D2 RECORD DEF BUF,I READ FROM DEF LSEOF LS TRACKS CLB EOF RETURN LDA LEN,I FETCH ORGINAL REQUEST WAS SSA IT WORDS OR CHARACTERS? JMP *+4 CHARACTERS - SKIP CONVERSION. SLB WORDS - IF ODD INB MAKE EVEN AND THEN BRS DIVIDE BY TWO. STB IWDS,I RETURN COUNT TO USER. JMP LSRED,I RETURN SPC 1 * RELEASE LS TRACKS SPC 1 LSREL NOP ISZ LSREL ADJUST RETURN ADDRESS. JSB EXEC ASK DEF *+3 EXEC TO DEF D5 RELEASE ALL DEF N1 TRACKS ASSIGN TO PROGRAM. JMP LSREL,I RETURN SPC 1 * CONSTANTS & CORE ALLOCATION SPC 1 B EQU 1 B377 OCT 377 D2 DEC 2 D5 DEC 5 N1 DEC -1 NCHAR NOP SFCUN EQU 1767B SPC 1 END