TITLE 'ALGOL W MTS INTERFACE' PRINT NOGEN GETELT EQU 38 SPACE *********************************************************************** * * * NUMAC ALGOL W SUBMONITOR * * MTS INTERFACE * * MARCH 1971 * * * *********************************************************************** SPACE 2 XALGOLW CSECT EXTRN LOADDATA SPACE USING XALGOLW,15 SAVE (14,12),,* ESTABLISH IBM CONVENTIONS LR 12,15 USING XALGOLW,12 DROP 15 LR 2,13 L 13,=A(SAVE) ST 13,8(,2) ST 2,4(,13) L 11,=A(LOADDATA) ESTABLISH LOADER COMMON BASE USING COMMON,11 SPACE MVI ENDDS,0 INITIALIZE READER FLAGS MVI CONTCARD,0 INITIALIZE JOB FLAGS MVI EOF,0 MVI GOTACARD,0 NO PENDING CARD IMAGE CALL INITPCNT INITIALIZE PAGE COUNTER * * INSURE THAT FIRST CARD IS "/COMPILE" * LA 0,CONBUFF WHERE TO READ CARD INTO L 3,=A(GETCARD) BALR 2,3 LTR 0,0 END OF FILE? BM CLEANUP YES. STOP CLI CONTCARD,X'FF' /COMPILE? BE I1 YES * * NO "/COMPILE" CARD * CLC =C'$ALGOL',CONBUFF USING WROG CONTROL CARDS? BE BADCNTL YES. * SERCOM 'NO "/COMPILE" CARD. ONE HAS BEEN ASSUMED.' MVC CONBUFF(9),=C'/COMPILE ' GENERATE ONE IN BUFFER MVC CONBUFF+9(71),CONBUFF+8 FOLLOWED BY BLANKS MVI GOTACARD,X'FF' REMEMBER CARD IN "BUFFER" B I1 SPACE BADCNTL SERCOM ' *XALGOLW CONTROL CARDS HAVE BEEN CHANGED:' SERCOM ' FROM "$ALGOL" TO "/COMPILE"' SERCOM ' FROM "$DATA" TO "/EXECUTE"' SYSTEM EJECT *********************************************************************** * THE FOLLOWING CODE SCHEDULES EACH JOB THROUGH THE SUBSYSTEM, * * DECODING CONTROL CARDS AND MANAGING STORAGE ALLOCATION. * *********************************************************************** SPACE 2 LOOP DS 0H PROCESSING CYCLES HERE FOR JOB SPACE CLI CONTCARD,X'FF' TEST FOR CONTROL CARD IN BUFFER BE I1 LA 0,CONBUFF READ TO CONTROL CARD L 3,=A(GETCARD) BALR 2,3 B LOOP SPACE I1 MVI CONTCARD,0 BAL 4,ANALYZE ANALYZE CONTROL CARD INFO LA 0,3 OBTAIN MEMORY FOR JOB L 1,FREESIZE CALL GETSPACE ST 1,FREEBASE A 1,FREESIZE SET WORK AND COMMON BOUNDS LR 0,1 S 0,COMMSIZE ST 0,FREEPTR STM 0,1,COMMLIM SPACE MVI EOF,0 LA 0,6 GET TIME AND DATE ST 0,TIMEKEY CALL TIME,(TIMEKEY,TIMEOPT,MTSTIME) MVI RUNID,C' ' SET ID STRING MVC RUNID+1(31),RUNID MVC RUNID+10(2),MTSTIME+12 DAY MVC RUNID+13(3),MTSTIME+8 MONTH MVC RUNID+17(2),MTSTIME+18 YEAR MVI RUNID+21,C'@' MVC RUNID+24(5),MTSTIME TIME EJECT *********************************************************************** * THE FOLLOWING CODE CONTROLS LOADING OF THE COMPILER PHASES * *********************************************************************** SPACE 2 COMPILE DS 0H EXECUTE COMPILER PHASES SPACE MVI PANEL,0 SET FAILURE EXIT LM 0,1,=A(COMPERR,PANEL) CALL PGNTTRP MVI NOGO,0 RESET ERROR FLAG CALL LOAD,(DPHASEA,0,LOADSW,0) LOAD PHASE A ST 15,EPA ST 0,SI#A SPACE LM 0,1,=CL8'1 ' CHECK UNIT 1 SPECIFICATION CALL GDINFO LTR 15,15 BZ FS1 SR 2,2 SELECT SPRINT FOR OUTPUT B FS2 FS1 LA 2,4 SELECT UNIT 1 FOR OUTPUT MVC FDUB(4),0(1) SAVE FDUB POINTER SR 0,0 CALL FREESPAC RELEASE SPACE FS2 ST 2,PRINTX SPACE SVC GETELT GET CURRENT CPU TIME AR 0,1 ADD SUPERVISOR AND PROBLEM STATE TIME ST 1,TIMEBASE REMEMBER TIME AT BEGINNING OF COMPILE SR 0,0 MASK INTERRUPTIONS SPM 0 LA 1,ENTVECT PARAMETER LIST L 15,EPA BALR 14,15 EXECUTE PHASE A LTR 15,15 TEST FOR ERRORS BZ CA MVI NOGO,X'FF' CA CALL UNLOAD,(0,SI#A,0) UNLOAD PHASE A CLI NOGO,X'FF' BE X7 SPACE * INITIALIZE VARIABLES FOR LOADER COROUTINE (LOADCARD) * MVI BLANK,C' ' L 0,=F'-16' MARK ESDTABLE EMPTY ST 0,ESDINDEX L 0,COMMLIM+4 SET UP STORAGE BOUNDS ST 0,LOCORE ST 0,HICORE ST 0,LOADBASE MVI ENTRYSET,0 SET LOADER STATUS FLAGS MVI LOADERR,0 MVI INIT,X'FF' MVC ERRBUF(132),BLANK LA 0,8 SELECT SERCOM FOR OUTPUT ST 0,PRINTX SPACE CALL LOAD,(DPHASEB,0,LOADSW,0) LOAD PHASE B ST 0,SI#B LA 1,ENTVECT PARAMETER LIST BALR 14,15 EXECUTE PHASE B LTR 15,15 BZ CB MVI NOGO,X'FF' CB CALL UNLOAD,(0,SI#B,0) UNLOAD PHASE B CLI NOGO,X'FF' BE X7 IF ERRORS, ABORT EJECT *********************************************************************** * THE FOLLOWING CODE PROCESSES ANY OBJECT CARDS, LOADS * * ALGOLRUN, AND EXECUTES THE COMPILED PROGRAM * *********************************************************************** SPACE 2 LOADTEXT DS 0H LOAD OBJECT CARDS, EXECUTE SPACE X1 CLI EOF,X'FF' TEST FOR END-OF-FILE BE X2 LA 0,CONBUFF L 3,=A(GETCARD) BALR 2,3 B X1 SPACE X2 L 4,LOADBASE BASE OF COMPILED PROGRAM N 4,=F'-8' ST 4,FREEPTR FREE UNUSED COMMON MVC NOLOAD(1),LOADERR SAVE ERROR STATUS CLI NOLOAD,0 TEST FOR ERRORS BNE X4 IF ANY, BYPASS LOADING LIBRARY CALL LOAD,(DRUNLIB,0,LOADSW,0) LOAD LIBRARY MODULE ST 0,SI#R STORAGE INDEX NUMBER L 2,DERROR(,15) SAVE ERROR ENTRY ADDRESS ST 2,AERROR L 2,DDATA(,15) AND DATA SEGMENT ADDRESS ST 2,ARUNDSEG LR 0,15 R15 = ENTRY POINT X4 LA 1,ENTVECT MERGE DIRECTORIES, FILL ENTVECT, L 15,=V(ENDLOAD) COMPLETE LOAD PROCESSING BALR 14,15 CLI LOADERR,0 BYPASS EXECUTION IF ERRORS BNE X5 SPACE LA 2,12 SELECT SPRINT FOR OUTPUT ST 2,PRINTX MVI PANEL,0 INTERCEPT ALL INTERRUPTIONS LM 0,1,=A(INTEXIT,PANEL) CALL PGNTTRP * * DETERMINE ACTUAL PAGE ESTIMATE * CALL GPAGSLFT GET MTS REMAINING PAGES S 0,=F'1' LEAVE ROOM FOR ONE PAGE BP *+8 LA 0,1 USE AT LEAST 1 C 0,XPLIM COMPARE WITH DECLARED PAGE EST BL *+8 L 0,XPLIM USE SMALLEST ST 0,PAGELIM MVC EOF(1),CONTCARD SET EXECUTION EOF OC EOF(1),ENDDS MVC XEOF(1),EOF SET RUN FLAGS MVI XTRACE,0 MVC XDEBUG(1),ENTVECT+56 MVI ENTVECT+56,0 * * DETERMINE ACTUAL TIME ESTIMATE * CALL GTIMEST GET MTS TIME REMAINING S 0,=F'76800' SUBTRACT 1 SECOND BP *+8 LA 0,4095 USE AT LEAST .053 SECS C 0,XTLIM COMPARE WITH DECLARED TIME EST BH *+8 ST 0,XTLIM USE LOWEST MVI TQ,0 DISABLE TIMER TRAP * * START THE EXECUTION TIMER * LA 1,=A(CODE,EXITID,XTLIM,EXITAREA) CALL SETIME CREATE TIMER INTERRUPT LM 15,1,TIMNTPAR BALR 14,15 EMABLE TIMER INTERRUPT * SVC GETELT GET CPU TIME AR 1,0 ADD SUPERVISOR AND PROBLEM STATE TIME ST 1,TIMEBASE REMEMBER TIME AT BEGINNING OF EXECUTI N * TS TQ ENABLE TIMER TRAP BNZ XX LESS THAN 1 SECOND REMAINING LA 1,ENTVECT L 15,ENTRYPT CALL COMPILED PROGRAM BALR 14,15 XX MVI TQ,0 DISABLE TIMER * LA 1,=A(EXITID,XTLIM,EXITAREA) CALL RSTIME DESTROY TIMER INTERRUPT SR 0,0 LR 1,0 CALL PGNTTRP DISABLE INTERRUPT TRAP B X6 SPACE X5 LA 0,ERRBUF PRINT ERROR MESSAGE LA 1,C'1' L 3,=A(PUTLINE) BALR 2,3 SPACE X6 CLI NOLOAD,0 DELETE LIBR MODULE IF LOADED BNE X7 CALL UNLOAD,(0,SI#R,0) X7 L 0,FREESIZE RELEASE MEMORY AREA L 1,FREEBASE CALL FREESPAC B LOOP CYCLE TO NEXT JOB SPACE DERROR EQU 8 DISPL OF ERROR ENTRY ADDR DDATA EQU 12 DISPL OF DATA SEGMENT ADDR SPACE TIMNTPAR DC V(TIMNTRP) DC A(TIMEEXIT) EXITAREA DC A(TIMEID) CODE DC F'4' EXITID DC F'4' EJECT *********************************************************************** * THE FOLLOWING CODE RELEASES RESOURCES AND TERMINATES * *********************************************************************** SPACE 2 CLEANUP DS 0H TERMINATE SUBSYSTEM SPACE L 13,4(,13) RETURN (14,12),RC=0 EJECT *********************************************************************** * THE FOLLOWING CODE IS ENTERED FOR COMPILER ERRORS * *********************************************************************** SPACE 2 COMPERR DS 0H SPACE USING COMPERR,15 LM 11,13,=A(LOADDATA,XALGOLW,SAVE) RESTORE ADDRESSING DROP 15 L 3,=A(PUTLINE) PREPARE FOR PRINTING MVI BLANK,C' ' MVC ERRBUF(132),BLANK MVC ERRBUF(30),=C'** COMPILER ERROR. JOB ABORTED.' LA 0,ERRBUF LA 1,C'1' BALR 2,3 MVC ERRBUF(41),BLANK LR 1,0 DISPLAY PSW L 0,OLDPSW BAL 4,UNPACK L 0,OLDPSW+4 BAL 4,UNPACK LA 0,ERRBUF LA 1,C'0' BALR 2,3 SR 5,5 DISPLAY GENERAL REGISTERS LA 6,4 CERR1 LR 1,0 MVC ERRBUF(132),BLANK LA 7,4 CERR2 L 0,OLDREG(5) BAL 4,UNPACK LA 5,4(,5) BCT 7,CERR2 LA 0,ERRBUF LA 1,C' ' BALR 2,3 BCT 6,CERR1 B X7 SPACE UNPACK ST 0,TEMP UNPACK HEX NUMBER IN R0 UNPK 0(9,1),TEMP(5) TO ADDRESS IN R1 TR 0(8,1),DECTOHEX-240 MVI 8(1),C' ' LA 1,12(,1) STEP DESTINATION POINTER BR 4 DECTOHEX DC C'0123456789ABCDEF' EJECT *********************************************************************** * THE FOLLOWING CODE ANALYZES TIME AND LINE LIMITS ON CONT CARD * * R4 = RETURN ADDRESS, XTLIM := TIME, XPLIM := LINES * *********************************************************************** SPACE 2 ANALYZE DS 0H SPACE K EQU 1024 CMIN EQU 18*K MINIMUM COMMON SIZE WMIN EQU 12*K MINIMUM SCRATCH SIZE WMAX EQU 24*K MAXIMUM SCRATCH SIZE STDSIZE EQU 48*K DEFAULT STORAGE REQUEST SPACE L 0,=X'0FFFFFFF' HUGE DEFAULT TIME EST ST 0,XTLIM L 0,=X'7FFFFFFF' HUGE DEFAULT PAGE EST ST 0,XPLIM L 0,=A(STDSIZE) ST 0,SIZE MVI CONBUFF+80,C' ' STOP SCAN HERE LA 5,CONBUFF+8 SPACE AN1 LA 5,1(,5) SCAN TO NON-BLANK C 5,=A(CONBUFF+80) 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,SIZE CHECK AND SPLIT SPACE N 0,=F'-8' C 0,=A(CMIN+WMIN) FORCE INTO RANGE BNL AN4 L 0,=A(CMIN+WMIN) AN4 ST 0,FREESIZE TOTAL STORAGE REQUEST S 0,=A(WMIN) COMPUTE COMMON SIZE LR 1,0 S 1,=A(2*CMIN) FIRST CMIN EXTRA TO COMMON BL AN6 SRA 1,5 REMAINDER/32 TO WORK SPACE N 1,=F'-8' C 1,=A(WMAX-WMIN) (OR MAXIMUM USEFUL) BNH AN5 L 1,=A(WMAX-WMIN) AN5 SR 0,1 SUBTRACT WORK AREA INCREMENT AN6 ST 0,COMMSIZE SAVE COMMON SIZE BR 4 SPACE EXTAB DS 0H KEYWORD EXECUTE TABLE ST 2,XTLIM ST 2,XPLIM ST 2,SIZE BCR 0,0 ***** NO-OP FOR ACCOUNT 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(23,0,1),C'P' PAGES DC AL1(23,0,3),C'PGS' DC AL1(23,0,5),C'PAGES' DC AL1(31,0,4),C'SIZE' SIZE DC AL1(49,0,0) ACCOUNT NUMBER SPACE RHTAB DS 0X KEYWORD RIGHT-HAND TABLE DC AL1(4,0,20) TIME DC C'S',AL4(1),C'M',AL4(60) DC C'*',AL4(768) DC C'/',AL4(10) 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(8,12,0) ***** NO-OP FOR ACCOUNT NO. 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 11 DROP 12 EJECT *********************************************************************** * THE FOLLOWING CODE IS ENTERED FOR PROGRAM INTERRUPTIONS * *********************************************************************** SPACE RETA EQU 20 DISPL OF RETURN ADDR IN BLK MARK TERMFLAG EQU X'F0' OFFSET IN ROOT DATA SEGMENT SPACE 2 INTEXIT DS 0H SPACE USING INTEXIT,15 L 12,=A(XALGOLW) ESTABLISH ADDRESSING USING XALGOLW,12 DROP 15 L 13,OLDREG+13*4 LA 0,7 TEST FOR DATA EXCEPTION CH 0,OLDPSW+2 BNE IX1 SPACE MVI OLDPSW,0 RE-ENABLE TRAP LM 0,1,=A(INTEXIT,PANEL) CALL PGNTTRP L 0,OLDPSW+4 CORRECT PSW TO RETRY 'AP' SL 0,=F'6' ST 0,OLDPSW+4 SR 0,0 LR 7,0 SET CODES FOR TRACING LA 8,OLDPSW (PANEL INTACT) LA 9,OLDREG L 15,AERROR START TRACE ROUTINE BR 15 (NO RETURN) SPACE IX1 LA 7,4 INDICATE PROGRAM INTERRUPTION B CX1 CONTINUE WITH COMMON SECTION DROP 12 EJECT * TIME ESTIMATE EXCEEDED * SPACE TIMEEXIT DS 0H TIMER TRAP EXIT SPACE USING TIMEEXIT,15 TS TQ TEST FOR CRITICAL SECTION BZR 14 IF ZERO, QUEUE AND RETURN STM 14,12,12(13) ST 13,SAVE13 L 12,=A(XALGOLW) USING XALGOLW,12 DROP 15 L 13,OLDREG+13*4 SPACE * ROUTINE TO PROCESS TIME INTERRUPTION TXPROC CLI TERMFLAG(13),X'FF' TEST FOR POST-MORTEM PROCESSING BNE TX2 NO. GENERATE ERROR COMMENT * * WE ARE IN MIDDLE OF POST MORTEM * MAY AS WELL FINISH UP * L 13,SAVE13 LM 14,12,12(13) BR 14 SPACE SAVE13 DS F SPACE TX2 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,AERROR CALL ERROR PROCESSOR BALR 2,15 DROP 12 USING *,2 L 12,=A(XALGOLW) DROP 2 USING XALGOLW,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 TIMEID DS F PANEL DS 18F OLDPSW EQU PANEL+0 INTERRUPTION PSW OLDREG EQU PANEL+8 INTERRUPTION REGISTERS EJECT LTORG SAVE DS 18F SAVE AREA PROVIDED BY MONITOR DPHASEA DC CL16'*AWXCMPA2 ' PHASE A FILE ID DPHASEB DC CL16'*AWXCMPB2 ' PHASE B FILE ID DRUNLIB DC CL16'*AWXLIBR2 ' LIBRARY FILE ID ZERO DC F'0' LOADSW DC XL4'00000019' LOADING OPTIONS SPACE XTLIM DS F EXECUTION TIME LIMIT XPLIM DS F EXECUTION PAGE LIMIT SIZE DS F PARAMETRIC STORAGE REQUEST COMMSIZE DS F COMMON AREA SIZE SI#A DS F PHASE A STORAGE INDEX SI#B DS F PHASE B STORAGE INDEX SI#R DS F LIBRARY STORAGE INDEX EPA DS A PHASE A ENTRY POINT RUNID DS CL32 SYSTEM IDENTIFICATION NOGO DS X COMPILATION ERROR FLAG NOLOAD DS X NON-ZERO IFF LIBRARY NOT LOADED SPACE ENTVECT DS 0F ENTRY VECTOR PASSED TO COMPILER COMMLIM DS 2F COMMON LIMITS XEOF EQU COMMLIM+0 EXECUTION END-OF-FILE XTRACE EQU COMMLIM+1 EXECUTION TRACE OPTION XDEBUG EQU COMMLIM+2 EXECUTION DEBUG OPTION PAGELIM EQU COMMLIM+4 EXECUTION LINE LIMIT DC A(PUTLINE) SERVICE ROUTINE ENTRY POINTS DC A(GETCARD) DC A(PUTCARD) DC A(GETMAIN) DC A(FREEMAIN) DC A(GETTIME) DC A(GETCLOCK) DC 6A(0) RESERVED FOR EXPANSION DC X'00',AL3(RUNID) SYSTEM IDENTIFICATION DS A ENTRY ADDR (SET BY ENDLOAD) DS A RECTAB ADDR (SET BY ENDLOAD) SPACE 2 * THE FOLLOWING SECTION CONTAINS THE VARIABLES SHARED BY THE * * MONITOR AND THE PL360 LOADER PROCEDURES * SPACE COMMON DSECT SPACE DS 0D COMMON DATA SEGMENT ESDTABLE DS 384F GLOBAL SYMBOL DICTIONARY ESDINDEX DS F ESD TABLE INDEX LOCORE DS F LOAD AREA BOUNDS HICORE DS F LOADBASE DS F LOWEST LOADED ADDRESS ENTRYPT DS F LOADED PROGRAM ENTRY POINT ENTRYSET DS X SET IFF ENTRY ADDR VALID INIT DS X SET TO INITIALIZE LOADER TABLES LOADERR DS X NON-ZERO IFF LOADING ERROR BLANK DS C ERRBUF DS CL132 ASSEMBLY AREA FOR ERROR MESSAGES SPACE XALGOLW CSECT 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 CLI ENDDS,X'FF' TEST FOR PREVIOUS END OF DS BNE READ1 L 12,=A(XALGOLW) REESTABLISH ADDRESSING USING XALGOLW,12 B CLEANUP TERMINATE SUBSYSTEM DROP 12 SPACE READ1 LR 2,0 SAVE DESTINATION ADDRESS MVC 0(8,2),=C' ' CLEAR TARGET STRING MVC 8(72,2),0(2) CLI GOTACARD,X'FF' GAT A CARD ALREADY? BE READ2A YES. USE IT CALL SCARDS,(BUFFER,LINELEN,0,LINENO) LTR 15,15 TEST FOR END OF DS BZ READ2 READEOF MVI ENDDS,X'FF' SET FLAG MVC 0(8,2),=C'/EXECUTE' RETURN EOF RECORD B READ6 SPACE READ2A MVI GOTACARD,0 READ2 LH 1,LINELEN TEST LINE LENGTH LTR 1,1 NULL LINE? BZ READ6 BCTR 1,0 C 1,=F'79' OVER LENGTH? BNH READ5 CLI BUFFER+80,C' ' CHECK FOR NON-BLANKS BNE READ3 S 1,=F'81' BL READ4 EX 1,BLNKTEST BE READ4 READ3 SERCOM '** SCARDS LINE TRUNCATED TO 80 CHARACTERS' READ4 LA 1,79 TRUNCATE LINE READ5 EX 1,MOVECARD MOVE CHARACTER STRING SPACE READ6 CLI 0(2),C'/' TEST FOR CONTROL CARDS BNE READ8 CLC 0(4,2),=C'/END' BE READEOF CLC 0(8,2),=C'/EXECUTE' BE READ7 CLC 0(9,2),=C'/COMPILE ' BNE READ8 MVI CONTCARD,X'FF' MVC CONBUFF(80),0(2) SAVE '/COMPILE' CARD READ7 MVI EOF,X'FF' SET END-OF-FILE OI SSAVE+16,X'80' READ8 LM 12,2,SSAVE TS TQ BZR 2 L 12,=A(XALGOLW) 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 SAVE ADDRESS MVC BUFFER+81(132),0(2) MOVE LINE IMAGE STC 1,BUFFER+80 PREFIX CONTROL CHARACTER L 15,PRINTX SELECT OUTPUT STREAM C 15,=F'8' BNL WRITE NOT LISTING - NO SWITCH CLI BUFFER+80,C'1' CHECK FOR DIAGNOSTICS BNE WRITE CLC BUFFER+127(23),=C'COMPILATION DIAGNOSTICS' BNE WRITE LA 15,8 SELECT SERCOM ST 15,PRINTX WRITE B *+4(15) B SPRINT B UNIT1 B SERCOM B SPRINT UNIT1 CALL WRITE,(BUFFER+80,H133,0,LINENO,FDUB) B WRITE0 SERCOM CALL SERCOM,(BUFFER+80,H133,0) B WRITE0 SPRINT CALL SPRINT,(BUFFER+80,H133,0) WRITE0 LM 12,2,SSAVE TS TQ REENABLE TIMER BZR 2 L 12,=A(XALGOLW) B TSERVICE H133 DC H'133' DROP 3 SPACE 3 *********************************************************************** * PUTCARD * * ACCEPT 80 CHARACTER OBJECT OUTPUT STRING * * R0 = ADDRESS OF STRING, R1 = ADDRESS OF HIGHEST COMMON IN USE * *********************************************************************** SPACE 2 PUTCARD DS 0H PUNCH CARD IMAGE SPACE USING PUTCARD,3 STM 11,15,SSAVE SAVE REGISTERS L 15,=V(LOADCARD) PROCESS CARD IMAGE BALR 14,15 (R11, R14, R15 DESTROYED) LM 11,15,SSAVE BR 2 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 SVC GETELT GET TIME AR 0,1 ADD SUPERVISOR AND PROBLEM TIMES S 0,TIMEBASE GET RELATIVE TO BASE 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(XALGOLW) 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(XALGOLW) B TSERVICE DROP 3 SPACE 4 USING XALGOLW,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 CLI TERMFLAG(13),X'FF' BER 2 SR 0,0 ST 0,OLDPSW B TX2 PROCESS TIMER INTERRUPT DROP 12 SPACE 4 LTORG TIMEOPT DC F'0' TIME OPTION (NO PRINTING) EJECT BUFFER DS CL256 CARD AND LINE BUFFER CONBUFF DS CL81 CONTROL CARD BUFFER CLOCK DS D DECIMAL TIMER VALUE TIMEBASE DS F TIME AT BEG OF COMPILE OR EXECUTE MTSTIME DS 5F BINARY/BCD TIMER VALUES TIMEKEY DS F TIMER OPTION AERROR DS A ADDR OF ALGOLRUN ERROR PROCESSOR ARUNDSEG DS A ADDR OF ALGOLRUN FIXED DATA SEG 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 PRINTX DS F OUTPUT STREAM INDEX FDUB DS A LINENO DS F MTS LINE NUMBER LINELEN DS H MTS LINE LENGTH TEMP DS F SHARED TEMPORARY CONTCARD DS X ON IF CONBUFF FILLED EOF DS X READER END-OF-FILE FOR JOB ENDDS DS X READER END-OF-FILE FOR SYSTEM TQ DS X TIMER CRITICAL SECTION SWITCH GOTACARD DS X FIRST CARD WASNT "/COMPILE" QUILT DS XL40 END XALGOLW