TITLE 'ALGOL W MTS RUN-TIME INTERFACE' PRINT NOGEN SPACE *********************************************************************** * * * NUMAC ALGOL W INTERFACE PACKAGE * * (OBJECT PROGRAM TO MTS) * * APRIL 1971 * * * *********************************************************************** SPACE ALGOLX CSECT EXTRN AWXSC001,AWXRCTBL,AWXERROR SPACE USING ALGOLX,15 SAVE (14,12),,* ESTABLISH LINKAGE LR 12,15 USING ALGOLX,12 DROP 15 LR 2,13 L 13,=A(SAVE) ST 13,8(,2) ST 2,4(,13) SPACE BAL 4,ANALYZE DECODE PARAMETER LIST CLI CC,X'FF' TEST FOR CARRIAGE CONTROL BNE X1 LA 1,P133 USE PREFIX (133 BYTE LINES) B X2 X1 LA 1,P132 DISCARD PREFIX (132 BYTE LINES) X2 ST 1,SPRINTP LA 0,3 OBTAIN WORKING STORAGE L 1,FREESIZE CALL GETSPACE ST 1,FREEBASE SET-UP SPACE LIST A 1,FREESIZE ST 1,FREEPTR SPACE MVI XEOF,0 INITIALIZE RUN FLAGS MVI XTRACE,0 MVI XDEBUG,0 MVI PANEL,0 INTERCEPT INTERRUPTIONS LM 0,1,=A(INTEXIT,PANEL) CALL PGNTTRP MVI TQ,0 DISABLE TIMER TRAP L 1,TIMELIM TEST AND SAVE TIME LIMIT LTR 2,1 (NONE IF SIGN BIT SET) BL X3 M 0,=F'76800' CONVERT TO TIMER UNITS D 0,=F'1000' ST 1,TIMELIM MVI PANEL,0 LM 0,1,=A(TIMEEXIT,PANEL) CALL CPUTTRP SET TIME INTERVAL (MS.) X3 CALL TIME,(ZERO,ZERO) INITIALIZE TIMER TS TQ ENABLE TIMER TRAP BNZ X4 LA 1,ENTVECT CALL COMPILED PROGRAM L 15,=V(SEGN001) (INDIRECTLY) BALR 14,15 SPACE X4 MVI TQ,0 DISABLE TIMER TM TIMELIM,X'80' TEST FOR VALID INTERVAL BO X5 SR 0,0 DISABLE TIMER TRAP LR 1,0 CALL CPUTTRP X5 SR 0,0 DISABLE INTERRUPT TRAP LR 1,0 CALL PGNTTRP L 0,FREESIZE RELEASE WORKING STORAGE L 1,FREEBASE CALL FREESPAC L 13,4(,13) RETURN TO MTS RETURN (14,12),RC=0 EJECT *********************************************************************** * THE FOLLOWING ROUTINE DECODES THE PARAMETER LIST AND * * SETS THE STORAGE ALLOCATION PARAMETERS * *********************************************************************** SPACE 2 ANALYZE DS 0H SPACE K EQU 1024 MINSIZE EQU 8*K MINIMUM STORAGE REQUEST STDSIZE EQU 36*K DEFAULT STORAGE REQUEST SPACE L 0,=A(STDSIZE) SET DEFAULT PARAMETERS ST 0,FREESIZE MVI CC,X'FF' ASSUME CARRIAGE CONTROL L 0,=XL4'7FFFFFFF' 'INFINITE' PAGE LIMIT ST 0,PAGELIM MVI TIMELIM,X'80' INDICATE NO TIME LIMIT L 1,0(,1) RECOVER PARAMETERS LH 2,0(,1) LTR 2,2 BZ AN3 (NONE) LA 6,2(2,1) SCAN LIMIT LA 5,1(,1) SPACE AN1 LA 5,1(,5) SCAN TO NON-BLANK CR 5,6 BNL AN3 CLI 0(5),C' ' BE AN1 ST 5,AKEYTEXT DECODE AS A POSSIBLE KEYWORD LA 1,KEYPAR L 15,=V(KEYWRD) BALR 14,15 AN2 CLI 1(5),C' ' SKIP OVER KEYWORD BE AN1 LA 5,1(,5) B AN2 SPACE AN3 L 0,FREESIZE CHECK SPACE N 0,=F'-8' C 0,=A(MINSIZE) FORCE INTO RANGE BNL AN4 L 0,=A(MINSIZE) AN4 ST 0,FREESIZE TOTAL STORAGE REQUEST BR 4 SPACE EXTAB DS 0H KEYWORD EXECUTE TABLE ST 2,TIMELIM ST 2,PAGELIM ST 2,FREESIZE MVI CC,X'FF' MVI CC,0 SPACE LHTAB DS 0X KEYWORD LEFT-HAND TABLE DC AL1(0,0,1),C'T' TIME DC AL1(0,0,4),C'TIME' DC AL1(13,0,1),C'P' PAGES DC AL1(13,0,3),C'PGS' DC AL1(13,0,5),C'PAGES' DC AL1(21,0,4),C'SIZE' SIZE DC AL1(39,0,2),C'CC' CARRIAGE CONTROL DC AL1(42,0,4),C'NOCC' NO CARRIAGE CONTROL SPACE RHTAB DS 0X KEYWORD RIGHT-HAND TABLE DC AL1(4,0,10) TIME DC C'S',AL4(1),C'M',AL4(60) DC AL1(4,4,5) PAGES DC C'/',AL4(1000) DC AL1(4,8,15) SIZE DC C'/',AL4(1000) DC C'K',AL4(1024),C'P',AL4(4096) DC AL1(7,12,0) CC DC AL1(7,16,0) NOCC DC X'FF' SPACE KEYPAR DS 0A KEYWORD PARAMETER LIST DC A(LHTLEN,LHTAB,EXTAB) AKEYTEXT DS A DC A(RHTAB) LHTLEN DC AL2(RHTAB-LHTAB) SPACE DROP 12 EJECT *********************************************************************** * THE FOLLOWING CODE IS ENTERED FOR PROGRAM INTERRUPTIONS * *********************************************************************** SPACE RETA EQU 20 DISPL OF RETURN ADDR IN BLK MARK SPACE 2 INTEXIT DS 0H SPACE USING INTEXIT,15 L 12,=A(ALGOLX) ESTABLISH ADDRESSING USING ALGOLX,12 DROP 15 LA 7,4 INDICATE PROGRAM INTERRUPTION B CX1 CONTINUE WITH COMMON SECTION DROP 12 SPACE 2 TIMEEXIT DS 0H TIMER TRAP EXIT SPACE USING TIMEEXIT,15 TS TQ TEST FOR CRITICAL SECTION BZR 14 IF ZERO, QUEUE AND RETURN L 12,=A(ALGOLX) USING ALGOLX,12 DROP 15 L 13,OLDREG+13*4 SPACE TXPROC LA 0,8 ROUTINE TO PROCESS TIME INT. ST 0,TIMEKEY TEST PROBLEM STATE TIMER CALL TIME,(TIMEKEY,TIMEOPT,MTSTIME) L 0,MTSTIME C 0,TIMELIM CHECK AGAINST LIMIT BNL TX1 MVI OLDPSW,X'FF' LM 0,1,=A(TIMEEXIT,PANEL) LA 2,500 CONTINUE FOR 500 MS. CALL CPUTTRP (NO RETURN) TX1 LA 7,2 INDICATE TIME-OUT SPACE 2 CX1 SR 0,0 SET AWXERROR CODES LA 8,OLDPSW LA 9,OLDREG LM 13,14,OLDREG+13*4 L 15,=V(AWXERROR) CALL ERROR PROCESSOR BALR 2,15 DROP 12 USING *,2 L 12,=A(ALGOLX) DROP 2 USING ALGOLX,12 MVI OLDPSW,X'FF' SET PGNTTRP FOR RESTART LTR 0,0 TEST FOR FATAL ERROR BZ CX2 L 1,OLDREG+12*4 GET RETURN ADDRESS L 1,RETA(,1) ST 1,OLDPSW+4 STORE IN PSW ST 1,OLDREG+1*4 AND R1 CX2 LM 0,1,=A(INTEXIT,PANEL) RESET TRAP AND RESTART CALL PGNTTRP DROP 12 SPACE 2 PANEL DS 18F OLDPSW EQU PANEL+0 INTERRUPTION PSW OLDREG EQU PANEL+8 INTERRUPTION REGISTERS EJECT LTORG ZERO DC F'0' SAVE DS 18F SAVE AREA PROVIDED BY MONITOR TIMELIM DS F EXECUTION TIME LIMIT SPACE ENTVECT DS 0F ENTRY VECTOR PASSED TO LIBRARY RUNFLAGS DS F RUN TIME FLAGS XEOF EQU RUNFLAGS+0 END-OF-FILE XTRACE EQU RUNFLAGS+1 TRACE OPTION (ZERO) XDEBUG EQU RUNFLAGS+2 DEBUG OPTION (ZERO) PAGELIM DS F PAGE LIMIT DC A(PUTLINE) SERVICE ROUTINE ENTRY POINTS DC A(GETCARD) DC A(0) DC A(GETMAIN) DC A(FREEMAIN) DC A(GETTIME) DC A(GETCLOCK) DC 7A(0) RESERVED FOR EXPANSION DC V(AWXSC001) PROGRAM ENTRY POINT DC A(AWXRCTBL) RECORD TABLE ADDRESS EJECT *********************************************************************** * GETCARD * * SUPPLY 80 CHARACTER INPUT RECORD, DETECT SYSTEM CONTROL CARDS * * R0 = ADDRESS OF RECORD DESTINATION, R0(0:0) := 1 FOR EOF * *********************************************************************** SPACE 2 GETCARD DS 0H GET CARD IMAGE SPACE USING GETCARD,3 MVI TQ,0 MTS CRITICAL SECTION STM 12,2,SSAVE LR 2,0 SAVE DESTINATION ADDRESS MVC 0(8,2),=C' ' CLEAR DESTINATION MVC 8(72,2),0(2) CALL SCARDS,(BUFFER,LINELEN,0,LINENO) LTR 15,15 TEST FOR EOF BZ READ1 OI SSAVE+16,X'80' SET EOF BIT B READ5 READ1 LH 1,LINELEN TEST LINE LENGTH LTR 1,1 NULL LINE? BZ READ5 BCTR 1,0 C 1,=F'79' OVER LENGTH? BNH READ4 CLI BUFFER+80,C' ' CHECK FOR NON-BLANKS BNE READ2 S 1,=F'81' BL READ3 EX 1,BLNKTEST BE READ3 READ2 SERCOM '** LINE TRUNCATED - SCARDS' READ3 LA 1,79 TRUNCATE READ4 EX 1,MOVECARD MOVE CHARACTER STRING SPACE READ5 LM 12,2,SSAVE TS TQ BZR 2 L 12,=A(ALGOLX) B TSERVICE SPACE MOVECARD MVC 0(0,2),BUFFER EXECUTED BLNKTEST CLC BUFFER+81(0),BUFFER+80 DROP 3 SPACE 3 *********************************************************************** * PUTLINE * * ACCEPT 132 CHARACTER OUTPUT STRING AND USASI CONTROL CODE * * R0 = ADDRESS OF STRING, R1 = CONTROL CHARACTER * *********************************************************************** SPACE 2 PUTLINE DS 0H PRINT LINE IMAGE SPACE USING PUTLINE,3 MVI TQ,0 MTS CRITICAL SECTION STM 12,2,SSAVE LR 2,0 MVC BUFFER+81(132),0(2) MOVE LINE IMAGE STC 1,BUFFER+80 PREFIX CONTROL CHARACTER L 1,SPRINTP SELECT PARAMETER LIST CALL SPRINT LM 12,2,SSAVE TS TQ BZR 2 L 12,=A(ALGOLX) B TSERVICE SPACE * SPRINT PARAMETER LISTS P132 DC A(BUFFER+81,H132,0) 132 BYTE LINES P133 DC A(BUFFER+80,H133,0) 133 BYTE LINES (@CC) H132 DC H'132' H133 DC H'133' DROP 3 SPACE 3 *********************************************************************** * GETMAIN * * SUPPLY VARIABLE-LENGTH FREE STORAGE AREA (NESTED ALLOCATION) * * R0,R1 = MINIMUM, MAXIMUM LENGTH, R0 := ADDRESS, R1 := LENGTH * *********************************************************************** SPACE 2 GETMAIN DS 0H OBTAIN FREE STORAGE SPACE USING GETMAIN,3 L 0,FREEPTR LOWEST ALLOCATED LOCATION SR 0,1 TRY MAXIMUM REQUEST C 0,FREEBASE BNL GM1 L 0,FREEBASE OTHERWISE, GIVE ALL REMAINING GM1 L 1,FREEPTR UPDATE POINTER ST 0,FREEPTR SR 1,0 COMPUTE AREA SIZE BR 2 DROP 3 SPACE 3 *********************************************************************** * FREEMAIN * * RETURN FREE STORAGE AREA TO SYSTEM (NESTED ALLOCATION) * * R0 = ADDRESS, R1 = LENGTH * *********************************************************************** SPACE 2 FREEMAIN DS 0H RELEASE FREE STORAGE SPACE USING FREEMAIN,3 A 1,FREEPTR ADD SPACE BACK ST 1,FREEPTR UPDATE POINTER BR 2 DROP 3 SPACE 3 *********************************************************************** * GETTIME * * OBTAIN ELAPSED TIME IN OS TIMER UNITS (1 OS TU = 2 MACHINE TU) * * R0 := ELAPSED TIME * *********************************************************************** SPACE 2 GETTIME DS 0H GET ELAPSED COMPILATION TIME SPACE USING GETTIME,3 MVI TQ,0 MTS CRITICAL SECTION STM 12,2,SSAVE LA 0,8 ST 0,TIMEKEY OBTAIN PROBLEM STATE TIME CALL TIME,(TIMEKEY,TIMEOPT,MTSTIME) L 0,MTSTIME SRL 0,1 CONVERT TO OS TU LM 12,15,SSAVE LM 1,2,SSAVE+20 TS TQ BZR 2 ST 0,SSAVE+16 SET RESULT REGISTER L 12,=A(ALGOLX) B TSERVICE DROP 3 SPACE 3 *********************************************************************** * GETCLOCK * * OBTAIN TIME OF DAY IN OS TIMER UNITS (1 OS TU = 2 MACHINE TU) * * R0 := TIME OF DAY * *********************************************************************** SPACE 2 GETCLOCK DS 0H GET TIME OF DAY SPACE USING GETCLOCK,3 MVI TQ,0 MTS CRITICAL SECTION STM 12,2,SSAVE LA 0,4 ST 0,TIMEKEY OBTAIN TIME OF DAY CALL TIME,(TIMEKEY,TIMEOPT,MTSTIME) PACK CLOCK(8),MTSTIME(2) HOURS MP CLOCK(8),=PL2'60' PACK TEMP(2),MTSTIME+3(2) MINUTES AP CLOCK(8),TEMP(2) MP CLOCK(8),=PL2'60' PACK TEMP(2),MTSTIME+6(2) SECONDS AP CLOCK(8),TEMP(2) CVB 1,CLOCK M 0,=F'38400' CONVERT TO TIMER UNITS LR 0,1 LM 12,15,SSAVE LM 1,2,SSAVE+20 TS TQ BZR 2 ST 0,SSAVE+16 SET RESULT REGISTER L 12,=A(ALGOLX) B TSERVICE DROP 3 SPACE 4 USING ALGOLX,12 TSERVICE ST 2,OLDPSW+4 SET-UP STATUS AREA NI OLDPSW+4,X'CF' ZERO CONDITION CODE MVC OLDREG(12),SSAVE+16 STM 3,11,OLDREG+3*4 MVC OLDREG+12*4(16),SSAVE SR 0,0 ST 0,OLDPSW B TXPROC PROCESS TIMER INTERRUPT DROP 12 SPACE 4 LTORG TIMEOPT DC F'0' TIME OPTION (NO PRINTING) EJECT BUFFER DS CL256 CARD AND LINE BUFFER CLOCK DS D DECIMAL TIMER VALUE MTSTIME DS 5F BINARY/BCD TIMER VALUES TIMEKEY DS F TIMER OPTION TIMEINIT DS F INITIAL TIMER SETTING SSAVE DS 7F LOCAL SAVE AREA FREESIZE DS F TOTAL SIZE OF WORKING STORE FREEBASE DS A BASE OF WORKING STORE FREEPTR DS A TOP OF FREE STORAGE SPRINTP DS A SPRINT PARAMETER LOCATION LINENO DS F MTS LINE NUMBER LINELEN DS H MTS LINE LENGTH TEMP DS 2X DECIMAL TEMPORARY CC DS X SET IFF SPRINT USES CC TQ DS X TIMER TRAP SWITCH END ALGOLX